implemented texture caching for pango-gadgets

extra/cairo/gadgets/gadgets.factor

@@ -22,8 +22,10 @@ TUPLE: cairo-gadget < texture-gadget quot ;
         swap >>quot
         swap >>dim ;
 
-M: cairo-gadget graft* ( gadget -- )
-    GL_BGRA >>format dup
+M: cairo-gadget format>> drop GL_BGRA ;
+
+M: cairo-gadget render* ( gadget -- )
+    dup
     [ dim>> 2^-bounds ] [ quot>> copy-cairo ] bi
     >>bytes call-next-method ;
 

extra/opengl/gadgets/gadgets.factor

@@ -19,7 +19,9 @@ TUPLE: texture-gadget bytes format dim tex ;
         swap >>format
         swap >>bytes ;
 
-:: render ( gadget -- )
+GENERIC: render* ( texture-gadget -- )
+
+M:: texture-gadget render* ( gadget -- )
     GL_ENABLE_BIT [
         GL_TEXTURE_2D glEnable
         GL_TEXTURE_2D gadget tex>> glBindTexture
@@ -63,8 +65,8 @@ M: texture-gadget draw-gadget* ( gadget -- )
     ] with-translation ;
 
 M: texture-gadget graft* ( gadget -- )
-    gen-texture >>tex [ render ]
-    [ f >>bytes f >>format drop ] bi ;
+    gen-texture >>tex [ render* ]
+    [ f >>bytes drop ] bi ;
 
 M: texture-gadget ungraft* ( gadget -- )
     tex>> delete-texture ;

extra/pango/cairo/cairo.factor

@@ -130,5 +130,8 @@ MEMO: dummy-cairo ( -- cr )
 : layout-text ( str -- )
     layout swap -1 pango_layout_set_text ;
 
+: show-layout ( -- )
+    cr layout pango_cairo_show_layout ;
+
 : families ( -- families )
     pango_cairo_font_map_get_default list-families ;

extra/pango/cairo/gadgets/gadgets.factor

@@ -1,30 +1,58 @@
 ! Copyright (C) 2008 Matthew Willis.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: pango.cairo cairo cairo.ffi cairo.gadgets
+USING: pango.cairo cairo cairo.ffi
+cairo.gadgets namespaces arrays
+fry accessors ui.gadgets assocs
+sequences shuffle opengl opengl.gadgets
 alien.c-types kernel math ;
 IN: pango.cairo.gadgets
 
-: (pango-gadget) ( setup show -- gadget )
-    [ drop layout-size ]
-    [ compose [ with-pango ] curry <cairo-gadget> ] 2bi ;
+SYMBOL: textures
+SYMBOL: dims
+SYMBOL: refcounts
 
-: <pango-gadget> ( quot -- gadget )
-    [ cr layout pango_cairo_show_layout ] (pango-gadget) ;
+: init-cache ( symbol -- )
+    dup get [ drop ] [ H{ } clone swap set-global ] if ;
 
-USING: prettyprint sequences ui.gadgets.panes
-threads io.backend io.encodings.utf8 io.files ;
-: hello-pango ( -- )
-    50 [ 6 + ] map [
-        "Sans " swap unparse append
-        [ 
-            cr 0 1 0.2 0.6 cairo_set_source_rgba
-            layout-font "今日は、 Pango!" layout-text
-        ] curry
-        <pango-gadget> gadget. yield
-    ] each
-    [ 
-        "resource:extra/pango/cairo/gadgets/gadgets.factor"
-        normalize-path utf8 file-contents layout-text
-    ] <pango-gadget> gadget. ;
+textures init-cache
+dims init-cache
+refcounts init-cache
 
-MAIN: hello-pango
+TUPLE: pango-gadget < cairo-gadget text font ;
+
+: cache-key ( gadget -- key )
+    [ font>> ] [ text>> ] bi 2array ;
+
+: refcount-change ( gadget quot -- )
+    >r cache-key refcounts get
+    [ [ 0 ] unless* ] r> compose change-at ;
+
+: <pango-gadget> ( font text -- gadget )
+    pango-gadget construct-gadget
+        swap >>text
+        swap >>font ;
+
+: setup-layout ( {font,text} -- quot )
+    first2 '[ , layout-font , layout-text ] ;
+
+M: pango-gadget quot>> ( gadget -- quot )
+    cache-key setup-layout [ show-layout ] compose
+    [ with-pango ] curry ;
+
+M: pango-gadget dim>> ( gadget -- dim )
+    cache-key dims get [ setup-layout layout-size ] cache ;
+
+M: pango-gadget graft* ( gadget -- ) [ 1+ ] refcount-change ;
+
+M: pango-gadget ungraft* ( gadget -- ) [ 1- ] refcount-change ;
+
+M: pango-gadget render* ( gadget -- ) 
+    [ gen-texture ] [ cache-key textures get set-at ]
+    [ call-next-method ] tri ;
+
+M: pango-gadget tex>> ( gadget -- texture )
+    dup cache-key textures get at 
+    [ ] [ render* tex>> ] ?if ;
+
+USE: ui.gadgets.panes
+: hello "Sans 50" "hello" <pango-gadget> gadget. ;

extra/pango/cairo/samples/samples.factor

@@ -0,0 +1,23 @@
+! Copyright (C) 2008 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: prettyprint sequences ui.gadgets.panes
+pango.cairo.gadgets math kernel cairo cairo.ffi
+pango.cairo tools.time namespaces assocs
+threads io.backend io.encodings.utf8 io.files ;
+
+IN: pango.cairo.samples
+
+: hello-pango ( -- )
+    "monospace 10" "resource:extra/pango/cairo/gadgets/gadgets.factor"
+    normalize-path utf8 file-contents
+    <pango-gadget> gadget. ;
+
+: time-pango ( -- )
+    [ hello-pango ] time ;
+
+! clear the caches, for testing.
+: clear-pango ( -- )
+    dims get clear-assoc
+    textures get clear-assoc ;
+
+MAIN: time-pango