From 77f968fad6fa529086631e1ed9f5b28012764b96 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 8 Oct 2009 18:18:33 -0500 Subject: [PATCH] load greyscale png images, refactor some code --- basis/images/png/png.factor | 95 ++++++++++++++++++++++++------------- 1 file changed, 61 insertions(+), 34 deletions(-) diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor index 74c40d1291..469c060776 100755 --- 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: ; + } case bs: ; : 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 ; +: scale-factor ( n -- n' ) + { + { 1 [ 255 ] } + { 2 [ 127 ] } + { 4 [ 17 ] } + { 8 [ 1 ] } + } case ; -: 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 ; - -: 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 [ _ * ] 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 ) [ @@ -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 ;