methodize jpeg

pitfall/pitfall/jpeg.rkt

@@ -1,80 +1,71 @@
 #lang debug racket/base
 (require
   racket/class
-    "reference.rkt"
-  racket/contract
+  racket/match
+  "reference.rkt"
   racket/dict
-  sugar/unstable/class
-  sugar/unstable/js
-  sugar/unstable/dict
-  sugar/unstable/port)
+  sugar/unstable/dict)
 
 (provide JPEG)
 
-(define MARKERS '(#xffc0 #xffc1 #xffc2 #xffc3 #xffc5 #xffc6 #xffc7
-                         #xffc8 #xffc9 #xffca #xffcb #xffcc #xffcd #xffce #xffcf))
+(define MARKERS '(#xffc0 #xffc1 #xffc2 #xffc3
+                         #xffc5 #xffc6 #xffc7
+                         #xffc8 #xffc9 #xffca #xffcb
+                         #xffcc #xffcd #xffce #xffcf))
 
-(define-subclass object% (JPEG data [label #f])
-  (define last-ip (current-input-port))
-  (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 (peek-bytes 2 0))))))
-                         
-  (read-16bit-integer)
-  (field [bits (read-byte)]
-         [height (read-16bit-integer)]
-         [width (read-16bit-integer)]
-         [channels (read-byte)]
-         [colorSpace (case channels
-                       [(1) "DeviceGray"]
-                       [(3) "DeviceRGB"]
-                       [(4) "DeviceCMYK"])]
-         [obj #f])
-
-  (current-input-port last-ip)
+(define JPEG
+  (class object%
+    (super-new)
+    (init-field [(@data data)] [(@label label) #f])
+    
+    (define jpeg-ip (if (input-port? @data) @data (open-input-bytes @data)))
+    (unless (= (read-16bit-integer jpeg-ip) #xffd8)
+      (error 'JPEG "Start of input marker byte not found"))
+    (define marker (let loop ([skip 0])
+                     (read-bytes skip jpeg-ip)
+                     (define m (read-16bit-integer jpeg-ip))
+                     (if (memv m MARKERS)
+                         m
+                         (loop (read-16bit-integer (peek-bytes 2 0 jpeg-ip))))))
+    (read-16bit-integer jpeg-ip)
+    (field [(@bits bits) (read-byte jpeg-ip)]
+           [(@height height) (read-16bit-integer jpeg-ip)]
+           [(@width width) (read-16bit-integer jpeg-ip)]
+           [(@channels channels) (read-byte jpeg-ip)]
+           [(@colorSpace colorSpace) (case @channels
+                                       [(1) "DeviceGray"]
+                                       [(3) "DeviceRGB"]
+                                       [(4) "DeviceCMYK"])]
+           [(@obj obj) #f])
 
-  (as-methods
-   embed))
+    (define/public (embed)
+      (unless @obj
+        (set! @obj (make-ref
+                    (mhash
+                     'Type "XObject"
+                     'Subtype "Image"
+                     'BitsPerComponent @bits
+                     'Width @width
+                     'Height @height
+                     'ColorSpace @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? @colorSpace "DeviceCMYK")
+          (dict-set! @obj 'Decode '(1.0 0.0 1.0 0.0 1.0 0.0 1.0 0.0)))
+        (file-position @data 0)
+        (send* @obj [write @data]
+          [end])))))
 
-(define (read-16bit-integer [bytes-or-port #f])
+(define (read-16bit-integer ip-or-bytes)
   (define signed #f) (define big-endian #t)
-  (integer-bytes->integer
-   (read-bytes 2 (cond
-                   [(bytes? bytes-or-port) (open-input-bytes bytes-or-port)]
-                   [(port? bytes-or-port) bytes-or-port]
-                   [else (current-input-port)])) signed big-endian))
-
-(define/contract (embed this)
-  (->m void?)
+  (integer-bytes->integer (read-bytes 2 (match ip-or-bytes
+                                          [(? bytes? bs) (open-input-bytes bs)]
+                                          [ip ip])) signed big-endian))
 
-  (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) [write (· this data)]
-      [end])))
 
 (module+ test
   (require rackunit)