 strings images endian summary ;
 IN: images.bitmap
 
+: assert-sequence= ( a b -- )
+    2dup sequence= [ 2drop ] [ assert ] if ;
+
+: read2 ( -- n ) 2 read le> ;
+: read4 ( -- n ) 4 read le> ;
+
+TUPLE: bitmap-image < image ;
+
+! Used to construct the final bitmap-image
+
 TUPLE: loading-bitmap 
 magic size reserved offset header-length width
 height planes bit-count compression size-image
 x-pels y-pels color-used color-important rgb-quads color-index ;
-
-TUPLE: bitmap-image < image ;
-
-! Currently can only handle 24/32bit bitmaps.
-! Handles row-reversed bitmaps (their height is negative)
 
 ERROR: bitmap-magic magic ;
 

    drop loading-bitmap new
    load-bitmap-data loading-bitmap>bitmap-image ;

MACRO: (nbits>bitmap) ( bits -- )
    [ -3 shift ] keep '[
        loading-bitmap new
            2over * _ * >>size-image
            swap >>height
            swap >>width
            swap array-copy [ >>bitmap ] [ >>color-index ] bi
            _ >>bit-count
    ] ;

: bgr>bitmap ( array height width -- bitmap )
    24 (nbits>bitmap) ;

: bgra>bitmap ( array height width -- bitmap )
    32 (nbits>bitmap) ;

: write2 ( n -- ) 2 >le write ;
: write4 ( n -- ) 4 >le write ;

PRIVATE>

: bitmap>color-index ( bitmap-array -- byte-array )
    4 <sliced-groups> [ 3 head-slice reverse ] map B{ } join ; inline

: save-bitmap ( image path -- )
    binary [

    {
        { 32 [ color-index>> ] }
        { 24 [ color-index>> ] }
        { 8 [ 8bit>buffer ] }
        [ bmp-not-supported ]
    } case >byte-array ;

: parse-file-header ( bitmap -- bitmap )
    2 read "BM" assert-sequence=
    read4 >>size
    read4 >>reserved
    read4 >>offset ;
