write out bitmaps from arbitrary image tuples
parent
07d906086d
commit
cdec85dc8f
|
@ -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 ;
|
||||||
|
|
Loading…
Reference in New Issue