From 31595542d338cddc96b96dc2705b41ccfd4b928b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 3 Jun 2009 21:36:03 -0500 Subject: [PATCH] clean up bitmap code, support a lot more bitmaps like 1/4/16 bit --- basis/images/bitmap/bitmap.factor | 228 ++++++++++++++++++++++-------- 1 file changed, 172 insertions(+), 56 deletions(-) diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor index 8bf8d59944..151c12132b 100755 --- a/basis/images/bitmap/bitmap.factor +++ b/basis/images/bitmap/bitmap.factor @@ -2,14 +2,14 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien alien.c-types arrays byte-arrays columns combinators compression.run-length endian fry grouping images -images.loader io io.binary io.encodings.binary io.files kernel -locals macros math math.bitwise math.functions namespaces -sequences strings summary ; +images.loader io io.binary io.encodings.binary io.files +io.streams.limited kernel locals macros math math.bitwise +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 -: assert-sequence= ( a b -- ) - 2dup sequence= [ 2drop ] [ assert ] if ; - : read2 ( -- n ) 2 read le> ; : read4 ( -- n ) 4 read le> ; : write2 ( n -- ) 2 >le write ; @@ -17,62 +17,130 @@ IN: images.bitmap TUPLE: bitmap-image < image ; -! Used to construct the final bitmap-image - TUPLE: loading-bitmap -size reserved offset header-length width +magic size reserved1 reserved2 offset header-length width height planes bit-count compression size-image -x-pels y-pels color-used color-important color-palette color-index -uncompressed-bytes ; +x-pels y-pels color-used color-important +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 ; - -M: bitmap-magic summary - drop "First two bytes of bitmap stream must be 'BM'" ; +! endpoints-triple is ciexyzX/Y/Z, 3x fixed-point-2.30 aka 3x uint buffer ( bitmap -- array ) - [ color-palette>> 4 [ 3 head-slice ] map ] - [ color-index>> >array ] bi [ swap nth ] with map concat ; +: os2-color-lookup ( loading-bitmap -- seq ) + [ color-index>> >array ] + [ color-palette>> 3 ] bi + '[ _ nth ] map concat ; + +: os2v2-color-lookup ( loading-bitmap -- seq ) + [ color-index>> >array ] + [ color-palette>> 3 ] bi + '[ _ nth ] map concat ; + +: v3-color-lookup ( loading-bitmap -- seq ) + [ color-index>> >array ] + [ color-palette>> 4 [ 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 ; -: reverse-lines ( byte-array width -- byte-array ) - concat ; inline +: uncompress-bitfield ( seq masks -- bytes' ) + '[ + _ [ + [ 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>> { { 32 [ color-index>> ] } - { 24 [ [ color-index>> ] [ width>> 3 * ] bi reverse-lines ] } - { 8 [ [ 8bit>buffer ] [ width>> 3 * ] bi reverse-lines ] } + { 24 [ color-index>> ] } + { 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 ] } 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 ; : uncompress-bitmap ( loading-bitmap -- loading-bitmap' ) dup compression>> { + { f [ ] } { 0 [ ] } - { 1 [ [ run-length-uncompress8 ] change-color-index ] } - { 2 [ "run-length encoding 4" unsupported-bitmap-compression ] } - { 3 [ "bitfields" unsupported-bitmap-compression ] } + { 1 [ [ run-length-uncompress ] change-color-index ] } + { 2 [ [ 4 b:byte-array-n>seq run-length-uncompress >byte-array ] change-color-index ] } + { 3 [ uncompress-bitfield-widths ] } { 4 [ "jpeg" unsupported-bitmap-compression ] } { 5 [ "png" unsupported-bitmap-compression ] } } case ; +: bitmap-padding ( width -- n ) + 3 * 4 mod 4 swap - 4 mod ; inline + : loading-bitmap>bytes ( loading-bitmap -- byte-array ) - uncompress-bitmap bitmap>bytes ; + uncompress-bitmap + bitmap>bytes ; : parse-file-header ( loading-bitmap -- loading-bitmap ) - 2 read "BM" assert-sequence= + 2 read latin1 decode >>magic read4 >>size - read4 >>reserved + read2 >>reserved1 + read2 >>reserved2 read4 >>offset ; -: parse-bitmap-header ( loading-bitmap -- loading-bitmap ) - read4 >>header-length +: read-v3-header ( loading-bitmap -- loading-bitmap ) read4 >>width read4 32 >signed >>height read2 >>planes @@ -84,6 +152,50 @@ ERROR: unsupported-bitmap-compression compression ; read4 >>color-used 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 ) [ offset>> 14 - ] [ header-length>> ] bi - ; @@ -98,53 +210,54 @@ ERROR: unsupported-bitmap-compression compression ; : image-size ( loading-bitmap -- n ) [ [ 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 - [ width*3 head-slice ] map concat - ] change-color-index - ] when ; - : parse-bitmap ( loading-bitmap -- loading-bitmap ) dup color-palette-length read >>color-palette - dup color-index-length read >>color-index - fixup-color-index ; + dup size-image>> [ + read >>color-index + ] [ + dup color-index-length read >>color-index + ] if* ; + +ERROR: unsupported-bitmap-file magic ; : load-bitmap ( path -- loading-bitmap ) - binary [ + binary stream-throws [ loading-bitmap new - parse-file-header parse-bitmap-header parse-bitmap - ] with-file-reader ; + parse-file-header dup magic>> { + { "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 ; : bitmap>component-order ( loading-bitmap -- object ) bit-count>> { - { 32 [ BGRA ] } + { 32 [ BGR ] } { 24 [ BGR ] } + { 16 [ BGR ] } { 8 [ BGR ] } + { 4 [ BGR ] } + { 1 [ BGR ] } [ unknown-component-order ] } case ; -: loading-bitmap>bitmap-image ( bitmap-image loading-bitmap -- bitmap-image ) +: loading-bitmap>image ( image loading-bitmap -- bitmap-image ) { [ loading-bitmap>bytes >>bitmap ] [ [ 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 ] } cleave ; 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 @@ -165,6 +278,9 @@ PRIVATE> ] if ] bi ; +: reverse-lines ( byte-array width -- byte-array ) + concat ; inline + : save-bitmap ( image path -- ) binary [ B{ CHAR: B CHAR: M } write