Add extra/frame-buffer

diff --git a/extra/frame-buffer/frame-buffer.factor b/extra/frame-buffer/frame-buffer.factor
new file mode 100644 (file)
index 0000000..708c0d8
--- /dev/null
+++ b/extra/frame-buffer/frame-buffer.factor
@@ -0,0 +1,112 @@
+
+USING: accessors alien.c-types combinators grouping kernel
+       locals math math.geometry.rect math.vectors opengl.gl sequences
+       ui.gadgets ui.render ;
+
+IN: frame-buffer
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+TUPLE: <frame-buffer> < gadget pixels last-dim ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+GENERIC: update-frame-buffer ( <frame-buffer> -- )
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: init-frame-buffer-pixels ( frame-buffer -- )
+  dup
+    rect-dim product "uint[4]" <c-array>
+  >>pixels
+  drop ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: frame-buffer ( -- <frame-buffer> ) <frame-buffer> new-gadget ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: draw-pixels ( FRAME-BUFFER -- )
+
+  FRAME-BUFFER rect-dim first2
+  GL_RGBA
+  GL_UNSIGNED_INT
+  FRAME-BUFFER pixels>>
+  glDrawPixels ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: read-pixels ( FRAME-BUFFER -- )
+
+  0
+  0
+  FRAME-BUFFER rect-dim first2
+  GL_RGBA
+  GL_UNSIGNED_INT
+  FRAME-BUFFER pixels>>
+  glReadPixels ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: copy-row ( OLD NEW -- )
+  
+  [let | LEN [ OLD NEW min-length ] |
+
+    OLD LEN head-slice 0 NEW copy ] ;
+
+: copy-pixels ( old-pixels old-width new-pixels new-width -- )
+  [ 16 * <sliced-groups> ] 2bi@
+  [ copy-row ] 2each ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: update-last-dim ( frame-buffer -- ) dup rect-dim >>last-dim drop ;
+
+M:: <frame-buffer> layout* ( FRAME-BUFFER -- )
+
+  {
+    {
+      [ FRAME-BUFFER last-dim>> f = ]
+      [
+        FRAME-BUFFER init-frame-buffer-pixels
+
+        FRAME-BUFFER update-last-dim
+      ]
+    }
+    {
+      [ FRAME-BUFFER [ rect-dim ] [ last-dim>> ] bi = not ]
+      [
+        [let | OLD-PIXELS [ FRAME-BUFFER pixels>>         ]
+               OLD-WIDTH  [ FRAME-BUFFER last-dim>> first ] |
+
+          FRAME-BUFFER init-frame-buffer-pixels
+
+          FRAME-BUFFER update-last-dim
+
+          [let | NEW-PIXELS [ FRAME-BUFFER pixels>>         ]
+                 NEW-WIDTH  [ FRAME-BUFFER last-dim>> first ] |
+
+            OLD-PIXELS OLD-WIDTH NEW-PIXELS NEW-WIDTH copy-pixels ] ]
+      ]
+    }
+    { [ t ] [ ] }
+  }
+  cond ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+M:: <frame-buffer> draw-gadget* ( FRAME-BUFFER -- )
+
+  FRAME-BUFFER rect-dim { 0 1 } v* first2 glRasterPos2i
+
+  FRAME-BUFFER draw-pixels
+
+  FRAME-BUFFER update-frame-buffer
+
+  glFlush
+
+  FRAME-BUFFER read-pixels ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+