start deflation

pitfall/pitfall/document.rkt

@@ -5,68 +5,66 @@
 
 (define mixed% (image-mixin (text-mixin (fonts-mixin (color-mixin (vector-mixin object%))))))
 
-(define PDFDocument
-  (class mixed% ; actually is an instance of readable.Stream, which is an input port
-    (init-field [options (mhash)])
-    (super-new)
-
-    (field [byte-strings empty] ; list of byte chunks to push onto; simulates interface of stream.readable
-           [version 1.3] ; PDF version
-           [compress (hash-ref options 'compress #t)] ; Whether streams should be compressed
-           [_pageBuffer null]
-           [_pageBufferStart 0]
-           [_offsets null] ; The PDF object store
-           [_waiting 0]
-           [_ended #f]
-           [_offset 0]
-           [_root (ref this
-                       (mhash 'Type "Catalog"
-                              'Pages (ref this
-                                          (mhash 'Type "Pages"
-                                                 'Count 0
-                                                 'Kids empty))))] ; top object
-           [page #f] ; The current page
-           [x 0]
-           [y 0]
-           [info (mhash
-                  'Producer "PitfallKit"
-                  'Creator "PitfallKit"
-                  'CreationDate (seconds->date (if (test-mode)
-                                                   0
-                                                   (current-seconds)) #f))]  ; Initialize the metadata
-           [op #f] ; for `pipe`
-           [_info #f]) ; for `end`
-
-    ;; Initialize mixins
-    (· this initColor)
-    (· this initVector)
-    (· this initFonts)
-    (· this initText)
-    ;(· this initImages)
-
-    (as-methods
-     addPage
-     flushPages
-     ref
-     push
-     _write
-     addContent
-     _refEnd
-     pipe
-     end
-     _finalize)
-
-    (for ([(key val) (in-hash (hash-ref options 'info (hash)))]) ; if no 'info key, nothing will be copied from (hash)
-      (hash-set! info key val))
-
-    ;; Write the header
-    (_write this (format "%PDF-~a" version)) ;  PDF version
-    (let ([c (integer->char #xFF)])
-      (_write this (string-append "%" (string c c c c)))) ; 4 binary chars, as recommended by the spec
-
-    ;; Add the first page
-    (unless (not (hash-ref options 'autoFirstPage #t))
-      (addPage this))))
+(define-subclass mixed% (PDFDocument [options (mhash)])
+  (super-new)
+
+  (field [byte-strings empty] ; list of byte chunks to push onto; simulates interface of stream.readable
+         [version 1.3] ; PDF version
+         [compress (hash-ref options 'compress #t)] ; Whether streams should be compressed
+         [_pageBuffer null]
+         [_pageBufferStart 0]
+         [_offsets null] ; The PDF object store
+         [_waiting 0]
+         [_ended #f]
+         [_offset 0]
+         [_root (ref this
+                     (mhash 'Type "Catalog"
+                            'Pages (ref this
+                                        (mhash 'Type "Pages"
+                                               'Count 0
+                                               'Kids empty))))] ; top object
+         [page #f] ; The current page
+         [x 0]
+         [y 0]
+         [info (mhash
+                'Producer "PitfallKit"
+                'Creator "PitfallKit"
+                'CreationDate (seconds->date (if (test-mode)
+                                                 0
+                                                 (current-seconds)) #f))]  ; Initialize the metadata
+         [op #f] ; for `pipe`
+         [_info #f]) ; for `end`
+
+  ;; Initialize mixins
+  (· this initColor)
+  (· this initVector)
+  (· this initFonts)
+  (· this initText)
+  ;(· this initImages)
+
+  (as-methods
+   addPage
+   flushPages
+   ref
+   push
+   _write
+   addContent
+   _refEnd
+   pipe
+   end
+   _finalize)
+
+  (for ([(key val) (in-hash (hash-ref options 'info (hash)))]) ; if no 'info key, nothing will be copied from (hash)
+    (hash-set! info key val))
+
+  ;; Write the header
+  (_write this (format "%PDF-~a" version)) ;  PDF version
+  (let ([c (integer->char #xFF)])
+    (_write this (string-append "%" (string c c c c)))) ; 4 binary chars, as recommended by the spec
+
+  ;; Add the first page
+  (unless (not (hash-ref options 'autoFirstPage #t))
+    (addPage this)))
 
     
 (define/contract (addPage this [options-arg (· this options)])

pitfall/pitfall/helper.rkt

@@ -163,4 +163,9 @@
   (and (string? x)
        (if (string-prefix? x "#")
            (or (= (string-length x) 4) (= (string-length x) 7))
-           #t)))
+           #t)))
+
+(define-syntax-rule (define-subclass CLASS-ID (SUBCLASS-ID INIT-FIELD ...) . EXPRS)
+  (define SUBCLASS-ID
+    (class CLASS-ID
+      (init-field INIT-FIELD ...) . EXPRS)))

pitfall/pitfall/image.rkt

@@ -1,4 +1,5 @@
 #lang pitfall/racket
+(require "jpeg.rkt" "png.rkt")
 (provide PDFImage)
 
 (define PDFImage

pitfall/pitfall/jpeg.rkt

@@ -0,0 +1 @@
+#lang pitfall/racket

pitfall/pitfall/object.rkt

@@ -35,6 +35,7 @@
 
 ;; Convert little endian UTF-16 to big endian
 ;; endianness of `bytes-open-converter` is relative to platform, so little endian on all x86
+;; can detect with `system-big-endian?`
 (define/contract (utf8->utf16 bytes)
   (bytes? . -> . bytes?)
   (define-values (bs bslen bsresult)

pitfall/pitfall/png.rkt

@@ -0,0 +1,8 @@
+#lang pitfall/racket
+(require racket/draw/unsafe/png)
+
+(define PNGImage
+  (class object%
+    (init-field data label)
+    (field [image 'newPngobject]
+           [width '()])))

pitfall/pitfall/test/test0.rkt

@@ -3,8 +3,8 @@
 
 (check-true
  (let ()
-   (define doc (new PDFDocument))
+   (define doc (make-object PDFDocument (hash 'compress #f)))
    (send doc pipe (open-output-file this #:exists 'replace))
    (send doc end)))
 
-(check-copy-equal? this)
+;(check-copy-equal? this)

pitfall/pitfall/test/test1.rkt

@@ -2,7 +2,7 @@
 (define-runtime-path this "test1rkt.pdf")
 
 (check-true
- (let ([doc (new PDFDocument)])
+ (let ([doc (make-object PDFDocument (hash 'compress #f))])
    (send doc pipe (open-output-file this #:exists 'replace))
 
    ;; Draw a triangle and a circle

pitfall/pitfall/test/test4.rkt

@@ -2,7 +2,7 @@
 (define-runtime-path this "test4rkt.pdf")
 
 (check-true
- (let ([doc (new PDFDocument)])
+ (let ([doc (make-object PDFDocument (hash 'compress #f))])
    (send doc pipe (open-output-file this #:exists 'replace))
 
    (send* doc

pitfall/pitfall/zlib.rkt

@@ -0,0 +1,30 @@
+#lang pitfall/racket
+(provide deflate inflate)
+
+;; see https://groups.google.com/d/topic/racket-users/3CvjHLAmwSQ/discussion
+;; for discrepancies between gzip gunzip and zlib
+
+(require (prefix-in gzip: file/gzip)
+         (prefix-in gunzip: file/gunzip) png-image)
+
+(define (deflate bstr)
+  ;; https://www.ietf.org/rfc/rfc1950.txt
+  (define rfc-1950-header (bytes #x78 #x9c))
+  (define op (open-output-bytes))
+  (gzip:deflate (open-input-bytes bstr) op)
+  (bytes-append rfc-1950-header
+                (get-output-bytes op)
+                (integer->integer-bytes (bytes-adler32 bstr) 4 #f 'want-big-endian)))
+
+(define (inflate bstr)
+  (define op (open-output-bytes))
+  (gunzip:inflate (open-input-bytes (subbytes bstr 2)) op)
+  (get-output-bytes op))
+
+(module+ test
+  (require rackunit)
+  (for ([i (in-range 100)])
+    (define random-bytes
+      (apply bytes (for/list ([bidx (in-range 100)])
+                     (random 256))))
+    (check-equal? random-bytes (inflate (deflate random-bytes)))))