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

make png-loading not an image tuple

db4
Doug Coleman 2009-06-10 15:50:16 -04:00
parent 0262074b97
commit 38ac04d317
1 changed files with 25 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -10,9 +10,10 @@ IN: images.png
SINGLETON: png-image SINGLETON: png-image
"png" png-image register-image-class "png" png-image register-image-class
TUPLE: loading-png < image chunks TUPLE: loading-png
width height bit-depth color-type compression-method chunks
filter-method interlace-method uncompressed ; width height bit-depth color-type compression-method
filter-method interlace-method uncompressed ;
CONSTRUCTOR: loading-png ( -- image ) CONSTRUCTOR: loading-png ( -- image )
V{ } clone >>chunks ; V{ } clone >>chunks ;
@ -33,22 +34,21 @@ ERROR: bad-png-header header ;
ERROR: bad-checksum ; ERROR: bad-checksum ;
: read-png-chunks ( image -- image ) : read-png-chunks ( loading-png -- loading-png )
<png-chunk> <png-chunk>
4 read be> [ >>length ] [ 4 + ] bi 4 read be> [ >>length ] [ 4 + ] bi
read dup crc32 checksum-bytes read dup crc32 checksum-bytes
4 read = [ bad-checksum ] unless 4 read = [ bad-checksum ] unless
4 cut-slice 4 cut-slice
[ ascii decode >>type ] [ ascii decode >>type ] [ B{ } like >>data ] bi*
[ B{ } like >>data ] bi*
[ over chunks>> push ] [ over chunks>> push ]
[ type>> ] bi "IEND" = [ type>> ] bi "IEND" =
[ read-png-chunks ] unless ; [ read-png-chunks ] unless ;
: find-chunk ( image string -- chunk ) : find-chunk ( loading-png string -- chunk )
[ chunks>> ] dip '[ type>> _ = ] find nip ; [ chunks>> ] dip '[ type>> _ = ] find nip ;
: parse-ihdr-chunk ( image -- image ) : parse-ihdr-chunk ( loading-png -- loading-png )
dup "IHDR" find-chunk data>> { dup "IHDR" find-chunk data>> {
[ [ 0 4 ] dip subseq be> >>width ] [ [ 0 4 ] dip subseq be> >>width ]
[ [ 4 8 ] dip subseq be> >>height ] [ [ 4 8 ] dip subseq be> >>height ]
@ -59,44 +59,44 @@ ERROR: bad-checksum ;
[ [ 12 ] dip nth >>interlace-method ] [ [ 12 ] dip nth >>interlace-method ]
} cleave ; } cleave ;
: find-compressed-bytes ( image -- bytes ) : find-compressed-bytes ( loading-png -- bytes )
chunks>> [ type>> "IDAT" = ] filter chunks>> [ type>> "IDAT" = ] filter
[ data>> ] map concat ; [ data>> ] map concat ;
: fill-image-data ( image -- image )
dup [ width>> ] [ height>> ] bi 2array >>dim ;
: zlib-data ( png-image -- bytes ) : zlib-data ( loading-png -- bytes )
chunks>> [ type>> "IDAT" = ] find nip data>> ; chunks>> [ type>> "IDAT" = ] find nip data>> ;
ERROR: unknown-color-type n ; ERROR: unknown-color-type n ;
ERROR: unimplemented-color-type image ; ERROR: unimplemented-color-type image ;
: inflate-data ( image -- bytes ) : inflate-data ( loading-png -- bytes )
zlib-data zlib-inflate ; zlib-data zlib-inflate ;
: decode-greyscale ( image -- image ) : decode-greyscale ( loading-png -- loading-png )
unimplemented-color-type ; unimplemented-color-type ;
: decode-truecolor ( image -- image ) : png-image-bytes ( loading-png -- byte-array )
{ [ inflate-data ] [ width>> 3 * 1 + ] bi group
[ inflate-data ] reverse-png-filter ;
[ dim>> first 3 * 1 + group reverse-png-filter ]
[ swap >byte-array >>bitmap drop ] : decode-truecolor ( loading-png -- loading-png )
[ RGB >>component-order drop ] [ <image> ] dip {
[ ] [ png-image-bytes >>bitmap ]
[ [ width>> ] [ height>> ] bi 2array >>dim ]
[ drop RGB >>component-order ]
} cleave ; } cleave ;
: decode-indexed-color ( image -- image ) : decode-indexed-color ( loading-png -- loading-png )
unimplemented-color-type ; unimplemented-color-type ;
: decode-greyscale-alpha ( image -- image ) : decode-greyscale-alpha ( loading-png -- loading-png )
unimplemented-color-type ; unimplemented-color-type ;
: decode-truecolor-alpha ( image -- image ) : decode-truecolor-alpha ( loading-png -- loading-png )
unimplemented-color-type ; unimplemented-color-type ;
: decode-png ( image -- image ) : decode-png ( loading-png -- loading-png )
dup color-type>> { dup color-type>> {
{ 0 [ decode-greyscale ] } { 0 [ decode-greyscale ] }
{ 2 [ decode-truecolor ] } { 2 [ decode-truecolor ] }
@ -112,7 +112,6 @@ ERROR: unimplemented-color-type image ;
read-png-header read-png-header
read-png-chunks read-png-chunks
parse-ihdr-chunk parse-ihdr-chunk
fill-image-data
decode-png decode-png
] with-input-stream ; ] with-input-stream ;