main
Matthew Butterick 6 years ago
parent cb4dcd8bc0
commit 621769a279

@ -104,19 +104,24 @@
#;(report 'unpacking-argb) #;(report 'unpacking-argb)
(define-values (imgBytes alphaBytes) (define-values (imgBytes alphaBytes)
(time (for/fold ([img-bytes empty] (parameterize ([current-input-port (open-input-bytes pixels)])
[alpha-bytes empty]) (for/fold ([img-bytes empty]
([pixel (in-port (λ (p) (read-bytes 4 p)) (open-input-bytes pixels))]) [alpha-bytes empty]
(values (cons (subbytes pixel 1 4) img-bytes) #:result (values (apply bytes-append (reverse img-bytes))
(cons (subbytes pixel 0 1) alpha-bytes))))) (apply bytes-append (reverse alpha-bytes))))
([i (in-naturals)]
#:break (eof-object? (peek-byte)))
(if (even? i)
(values img-bytes (cons (read-bytes 1) alpha-bytes))
(values (cons (read-bytes 3) img-bytes) alpha-bytes)))))
(report 'deflate-imgBytes) #;(report 'deflate-imgBytes)
(set-field! imgData this (time (deflate (apply bytes-append (reverse imgBytes))))) (set-field! imgData this (deflate imgBytes))
(report 'deflate-alphaBytes) #;(report 'deflate-alphaBytes)
(set-field! alphaChannel this (time (deflate (apply bytes-append (reverse alphaBytes)))))) (set-field! alphaChannel this (deflate alphaBytes)))
;; test files ;; test files
;; http://www.libpng.org/pub/png/png-sitemap.html#images ;; http://www.libpng.org/pub/png/png-sitemap.html#images
(module+ test (module+ test
(define pic (make-object PNG (open-input-file "../ptest/assets/test.png"))) (define pic (make-object PNG (open-input-file "../ptest/assets/death-alpha.png")))
(splitAlphaChannel pic)) (splitAlphaChannel pic))
Loading…
Cancel
Save