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

images.gif: added transparent pixel support

db4
Keith Lazuka 2009-09-25 09:33:48 -04:00
parent e9c780ba28
commit bb71143054
1 changed files with 21 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
extra/images/gif/gif.factor
View File

@ -37,9 +37,7 @@ ERROR: unknown-extension n ;
ERROR: gif-unexpected-eof ; ERROR: gif-unexpected-eof ;
TUPLE: graphics-control-extension TUPLE: graphics-control-extension
label block-size raw-data flags delay-time transparent-color-index ;
packed delay-time color-index
block-terminator ;
TUPLE: image-descriptor TUPLE: image-descriptor
left top width height flags first-code-size ; left top width height flags first-code-size ;
@ -67,6 +65,8 @@ CONSTANT: graphic-control-extension HEX: f9
CONSTANT: comment-extension HEX: fe CONSTANT: comment-extension HEX: fe
CONSTANT: application-extension HEX: ff CONSTANT: application-extension HEX: ff
CONSTANT: trailer HEX: 3b CONSTANT: trailer HEX: 3b
CONSTANT: graphic-control-extension-block-size HEX: 04
CONSTANT: block-terminator HEX: 00
: <loading-gif> ( -- loading-gif ) : <loading-gif> ( -- loading-gif )
\ loading-gif new \ loading-gif new
@ -101,9 +101,11 @@ M: input-port stream-peek1
: read-graphic-control-extension ( -- graphic-control-extension ) : read-graphic-control-extension ( -- graphic-control-extension )
\ graphics-control-extension new \ graphics-control-extension new
1 read le> [ >>block-size ] [ read ] bi 1 read le> graphic-control-extension-block-size assert=
>>raw-data 1 read le> >>flags
1 read le> >>block-terminator ; 2 read le> >>delay-time
1 read le> >>transparent-color-index
1 read le> block-terminator assert= ;
: read-plain-text-extension ( -- plain-text-extension ) : read-plain-text-extension ( -- plain-text-extension )
\ plain-text-extension new \ plain-text-extension new
@ -147,6 +149,8 @@ ERROR: unimplemented message ;
: interlaced? ( image -- ? ) flags>> 6 bit? ; inline : interlaced? ( image -- ? ) flags>> 6 bit? ; inline
: sort? ( image -- ? ) flags>> 5 bit? ; inline : sort? ( image -- ? ) flags>> 5 bit? ; inline
: color-table-size ( image -- ? ) flags>> 3 bits 1 + 2^ 3 * ; inline : color-table-size ( image -- ? ) flags>> 3 bits 1 + 2^ 3 * ; inline
: transparency? ( image -- ? )
graphic-control-extensions>> first flags>> 0 bit? ; inline
: color-resolution ( image -- ? ) flags>> -4 shift 3 bits ; inline : color-resolution ( image -- ? ) flags>> -4 shift 3 bits ; inline
@ -225,18 +229,26 @@ ERROR: unhandled-data byte ;
[ compressed-bytes>> ] bi [ compressed-bytes>> ] bi
lzw-uncompress ; lzw-uncompress ;
: apply-palette ( indexes palette -- bitmap ) : colorize ( index palette transparent-index/f -- seq )
[ nth 255 suffix ] curry V{ } map-as concat ; pick = [ 2drop B{ 0 0 0 0 } ] [ nth 255 suffix ] if ;
: apply-palette ( indexes palette transparent-index/f -- bitmap )
[ colorize ] 2curry V{ } map-as concat ;
: dimensions ( loading-gif -- dim ) : dimensions ( loading-gif -- dim )
[ image-descriptor>> width>> ] [ image-descriptor>> height>> ] bi 2array ; [ image-descriptor>> width>> ] [ image-descriptor>> height>> ] bi 2array ;
: ?transparent-color-index ( loading-gif -- index/f )
dup transparency?
[ graphic-control-extensions>> first transparent-color-index>> ]
[ drop f ] if ;
: loading-gif>image ( loading-gif -- image ) : loading-gif>image ( loading-gif -- image )
[ <image> ] dip [ <image> ] dip
[ dimensions >>dim ] [ dimensions >>dim ]
[ drop RGBA >>component-order ubyte-components >>component-type ] [ drop RGBA >>component-order ubyte-components >>component-type ]
[ [
[ decompress ] [ global-color-table>> ] bi [ decompress ] [ global-color-table>> ] [ ?transparent-color-index ] tri
apply-palette >>bitmap apply-palette >>bitmap
] tri ; ] tri ;