clean up bitmap code, support a lot more bitmaps like 1/4/16 bit

db4
Doug Coleman 2009-06-03 21:36:03 -05:00
parent 3550621341
commit 31595542d3
1 changed files with 172 additions and 56 deletions

View File

@ -2,14 +2,14 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types arrays byte-arrays columns USING: accessors alien alien.c-types arrays byte-arrays columns
combinators compression.run-length endian fry grouping images combinators compression.run-length endian fry grouping images
images.loader io io.binary io.encodings.binary io.files kernel images.loader io io.binary io.encodings.binary io.files
locals macros math math.bitwise math.functions namespaces io.streams.limited kernel locals macros math math.bitwise
sequences strings summary ; math.functions namespaces sequences specialized-arrays.uint
specialized-arrays.ushort strings summary io.encodings.8-bit
io.encodings.string ;
QUALIFIED-WITH: bitstreams b
IN: images.bitmap IN: images.bitmap
: assert-sequence= ( a b -- )
2dup sequence= [ 2drop ] [ assert ] if ;
: read2 ( -- n ) 2 read le> ; : read2 ( -- n ) 2 read le> ;
: read4 ( -- n ) 4 read le> ; : read4 ( -- n ) 4 read le> ;
: write2 ( n -- ) 2 >le write ; : write2 ( n -- ) 2 >le write ;
@ -17,62 +17,130 @@ IN: images.bitmap
TUPLE: bitmap-image < image ; TUPLE: bitmap-image < image ;
! Used to construct the final bitmap-image
TUPLE: loading-bitmap TUPLE: loading-bitmap
size reserved offset header-length width magic size reserved1 reserved2 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 color-palette color-index x-pels y-pels color-used color-important
uncompressed-bytes ; red-mask green-mask blue-mask alpha-mask
cs-type end-points
gamma-red gamma-green gamma-blue
intent profile-data profile-size reserved3
color-palette color-index bitfields ;
ERROR: bitmap-magic magic ; ! endpoints-triple is ciexyzX/Y/Z, 3x fixed-point-2.30 aka 3x uint
M: bitmap-magic summary
drop "First two bytes of bitmap stream must be 'BM'" ;
<PRIVATE <PRIVATE
: 8bit>buffer ( bitmap -- array ) : os2-color-lookup ( loading-bitmap -- seq )
[ color-palette>> 4 <sliced-groups> [ 3 head-slice ] map ] [ color-index>> >array ]
[ color-index>> >array ] bi [ swap nth ] with map concat ; [ color-palette>> 3 <sliced-groups> ] bi
'[ _ nth ] map concat ;
: os2v2-color-lookup ( loading-bitmap -- seq )
[ color-index>> >array ]
[ color-palette>> 3 <sliced-groups> ] bi
'[ _ nth ] map concat ;
: v3-color-lookup ( loading-bitmap -- seq )
[ color-index>> >array ]
[ color-palette>> 4 <sliced-groups> [ 3 head-slice ] map ] bi
'[ _ nth ] map concat ;
: color-lookup ( loading-bitmap -- seq )
dup header-length>> {
{ 12 [ os2-color-lookup ] }
{ 64 [ os2v2-color-lookup ] }
{ 40 [ v3-color-lookup ] }
! { 108 [ v4-color-lookup ] }
! { 124 [ v5-color-lookup ] }
} case ;
ERROR: bmp-not-supported n ; ERROR: bmp-not-supported n ;
: reverse-lines ( byte-array width -- byte-array ) : uncompress-bitfield ( seq masks -- bytes' )
<sliced-groups> <reversed> concat ; inline '[
_ [
[ bitand ] [ bit-count ] [ log2 ] tri - shift
] with map
] { } map-as B{ } concat-as ;
: bitmap>bytes ( loading-bitmap -- array ) : bitmap>bytes ( loading-bitmap -- byte-array )
dup bit-count>> dup bit-count>>
{ {
{ 32 [ color-index>> ] } { 32 [ color-index>> ] }
{ 24 [ [ color-index>> ] [ width>> 3 * ] bi reverse-lines ] } { 24 [ color-index>> ] }
{ 8 [ [ 8bit>buffer ] [ width>> 3 * ] bi reverse-lines ] } { 16 [
[
! byte-array>ushort-array
2 group [ le> ] map
! 5 6 5
! { HEX: f800 HEX: 7e0 HEX: 1f } uncompress-bitfield
! 5 5 5
{ HEX: 7c00 HEX: 3e0 HEX: 1f } uncompress-bitfield
] change-color-index
color-index>>
] }
{ 8 [ color-lookup ] }
{ 4 [ [ 4 b:byte-array-n>seq ] change-color-index color-lookup ] }
{ 1 [ [ 1 b:byte-array-n>seq ] change-color-index color-lookup ] }
[ bmp-not-supported ] [ bmp-not-supported ]
} case >byte-array ; } case >byte-array ;
: set-bitfield-widths ( loading-bitmap -- loading-bitmap' )
dup bit-count>> {
{ 16 [ dup color-palette>> 4 group [ le> ] map ] }
{ 32 [ { HEX: ff0000 HEX: ff00 HEX: ff } ] }
} case reverse >>bitfields ;
ERROR: unsupported-bitfield-widths n ;
M: unsupported-bitfield-widths summary
drop "Bitmaps only support bitfield compression in 16/32bit images" ;
: uncompress-bitfield-widths ( loading-bitmap -- loading-bitmap' )
set-bitfield-widths
dup bit-count>> {
{ 16 [
dup bitfields>> '[
byte-array>ushort-array _ uncompress-bitfield
] change-color-index
] }
{ 32 [
dup bitfields>> '[
byte-array>uint-array _ uncompress-bitfield
] change-color-index
] }
[ unsupported-bitfield-widths ]
} case ;
ERROR: unsupported-bitmap-compression compression ; ERROR: unsupported-bitmap-compression compression ;
: uncompress-bitmap ( loading-bitmap -- loading-bitmap' ) : uncompress-bitmap ( loading-bitmap -- loading-bitmap' )
dup compression>> { dup compression>> {
{ f [ ] }
{ 0 [ ] } { 0 [ ] }
{ 1 [ [ run-length-uncompress8 ] change-color-index ] } { 1 [ [ run-length-uncompress ] change-color-index ] }
{ 2 [ "run-length encoding 4" unsupported-bitmap-compression ] } { 2 [ [ 4 b:byte-array-n>seq run-length-uncompress >byte-array ] change-color-index ] }
{ 3 [ "bitfields" unsupported-bitmap-compression ] } { 3 [ uncompress-bitfield-widths ] }
{ 4 [ "jpeg" unsupported-bitmap-compression ] } { 4 [ "jpeg" unsupported-bitmap-compression ] }
{ 5 [ "png" unsupported-bitmap-compression ] } { 5 [ "png" unsupported-bitmap-compression ] }
} case ; } case ;
: bitmap-padding ( width -- n )
3 * 4 mod 4 swap - 4 mod ; inline
: loading-bitmap>bytes ( loading-bitmap -- byte-array ) : loading-bitmap>bytes ( loading-bitmap -- byte-array )
uncompress-bitmap bitmap>bytes ; uncompress-bitmap
bitmap>bytes ;
: parse-file-header ( loading-bitmap -- loading-bitmap ) : parse-file-header ( loading-bitmap -- loading-bitmap )
2 read "BM" assert-sequence= 2 read latin1 decode >>magic
read4 >>size read4 >>size
read4 >>reserved read2 >>reserved1
read2 >>reserved2
read4 >>offset ; read4 >>offset ;
: parse-bitmap-header ( loading-bitmap -- loading-bitmap ) : read-v3-header ( loading-bitmap -- loading-bitmap )
read4 >>header-length
read4 >>width read4 >>width
read4 32 >signed >>height read4 32 >signed >>height
read2 >>planes read2 >>planes
@ -84,6 +152,50 @@ ERROR: unsupported-bitmap-compression compression ;
read4 >>color-used read4 >>color-used
read4 >>color-important ; read4 >>color-important ;
: read-v4-header ( loading-bitmap -- loading-bitmap )
read-v3-header
read4 >>red-mask
read4 >>green-mask
read4 >>blue-mask
read4 >>alpha-mask
read4 >>cs-type
read4 read4 read4 3array >>end-points
read4 >>gamma-red
read4 >>gamma-green
read4 >>gamma-blue ;
: read-v5-header ( loading-bitmap -- loading-bitmap )
read-v4-header
read4 >>intent
read4 >>profile-data
read4 >>profile-size
read4 >>reserved3 ;
: read-os2-header ( loading-bitmap -- loading-bitmap )
read2 >>width
read2 16 >signed >>height
read2 >>planes
read2 >>bit-count ;
: read-os2v2-header ( loading-bitmap -- loading-bitmap )
read4 >>width
read4 32 >signed >>height
read2 >>planes
read2 >>bit-count ;
ERROR: unknown-bitmap-header n ;
: parse-bitmap-header ( loading-bitmap -- loading-bitmap )
read4 [ >>header-length ] keep
{
{ 12 [ read-os2-header ] }
{ 64 [ read-os2v2-header ] }
{ 40 [ read-v3-header ] }
{ 108 [ read-v4-header ] }
{ 124 [ read-v5-header ] }
[ unknown-bitmap-header ]
} case ;
: color-palette-length ( loading-bitmap -- n ) : color-palette-length ( loading-bitmap -- n )
[ offset>> 14 - ] [ header-length>> ] bi - ; [ offset>> 14 - ] [ header-length>> ] bi - ;
@ -98,53 +210,54 @@ ERROR: unsupported-bitmap-compression compression ;
: image-size ( loading-bitmap -- n ) : image-size ( loading-bitmap -- n )
[ [ width>> ] [ height>> ] bi * ] [ bit-count>> 8 /i ] bi * abs ; [ [ width>> ] [ height>> ] bi * ] [ bit-count>> 8 /i ] bi * abs ;
: bitmap-padding ( width -- n )
3 * 4 mod 4 swap - 4 mod ; inline
:: fixup-color-index ( loading-bitmap -- loading-bitmap )
loading-bitmap width>> :> width
width 3 * :> width*3
loading-bitmap width>> bitmap-padding :> padding
loading-bitmap [ color-index>> length ] [ height>> abs ] bi /i :> stride
loading-bitmap
padding 0 > [
[
stride <sliced-groups>
[ width*3 head-slice ] map concat
] change-color-index
] when ;
: parse-bitmap ( loading-bitmap -- loading-bitmap ) : parse-bitmap ( loading-bitmap -- loading-bitmap )
dup color-palette-length read >>color-palette dup color-palette-length read >>color-palette
dup color-index-length read >>color-index dup size-image>> [
fixup-color-index ; read >>color-index
] [
dup color-index-length read >>color-index
] if* ;
ERROR: unsupported-bitmap-file magic ;
: load-bitmap ( path -- loading-bitmap ) : load-bitmap ( path -- loading-bitmap )
binary [ binary stream-throws <limited-file-reader> [
loading-bitmap new loading-bitmap new
parse-file-header parse-bitmap-header parse-bitmap parse-file-header dup magic>> {
] with-file-reader ; { "BM" [ parse-bitmap-header parse-bitmap ] }
! { "BA" [ parse-os2-bitmap-array ] }
! { "CI" [ parse-os2-color-icon ] }
! { "CP" [ parse-os2-color-pointer ] }
! { "IC" [ parse-os2-icon ] }
! { "PT" [ parse-os2-pointer ] }
[ unsupported-bitmap-file ]
} case
] with-input-stream ;
ERROR: unknown-component-order bitmap ; ERROR: unknown-component-order bitmap ;
: bitmap>component-order ( loading-bitmap -- object ) : bitmap>component-order ( loading-bitmap -- object )
bit-count>> { bit-count>> {
{ 32 [ BGRA ] } { 32 [ BGR ] }
{ 24 [ BGR ] } { 24 [ BGR ] }
{ 16 [ BGR ] }
{ 8 [ BGR ] } { 8 [ BGR ] }
{ 4 [ BGR ] }
{ 1 [ BGR ] }
[ unknown-component-order ] [ unknown-component-order ]
} case ; } case ;
: loading-bitmap>bitmap-image ( bitmap-image loading-bitmap -- bitmap-image ) : loading-bitmap>image ( image loading-bitmap -- bitmap-image )
{ {
[ loading-bitmap>bytes >>bitmap ] [ loading-bitmap>bytes >>bitmap ]
[ [ width>> ] [ height>> abs ] bi 2array >>dim ] [ [ width>> ] [ height>> abs ] bi 2array >>dim ]
[ height>> 0 < [ t >>upside-down? ] when ] [ height>> 0 < not >>upside-down? ]
[ compression>> 3 = [ t >>upside-down? ] when ]
[ bitmap>component-order >>component-order ] [ bitmap>component-order >>component-order ]
} cleave ; } cleave ;
M: bitmap-image load-image* ( path loading-bitmap -- bitmap ) M: bitmap-image load-image* ( path loading-bitmap -- bitmap )
swap load-bitmap loading-bitmap>bitmap-image ; swap load-bitmap loading-bitmap>image ;
"bmp" bitmap-image register-image-class "bmp" bitmap-image register-image-class
@ -165,6 +278,9 @@ PRIVATE>
] if ] if
] bi ; ] bi ;
: reverse-lines ( byte-array width -- byte-array )
<sliced-groups> <reversed> concat ; inline
: save-bitmap ( image path -- ) : save-bitmap ( image path -- )
binary [ binary [
B{ CHAR: B CHAR: M } write B{ CHAR: B CHAR: M } write