     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 - ;
 

! 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 ;
IN: images.bitmap

: assert-sequence= ( a b -- )
    2dup sequence= [ 2drop ] [ assert ] if ;

: read2 ( -- n ) 2 read le> ;
: read4 ( -- n ) 4 read le> ;

: 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>> [
        read >>color-index
    ] [
        dup color-index-length read >>color-index
    ] if* ;

ERROR: unsupported-bitmap-file magic ;

: load-bitmap ( path -- loading-bitmap )
    binary stream-throws <limited-file-reader> [
        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 ;

: loading-bitmap>image ( image loading-bitmap -- bitmap-image )
    {
        [ 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 ;

M: bitmap-image load-image* ( path loading-bitmap -- bitmap )
    swap load-bitmap loading-bitmap>image ;

"bmp" bitmap-image register-image-class

