From 44850e6533825f0501dd1bf68734cfbe773237e6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 6 Jun 2009 21:10:40 -0400 Subject: [PATCH] refactoring bitmap to bitmap.loading and bitmap.saving vocabs --- basis/images/bitmap/bitmap.factor | 168 +++--------------- basis/images/bitmap/loading/authors.txt | 1 + basis/images/bitmap/loading/loading.factor | 197 +++++++++++++++++++++ 3 files changed, 225 insertions(+), 141 deletions(-) create mode 100644 basis/images/bitmap/loading/authors.txt create mode 100644 basis/images/bitmap/loading/loading.factor diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor index 4f2ad720b6..004bca6db0 100755 --- a/basis/images/bitmap/bitmap.factor +++ b/basis/images/bitmap/bitmap.factor @@ -2,34 +2,23 @@ ! 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 -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 ; +images.bitmap.loading images.loader io io.binary +io.encodings.8-bit io.encodings.binary io.encodings.string +io.files io.streams.limited kernel locals macros math +math.bitwise math.functions namespaces sequences +specialized-arrays.uint specialized-arrays.ushort strings +summary ; QUALIFIED-WITH: bitstreams b IN: images.bitmap -: read2 ( -- n ) 2 read le> ; -: read4 ( -- n ) 4 read le> ; -: write2 ( n -- ) 2 >le write ; -: write4 ( n -- ) 4 >le write ; - SINGLETON: bitmap-image "bmp" bitmap-image register-image-class -TUPLE: loading-bitmap -magic size reserved1 reserved2 offset header-length width -height planes bit-count compression size-image -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 ; - ! endpoints-triple is ciexyzX/Y/Z, 3x fixed-point-2.30 aka 3x uint +: write2 ( n -- ) 2 >le write ; +: write4 ( n -- ) 4 >le write ; + > { + dup file-header>> header-length>> { { 12 [ os2-color-lookup ] } { 64 [ os2v2-color-lookup ] } { 40 [ v3-color-lookup ] } @@ -66,7 +55,7 @@ ERROR: bmp-not-supported n ; ] { } map-as B{ } concat-as ; : bitmap>bytes ( loading-bitmap -- byte-array ) - dup bit-count>> + dup header>> bit-count>> { { 32 [ color-index>> ] } { 24 [ color-index>> ] } @@ -82,13 +71,13 @@ ERROR: bmp-not-supported n ; color-index>> ] } { 8 [ color-lookup ] } - { 4 [ [ 4 b:byte-array-n>seq ] change-color-index color-lookup ] } + { 4 [ B [ 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>> { + dup header>> bit-count>> { { 16 [ dup color-palette>> 4 group [ le> ] map ] } { 32 [ { HEX: ff0000 HEX: ff00 HEX: ff } ] } } case reverse >>bitfields ; @@ -100,7 +89,7 @@ M: unsupported-bitfield-widths summary : uncompress-bitfield-widths ( loading-bitmap -- loading-bitmap' ) set-bitfield-widths - dup bit-count>> { + dup header>> bit-count>> { { 16 [ dup bitfields>> '[ byte-array>ushort-array _ uncompress-bitfield @@ -116,8 +105,16 @@ M: unsupported-bitfield-widths summary ERROR: unsupported-bitmap-compression compression ; -: uncompress-bitmap ( loading-bitmap -- loading-bitmap' ) - dup compression>> { +GENERIC: uncompress-bitmap* ( loading-bitmap header -- loading-bitmap ) + +: uncompress-bitmap ( loading-bitmap -- loading-bitmap ) + dup header>> uncompress-bitmap* ; + +M: os2-header uncompress-bitmap* ( loading-bitmap header -- loading-bitmap' ) + drop ; + +M: v-header uncompress-bitmap* ( loading-bitmap header -- loading-bitmap' ) + compression>> { { f [ ] } { 0 [ ] } { 1 [ [ run-length-uncompress ] change-color-index ] } @@ -134,73 +131,11 @@ ERROR: unsupported-bitmap-compression compression ; uncompress-bitmap bitmap>bytes ; -: parse-file-header ( loading-bitmap -- loading-bitmap ) - 2 read latin1 decode >>magic - read4 >>size - read2 >>reserved1 - read2 >>reserved2 - read4 >>offset ; - -: read-v3-header ( loading-bitmap -- loading-bitmap ) - read4 >>width - read4 32 >signed >>height - read2 >>planes - read2 >>bit-count - read4 >>compression - read4 >>size-image - read4 >>x-pels - read4 >>y-pels - 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 ) + file-header>> [ offset>> 14 - ] [ header-length>> ] bi - ; -: color-index-length ( loading-bitmap -- n ) +: color-index-length ( header -- n ) { [ width>> ] [ planes>> * ] @@ -208,57 +143,8 @@ ERROR: unknown-bitmap-header n ; [ height>> abs * ] } cleave ; -: image-size ( loading-bitmap -- n ) - [ [ width>> ] [ height>> ] bi * ] [ bit-count>> 8 /i ] bi * abs ; - -: parse-bitmap ( loading-bitmap -- loading-bitmap ) - dup color-palette-length read >>color-palette - dup size-image>> dup 0 > [ - read >>color-index - ] [ - drop dup color-index-length read >>color-index - ] if ; - ERROR: unsupported-bitmap-file magic ; -: load-bitmap ( path -- loading-bitmap ) - binary stream-throws [ - loading-bitmap new - 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 [ BGR ] } - { 24 [ BGR ] } - { 16 [ BGR ] } - { 8 [ BGR ] } - { 4 [ BGR ] } - { 1 [ BGR ] } - [ unknown-component-order ] - } case ; - -M: bitmap-image load-image* ( path bitmap-image -- bitmap ) - drop load-bitmap - [ image new ] dip - { - [ loading-bitmap>bytes >>bitmap ] - [ [ width>> ] [ height>> abs ] bi 2array >>dim ] - [ height>> 0 < not >>upside-down? ] - [ compression>> 3 = [ t >>upside-down? ] when ] - [ bitmap>component-order >>component-order ] - } cleave ; - PRIVATE> : bitmap>color-index ( bitmap -- byte-array ) @@ -301,7 +187,7 @@ PRIVATE> ! compression [ drop 0 write4 ] - ! size-image + ! image-size [ bitmap>color-index length write4 ] ! x-pels diff --git a/basis/images/bitmap/loading/authors.txt b/basis/images/bitmap/loading/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/images/bitmap/loading/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/images/bitmap/loading/loading.factor b/basis/images/bitmap/loading/loading.factor new file mode 100644 index 0000000000..f8fa52cd6f --- /dev/null +++ b/basis/images/bitmap/loading/loading.factor @@ -0,0 +1,197 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays combinators images images.bitmap +images.bitmap.private io io.binary io.encodings.8-bit +io.encodings.binary io.encodings.string io.streams.limited +kernel math math.bitwise ; +IN: images.bitmap.loading + +! http://www.fileformat.info/format/bmp/egff.htm + +ERROR: unknown-component-order bitmap ; +ERROR: unknown-bitmap-header n ; + +: read2 ( -- n ) 2 read le> ; +: read4 ( -- n ) 4 read le> ; + +TUPLE: loading-bitmap + file-header header + color-palette color-index bitfields ; + +TUPLE: file-header + magic size reserved1 reserved2 offset header-length ; + +TUPLE: v3-header + width height planes bit-count + compression image-size x-resolution y-resolution + colors-used colors-important ; + +TUPLE: v4-header < v3-header + red-mask green-mask blue-mask alpha-mask + cs-type end-points + gamma-red gamma-green gamma-blue ; + +TUPLE: v5-header < v4-header + intent profile-data profile-size reserved3 ; + +TUPLE: os2v1-header width height planes bit-count ; +TUPLE: os2v2-header < os2v1-header + compression image-size x-resolution y-resolution + colors-used colors-important units reserved + recording rendering size1 size2 color-encoding identifier ; + +UNION: v-header v3-header v4-header v5-header ; +UNION: os2-header os2v1-header os2v2-header ; + +: parse-file-header ( -- file-header ) + \ file-header new + 2 read latin1 decode >>magic + read4 >>size + read2 >>reserved1 + read2 >>reserved2 + read4 >>offset + read4 >>header-length ; + +: read-v3-header-data ( header -- header ) + read4 >>width + read4 32 >signed >>height + read2 >>planes + read2 >>bit-count + read4 >>compression + read4 >>image-size + read4 >>x-resolution + read4 >>y-resolution + read4 >>colors-used + read4 >>colors-important ; + +: read-v3-header ( -- header ) + \ v3-header new + read-v3-header-data ; + +: read-v4-header-data ( header -- 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-v4-header ( -- v4-header ) + \ v4-header new + read-v3-header-data + read-v4-header-data ; + +: read-v5-header-data ( v5-header -- v5-header ) + read4 >>intent + read4 >>profile-data + read4 >>profile-size + read4 >>reserved3 ; + +: read-v5-header ( -- loading-bitmap ) + \ v5-header new + read-v3-header-data + read-v4-header-data + read-v5-header-data ; + +: read-os2v1-header ( -- os2v1-header ) + \ os2v1-header new + read2 >>width + read2 16 >signed >>height + read2 >>planes + read2 >>bit-count ; + +: read-os2v2-header-data ( os2v2-header -- os2v2-header ) + read4 >>width + read4 32 >signed >>height + read2 >>planes + read2 >>bit-count + read4 >>compression + read4 >>image-size + read4 >>x-resolution + read4 >>y-resolution + read4 >>colors-used + read4 >>colors-important + read2 >>units + read2 >>reserved + read2 >>recording + read2 >>rendering + read4 >>size1 + read4 >>size2 + read4 >>color-encoding + 4 read >>identifier ; + +: read-os2v2-header ( -- os2v2-header ) + \ os2v2-header new + read-os2v2-header-data ; + +: parse-header ( n -- header ) + { + { 12 [ read-os2v1-header ] } + { 64 [ read-os2v2-header ] } + { 40 [ read-v3-header ] } + { 108 [ read-v4-header ] } + { 124 [ read-v5-header ] } + [ unknown-bitmap-header ] + } case ; + +: parse-color-palette ( loading-bitmap -- loading-bitmap ) + dup color-palette-length read >>color-palette ; + +GENERIC: parse-color-data* ( loading-bitmap header -- loading-bitmap ) + +: parse-color-data ( loading-bitmap -- loading-bitmap ) + dup header>> parse-color-data* ; + +M: os2v1-header parse-color-data* ( loading-bitmap header -- loading-bitmap ) + color-index-length read >>color-index ; + +M: object parse-color-data* ( loading-bitmap header -- loading-bitmap ) + dup image-size>> [ + nip + ] [ + color-index-length + ] if* read >>color-index ; + +: bitmap>component-order ( loading-bitmap -- object ) + header>> bit-count>> { + { 32 [ BGR ] } + { 24 [ BGR ] } + { 16 [ BGR ] } + { 8 [ BGR ] } + { 4 [ BGR ] } + { 1 [ BGR ] } + [ unknown-component-order ] + } case ; + +ERROR: unsupported-bitmap-file magic ; + +: load-bitmap ( path -- loading-bitmap ) + binary stream-throws [ + \ loading-bitmap new + parse-file-header [ >>file-header ] [ ] bi magic>> { + { "BM" [ + dup file-header>> header-length>> parse-header >>header + parse-color-palette + parse-color-data + ] } + ! { "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 ; + +M: bitmap-image load-image* ( path bitmap-image -- bitmap ) + drop load-bitmap + [ image new ] dip + { + [ loading-bitmap>bytes >>bitmap ] + [ header>> [ width>> ] [ height>> abs ] bi 2array >>dim ] + [ header>> height>> 0 < not >>upside-down? ] + [ bitmap>component-order >>component-order ] + } cleave ;