! Copyright (C) 2009 Marc Fauconneau.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs byte-arrays
-byte-vectors combinators fry grouping hashtables
-compression.huffman images io.binary kernel locals
-math math.bitwise math.order math.ranges multiline sequences
-sorting ;
+USING: accessors arrays assocs byte-vectors combinators
+compression.huffman fry hashtables io.binary kernel locals math
+math.bitwise math.order math.ranges sequences sorting ;
+QUALIFIED-WITH: bitstreams bs
IN: compression.inflate
QUALIFIED-WITH: bitstreams bs
{ } [ dup array? [ dup first 16 = ] [ f ] if [ [ unclip-last ] [ second 1 + swap <repetition> append ] bi* ] [ suffix ] if ] reduce
[ dup array? [ second 0 <repetition> ] [ 1array ] if ] map concat
nip swap cut 2array [ [ length>> [0,b) ] [ ] bi get-table ] map ;
-
+
+ : static-huffman-tables ( -- tables )
+ 0 143 [a,b] [ 8 ] replicate
+ 144 255 [a,b] [ 9 ] replicate append
+ 256 279 [a,b] [ 7 ] replicate append
+ 280 287 [a,b] [ 8 ] replicate append
+ 0 31 [a,b] [ 5 ] replicate
+ 2array [ [ length>> [0,b) ] [ ] bi get-table ] map ;
+
CONSTANT: length-table
{
3 4 5 6 7 8 9 10
] each
bytes ;
- :: inflate-dynamic ( bitstream -- bytes )
- bitstream decode-huffman-tables
- bitstream '[ _ swap <huffman-decoder> ] map :> tables
+ :: inflate-huffman ( bitstream tables -- bytes )
+ tables bitstream '[ _ swap <huffman-decoder> ] map :> tables
[
tables first read1-huff2
dup 256 >
bitstream bytes>> <slice>
len 8 * bitstream bs:seek ;
- : inflate-static ( bitstream -- bytes ) zlib-unimplemented ;
+ : inflate-dynamic ( bitstream -- bytes )
+ dup decode-huffman-tables inflate-huffman ;
+
+ : inflate-static ( bitstream -- bytes )
+ static-huffman-tables inflate-huffman ;
:: inflate-loop ( bitstream -- bytes )
[ 1 bitstream bs:read 0 = ]
case
]
[ 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>
-: 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 [ 0 ] replicate prefix
- [ { 0 0 } prepend ] map
- 2 clump [
- first2 dup [ third ] [ 0 2 rot set-nth ] bi png-unfilter-line
- ] map B{ } concat-as ;
-
: zlib-inflate ( bytes -- bytes )
bs:<lsb0-bit-reader>
[ check-zlib-header ] [ inflate-loop ] bi