load greyscale png images, refactor some code

diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor
index 74c40d12916c0a9a54db8f00b64b4dfa5ffadd72..469c060776ec231d6ecd4fce0b4e06ca5a077d01 100755 (executable)
--- a/basis/images/png/png.factor
+++ b/basis/images/png/png.factor
@@ -58,7 +58,7 @@ ERROR: bad-checksum ;
     4 read = [ bad-checksum ] unless
     4 cut-slice
     [ ascii decode >>type ] [ B{ } like >>data ] bi*
-    [ over chunks>> push ] 
+    [ over chunks>> push ]
     [ type>> ] bi "IEND" =
     [ read-png-chunks ] unless ;
 
@@ -84,11 +84,13 @@ ERROR: unknown-color-type n ;
 ERROR: unimplemented-color-type image ;
 
 : inflate-data ( loading-png -- bytes )
-    find-compressed-bytes zlib-inflate ; 
+    find-compressed-bytes zlib-inflate ;
 
 : png-components-per-pixel ( loading-png -- n )
     color-type>> {
+        { greyscale [ 1 ] }
         { truecolor [ 3 ] }
+        { greyscale-alpha [ 2 ] }
         { truecolor-alpha [ 4 ] }
         [ unknown-color-type ]
     } case ; inline
@@ -98,8 +100,8 @@ ERROR: unimplemented-color-type image ;
     [ [ png-components-per-pixel ] [ bit-depth>> ] bi * ]
     [ width>> ] bi * 1 + ;
 
-:: paeth ( a b c -- p ) 
-    a b + c - { a b c } [ [ - abs ] keep 2array ] with map 
+:: paeth ( a b c -- p )
+    a b + c - { a b c } [ [ - abs ] keep 2array ] with map
     sort-keys first second ;
 
 :: png-unfilter-line ( width prev curr filter -- curr' )
@@ -114,7 +116,7 @@ ERROR: unimplemented-color-type image ;
         { 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 
+    } case
     curr width tail ;
 
 :: reverse-png-filter ( lines n -- byte-array )
@@ -135,12 +137,12 @@ ERROR: unimplemented-interlace ;
         { interlace-none [ ] }
         { interlace-adam7 [ unimplemented-interlace ] }
         [ unimplemented-interlace ]
-    } case bs:<lsb0-bit-reader> ;
+    } case bs:<msb0-bit-reader> ;
 
 : uncompress-bytes ( loading-png -- bitstream )
     [ inflate-data ] [ interlace-method>> ] bi reverse-interlace ;
 
-:: png-image-bytes ( loading-png -- byte-array )
+:: raw-bytes ( loading-png -- array )
     loading-png uncompress-bytes :> bs
     loading-png width>> :> width
     loading-png height>> :> height
@@ -165,33 +167,41 @@ ERROR: unknown-component-type n ;
 
 : png-component ( loading-png -- obj )
     bit-depth>> {
+        { 1 [ ubyte-components ] }
+        { 2 [ ubyte-components ] }
+        { 4 [ ubyte-components ] }
         { 8 [ ubyte-components ] }
         { 16 [ ushort-components ] }
         [ unknown-component-type ]
     } case ;
 
-: loading-png>image ( loading-png -- image )
-    [ image new ] dip {
-        [ png-image-bytes >>bitmap ]
-        [ [ width>> ] [ height>> ] bi 2array >>dim ]
-        [ png-component >>component-type ]
-    } cleave ;
-
-: decode-greyscale ( loading-png -- image )
-    unimplemented-color-type ;
-
-: decode-truecolor ( loading-png -- image )
-    loading-png>image RGB >>component-order ;
-    
-: decode-indexed-color ( loading-png -- image )
-    unimplemented-color-type ;
-
-: decode-greyscale-alpha ( loading-png -- image )
-    unimplemented-color-type ;
+: scale-factor ( n -- n' )
+    {
+        { 1 [ 255 ] }
+        { 2 [ 127 ] }
+        { 4 [ 17 ] }
+        { 8 [ 1 ] }
+    } case ;
 
-: decode-truecolor-alpha ( loading-png -- image )
-    loading-png>image RGBA >>component-order ;
+: scale-greyscale ( byte-array loading-png -- byte-array' )
+    [ bit-depth>> ] [ color-type>> ] bi {
+        { greyscale [
+            dup 16 = [
+                drop
+            ] [
+                scale-factor '[ _ * ] B{ } map-as
+            ] if
+        ] }
+        { greyscale-alpha [
+            [ 8 group ] dip '[
+                [ [ 0 5 ] dip <slice> [ _ * ] change-each ] keep
+            ] map B{ } concat-as
+        ] }
+    } case ;
 
+: decode-greyscale ( loading-png -- byte-array )
+    [ raw-bytes ] keep scale-greyscale ;
+ 
 ERROR: invalid-color-type/bit-depth loading-png ;
 
 : validate-bit-depth ( loading-png seq -- loading-png )
@@ -213,16 +223,33 @@ ERROR: invalid-color-type/bit-depth loading-png ;
 : validate-truecolor-alpha ( loading-png -- loading-png )
     { 8 16 } validate-bit-depth ;
 
-: png>image ( loading-png -- image )
+: loading-png>bitmap ( loading-png -- bytes component-order )
     dup color-type>> {
-        { greyscale [ validate-greyscale decode-greyscale ] }
-        { truecolor [ validate-truecolor decode-truecolor ] }
-        { indexed-color [ validate-indexed-color decode-indexed-color ] }
-        { greyscale-alpha [ validate-greyscale-alpha decode-greyscale-alpha ] }
-        { truecolor-alpha [ validate-truecolor-alpha decode-truecolor-alpha ] }
+        { greyscale [
+            validate-greyscale decode-greyscale L
+        ] }
+        { truecolor [
+            validate-truecolor raw-bytes RGB
+        ] }
+        { indexed-color [
+            validate-indexed-color unimplemented-color-type
+        ] }
+        { greyscale-alpha [
+            validate-greyscale-alpha decode-greyscale LA
+        ] }
+        { truecolor-alpha [
+            validate-truecolor-alpha raw-bytes RGBA
+        ] }
         [ unknown-color-type ]
     } case ;
 
+: loading-png>image ( loading-png -- image )
+    [ image new ] dip {
+        [ loading-png>bitmap [ >>bitmap ] [ >>component-order ] bi* ]
+        [ [ width>> ] [ height>> ] bi 2array >>dim ]
+        [ png-component >>component-type ]
+    } cleave ;
+
 : load-png ( stream -- loading-png )
     [
         <loading-png>
@@ -232,4 +259,4 @@ ERROR: invalid-color-type/bit-depth loading-png ;
     ] with-input-stream ;
 
 M: png-image stream>image
-    drop load-png png>image ;
+    drop load-png loading-png>image ;