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>
: 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 [
B{ CHAR: B CHAR: M } write
[
color-index>> length 14 + 40 + write4
bitmap>> bitmap>color-index length 14 + 40 + write4
0 write4
54 write4
40 write4
] [
{
[ width>> write4 ]
[ height>> write4 ]
[ planes>> 1 or write2 ]
[ bit-count>> 24 or write2 ]
[ compression>> 0 or write4 ]
[ size-image>> write4 ]
[ x-pels>> 0 or write4 ]
[ y-pels>> 0 or write4 ]
[ color-used>> 0 or write4 ]
[ color-important>> 0 or write4 ]
[ rgb-quads>> write ]
[ color-index>> write ]
[ dim>> first2 [ write4 ] bi@ ]
[ drop 1 write2 ]
[ drop 24 write2 ]
[ drop 0 write4 ]
[ bitmap>> bitmap>color-index length write4 ]
[ drop 0 write4 ]
[ drop 0 write4 ]
[ drop 0 write4 ]
[ drop 0 write4 ]
! rgb-quads
[ bitmap>> bitmap>color-index write ]
} cleave
] bi
] with-file-writer ;