From 6773021b41573c70a82adf14f38b214142f3a8e7 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 21 May 2017 22:23:28 -1000 Subject: [PATCH] refac --- pitfall/pitfall/png-reader.rkt | 102 ++++++++++++++------------------- 1 file changed, 43 insertions(+), 59 deletions(-) diff --git a/pitfall/pitfall/png-reader.rkt b/pitfall/pitfall/png-reader.rkt index af9d85be..843b88f9 100644 --- a/pitfall/pitfall/png-reader.rkt +++ b/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)