refac

pitfall/pitfall/png-reader.rkt

@@ -81,81 +81,65 @@ Grab key chunks from PNG. Doesn't require heavy lifting from libpng.
   (define scanlineLength (* pixelBytes width))
   (define pixels (make-bytes (* scanlineLength height)))
 
-  (define (left-byte i c) (if (< i pixelBytes)
+  (define (left-byte idx c) (if (< idx pixelBytes)
                               0
                               (bytes-ref pixels (- c pixelBytes))))
 
-  (define (upper-byte row col i)
-    (if (zero? row)
-        row
-        (bytes-ref pixels
-                   (+ (* (sub1 row) scanlineLength)
-                      (* col pixelBytes)
-                      (modulo i pixelBytes)))))
+  (define (upper-byte row col idx)
+    (if (zero? row) 0 (bytes-ref pixels (+ (* (sub1 row) scanlineLength)
+                                           (* col pixelBytes)
+                                           (modulo idx pixelBytes)))))
 
   (define (get-col i) ((i . - . (modulo i pixelBytes)) . / . pixelBytes))
 
+  (define (fold/scanline c-in proc)
+    (for/fold ([c c-in])
+              ([idx (in-range scanlineLength)]
+               [byte (in-port read-byte)])
+      (bytes-set! pixels c (proc c idx byte))
+      (add1 c)))
+
   (parameterize ([current-input-port (open-input-bytes (inflate imgData))])
     (for/fold ([c 0])
               ([row (in-naturals)]
                #:break (eof-object? (peek-byte)))
       (case (read-byte)
-        [(0) ; none
-         (for/fold ([c c])
-                   ([i (in-range scanlineLength)]
-                    [byte (in-port read-byte)])
-           (bytes-set! pixels c byte)
-           (add1 c))]
-        [(1) ; sub
-         (for/fold ([c c])
-                   ([i (in-range scanlineLength)]
-                    [byte (in-port read-byte)])
-           (define left (left-byte i c))
-           (bytes-set! pixels c (modulo (+ byte left) 256))
-           (add1 c))]
-        [(2) ; up
-         (for/fold ([c c])
-                   ([i (in-range scanlineLength)]
-                    [byte (in-port read-byte)])
-           (bytes-set! pixels c (modulo (+ (upper-byte row (get-col i) i) byte) 256))
-           (add1 c))]
-        [(3) ; average
-         (for/fold ([c c])
-                   ([i (in-range scanlineLength)]
-                    [byte (in-port read-byte)])
-           (bytes-set! pixels c (modulo (+ byte (floor (/ (+ (left-byte i c) (upper-byte row (get-col i) i)) 2))) 256))
-           (add1 c))]
+        ;; none
+        [(0) (fold/scanline c (λ (c idx byte) byte))]
+        ;; sub
+        [(1) (fold/scanline c (λ (c idx byte) (modulo (+ byte (left-byte idx c)) 256)))]
+        ;; up
+        [(2) (fold/scanline c (λ (c idx byte) (modulo (+ (upper-byte row (get-col idx) idx) byte) 256)))]
+        ;; ; average
+        [(3) (fold/scanline c (λ (c idx byte) (modulo (+ byte (floor (/ (+ (left-byte idx c) (upper-byte row (get-col idx) idx)) 2))) 256)))]
         [(4) ; paeth
-         (for/fold ([c c])
-                   ([i (in-range scanlineLength)]
-                    [byte (in-port read-byte)])
-           (define col (get-col i))
-           (match-define (list upper upperLeft)
-             (cond
-               [(zero? row) (list 0 0)]
-               [else (define upper (upper-byte row col i))
-                     (define upperLeft (if (zero? col)
-                                           col
-                                           (bytes-ref pixels
-                                                      (+ (* (sub1 row) scanlineLength)
-                                                         (* (sub1 col) pixelBytes)
-                                                         (modulo i pixelBytes)))))
-                     (list upper upperLeft)]))
+         (fold/scanline c (λ (c idx byte)
+                            (define col (get-col idx))
+                            (match-define (list upper upperLeft)
+                              (cond
+                                [(zero? row) (list 0 0)]
+                                [else (define upper (upper-byte row col idx))
+                                      (define upperLeft (if (zero? col)
+                                                            col
+                                                            (bytes-ref pixels
+                                                                       (+ (* (sub1 row) scanlineLength)
+                                                                          (* (sub1 col) pixelBytes)
+                                                                          (modulo idx pixelBytes)))))
+                                      (list upper upperLeft)]))
 
-           (define left (left-byte i c))
+                            (define left (left-byte idx c))
            
-           (match-define (list pa pb pc)
-             (for/list ([x (in-list (list left upper upperLeft))])
-               (define p (+ left upper (- upperLeft)))
-               (abs (- p x))))
+                            (match-define (list pa pb pc)
+                              (for/list ([x (in-list (list left upper upperLeft))])
+                                (define p (+ left upper (- upperLeft)))
+                                (abs (- p x))))
            
-           (define paeth (cond
-                           [(and (<= pa pb) (<= pa pc)) left]
-                           [(<= pb pc) upper]
-                           [else upperLeft]))
+                            (define paeth (cond
+                                            [(and (<= pa pb) (<= pa pc)) left]
+                                            [(<= pb pc) upper]
+                                            [else upperLeft]))
            
-           (bytes-set! pixels c (modulo (+ byte paeth) 256))
-           (add1 c))]
+                            (modulo (+ byte paeth) 256)))]
         [else (error 'invalid-png-filter-algorithm )])))
   pixels)