fill & stroke

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)

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 "#")))
+  (and (string? x)
+       (if (string-prefix? x "#")
+           (or (= (string-length x) 4) (= (string-length x) 7))
+           #t)))

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

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?)