move the png filtering code to images.png

db4
Doug Coleman 2009-09-26 20:09:16 -05:00
parent 16cf080393
commit 030351ef87
2 changed files with 35 additions and 42 deletions

View File

@ -1,10 +1,9 @@
! Copyright (C) 2009 Marc Fauconneau. ! Copyright (C) 2009 Marc Fauconneau.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs byte-arrays USING: accessors arrays assocs byte-vectors combinators
byte-vectors combinators fry grouping hashtables compression.huffman fry hashtables io.binary kernel locals math
compression.huffman images io.binary kernel locals math.bitwise math.order math.ranges sequences sorting ;
math math.bitwise math.order math.ranges multiline sequences QUALIFIED-WITH: bitstreams bs
sorting ;
IN: compression.inflate IN: compression.inflate
QUALIFIED-WITH: bitstreams bs QUALIFIED-WITH: bitstreams bs
@ -178,41 +177,8 @@ CONSTANT: dist-table
] ]
[ produce ] keep call suffix concat ; [ produce ] keep call suffix concat ;
! [ produce ] keep dip swap suffix
:: paeth ( a b c -- p )
a b + c - { a b c } [ [ - abs ] keep 2array ] with map
sort-keys first second ;
:: png-unfilter-line ( prev curr filter -- curr' )
prev :> c
prev 3 tail-slice :> b
curr :> a
curr 3 tail-slice :> x
x length [0,b)
filter {
{ 0 [ drop ] }
{ 1 [ [| n | n x nth n a nth + 256 wrap n x set-nth ] each ] }
{ 2 [ [| n | n x nth n b nth + 256 wrap n x set-nth ] each ] }
{ 3 [ [| n | n x nth n a nth n b nth + 2/ + 256 wrap n x set-nth ] each ] }
{ 4 [ [| n | n x nth n a nth n b nth n c nth paeth + 256 wrap n x set-nth ] each ] }
} case
curr 3 tail ;
PRIVATE> PRIVATE>
: reverse-png-filter' ( lines -- byte-array )
[ first ] [ 1 tail ] [ map ] bi-curry@ bi nip
concat [ 128 + ] B{ } map-as ;
: reverse-png-filter ( lines -- byte-array )
dup first length 0 <array> prefix
[ { 0 0 } prepend ] map
2 clump [
first2 dup [ third ] [ [ 0 2 ] dip set-nth ] bi
png-unfilter-line
] map B{ } concat-as ;
: zlib-inflate ( bytes -- bytes ) : zlib-inflate ( bytes -- bytes )
bs:<lsb0-bit-reader> bs:<lsb0-bit-reader>
[ check-zlib-header ] [ inflate-loop ] bi [ check-zlib-header ] [ inflate-loop ] bi

View File

@ -1,9 +1,9 @@
! Copyright (C) 2009 Doug Coleman. ! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors images io io.binary io.encodings.ascii USING: accessors arrays checksums checksums.crc32 combinators
io.encodings.binary io.encodings.string io.files io.files.info kernel compression.inflate fry grouping images images.loader io
sequences io.streams.limited fry combinators arrays math checksums io.binary io.encodings.ascii io.encodings.string kernel locals
checksums.crc32 compression.inflate grouping byte-arrays images.loader ; math math.bitwise math.ranges sequences sorting ;
IN: images.png IN: images.png
SINGLETON: png-image SINGLETON: png-image
@ -90,6 +90,33 @@ ERROR: unknown-filter-method image ;
[ unknown-color-type ] [ unknown-color-type ]
} case ; } case ;
:: paeth ( a b c -- p )
a b + c - { a b c } [ [ - abs ] keep 2array ] with map
sort-keys first second ;
:: png-unfilter-line ( prev curr filter -- curr' )
prev :> c
prev 3 tail-slice :> b
curr :> a
curr 3 tail-slice :> x
x length [0,b)
filter {
{ filter-none [ drop ] }
{ filter-sub [ [| n | n x nth n a nth + 256 wrap n x set-nth ] each ] }
{ filter-up [ [| n | n x nth n b nth + 256 wrap n x set-nth ] each ] }
{ filter-average [ [| n | n x nth n a nth n b nth + 2/ + 256 wrap n x set-nth ] each ] }
{ filter-paeth [ [| n | n x nth n a nth n b nth n c nth paeth + 256 wrap n x set-nth ] each ] }
} case
curr 3 tail ;
: reverse-png-filter ( lines -- byte-array )
dup first length 0 <array> prefix
[ { 0 0 } prepend ] map
2 clump [
first2 dup [ third ] [ [ 0 2 ] dip set-nth ] bi
png-unfilter-line
] map B{ } concat-as ;
: filter-png ( groups loading-png -- byte-array ) : filter-png ( groups loading-png -- byte-array )
filter-method>> { filter-method>> {
{ filter-none [ reverse-png-filter ] } { filter-none [ reverse-png-filter ] }