cleaning up bitmaps
parent
cdec85dc8f
commit
8ac5834861
|
@ -6,11 +6,13 @@ kernel macros math math.bitwise math.functions namespaces sequences
|
||||||
strings images endian summary ;
|
strings images endian summary ;
|
||||||
IN: images.bitmap
|
IN: images.bitmap
|
||||||
|
|
||||||
TUPLE: bitmap-image < image
|
TUPLE: loading-bitmap
|
||||||
magic size reserved offset header-length width
|
magic size reserved offset header-length width
|
||||||
height planes bit-count compression size-image
|
height planes bit-count compression size-image
|
||||||
x-pels y-pels color-used color-important rgb-quads color-index ;
|
x-pels y-pels color-used color-important rgb-quads color-index ;
|
||||||
|
|
||||||
|
TUPLE: bitmap-image < image ;
|
||||||
|
|
||||||
! Currently can only handle 24/32bit bitmaps.
|
! Currently can only handle 24/32bit bitmaps.
|
||||||
! Handles row-reversed bitmaps (their height is negative)
|
! Handles row-reversed bitmaps (their height is negative)
|
||||||
|
|
||||||
|
@ -30,7 +32,7 @@ M: bitmap-magic summary
|
||||||
|
|
||||||
ERROR: bmp-not-supported n ;
|
ERROR: bmp-not-supported n ;
|
||||||
|
|
||||||
: raw-bitmap>buffer ( bitmap -- array )
|
: raw-bitmap>seq ( bitmap -- array )
|
||||||
dup bit-count>>
|
dup bit-count>>
|
||||||
{
|
{
|
||||||
{ 32 [ color-index>> ] }
|
{ 32 [ color-index>> ] }
|
||||||
|
@ -64,10 +66,10 @@ ERROR: bmp-not-supported n ;
|
||||||
read4 >>color-used
|
read4 >>color-used
|
||||||
read4 >>color-important ;
|
read4 >>color-important ;
|
||||||
|
|
||||||
: rgb-quads-length ( bitmap -- n )
|
: rgb-quads-length ( loading-bitmap -- n )
|
||||||
[ offset>> 14 - ] [ header-length>> ] bi - ;
|
[ offset>> 14 - ] [ header-length>> ] bi - ;
|
||||||
|
|
||||||
: color-index-length ( bitmap -- n )
|
: color-index-length ( loading-bitmap -- n )
|
||||||
{
|
{
|
||||||
[ width>> ]
|
[ width>> ]
|
||||||
[ planes>> * ]
|
[ planes>> * ]
|
||||||
|
@ -79,14 +81,11 @@ ERROR: bmp-not-supported n ;
|
||||||
dup rgb-quads-length read >>rgb-quads
|
dup rgb-quads-length read >>rgb-quads
|
||||||
dup color-index-length read >>color-index ;
|
dup color-index-length read >>color-index ;
|
||||||
|
|
||||||
: load-bitmap-data ( path bitmap -- bitmap )
|
: load-bitmap-data ( path loading-bitmap -- loading-bitmap )
|
||||||
[ binary ] dip '[
|
[ binary ] dip '[
|
||||||
_ parse-file-header parse-bitmap-header parse-bitmap
|
_ parse-file-header parse-bitmap-header parse-bitmap
|
||||||
] with-file-reader ;
|
] with-file-reader ;
|
||||||
|
|
||||||
: process-bitmap-data ( bitmap -- bitmap )
|
|
||||||
dup raw-bitmap>buffer >>bitmap ;
|
|
||||||
|
|
||||||
ERROR: unknown-component-order bitmap ;
|
ERROR: unknown-component-order bitmap ;
|
||||||
|
|
||||||
: bitmap>component-order ( bitmap -- object )
|
: bitmap>component-order ( bitmap -- object )
|
||||||
|
@ -97,26 +96,26 @@ ERROR: unknown-component-order bitmap ;
|
||||||
[ unknown-component-order ]
|
[ unknown-component-order ]
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
: fill-image-slots ( bitmap -- bitmap )
|
: loading-bitmap>bitmap-image ( loading-bitmap -- bitmap-image )
|
||||||
dup {
|
[ bitmap-image new ] dip
|
||||||
|
{
|
||||||
|
[ raw-bitmap>seq >>bitmap ]
|
||||||
[ [ width>> ] [ height>> ] bi 2array >>dim ]
|
[ [ width>> ] [ height>> ] bi 2array >>dim ]
|
||||||
[ bitmap>component-order >>component-order ]
|
[ bitmap>component-order >>component-order ]
|
||||||
[ bitmap>> >>bitmap ]
|
|
||||||
} cleave ;
|
} cleave ;
|
||||||
|
|
||||||
M: bitmap-image load-image* ( path bitmap -- bitmap )
|
M: bitmap-image load-image* ( path loading-bitmap -- bitmap )
|
||||||
load-bitmap-data process-bitmap-data
|
drop loading-bitmap new
|
||||||
fill-image-slots ;
|
load-bitmap-data loading-bitmap>bitmap-image ;
|
||||||
|
|
||||||
MACRO: (nbits>bitmap) ( bits -- )
|
MACRO: (nbits>bitmap) ( bits -- )
|
||||||
[ -3 shift ] keep '[
|
[ -3 shift ] keep '[
|
||||||
bitmap-image new
|
loading-bitmap new
|
||||||
2over * _ * >>size-image
|
2over * _ * >>size-image
|
||||||
swap >>height
|
swap >>height
|
||||||
swap >>width
|
swap >>width
|
||||||
swap array-copy [ >>bitmap ] [ >>color-index ] bi
|
swap array-copy [ >>bitmap ] [ >>color-index ] bi
|
||||||
_ >>bit-count fill-image-slots
|
_ >>bit-count
|
||||||
t >>upside-down?
|
|
||||||
] ;
|
] ;
|
||||||
|
|
||||||
: bgr>bitmap ( array height width -- bitmap )
|
: bgr>bitmap ( array height width -- bitmap )
|
||||||
|
@ -143,15 +142,33 @@ PRIVATE>
|
||||||
40 write4
|
40 write4
|
||||||
] [
|
] [
|
||||||
{
|
{
|
||||||
|
! width height
|
||||||
[ dim>> first2 [ write4 ] bi@ ]
|
[ dim>> first2 [ write4 ] bi@ ]
|
||||||
|
|
||||||
|
! planes
|
||||||
[ drop 1 write2 ]
|
[ drop 1 write2 ]
|
||||||
|
|
||||||
|
! bit-count
|
||||||
[ drop 24 write2 ]
|
[ drop 24 write2 ]
|
||||||
|
|
||||||
|
! compression
|
||||||
[ drop 0 write4 ]
|
[ drop 0 write4 ]
|
||||||
|
|
||||||
|
! size-image
|
||||||
[ bitmap>> bitmap>color-index length write4 ]
|
[ bitmap>> bitmap>color-index length write4 ]
|
||||||
|
|
||||||
|
! x-pels
|
||||||
[ drop 0 write4 ]
|
[ drop 0 write4 ]
|
||||||
|
|
||||||
|
! y-pels
|
||||||
[ drop 0 write4 ]
|
[ drop 0 write4 ]
|
||||||
|
|
||||||
|
! color-used
|
||||||
[ drop 0 write4 ]
|
[ drop 0 write4 ]
|
||||||
|
|
||||||
|
! color-important
|
||||||
[ drop 0 write4 ]
|
[ drop 0 write4 ]
|
||||||
|
|
||||||
! rgb-quads
|
! rgb-quads
|
||||||
[ bitmap>> bitmap>color-index write ]
|
[ bitmap>> bitmap>color-index write ]
|
||||||
} cleave
|
} cleave
|
||||||
|
|
Loading…
Reference in New Issue