Add byte-order slot to image tuple; rename <image> to load-image, add <image> for...

diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor
index 5530fa12b73a80c81cdcf66b5436ec348ebfa54e..c9bb15192b786da84e711a41008ef5c637957da6 100755 (executable)
--- a/basis/images/bitmap/bitmap.factor
+++ b/basis/images/bitmap/bitmap.factor
@@ -1,10 +1,9 @@
 ! Copyright (C) 2007, 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types arrays byte-arrays columns
-combinators fry grouping io io.binary io.encodings.binary
-io.files kernel libc macros math math.bitwise math.functions
-namespaces opengl opengl.gl prettyprint sequences strings
-summary ui ui.gadgets.panes images ;
+combinators fry grouping io io.binary io.encodings.binary io.files
+kernel macros math math.bitwise math.functions namespaces sequences
+strings images endian summary ;
 IN: images.bitmap
 
 TUPLE: bitmap-image < image ;
@@ -106,8 +105,9 @@ ERROR: unknown-component-order bitmap ;
     {
         [ [ width>> ] [ height>> ] bi 2array ]
         [ bitmap>component-order ]
+        [ drop little-endian ] ! XXX
         [ buffer>> ]
-    } cleave bitmap-image new-image ;
+    } cleave bitmap-image boa ;
 
 M: bitmap-image load-image* ( path bitmap -- bitmap-image )
     drop load-bitmap >image ;

diff --git a/basis/images/images.factor b/basis/images/images.factor
index 5fdc9ee5e95be21b466e6042deae0c6c158a604c..a2d90cc131f4e1067995d6e1fcd5c5bc04c0223d 100644 (file)
--- a/basis/images/images.factor
+++ b/basis/images/images.factor
@@ -5,7 +5,9 @@ IN: images
 
 SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR ;
 
-TUPLE: image dim component-order bitmap ;
+TUPLE: image dim component-order byte-order bitmap ;
+
+: <image> ( -- image ) image new ; inline
 
 GENERIC: load-image* ( path tuple -- image )
 
@@ -38,9 +40,3 @@ M: image normalize-scan-line-order ;
 : normalize-image ( image -- image )
     normalize-component-order
     normalize-scan-line-order ;
-
-: new-image ( dim component-order bitmap class -- image )
-    new 
-        swap >>bitmap
-        swap >>component-order
-        swap >>dim ; inline

diff --git a/basis/images/loader/loader.factor b/basis/images/loader/loader.factor
index 7aeba9f24a2f22ad6d567d48dcc8b01b73bb621a..9e3f90126935ec012b9bc57ac3fcc9e64629bf40 100644 (file)
--- a/basis/images/loader/loader.factor
+++ b/basis/images/loader/loader.factor
@@ -15,7 +15,4 @@ ERROR: unknown-image-extension extension ;
     } case ;
 
 : load-image ( path -- image )
-    dup image-class new load-image* ;
-
-: <image> ( path -- image )
-    load-image normalize-image ;
+    dup image-class new load-image* normalize-image ;

diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor
index dd4319a474b1bb3dea8bd6063c30b81a2ef9cf49..b4daf675f1de8db988374af268e671231d809e47 100755 (executable)
--- a/basis/images/tiff/tiff.factor
+++ b/basis/images/tiff/tiff.factor
@@ -272,8 +272,9 @@ ERROR: unknown-component-order ifd ;
     {
         [ [ image-width find-tag ] [ image-length find-tag ] bi 2array ]
         [ ifd-component-order ]
+        [ drop big-endian ] ! XXX
         [ bitmap>> ]
-    } cleave tiff-image new-image ;
+    } cleave tiff-image boa ;
 
 : tiff>image ( image -- image )
     ifds>> [ ifd>image ] map first ;

diff --git a/extra/images/viewer/viewer.factor b/extra/images/viewer/viewer.factor
index 0795900150229e39b0ef5155064d1fd06bdb6e14..06e4c686f3f12cae485fdc93b2ce482b85f9db8c 100644 (file)
--- a/extra/images/viewer/viewer.factor
+++ b/extra/images/viewer/viewer.factor
@@ -23,15 +23,15 @@ M: image-gadget draw-gadget* ( gadget -- )
         swap >>image ;
 
 : image-window ( path -- gadget )
-    [ <image> <image-gadget> dup ] [ open-window ] bi ;
+    [ load-image <image-gadget> dup ] [ open-window ] bi ;
 
 GENERIC: image. ( object -- )
 
 : default-image. ( path -- )
     <image-gadget> gadget. ;
 
-M: string image. ( image -- ) <image> default-image. ;
+M: string image. ( image -- ) load-image default-image. ;
 
-M: pathname image. ( image -- ) <image> default-image. ;
+M: pathname image. ( image -- ) load-image default-image. ;
 
 M: image image. ( image -- ) default-image. ;