]> gitweb.factorcode.org Git - factor.git/commitdiff
Move normalize-scanline-order implementation from images.bitmap to images
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 10 Mar 2009 21:35:47 +0000 (16:35 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 10 Mar 2009 21:35:47 +0000 (16:35 -0500)
Add upside-down? slot to image tuple
Update cap for recent changes

basis/images/bitmap/bitmap.factor
basis/images/images.factor
basis/images/tiff/tiff.factor
extra/cap/cap.factor

index 88eb984488b02921b813494269feb2425783f8d8..cf16df7d82b596cfec1132caae3abd8a9e784325 100755 (executable)
@@ -108,11 +108,6 @@ M: bitmap-image load-image* ( path bitmap -- bitmap )
     load-bitmap-data process-bitmap-data
     fill-image-slots ;
 
-M: bitmap-image normalize-scan-line-order
-    dup dim>> '[
-        _ first 4 * <sliced-groups> reverse concat
-    ] change-bitmap ;
-
 MACRO: (nbits>bitmap) ( bits -- )
     [ -3 shift ] keep '[
         bitmap-image new
@@ -121,6 +116,7 @@ MACRO: (nbits>bitmap) ( bits -- )
             swap >>width
             swap array-copy [ >>bitmap ] [ >>color-index ] bi
             _ >>bit-count fill-image-slots
+            t >>upside-down?
     ] ;
 
 : bgr>bitmap ( array height width -- bitmap )
index 82576774f49c58e5b4db7e99d8bf7b698796639e..cb44825e62222f10b1f28d73ed1dfc09209866fe 100644 (file)
@@ -27,7 +27,7 @@ R16G16B16 R32G32B32 R16G16B16A16 R32G32B32A32 ;
         { R32G32B32A32 [ 16 ] }
     } case ;
 
-TUPLE: image dim component-order bitmap ;
+TUPLE: image dim component-order upside-down? bitmap ;
 
 : <image> ( -- image ) image new ; inline
 
@@ -82,11 +82,16 @@ M: ARGB normalize-component-order*
 M: ABGR normalize-component-order*
     drop ARGB>RGBA 4 BGR>RGB ;
 
-GENERIC: normalize-scan-line-order ( image -- image )
-
-M: image normalize-scan-line-order ;
+: normalize-scan-line-order ( image -- image )
+    dup upside-down?>> [
+        dup dim>> first 4 * '[
+            _ <groups> reverse concat
+        ] change-bitmap
+        f >>upside-down?
+    ] when ;
 
 : normalize-image ( image -- image )
     [ >byte-array ] change-bitmap
     normalize-component-order
-    normalize-scan-line-order ;
+    normalize-scan-line-order
+    RGBA >>component-order ;
index a50ac0cad98b2c5d950137d71497a6e53d3763fb..2ea1b08e208e98079455b7e3c0ccbb34b934122e 100755 (executable)
@@ -503,7 +503,7 @@ ERROR: unknown-component-order ifd ;
 : ifd>image ( ifd -- image )
     {
         [ [ image-width find-tag ] [ image-length find-tag ] bi 2array ]
-        [ ifd-component-order ]
+        [ ifd-component-order ]
         [ bitmap>> ]
     } cleave tiff-image boa ;
 
index 1f6244102866a44c1df526c3a803d7d66a090fd2..64696759bb300b8a38ed14f067d27a5540701530 100644 (file)
@@ -1,30 +1,31 @@
 ! Copyright (C) 2008 Doug Coleman, Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays byte-arrays kernel math namespaces
-opengl.gl sequences math.vectors ui images.bitmap images.viewer
+opengl.gl sequences math.vectors ui images images.viewer
 models ui.gadgets.worlds ui.gadgets fry alien.syntax ;
 IN: cap
 
 : screenshot-array ( world -- byte-array )
-    dim>> [ first 3 * 4 align ] [ second ] bi * <byte-array> ;
+    dim>> [ first 4 * ] [ second ] bi * <byte-array> ;
 
 : gl-screenshot ( gadget -- byte-array )
     [
-        GL_BACK glReadBuffer
-        GL_PACK_ALIGNMENT 4 glPixelStorei
-        0 0
-    ] dip
-    [ dim>> first2 GL_BGR GL_UNSIGNED_BYTE ]
+        [
+            GL_BACK glReadBuffer
+            GL_PACK_ALIGNMENT 4 glPixelStorei
+            0 0
+        ] dip
+        dim>> first2 GL_RGBA GL_UNSIGNED_BYTE
+    ]
     [ screenshot-array ] bi
     [ glReadPixels ] keep ;
 
 : screenshot ( window -- bitmap )
-    [ gl-screenshot ]
-    [ dim>> first2 ] bi
-    bgr>bitmap ;
-
-: save-screenshot ( window path -- )
-    [ screenshot ] dip save-bitmap ;
+    [ <image> ] dip
+    [ gl-screenshot >>bitmap ] [ dim>> >>dim ] bi
+    RGBA >>component-order
+    t >>upside-down?
+    normalize-image ;
 
 : screenshot. ( window -- )
     [ screenshot <image-gadget> ] [ title>> ] bi open-window ;