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

make a png-image type instead of having a singleton class

db4
Doug Coleman 2009-09-28 14:50:36 -05:00
parent bf2cfd0aa6
commit 1fb7cf37c4
1 changed files with 13 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -6,7 +6,7 @@ io.binary io.encodings.ascii io.encodings.string kernel locals
math math.bitwise math.ranges sequences sorting ; math math.bitwise math.ranges sequences sorting ;
IN: images.png IN: images.png
SINGLETON: png-image TUPLE: png-image < image ;
"png" png-image register-image-class "png" png-image register-image-class
TUPLE: loading-png TUPLE: loading-png
@ -123,17 +123,22 @@ ERROR: unimplemented-color-type image ;
] map B{ } concat-as ; ] map B{ } concat-as ;
: png-image-bytes ( loading-png -- byte-array ) : png-image-bytes ( loading-png -- byte-array )
[ png-bytes-per-pixel ] [ inflate-data ] [ png-group-width ] tri group reverse-png-filter ; [ png-bytes-per-pixel ]
[ inflate-data ]
[ png-group-width ] tri group reverse-png-filter ;
: loading-png>image ( loading-png -- image )
[ png-image new ] dip {
[ png-image-bytes >>bitmap ]
[ [ width>> ] [ height>> ] bi 2array >>dim ]
[ drop ubyte-components >>component-type ]
} cleave ;
: decode-greyscale ( loading-png -- image ) : decode-greyscale ( loading-png -- image )
unimplemented-color-type ; unimplemented-color-type ;
: decode-truecolor ( loading-png -- image ) : decode-truecolor ( loading-png -- image )
[ <image> ] dip { loading-png>image RGB >>component-order ;
[ png-image-bytes >>bitmap ]
[ [ width>> ] [ height>> ] bi 2array >>dim ]
[ drop RGB >>component-order ubyte-components >>component-type ]
} cleave ;
: decode-indexed-color ( loading-png -- image ) : decode-indexed-color ( loading-png -- image )
unimplemented-color-type ; unimplemented-color-type ;
@ -142,11 +147,7 @@ ERROR: unimplemented-color-type image ;
unimplemented-color-type ; unimplemented-color-type ;
: decode-truecolor-alpha ( loading-png -- image ) : decode-truecolor-alpha ( loading-png -- image )
[ <image> ] dip { loading-png>image RGBA >>component-order ;
[ png-image-bytes >>bitmap ]
[ [ width>> ] [ height>> ] bi 2array >>dim ]
[ drop RGBA >>component-order ubyte-components >>component-type ]
} cleave ;
ERROR: invalid-color-type/bit-depth loading-png ; ERROR: invalid-color-type/bit-depth loading-png ;