]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'a7a39d3766624227966bca34f0778030592d82c2' of git://github.com/prunedtre...
authorDoug Coleman <doug.coleman@gmail.com>
Tue, 6 Oct 2009 03:27:43 +0000 (22:27 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Tue, 6 Oct 2009 03:27:43 +0000 (22:27 -0500)
1  2 
basis/compression/inflate/inflate.factor

index 26b851cc1eb5b20157dd0c1144c95cb294ee0363,e56b2c7a1ccf70d75fd26f64ff9181cde91328dc..ecc6493c3288f1c928fc3f7e4ba3a2cf52333486
@@@ -1,9 -1,10 +1,9 @@@
  ! 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
@@@ -66,7 -67,15 +66,15 @@@ CONSTANT: clen-shuffle { 16 17 18 0 8 
      { } [ 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
@@@ -102,9 -111,8 +110,8 @@@ CONSTANT: dist-tabl
      ] 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