nits

pitfall/pitfall/core.rkt

@@ -4,8 +4,10 @@
 
 ;; structs
 
-(struct $img (data label width height obj embed-proc) #:transparent #:mutable)
+;; for JPEG and PNG
+(struct $img (data label width height ref embed-proc) #:transparent #:mutable)
 
+;; for reference
 (struct $ref (id payload offset port) #:transparent #:mutable
   #:methods gen:dict
   [(define (dict-ref $ key [thunk (λ () (error 'dict-ref-key-not-found))])
@@ -16,9 +18,6 @@
    (define (dict-update! $ key updater [failure-result (λ () (error 'update-no-key))])
      (hash-update! ($ref-payload $) key updater failure-result))])
 
-;; for JPEG and PNG
-(struct image (label width height obj) #:transparent #:mutable)
-
 ;; for page
 (struct margin (top left bottom right) #:transparent #:mutable)
 

pitfall/pitfall/image.rkt

@@ -1,19 +0,0 @@
-#lang racket/base
-(require
-  racket/class
-  "jpeg.rkt"
-  "png.rkt")
-(provide PDFImage-open)
-
-(define (PDFImage-open src label)
-  (define data (cond
-                 [(bytes? src) (open-input-bytes src)]
-                 [(regexp-match #rx"^data:.+;base64,(.*)$" src) (void)] ;; base64 ; todo
-                 [else (open-input-file src)]))
-  (define img-constructor
-    (cond
-      [(equal? (peek-bytes 2 0 data) (bytes #xff #xd8)) make-jpeg]
-      [(equal? (peek-bytes 4 0 data) (apply bytes (map char->integer '(#\u0089 #\P #\N #\G)))) make-png]
-      [else (raise-argument-error 'PDFImage-open "valid image format" src)]))
-  (img-constructor data label))
-           

pitfall/pitfall/images.rkt

@@ -3,11 +3,24 @@
   racket/class
   racket/match
   sugar/unstable/dict
-  "image.rkt"
   "core.rkt"
-  "page.rkt")
+  "page.rkt"
+  "png.rkt"
+  "jpeg.rkt")
 (provide image-mixin)
 
+(define (open-pdf-image src label)
+  (define data (cond
+                 [(bytes? src) (open-input-bytes src)]
+                 [(regexp-match #rx"^data:.+;base64,(.*)$" src) (void)] ;; base64 ; todo
+                 [else (open-input-file src)]))
+  (define img-constructor
+    (cond
+      [(equal? (peek-bytes 2 0 data) (bytes #xff #xd8)) make-jpeg]
+      [(equal? (peek-bytes 4 0 data) (apply bytes (map char->integer '(#\u0089 #\P #\N #\G)))) make-png]
+      [else (raise-argument-error 'open-pdf-image "valid image format" src)]))
+  (img-constructor data label))
+
 (define (image-mixin [% object%])
   (class %
     (super-new)
@@ -22,12 +35,11 @@
 
       (define image (cond
                       [(and (string? src) (hash-ref @image-registry src #f))]
-                      [(and (object? src) ($img-width src) ($img-height src)) src]
                       [(and ($img? src) ($img-width src) ($img-height src)) src]
                       [else (send this open-image src)]))
-      (unless ($img-obj image) (($img-embed-proc image) image))
+      (unless ($img-ref image) (($img-embed-proc image) image))
   
-      (hash-ref! (page-xobjects (page)) ($img-label image) ($img-obj image))
+      (hash-ref! (page-xobjects (page)) ($img-label image) ($img-ref image))
 
       (define image-width ($img-width image))
       (define image-height ($img-height image))
@@ -100,8 +112,9 @@
       (cond
         [(and (string? src) (hash-ref @image-registry src #f))]
         [else
-         (define new-image
-           (PDFImage-open src (string->symbol (format "I~a" (let () (set! @image-count (add1 @image-count)) @image-count)))))
+         (set! @image-count (add1 @image-count))
+         (define image-id (string->symbol (format "I~a" @image-count)))
+         (define new-image (open-pdf-image src image-id))
          (when (string? src) (hash-set! @image-registry src new-image))
          new-image]))))
 

pitfall/pitfall/jpeg-structy.rkt

@@ -1,74 +0,0 @@
-#lang debug racket/base
-(require
-  "core.rkt"
-  "reference.rkt"
-  racket/class
-  racket/contract
-  racket/dict
-  sugar/unstable/class
-  sugar/unstable/js
-  sugar/unstable/dict
-  sugar/unstable/port)
-
-(provide +JPEG (struct-out JPEG))
-
-(define MARKERS '(#xffc0 #xffc1 #xffc2 #xffc3 #xffc5 #xffc6 #xffc7
-                         #xffc8 #xffc9 #xffca #xffcb #xffcc #xffcd #xffce #xffcf))  
-
-(define (read-16bit-integer [port (current-input-port)])
-  (define signed #f) (define big-endian #t)
-  (integer-bytes->integer
-   (read-bytes 2 port) signed big-endian))
-
-(struct JPEG image (data bits channels colorSpace) #:transparent #:mutable)
-
-(define (+JPEG data [label #f])
-  (parameterize ([current-input-port (if (input-port? data) data (open-input-bytes data))])
-    (unless (equal? (read-16bit-integer) #xffd8)
-      (error 'JPEG "Start of Input marker byte not found"))
-    (define marker (let loop ([skip 0])
-                     (read-bytes skip)
-                     (define m (read-16bit-integer))
-                     (if (memv m MARKERS)
-                         m
-                         (loop (read-16bit-integer (open-input-bytes (peek-bytes 2 0)))))))
-    (read-16bit-integer) ; what is it and why am I ignoring it?
-    (define bits (read-byte))
-    (define height (read-16bit-integer))
-    (define width (read-16bit-integer))
-    (define channels (read-byte))
-    (define colorSpace (case channels
-                         [(1) "DeviceGray"]
-                         [(3) "DeviceRGB"]
-                         [(4) "DeviceCMYK"]))
-    (define obj #f)
-    (JPEG label width height obj data bits channels colorSpace)))
-
-(define (embed this)
-  #;(object? . ->m . void?)
-
-  (unless (· this obj)
-    (set-field! obj this
-                (make-ref
-                      (mhash
-                       'Type "XObject"
-                       'Subtype "Image"
-                       'BitsPerComponent (· this bits)
-                       'Width (· this width)
-                       'Height (· this height)
-                       'ColorSpace (· this colorSpace)
-                       'Filter "DCTDecode")))
-    
-    ;; add extra decode params for CMYK images. By swapping the
-    ;; min and max values from the default, we invert the colors. See
-    ;; section 4.8.4 of the spec. 
-    (when (equal? (· this colorSpace) "DeviceCMYK")
-      (dict-set! (· this obj) 'Decode '(1.0 0.0 1.0 0.0 1.0 0.0 1.0 0.0)))
-
-    (port-position (· this data) 0)
-    (send (· this obj) end (· this data))))
-
-(module+ test
-  (require rackunit)
-  (check-equal? (number->string (read-16bit-integer (open-input-bytes (bytes #x12 #x34 #x56))) 16) "1234")
-  (+JPEG (open-input-file "../ptest/assets/test.jpeg")))

pitfall/pitfall/jpeg.rkt

@@ -1,6 +1,5 @@
 #lang debug racket/base
 (require
-  racket/class
   racket/match
   "reference.rkt"
   "core.rkt"
@@ -18,8 +17,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/image/jpeg.coffee
                          #xffc8 #xffc9 #xffca #xffcb
                          #xffcc #xffcd #xffce #xffcf))
 
-(struct $jpeg $img (bits channels colorSpace)
-  #:transparent #:mutable)
+(struct $jpeg $img (bits channels colorSpace) #:transparent #:mutable)
 
 (define (make-jpeg data [label #f])
   
@@ -44,10 +42,9 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/image/jpeg.coffee
   (define obj #f)
   ($jpeg data label width height obj jpeg-embed bits channels colorSpace))
   
-
 (define (jpeg-embed jpeg)
-  (unless ($img-obj jpeg)
-    (set-$img-obj! jpeg
+  (unless ($img-ref jpeg)
+    (set-$img-ref! jpeg
                    (make-ref
                     (mhash
                      'Type 'XObject
@@ -62,10 +59,10 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/image/jpeg.coffee
     ;; min and max values from the default, we invert the colors. See
     ;; section 4.8.4 of the spec. 
     (when (eq? ($jpeg-colorSpace jpeg) 'DeviceCMYK)
-      (dict-set! ($img-obj jpeg) 'Decode '(1.0 0.0 1.0 0.0 1.0 0.0 1.0 0.0)))
+      (dict-set! ($img-ref jpeg) 'Decode '(1.0 0.0 1.0 0.0 1.0 0.0 1.0 0.0)))
     (file-position ($img-data jpeg) 0)
-    (ref-write ($img-obj jpeg) ($img-data jpeg))
-    (ref-end ($img-obj jpeg))))
+    (ref-write ($img-ref jpeg) ($img-data jpeg))
+    (ref-end ($img-ref jpeg))))
 
 (define (read-16bit-integer ip-or-bytes)
   (define signed #f) (define big-endian #t)

pitfall/pitfall/png.rkt

@@ -28,8 +28,8 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/image/png.coffee
   ($png data label width height obj png-embed image pixel-bit-length img-data alpha-channel))
 
 (define (png-embed png)
-  (unless ($img-obj png)
-    (set-$img-obj! png
+  (unless ($img-ref png)
+    (set-$img-ref! png
                    (make-ref
                     (mhash 'Type 'XObject
                            'Subtype 'Image
@@ -44,7 +44,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/image/png.coffee
                              'Colors (hash-ref ($png-image png) 'colors)
                              'BitsPerComponent (hash-ref ($png-image png) 'bits)
                              'Columns ($img-width png))))
-      (dict-set! ($img-obj png) 'DecodeParms params)
+      (dict-set! ($img-ref png) 'DecodeParms params)
       (ref-end params))
 
     (cond
@@ -54,9 +54,9 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/image/png.coffee
        (ref-write palette-ref (hash-ref ($png-image png) 'palette))
        (ref-end palette-ref)
        ;; build the color space array for the image
-       (dict-set! ($img-obj png) 'Colorspace
+       (dict-set! ($img-ref png) 'Colorspace
                   (list 'Indexed 'DeviceRGB (sub1 (/ (bytes-length (hash-ref ($png-image png) 'palette)) 3)) palette-ref))]
-      [else (dict-set! ($img-obj png) 'ColorSpace 'DeviceRGB)])
+      [else (dict-set! ($img-ref png) 'ColorSpace 'DeviceRGB)])
 
    
     (cond
@@ -89,11 +89,11 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/image/png.coffee
               'Decode '(0 1))))
     (ref-write sMask-ref ($png-alpha-channel png))
     (ref-end sMask-ref)
-    (dict-set! ($img-obj png) 'SMask sMask-ref))
+    (dict-set! ($img-ref png) 'SMask sMask-ref))
   
   ;; embed the actual image data
-  (ref-write ($img-obj png) ($png-img-data png))
-  (ref-end ($img-obj png)))
+  (ref-write ($img-ref png) ($png-img-data png))
+  (ref-end ($img-ref png)))
 
 
 (define (split-alpha-channel png)