Refactored cairo gadgets, basing them on the texture-gadget in opengl.gadgets

extra/cairo/gadgets/gadgets.factor

@@ -1,100 +1,39 @@
 ! Copyright (C) 2008 Matthew Willis.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: cairo cairo.ffi ui.render kernel opengl.gl opengl
+USING: sequences math opengl.gadgets kernel
-math byte-arrays ui.gadgets accessors arrays 
+byte-arrays cairo.ffi cairo io.backend
-namespaces io.backend memoize colors ;
+opengl.gl arrays ;
 
 IN: cairo.gadgets
 
-! We need two kinds of gadgets:
-! one performs the cairo ops once and caches the bytes, the other
-! performs cairo ops every refresh
-
-TUPLE: cairo-gadget width height quot cache? texture ;
-PREDICATE: cached-cairo < cairo-gadget cache?>> ;
-: <cairo-gadget> ( width height quot -- cairo-gadget )
-    cairo-gadget construct-gadget 
-    swap >>quot
-    swap >>height
-    swap >>width ;
-
-: <cached-cairo> ( width height quot -- cairo-gadget )
-    <cairo-gadget> t >>cache? ;
-
 : width>stride ( width -- stride ) 4 * ;
     
-: copy-cairo ( width height quot -- byte-array )
+: copy-cairo ( dim quot -- byte-array )
-    >r over width>stride
+    >r first2 over width>stride
     [ * nip <byte-array> dup CAIRO_FORMAT_ARGB32 ]
     [ cairo_image_surface_create_for_data ] 3bi
     r> with-cairo-from-surface ;
 
-: cairo>bytes ( gadget -- byte-array )
+: <cairo-gadget> ( dim quot -- )
-    [ width>> ] [ height>> ] [ quot>> ] tri copy-cairo ;
+    over 2^-bounds swap copy-cairo
+    GL_BGRA rot <texture-gadget> ;
 
-: cairo>png ( gadget path -- )
+! maybe also texture>png
-    >r [ cairo>bytes CAIRO_FORMAT_ARGB32 ] [ width>> ]
+! : cairo>png ( gadget path -- )
-    [ height>> ] tri over width>stride
+!    >r [ cairo>bytes CAIRO_FORMAT_ARGB32 ] [ width>> ]
-    cairo_image_surface_create_for_data
+!    [ height>> ] tri over width>stride
-    r> [ cairo_surface_write_to_png check-cairo ] curry with-surface ;
+!    cairo_image_surface_create_for_data
-
+!    r> [ cairo_surface_write_to_png check-cairo ] curry with-surface ;
-: with-cairo-gl ( quot -- )
-    >r origin get [
-        0 0 glRasterPos2i
-        1.0 -1.0 glPixelZoom
-    ] r> compose with-translation ;
-
-M: cairo-gadget draw-gadget* ( gadget -- )
-    [
-        [ width>> ] [ height>> GL_BGRA GL_UNSIGNED_BYTE ]
-        [ cairo>bytes ] tri glDrawPixels
-    ] with-cairo-gl ;
-
-MEMO: render-to-texture ( gadget -- )
-    GL_TEXTURE_BIT [
-        GL_TEXTURE_2D over texture>> glBindTexture
-        >r GL_TEXTURE_2D 0 GL_RGBA r>
-        [ width>> ] [ height>> 0 GL_BGRA GL_UNSIGNED_BYTE ]
-        [ cairo>bytes ] tri glTexImage2D
-        init-texture
-        GL_TEXTURE_2D 0 glBindTexture
-    ] do-attribs ;
-
-M: cached-cairo draw-gadget* ( gadget -- )
-    GL_TEXTURE_2D [
-        [
-            dup render-to-texture
-            white gl-color
-            GL_TEXTURE_2D over texture>> glBindTexture
-            GL_QUADS [
-                [ width>> ] [ height>> ] bi 2array four-sides
-            ] do-state
-            GL_TEXTURE_2D 0 glBindTexture
-        ] with-cairo-gl
-    ] do-enabled ;
-
-M: cached-cairo graft* ( gadget -- )
-    gen-texture >>texture drop ;
-
-M: cached-cairo ungraft* ( gadget -- )
-    [ texture>> delete-texture ]
-    [ \ render-to-texture invalidate-memoized ] bi ;
-    
-M: cairo-gadget pref-dim* ( gadget -- rect )
-    [ width>> ] [ height>> ] bi 2array ;
 
 : copy-surface ( surface -- )
     cr swap 0 0 cairo_set_source_surface
     cr cairo_paint ;
 
-: <bytes-gadget> ( width height bytes -- cairo-gadget )
-    >r [ ] <cached-cairo> r> >>texture ;
-
 : <png-gadget> ( path -- gadget )
     normalize-path cairo_image_surface_create_from_png
     [ cairo_image_surface_get_width ]
-    [ cairo_image_surface_get_height 2dup ]
+    [ cairo_image_surface_get_height 2array dup 2^-bounds ]
     [ [ copy-surface ] curry copy-cairo ] tri
