rearrangement servant

pitfall/pitfall/document.rkt

@@ -42,7 +42,8 @@
     ;; The current page
     (field [(@page page) #f])
 
-    ;; other fields, hoisted from below (why is this necessary?)
+    ;; other fields, moved up from below
+    ;; (why is this necessary? order seems to matter)
     (field [(@x x) 0])
     (field [(@y y) 0])
 
@@ -58,13 +59,13 @@
     (field [(@info info) (mhash
                           'Producer "PitfallKit"
                           'Creator "PitfallKit"
-                          'CreationDate (seconds->date (if (current-debug)
+                          'CreationDate (seconds->date (if (test-mode)
                                                            0
                                                            (current-seconds)) #f))])
 
     (when (hash-ref @options 'info #f)
       (for ([(key val) (in-hash (hash-ref @options 'info))])
-           (hash-set! @info key val)))
+        (hash-set! @info key val)))
 
     ;; Write the header
     ;; PDF version
@@ -158,9 +159,9 @@
 
     (define/public (_refEnd ref)
       (set! @_offsets (for/list ([(offset idx) (in-indexed @_offsets)])
-                                (if (= (· ref id) (add1 idx))
-                                    (· ref offset)
-                                    offset)))
+                        (if (= (· ref id) (add1 idx))
+                            (· ref offset)
+                            offset)))
       (-- @_waiting)
       (if (and (zero? @_waiting) @_ended)
           (@_finalize)
@@ -175,8 +176,8 @@
       (@flushPages)
       (set! @_info (@ref))
       (for ([(key val) (in-hash @info)])
-           ;; upgrade string literal to String struct
-           (hash-set! (· @_info data) key (if (string? val) (String val) val)))
+        ;; upgrade string literal to String struct
+        (hash-set! (· @_info data) key (if (string? val) (String val) val)))
       (· @_info end)
 
       ;; todo: fonts
@@ -190,7 +191,7 @@
           (@_finalize)
           (set! @_ended #t))
 
-      'done)
+      #t)
 
     (public (@_finalize _finalize))
     (define (@_finalize [fn #f])
@@ -200,9 +201,9 @@
       (@_write (format "0 ~a" (add1 (length @_offsets))))
       (@_write "0000000000 65535 f ")
       (for ([offset (in-list @_offsets)])
-           (@_write (string-append
-                     (~r offset #:min-width 10 #:pad-string "0")
-                     " 00000 n ")))
+        (@_write (string-append
+                  (~r offset #:min-width 10 #:pad-string "0")
+                  " 00000 n ")))
       ;; trailer
       (@_write "trailer")
       ;; todo: make `PDFObject:convert` a static method
@@ -223,16 +224,16 @@
       (close-output-port op))))
 
 
-(define doc (new PDFDocument))
 
-(module+ test
-  (require rackunit racket/file)
-  (define ob (open-output-bytes))
-  (send doc pipe ob)
-  (check-equal? (send doc end) 'done)
-  (define result-str (get-output-bytes ob))
-  (define fn "out")
-  (with-output-to-file (string-append fn ".pdf")
-    (λ () (display result-str)) #:exists 'replace)
-  (check-equal? (file->bytes (string-append fn ".pdf")) (file->bytes (string-append fn " copy.pdf")))
-  (display (bytes->string/latin-1 result-str)))
+#;(module+ test
+    (define doc (new PDFDocument))
+    (require rackunit racket/file)
+    (define ob (open-output-bytes))
+    (send doc pipe ob)
+    (check-true (send doc end))
+    (define result-str (get-output-bytes ob))
+    (define fn "out")
+    (with-output-to-file (string-append fn ".pdf")
+      (λ () (display result-str)) #:exists 'replace)
+    (check-equal? (file->bytes (string-append fn ".pdf")) (file->bytes (string-append fn " copy.pdf")))
+    (display (bytes->string/latin-1 result-str)))

pitfall/pitfall/helper.rkt

@@ -106,4 +106,13 @@
   (check-equal? (bounded 1 -2 0) 0)
   (check-equal? (bounded 0 .5 1) 0.5)
   (check-equal? (bounded 0 0 1) 0)
-  (check-equal? (bounded 0 1 1) 1))
+  (check-equal? (bounded 0 1 1) 1))
+
+
+(struct exn:pitfall:test exn (data))
+
+(define (raise-test-exn val)
+  (raise (exn:pitfall:test "pitfall test exn" (current-continuation-marks) val)))
+
+(define-syntax-rule (test-when cond expr)
+  (if cond (raise-test-exn expr) expr))

pitfall/pitfall/kit/struct.rkt

@@ -1,6 +0,0 @@
-#lang br
-(provide (struct-out String))
-
-;; use structs to sub for missing node types
-
-(struct String (string) #:transparent)

pitfall/pitfall/old/struct.rkt

@@ -0,0 +1,16 @@
+#lang racket/base
+(provide (all-defined-out))
+
+(struct co-dict (dict) #:transparent)
+(struct co-array (items) #:transparent)
+(struct co-stream (dict data) #:transparent)
+(struct co-version (num) #:transparent)
+(struct co-header (string) #:transparent)
+(struct co-string (string) #:transparent)
+(struct co-io (idx rev thing) #:transparent)
+(struct co-io-ref (idx rev) #:transparent)
+(struct co-comment (text) #:transparent)
+(struct co-trailer (dict) #:transparent)
+
+(struct co-hash (hash) #:transparent)
+(struct co-encoding-datum (datum) #:transparent)

pitfall/pitfall/out.pdf

@@ -0,0 +1,63 @@
+%PDF-1.3
+%ÿÿÿÿ
+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
+<<
+/ProcSet [/PDF /Text /ImageB /ImageC /ImageI]
+>>
+endobj
+3 0 obj
+<<
+/Length 18
+>>
+stream
+1 0 0 -1 0 792 cm
+
+endstream
+endobj
+6 0 obj
+<<
+/CreationDate (D:20170514163610Z)
+/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 7
+0000000000 65535 f 
+0000000403 00000 n 
+0000000354 00000 n 
+0000000186 00000 n 
+0000000119 00000 n 
+0000000015 00000 n 
+0000000254 00000 n 
+trailer
+<<
+/Info 6 0 R
+/Root 2 0 R
+/Size 7
+>>
+startxref
+460
+%%EOF

pitfall/pitfall/params.rkt

@@ -1,3 +1,3 @@
 #lang racket/base
 (provide (all-defined-out))
-(define current-debug (make-parameter #t))
+(define test-mode (make-parameter #f))

pitfall/pitfall/struct.rkt

@@ -1,16 +1,6 @@
-#lang racket/base
-(provide (all-defined-out))
+#lang br
+(provide (struct-out String))
 
-(struct co-dict (dict) #:transparent)
-(struct co-array (items) #:transparent)
-(struct co-stream (dict data) #:transparent)
-(struct co-version (num) #:transparent)
-(struct co-header (string) #:transparent)
-(struct co-string (string) #:transparent)
-(struct co-io (idx rev thing) #:transparent)
-(struct co-io-ref (idx rev) #:transparent)
-(struct co-comment (text) #:transparent)
-(struct co-trailer (dict) #:transparent)
+;; use structs to sub for missing node types
 
-(struct co-hash (hash) #:transparent)
-(struct co-encoding-datum (datum) #:transparent)
+(struct String (string) #:transparent)

pitfall/pitfall/test-helper.rkt

@@ -0,0 +1,7 @@
+#lang racket/base
+(require rackunit pitfall/helper)
+(provide (all-defined-out))
+
+(define-syntax-rule (check-exn-equal? expr val)
+    (check-equal? (with-handlers ([exn:pitfall:test? (λ (e) (exn:pitfall:test-data e))])
+                    expr) val))

pitfall/pitfall/test/test-all.rkt

@@ -0,0 +1,3 @@
+#lang racket
+(require pitfall/test/test0
+         pitfall/test/test1)

pitfall/pitfall/test/test0.rkt

@@ -0,0 +1,14 @@
+#lang racket
+(require pitfall/document pitfall/params rackunit)
+
+(test-mode #t)
+(check-true
+ (let ()
+   (define doc (new PDFDocument))
+   (send doc pipe (open-output-file "test0rkt.pdf" #:exists 'replace))
+   (send doc end)))
+
+(require racket/runtime-path)
+(define-runtime-path this "test0rkt.pdf")
+(define-runtime-path control "test0rkt copy.pdf")
+(check-equal? (file->bytes this) (file->bytes control))

pitfall/pitfall/test/test1.rkt

@@ -0,0 +1,27 @@
+#lang racket
+
+(require pitfall/document pitfall/helper pitfall/params rackunit)
+
+(require racket/runtime-path)
+(define-runtime-path this "test1rkt.pdf")
+(define-runtime-path control "test1rkt copy.pdf")
+
+;; Create a new PDFDocument
+(test-mode #t)
+(check-true
+ (let ()
+   (define doc (new PDFDocument))
+   (send doc pipe (open-output-file this #:exists 'replace))
+
+   ;; Draw a triangle and a circle
+   (send*/fold doc [save]
+               [moveTo 100 150]
+               [lineTo 100 250]
+               [lineTo 200 250]
+               [fill "#FF3300"])
+
+   (send*/fold doc [circle 280 200 50] [fill "#6600FF"])
+
+   (send doc end)))
+
+(check-equal? (file->bytes this) (file->bytes control))

pitfall/pitfall/test/test1rkt.pdf

@@ -0,0 +1,91 @@
+%PDF-1.3
+%ÿÿÿÿ
+6 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 <<
+/Gs1 6 0 R
+>>
+/ProcSet [/PDF /Text /ImageB /ImageC /ImageI]
+>>
+endobj
+3 0 obj
+<<
+/Length 294
+>>
+stream
+1 0 0 -1 0 792 cm
+q
+100 150 m
+100 250 l
+200 250 l
+/DeviceRGB cs
+1 0.2 0 scn
+/Gs1 gs
+f
+230 200 m
+230 172.385763 252.385763 150 280 150 c
+307.614237 150 330 172.385763 330 200 c
+330 227.614237 307.614237 250 280 250 c
+252.385763 250 230 227.614237 230 200 c
+h
+/DeviceRGB cs
+0.4 0 1 scn
+/Gs1 gs
+f
+
+endstream
+endobj
+7 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 8
+0000000000 65535 f 
+0000000752 00000 n 
+0000000703 00000 n 
+0000000258 00000 n 
+0000000163 00000 n 
+0000000059 00000 n 
+0000000015 00000 n 
+0000000603 00000 n 
+trailer
+<<
+/Info 7 0 R
+/Root 2 0 R
+/Size 8
+>>
+startxref
+809
+%%EOF

pitfall/pitfall/test0rkt.pdf

@@ -0,0 +1,63 @@
+%PDF-1.3
+%ÿÿÿÿ
+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
+<<
+/ProcSet [/PDF /Text /ImageB /ImageC /ImageI]
+>>
+endobj
+3 0 obj
+<<
+/Length 18
+>>
+stream
+1 0 0 -1 0 792 cm
+
+endstream
+endobj
+6 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 7
+0000000000 65535 f 
+0000000403 00000 n 
+0000000354 00000 n 
+0000000186 00000 n 
+0000000119 00000 n 
+0000000015 00000 n 
+0000000254 00000 n 
+trailer
+<<
+/Info 6 0 R
+/Root 2 0 R
+/Size 7
+>>
+startxref
+460
+%%EOF

pitfall/pitfall/test1rkt.pdf

@@ -0,0 +1,91 @@
+%PDF-1.3
+%ÿÿÿÿ
+6 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 <<
+/Gs1 6 0 R
+>>
+/ProcSet [/PDF /Text /ImageB /ImageC /ImageI]
+>>
+endobj
+3 0 obj
+<<
+/Length 238
+>>
+stream
+1 0 0 -1 0 792 cm
+q
+100 150 m
+100 250 l
+200 250 l
+/DeviceRGB cs
+1 0.2 0 scn
+/Gs1 gs
+f
+230 200 m
+230 150 230 150 280 150 c
+330 150 330 150 330 200 c
+330 250 330 250 280 250 c
+230 250 230 250 230 200 c
+h
+/DeviceRGB cs
+0.4 0 1 scn
+/Gs1 gs
+f
+
+endstream
+endobj
+7 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 8
+0000000000 65535 f 
+0000000696 00000 n 
+0000000647 00000 n 
+0000000258 00000 n 
+0000000163 00000 n 
+0000000059 00000 n 
+0000000015 00000 n 
+0000000547 00000 n 
+trailer
+<<
+/Info 7 0 R
+/Root 2 0 R
+/Size 8
+>>
+startxref
+753
+%%EOF

pitfall/pitfall/vector.rkt

@@ -1,17 +1,39 @@
 #lang racket/base
-(require racket/class racket/match racket/string racket/format)
-(provide vector-mixin)
-(require "helper.rkt")
+(require racket/class racket/match racket/string racket/format racket/contract)
+(require "helper.rkt" "params.rkt")
+(provide (contract-out
+          [vector-mixin (class? . -> .
+                                (class/c [initVector (->m void?)]
+                                         [save (->m object?)]
+                                         [restore (->m object?)]
+                                         [closePath (->m object?)]
+                                         [moveTo (number? number? . ->m . object?)]
+                                         [lineTo (number? number? . ->m . object?)]
+                                         [bezierCurveTo ( number? number? number? number? number? number? . ->m . object?)]
+                                         [ellipse ((number? number? number?) (number?) . ->*m . object?)]
+                                         [circle (number? number? number? . ->m . object?)]
+                                         [_windingRule (string? . ->m . string?)]
+                                         [fill ((string?) ((or/c string? #f)) . ->*m . object?)]
+                                         [transform ((number? number? number? number? number? number?) (#:debug boolean?) . ->*m . (or/c object? string?))]
+                                         [translate (number? number? . ->m . object?)]
+                                         [scale (case->m
+                                                 (number? . -> . object?)
+                                                 (number? hash? . -> . object?)
+                                                 (number? number? . -> . object?)
+                                                 (number? number? hash? . -> . object?))]))]))
+
 
 ;; This constant is used to approximate a symmetrical arc using a cubic
 ;; Bezier curve.
-(define KAPPA (* 4 (/ (- (sqrt 2) 1) 3.0)))
+(define kappa (* 4 (/ (- (sqrt 2) 1) 3.0)))
 
 (define default-ctm-value '(1 0 0 1 0 0))
 
+
 (define (vector-mixin %)
   (class %
     (super-new)
+    (init-field [(@test-mode test-mode) #f])
     (field [(@_ctm _ctm) default-ctm-value]
            [(@_ctmStack _ctmStack) null])
     
@@ -27,6 +49,7 @@
       (set! @_ctm (if (pair? @_ctmStack) (pop! @_ctmStack) default-ctm-value))
       (send this addContent "Q"))
 
+    (public [@closePath closePath])
     (define (@closePath)
       (send this addContent "h"))      
 
@@ -34,7 +57,6 @@
     (define (@moveTo x y)
       (send this addContent (format "~a ~a m" x y)))
 
-
     (public [@lineTo lineTo])
     (define (@lineTo x y)
       (send this addContent (format "~a ~a l" x y)))
@@ -51,12 +73,12 @@
       ;; based on http://stackoverflow.com/questions/2172798/how-to-draw-an-oval-in-html5-canvas/2173084#2173084
       (-= x r1)
       (-= y r2)
-      (define ox (* r1 KAPPA))
-      (define oy (* r2 KAPPA))
-      (define xe (+ x (* r1 2)))
-      (define ye (+ y (* r2 2)))
-      (define xm (+ x r1))
-      (define ym (+ y r2))
+      (define ox (* r1 kappa)) ; control point offset horizontal
+      (define oy (* r2 kappa)) ; control point offset vertical
+      (define xe (+ x (* r1 2))) ; x-end
+      (define ye (+ y (* r2 2))) ; y-end
+      (define xm (+ x r1)) ; x-middle
+      (define ym (+ y r2)) ; y-middle
       (@moveTo x ym)
       (@bezierCurveTo x (- ym oy) (- xm ox) y xm y)
       (@bezierCurveTo (+ xm ox) y xe (- ym oy) xe ym)
@@ -77,9 +99,7 @@
 
     (public [@_windingRule _windingRule])
     (define (@_windingRule rule)
-      (if (and (string? rule) (regexp-match #rx"^even-?odd$" rule))
-          "*"
-          ""))
+      (if (and (string? rule) (regexp-match #rx"^even-?odd$" rule)) "*" ""))
 
     (define/public (fill color [rule #f])
       (when (regexp-match #rx"^(even-?odd)|(non-?zero)$" color)
@@ -101,9 +121,8 @@
                         (+ (* m1 dx) (* m3 dy) m5)))
       (define values (string-join (map number (list m11 m12 m21 m22 dx dy)) " "))
       (define result (format "~a cm" values))
-      (if debug
-          result
-          (send this addContent result)))
+      (test-when @test-mode result)
+      (send this addContent result))
 
 
     (public [@translate translate])
@@ -121,17 +140,16 @@
            (match-let ([(list xo yo) (hash-ref options 'origin '(0 0))])
              (list (* xo (- 1 xFactor)) (* yo (- 1 yFactor)))))
          (@transform xFactor 0 0 yFactor x y)]))
-      
-
+     
     ))
 
 (module+ test
-  (require rackunit)
-  (define v (new (vector-mixin object%)))
-  (check-equal? (· v _ctm) default-ctm-value)
-  (check-equal? (send v transform 1 2 3 4 5 6 #:debug #t) "1 2 3 4 5 6 cm")
+  (require rackunit pitfall/test-helper)
+  (define v (make-object (vector-mixin object%) #t))
+  (check-equal? (· v _ctm) default-ctm-value)  
+  (check-exn-equal? (send v transform 1 2 3 4 5 6 #:debug #t) "1 2 3 4 5 6 cm")
   (check-equal? (· v _ctm) '(1 2 3 4 5 6))
-  (check-equal? (send v transform 1 2 3 4 5 6 #:debug #t) "1 2 3 4 5 6 cm")
+  (check-exn-equal? (send v transform 1 2 3 4 5 6 #:debug #t) "1 2 3 4 5 6 cm")
   (check-equal? (· v _ctm) '(7 10 15 22 28 40))
-  (check-equal? (send v transform 1 2 3 4 5 6 #:debug #t) "1 2 3 4 5 6 cm")
+  (check-exn-equal? (send v transform 1 2 3 4 5 6 #:debug #t) "1 2 3 4 5 6 cm")
   (check-equal? (· v _ctm) '(37 54 81 118 153 222)))

pitfall/pktest/test0.rkt

@@ -1,7 +0,0 @@
-#lang br
-
-(require pitfall/kit/document)
-
-(define doc (new PDFDocument))
-(send doc pipe (open-output-file "test0rkt.pdf" #:exists 'replace))
-(send doc end)

pitfall/pktest/test1.rkt

@@ -1,18 +0,0 @@
-#lang br
-
-(require pitfall/kit/document pitfall/kit/helper)
-
-;; Create a new PDFDocument
-(define doc (new PDFDocument))
-(send doc pipe (open-output-file "test1rkt.pdf" #:exists 'replace))
-
-;; Draw a triangle and a circle
-(send*/fold doc [save]
-            [moveTo 100 150]
-            [lineTo 100 250]
-            [lineTo 200 250]
-            [fill "#FF3300"])
-
-(send*/fold doc [circle 280 200 50] [fill "#6600FF"])
-
-(send doc end)