steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

load greyscale png images, refactor some code

db4
Doug Coleman 2009-10-08 18:18:33 -05:00
parent 7403bcef0c
commit 77f968fad6
1 changed files with 61 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
basis/images/png/png.factor
View File

@ -88,7 +88,9 @@ ERROR: unimplemented-color-type image ;
: png-components-per-pixel ( loading-png -- n )
color-type>> {
{ greyscale [ 1 ] }
{ truecolor [ 3 ] }
{ greyscale-alpha [ 2 ] }
{ truecolor-alpha [ 4 ] }
[ unknown-color-type ]
} case ; inline
@ -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,32 +167,40 @@ 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 ;
: 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-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 ;
: decode-greyscale ( loading-png -- byte-array )
[ raw-bytes ] keep scale-greyscale ;
ERROR: invalid-color-type/bit-depth 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 ;