Merge branch 'master' of http://factorcode.org/git/factor

basis/compression/inflate/inflate.factor

@@ -1,10 +1,9 @@
 ! Copyright (C) 2009 Marc Fauconneau.
 ! 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
 
 QUALIFIED-WITH: bitstreams bs
@@ -177,42 +176,9 @@ CONSTANT: dist-table
         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 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 )
     bs:<lsb0-bit-reader>
     [ check-zlib-header ] [ inflate-loop ] bi

basis/images/png/png.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! 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
 
 SINGLETON: png-image
@@ -78,27 +78,52 @@ ERROR: bad-checksum ;
 
 ERROR: unknown-color-type n ;
 ERROR: unimplemented-color-type image ;
-ERROR: unknown-filter-method image ;
 
 : inflate-data ( loading-png -- bytes )
     find-compressed-bytes zlib-inflate ; 
 
-: png-group-width ( loading-png -- n )
+: scale-bit-depth ( loading-png -- n ) bit-depth>> 8 / ; inline
-    dup color-type>> {
-        { 2 [ [ bit-depth>> 8 / 3 * ] [ width>> ] bi * 1 + ] }
-        { 6 [ [ bit-depth>> 8 / 4 * ] [ width>> ] bi * 1 + ] }
-        [ unknown-color-type ]
-    } case ;
 
-: filter-png ( groups loading-png -- byte-array )
+: png-bytes-per-pixel ( loading-png -- n )
-    filter-method>> {
+    dup color-type>> {
-        { filter-none [ reverse-png-filter ] }
+        { 2 [ scale-bit-depth 3 * ] }
-        [ unknown-filter-method ]
+        { 6 [ scale-bit-depth 4 * ] }
-    } case ;
+        [ unknown-color-type ]
+    } case ; inline
+
+: png-group-width ( loading-png -- n )
+    ! 1 + is for the filter type, 1 byte preceding each line
+    [ png-bytes-per-pixel ] [ width>> ] bi * 1 + ;
+
+:: 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 ;
 
 : png-image-bytes ( loading-png -- byte-array )
-    [ [ inflate-data ] [ png-group-width ] bi group ]
+    [ inflate-data ] [ png-group-width ] bi group reverse-png-filter ;
-    [ filter-png ] bi ;
 
 : decode-greyscale ( loading-png -- loading-png )
     unimplemented-color-type ;