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 ) : png-components-per-pixel ( loading-png -- n )
color-type>> { color-type>> {
{ greyscale [ 1 ] }
{ truecolor [ 3 ] } { truecolor [ 3 ] }
{ greyscale-alpha [ 2 ] }
{ truecolor-alpha [ 4 ] } { truecolor-alpha [ 4 ] }
[ unknown-color-type ] [ unknown-color-type ]
} case ; inline } case ; inline
@ -135,12 +137,12 @@ ERROR: unimplemented-interlace ;
{ interlace-none [ ] } { interlace-none [ ] }
{ interlace-adam7 [ unimplemented-interlace ] } { interlace-adam7 [ unimplemented-interlace ] }
[ unimplemented-interlace ] [ unimplemented-interlace ]
} case bs:<lsb0-bit-reader> ; } case bs:<msb0-bit-reader> ;
: uncompress-bytes ( loading-png -- bitstream ) : uncompress-bytes ( loading-png -- bitstream )
[ inflate-data ] [ interlace-method>> ] bi reverse-interlace ; [ 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 uncompress-bytes :> bs
loading-png width>> :> width loading-png width>> :> width
loading-png height>> :> height loading-png height>> :> height
@ -165,32 +167,40 @@ ERROR: unknown-component-type n ;
: png-component ( loading-png -- obj ) : png-component ( loading-png -- obj )
bit-depth>> { bit-depth>> {
{ 1 [ ubyte-components ] }
{ 2 [ ubyte-components ] }
{ 4 [ ubyte-components ] }
{ 8 [ ubyte-components ] } { 8 [ ubyte-components ] }
{ 16 [ ushort-components ] } { 16 [ ushort-components ] }
[ unknown-component-type ] [ unknown-component-type ]
} case ; } case ;
: loading-png>image ( loading-png -- image ) : scale-factor ( n -- n' )
[ image new ] dip { {
[ png-image-bytes >>bitmap ] { 1 [ 255 ] }
[ [ width>> ] [ height>> ] bi 2array >>dim ] { 2 [ 127 ] }
[ png-component >>component-type ] { 4 [ 17 ] }
} cleave ; { 8 [ 1 ] }
} case ;
: decode-greyscale ( loading-png -- image ) : scale-greyscale ( byte-array loading-png -- byte-array' )
unimplemented-color-type ; [ 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 ) : decode-greyscale ( loading-png -- byte-array )
loading-png>image RGB >>component-order ; [ raw-bytes ] keep scale-greyscale ;
: 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 ;
ERROR: invalid-color-type/bit-depth loading-png ; 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 ) : validate-truecolor-alpha ( loading-png -- loading-png )
{ 8 16 } validate-bit-depth ; { 8 16 } validate-bit-depth ;
: png>image ( loading-png -- image ) : loading-png>bitmap ( loading-png -- bytes component-order )
dup color-type>> { dup color-type>> {
{ greyscale [ validate-greyscale decode-greyscale ] } { greyscale [
{ truecolor [ validate-truecolor decode-truecolor ] } validate-greyscale decode-greyscale L
{ indexed-color [ validate-indexed-color decode-indexed-color ] } ] }
{ greyscale-alpha [ validate-greyscale-alpha decode-greyscale-alpha ] } { truecolor [
{ truecolor-alpha [ validate-truecolor-alpha decode-truecolor-alpha ] } 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 ] [ unknown-color-type ]
} case ; } 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 ) : load-png ( stream -- loading-png )
[ [
<loading-png> <loading-png>
@ -232,4 +259,4 @@ ERROR: invalid-color-type/bit-depth loading-png ;
] with-input-stream ; ] with-input-stream ;
M: png-image stream>image M: png-image stream>image
drop load-png png>image ; drop load-png loading-png>image ;