-    <bytes-gadget> ;
+    GL_BGRA rot <texture-gadget> ;
 
 

extra/cairo/pango/gadgets/gadgets.factor

@@ -1,10 +1,12 @@
+! Copyright (C) 2008 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
 USING: cairo.pango cairo cairo.ffi cairo.gadgets
 alien.c-types kernel math ;
 IN: cairo.pango.gadgets
 
 : (pango-gadget) ( setup show -- gadget )
     [ drop layout-size ]
-    [ compose [ with-pango ] curry <cached-cairo> ] 2bi ;
+    [ compose [ with-pango ] curry <cairo-gadget> ] 2bi ;
 
 : <pango-gadget> ( quot -- gadget )
     [ cr layout pango_cairo_show_layout ] (pango-gadget) ;

extra/cairo/pango/pango.factor

@@ -4,7 +4,7 @@
 ! pangocairo bindings, from pango/pangocairo.h
 USING: cairo.ffi alien.c-types math
 alien.syntax system combinators alien
-pango pango.fonts ;
+arrays pango pango.fonts ;
 IN: cairo.pango
 
 << "pangocairo" {
@@ -115,8 +115,8 @@ M: pango-layout dispose ( alien -- ) alien>> g_object_unref ;
     >r CAIRO_FORMAT_ARGB32 0 0 cairo_image_surface_create
     r> [ with-pango ] curry with-cairo-from-surface ; inline
 
-: layout-size ( quot -- width height )
+: layout-size ( quot -- dim )
-    [ layout pango-layout-get-pixel-size ] compose dummy-pango ; inline
+    [ layout pango-layout-get-pixel-size 2array ] compose dummy-pango ; inline
 
 : layout-font ( str -- )
     pango_font_description_from_string

extra/cairo/samples/samples.factor

@@ -142,6 +142,6 @@ IN: cairo.samples
  USING: quotations cairo.gadgets ui.gadgets.panes sequences ;
  : samples ( -- )
     { arc clip clip-image dash gradient text utf8 }
-    [ 256 256 rot 1quotation <cached-cairo> gadget. ] each ;
+    [ { 256 256 } swap 1quotation <cairo-gadget> gadget. ] each ;
  
  MAIN: samples

extra/opengl/gadgets/gadgets.factor

@@ -0,0 +1,72 @@
+! Copyright (C) 2008 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: locals math.functions math namespaces
+opengl.gl accessors kernel opengl ui.gadgets
+destructors sequences ui.render colors ;
+IN: opengl.gadgets
+
+TUPLE: texture-gadget bytes format dim tex ;
+
+: 2^-ceil ( x -- y )
+    dup 2 < [ 2 * ] [ 1- log2 1+ 2^ ] if ; foldable flushable
+
+: 2^-bounds ( dim -- dim' )
+    [ 2^-ceil ] map ; foldable flushable
+
+: <texture-gadget> ( bytes format dim -- gadget )
+    texture-gadget construct-gadget
+        swap >>dim
+        swap >>format
+        swap >>bytes ;
+
+:: render ( gadget -- )
+    GL_ENABLE_BIT [
+        GL_TEXTURE_2D glEnable
+        GL_TEXTURE_2D gadget tex>> glBindTexture
+        GL_TEXTURE_2D
+        0
+        GL_RGBA
+        gadget dim>> 2^-bounds first2
+        0
+        gadget format>>
+        GL_UNSIGNED_BYTE
+        gadget bytes>>
+        glTexImage2D
+        init-texture
+        GL_TEXTURE_2D 0 glBindTexture
+    ] do-attribs ;
+
+:: four-corners ( dim -- )
+    [let* | w [ dim first ]
+            h [ dim second ]
+            dim' [ dim dup 2^-bounds [ /f ] 2map ]
+            w' [ dim' first ]
+            h' [ dim' second ] |
+        0  0  glTexCoord2d 0 0 glVertex2d
+        0  h' glTexCoord2d 0 h glVertex2d
+        w' h' glTexCoord2d w h glVertex2d
+        w' 0  glTexCoord2d w 0 glVertex2d
+    ] ;
+
+M: texture-gadget draw-gadget* ( gadget -- )
+    origin get [
+        GL_ENABLE_BIT [
+            white gl-color
+            1.0 -1.0 glPixelZoom
+            GL_TEXTURE_2D glEnable
+            GL_TEXTURE_2D over tex>> glBindTexture
+            GL_QUADS [
+                dim>> four-corners
+            ] do-state
+            GL_TEXTURE_2D 0 glBindTexture
+        ] do-attribs
+    ] with-translation ;
+
+M: texture-gadget graft* ( gadget -- )
+    gen-texture >>tex [ render ]
+    [ f >>bytes f >>format drop ] bi ;
+
+M: texture-gadget ungraft* ( gadget -- )
+    tex>> delete-texture ;
+
+M: texture-gadget pref-dim* ( gadget -- dim ) dim>> ;