fix tiff/bitmaps color order

extra/images/backend/backend.factor

@@ -3,16 +3,19 @@
 USING: accessors kernel ;
 IN: images.backend
 
-TUPLE: image width height depth pitch buffer ;
+SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR ;
+
+TUPLE: image width height depth pitch component-order buffer ;
 
 GENERIC: load-image* ( path tuple -- image )
 
 : load-image ( path class -- image )
     new load-image* ;
 
-: new-image ( width height depth buffer class -- image )
+: new-image ( width height depth component-order buffer class -- image )
     new 
         swap >>buffer
+        swap >>component-order
         swap >>depth
         swap >>height
         swap >>width ; inline

extra/images/bitmap/bitmap.factor

@@ -97,8 +97,18 @@ M: bitmap-magic summary
 : load-bitmap ( path -- bitmap )
     load-bitmap-data process-bitmap-data ;
 
+ERROR: unknown-component-order bitmap ;
+
+: bitmap>component-order ( bitmap -- object )
+    bit-count>> {
+        { 32 [ BGRA ] }
+        { 24 [ BGR ] }
+        { 8 [ BGR ] }
+        [ unknown-component-order ]
+    } case ;
+
 : bitmap>image ( bitmap -- bitmap-image )
-    { [ width>> ] [ height>> ] [ bit-count>> ] [ buffer>> ] } cleave
+    { [ width>> ] [ height>> ] [ bit-count>> ] [ bitmap>component-order ] [ buffer>> ] } cleave
     bitmap-image new-image ;
 
 M: bitmap-image load-image* ( path bitmap -- bitmap-image )

extra/images/tiff/tiff.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors combinators io io.encodings.binary io.files
-kernel pack endian tools.hexdump constructors sequences arrays
+kernel pack endian constructors sequences arrays
 sorting.slots math.order math.parser prettyprint classes
 io.binary assocs math math.bitwise byte-arrays grouping
 images.backend ;
@@ -260,17 +260,27 @@ ERROR: bad-small-ifd-type n ;
 : strips>buffer ( ifd -- ifd )
     dup strips>> concat >>buffer ;
 
+ERROR: unknown-component-order ifd ;
+
+: ifd-component-order ( ifd -- byte-order )
+    bits-per-sample find-tag sum {
+        { 32 [ RGBA ] }
+        [ unknown-component-order ]
+    } case ;
+
 : ifd>image ( ifd -- image )
     {
         [ image-width find-tag ]
         [ image-length find-tag ]
         [ bits-per-sample find-tag sum ]
+        [ ifd-component-order ]
         [ buffer>> ]
     } cleave tiff-image new-image ;
 
 : parsed-tiff>images ( tiff -- sequence )
     ifds>> [ ifd>image ] map ;
 
+
 : load-tiff ( path -- parsed-tiff )
     binary [
         <parsed-tiff>

extra/images/viewer/viewer.factor

@@ -22,12 +22,18 @@ M: image-gadget draw-gadget* ( gadget -- )
     \ image-gadget new-gadget
         swap >>image ;
 
-: bits>gl-params ( n -- gl-bgr gl-format )
+: gl-component-order ( singletons -- n )
     {
-        { 32 [ GL_BGRA GL_UNSIGNED_BYTE ] }
+        { BGR [ GL_BGR ] }
-        { 24 [ GL_BGR GL_UNSIGNED_BYTE ] }
+        { RGB [ GL_BGR ] }
-        { 8 [ GL_BGR GL_UNSIGNED_BYTE ] }
+        { BGRA [ GL_BGRA ] }
-        { 4 [ GL_BGR GL_UNSIGNED_BYTE ] }
+        { RGBA [ GL_RGBA ] }
+        ! { RGBX [ GL_RGBX ] }
+        ! { BGRX [ GL_BGRX ] }
+        ! { ARGB [ GL_ARGB ] }
+        ! { ABGR [ GL_ABGR ] }
+        ! { XRGB [ GL_XRGB ] }
+        ! { XBGR [ GL_XBGR ] }
     } case ;
 
 M: bitmap-image draw-image ( bitmap -- )
@@ -44,7 +50,7 @@ M: bitmap-image draw-image ( bitmap -- )
         ]
         [ width>> abs ]
         [ height>> abs ]
-        [ depth>> bits>gl-params ]
+        [ component-order>> gl-component-order GL_UNSIGNED_BYTE ]
         [ buffer>> ]
     } cleave glDrawPixels ;
 
@@ -56,7 +62,7 @@ M: tiff-image draw-image ( tiff -- )
     {
         [ height>> ]
         [ width>> ]
-        [ depth>> bits>gl-params ]
+        [ component-order>> gl-component-order GL_UNSIGNED_BYTE ]
         [ buffer>> ]
     } cleave glDrawPixels ;