diff --git a/pitfall/pitfall/color.rkt b/pitfall/pitfall/color.rkt index d03ee5f7..dd729088 100644 --- a/pitfall/pitfall/color.rkt +++ b/pitfall/pitfall/color.rkt @@ -15,7 +15,9 @@ _setColor _setColorSpace fillColor + strokeColor fillOpacity + strokeOpacity _doOpacity))) @@ -56,7 +58,7 @@ (define/contract (_setColor this color stroke) - (color-string? (or/c #f number?) . ->m . boolean?) + (color-string? (or/c boolean? number?) . ->m . boolean?) (let ([color (_normalizeColor color)] [op (if stroke "SCN" "scn")]) (cond @@ -93,12 +95,26 @@ this) +(define/contract (strokeColor this color [opacity 1]) + ((color-string?) ((or/c number? #f)) . ->*m . object?) + (unless (_normalizeColor color) + (raise-argument-error 'strokeColor "valid color string" color)) + (when (_setColor this color #t) (strokeOpacity this opacity)) + this) + + (define/contract (fillOpacity this opacity) ((or/c number? #f) . ->m . object?) (_doOpacity this opacity #f) this) +(define/contract (strokeOpacity this opacity) + ((or/c number? #f) . ->m . object?) + (_doOpacity this #f opacity) + this) + + (define/contract (_doOpacity this fillOpacity strokeOpacity) ((or/c number? #f) (or/c number? #f) . ->m . object?) (when (or fillOpacity strokeOpacity) diff --git a/pitfall/pitfall/helper.rkt b/pitfall/pitfall/helper.rkt index 08b1dfdf..db91db1b 100644 --- a/pitfall/pitfall/helper.rkt +++ b/pitfall/pitfall/helper.rkt @@ -159,4 +159,7 @@ (begin (as-method id) ...)) (define (color-string? x) - (and (string? x) (or (= (string-length x) 4) (= (string-length x) 7)) (string-prefix? x "#"))) \ No newline at end of file + (and (string? x) + (if (string-prefix? x "#") + (or (= (string-length x) 4) (= (string-length x) 7)) + #t))) \ No newline at end of file diff --git a/pitfall/pitfall/test/test2rkt.pdf b/pitfall/pitfall/test/test2rkt.pdf index e69de29b..711ed54c 100644 --- a/pitfall/pitfall/test/test2rkt.pdf +++ b/pitfall/pitfall/test/test2rkt.pdf @@ -0,0 +1,131 @@ +%PDF-1.3 +%ÿÿÿÿ +6 0 obj +<< +/ca 0.8 +/Type /ExtGState +>> +endobj +7 0 obj +<< +/ca 1 +/Type /ExtGState +>> +endobj +8 0 obj +<< +/CA 1 +/Type /ExtGState +>> +endobj +5 0 obj +<< +/Parent 1 0 R +/Resources 4 0 R +/Contents 3 0 R +/MediaBox [0 0 612 792] +/Type /Page +>> +endobj +4 0 obj +<< +/ExtGState << +/Gs2 7 0 R +/Gs1 6 0 R +/Gs3 8 0 R +>> +/ProcSet [/PDF /Text /ImageB /ImageC /ImageI] +>> +endobj +3 0 obj +<< +/Length 595 +>> +stream +1 0 0 -1 0 792 cm +0 20 m +100 160 l +130 200 150 120 v +190 -40 200 200 300 150 c +400 90 l +S +1 0 0 1 0 200 cm +1 0 0 1 0 200 cm +100 0 m +50 100 l +150 100 l +h +S +q +1 0 0 1 200 0 cm +50 50 m +50 22.385763 72.385763 0 100 0 c +127.614237 0 150 22.385763 150 50 c +150 77.614237 127.614237 100 100 100 c +72.385763 100 50 77.614237 50 50 c +h +[5 10] 0 d +S +Q +q +1 0 0 1 400 0 cm +50 50 m +50 22.385763 72.385763 0 100 0 c +127.614237 0 150 22.385763 150 50 c +150 77.614237 127.614237 100 100 100 c +72.385763 100 50 77.614237 50 50 c +h +#3 +/Gs1 gs +/DeviceRGB cs +1 0 0 scn +/Gs2 gs +/DeviceRGB CS +0.6 0 0 SCN +/Gs3 gs +B +Q + +endstream +endobj +9 0 obj +<< +/CreationDate (D:19700101000000Z) +/Creator (PitfallKit) +/Producer (PitfallKit) +>> +endobj +2 0 obj +<< +/Pages 1 0 R +/Type /Catalog +>> +endobj +1 0 obj +<< +/Kids [5 0 R] +/Count 1 +/Type /Pages +>> +endobj +xref +0 10 +0000000000 65535 f +0000001165 00000 n +0000001116 00000 n +0000000370 00000 n +0000000253 00000 n +0000000149 00000 n +0000000015 00000 n +0000000061 00000 n +0000000105 00000 n +0000001016 00000 n +trailer +<< +/Info 9 0 R +/Root 2 0 R +/Size 10 +>> +startxref +1222 +%%EOF diff --git a/pitfall/pitfall/vector.rkt b/pitfall/pitfall/vector.rkt index e98e792d..5d29d29d 100644 --- a/pitfall/pitfall/vector.rkt +++ b/pitfall/pitfall/vector.rkt @@ -12,6 +12,7 @@ save restore closePath + lineWidth dash moveTo lineTo @@ -24,6 +25,7 @@ _windingRule fill stroke + fillAndStroke transform translate scale))) @@ -57,6 +59,11 @@ (send this addContent "h")) +(define/contract (lineWidth this w) + (number? . ->m . object?) + (send this addContent (format "#~a" (number w)))) + + (define/contract (dash this length [options (mhash)]) (((or/c number? (listof number?) #f)) (hash?) . ->*m . object?) (cond @@ -157,6 +164,13 @@ (send this addContent "S")) +(define/contract (fillAndStroke this [fill #f] [stroke fill] #:rule [rule #f]) + (() ((or/c color-string? #f) (or/c color-string? #f) #:rule (or/c string? #f)) . ->*m . object?) + (when fill + (send* this [fillColor fill] [strokeColor stroke])) + (send this addContent (format "B~a" (_windingRule rule)))) + + (define tm/c (list/c number? number? number? number? number? number?)) (define/contract (make-transform-string ctm) (tm/c . -> . string?)