working on screen capture

diff --git a/extra/cap/cap.factor b/extra/cap/cap.factor
new file mode 100644 (file)
index 0000000..858ec3e
--- /dev/null
+++ b/extra/cap/cap.factor
@@ -0,0 +1,53 @@
+USING: accessors arrays byte-arrays kernel math namespaces
+opengl.gl sequences math.vectors ui graphics.bitmap graphics.viewer
+models opengl.framebuffers ui.gadgets.worlds ui.gadgets fry ;
+IN: cap
+
+: screenshot-array ( world -- byte-array )
+    dim>> product 3 * <byte-array> ;
+
+: gl-screenshot ( gadget -- byte-array )
+    [
+        GL_COLOR_ATTACHMENT0_EXT glReadBuffer
+        GL_PACK_ALIGNMENT 1 glPixelStorei
+        0 0
+    ] dip
+    [ dim>> first2 GL_BGR GL_UNSIGNED_BYTE ]
+    [ screenshot-array ] bi
+    [ glReadPixels ] keep ;
+
+: screenshot ( window -- bitmap )
+    [ gl-screenshot ]
+    [ dim>> first2 ] bi
+    bgr>bitmap ;
+
+: gadget-world ( gadget -- world )
+    "fake" f <model> <world> ;
+
+: draw-world-to-fbo ( world fbo -- )
+    [ relayout-1 ] with-framebuffer ;
+
+: <fbo> ( w h -- fbo )
+    GL_DEPTH_TEST glDisable
+    gen-framebuffer [ '[
+        gen-renderbuffer
+        GL_RENDERBUFFER_EXT over glBindRenderbufferEXT
+        GL_RENDERBUFFER_EXT GL_RGB _ _ glRenderbufferStorageEXT
+        GL_FRAMEBUFFER_EXT
+        GL_COLOR_ATTACHMENT0_EXT
+        GL_RENDERBUFFER_EXT roll glFramebufferRenderbufferEXT
+        check-framebuffer
+    ] with-framebuffer ] keep ;
+
+: draw-gadget-to-bgr ( gadget -- byte-array )
+    [ [ prefer ] [ gadget-world ] bi ] [ dim>> first2 <fbo> ] bi
+    [ gl-screenshot ] with-framebuffer ;
+
+: save-screenshot ( window path -- )
+    [ screenshot ] dip save-bitmap ;
+
+: screenshot. ( window -- )
+    screenshot <graphics-gadget> "Screenshot" open-window ;
+
+
+

diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor
index 82fdc334cbf754bfec4c076ce9315afb14162244..651c5f7ca1908ca4a25486bdf4783d0aff7ec1e8 100755 (executable)
--- a/extra/graphics/bitmap/bitmap.factor
+++ b/extra/graphics/bitmap/bitmap.factor
@@ -15,6 +15,14 @@ TUPLE: 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 array ;
 
+: bgr>bitmap ( array height width -- bitmap )
+    bitmap new
+        2over * 3 * >>size-image
+        swap >>height
+        swap >>width
+        swap [ >>array ] [ >>color-index ] bi
+        24 >>bit-count ;
+
 : raw-bitmap>string ( str n -- str )
     {
         { 32 [ "32bit" throw ] }
@@ -74,7 +82,7 @@ M: bitmap-magic summary
 
 : save-bitmap ( bitmap path -- )
     binary [
-        "BM" write
+        "BM" >byte-array write
         dup array>> length 14 + 40 + 4 >le write
         0 4 >le write
         54 4 >le write
@@ -87,10 +95,10 @@ M: bitmap-magic summary
             [ bit-count>> 24 or 2 >le write ]
             [ compression>> 0 or 4 >le write ]
             [ size-image>> 4 >le write ]
-            [ x-pels>> 4 >le write ]
-            [ y-pels>> 4 >le write ]
-            [ color-used>> 4 >le write ]
-            [ color-important>> 4 >le write ]
+            [ x-pels>> 0 or 4 >le write ]
+            [ y-pels>> 0 or 4 >le write ]
+            [ color-used>> 0 or 4 >le write ]
+            [ color-important>> 0 or 4 >le write ]
             [ rgb-quads>> write ]
             [ color-index>> write ]
         } cleave