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

write out bitmaps from arbitrary image tuples

db4
Doug Coleman 2009-03-14 14:48:28 -05:00
parent 07d906086d
commit cdec85dc8f
1 changed files with 16 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
basis/images/bitmap/bitmap.factor
View File

@ -130,28 +130,30 @@ MACRO: (nbits>bitmap) ( bits -- )
PRIVATE> PRIVATE>
: save-bitmap ( bitmap path -- ) : bitmap>color-index ( bitmap-array -- byte-array )
4 <sliced-groups> [ 3 head-slice reverse ] map B{ } join ; inline
: save-bitmap ( image path -- )
binary [ binary [
B{ CHAR: B CHAR: M } write B{ CHAR: B CHAR: M } write
[ [
color-index>> length 14 + 40 + write4 bitmap>> bitmap>color-index length 14 + 40 + write4
0 write4 0 write4
54 write4 54 write4
40 write4 40 write4
] [ ] [
{ {
[ width>> write4 ] [ dim>> first2 [ write4 ] bi@ ]
[ height>> write4 ] [ drop 1 write2 ]
[ planes>> 1 or write2 ] [ drop 24 write2 ]
[ bit-count>> 24 or write2 ] [ drop 0 write4 ]
[ compression>> 0 or write4 ] [ bitmap>> bitmap>color-index length write4 ]
[ size-image>> write4 ] [ drop 0 write4 ]
[ x-pels>> 0 or write4 ] [ drop 0 write4 ]
[ y-pels>> 0 or write4 ] [ drop 0 write4 ]
[ color-used>> 0 or write4 ] [ drop 0 write4 ]
[ color-important>> 0 or write4 ] ! rgb-quads
[ rgb-quads>> write ] [ bitmap>> bitmap>color-index write ]
[ color-index>> write ]
} cleave } cleave
] bi ] bi
] with-file-writer ; ] with-file-writer ;