Merge branch 'master' of git://factorcode.org/git/factor

diff --git a/extra/cairo/gadgets/gadgets.factor b/extra/cairo/gadgets/gadgets.factor
index f5f4d3e9651bdad04d08103e4f0857fa1dc85527..b42c47d79b444e786b88f1502377158aaa86f7e3 100644 (file)
--- a/extra/cairo/gadgets/gadgets.factor
+++ b/extra/cairo/gadgets/gadgets.factor
@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: sequences math opengl.gadgets kernel
 byte-arrays cairo.ffi cairo io.backend
-opengl.gl arrays ;
+ui.gadgets accessors opengl.gl
+arrays ;
 
 IN: cairo.gadgets
 
@@ -14,9 +15,19 @@ IN: cairo.gadgets
     [ cairo_image_surface_create_for_data ] 3bi
     r> with-cairo-from-surface ;
 
-: <cairo-gadget> ( dim quot -- )
-    over 2^-bounds swap copy-cairo
-    GL_BGRA rot <texture-gadget> ;
+TUPLE: cairo-gadget < texture-gadget quot ;
+
+: <cairo-gadget> ( dim quot -- gadget )
+    cairo-gadget construct-gadget
+        swap >>quot
+        swap >>dim ;
+
+M: cairo-gadget format>> drop GL_BGRA ;
+
+M: cairo-gadget render* ( gadget -- )
+    dup
+    [ dim>> 2^-bounds ] [ quot>> copy-cairo ] bi
+    >>bytes call-next-method ;
 
 ! maybe also texture>png
 ! : cairo>png ( gadget path -- )

diff --git a/extra/opengl/gadgets/gadgets.factor b/extra/opengl/gadgets/gadgets.factor
index 1a15283048fc585042254e8416975809b9778770..de37969220ca6a48a96d6d4882d2842bd4b8c9fc 100644 (file)
--- a/extra/opengl/gadgets/gadgets.factor
+++ b/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 ;

diff --git a/extra/pango/cairo/cairo.factor b/extra/pango/cairo/cairo.factor
index 889052c3857606dc8c2a479db8b5a96f6844153b..d1b536d9bc98aa1125688fde2a8c2f686d99d359 100644 (file)
--- a/extra/pango/cairo/cairo.factor
+++ b/extra/pango/cairo/cairo.factor
@@ -4,6 +4,7 @@
 ! pangocairo bindings, from pango/pangocairo.h
 USING: cairo.ffi alien.c-types math
 alien.syntax system combinators alien
+memoize
 arrays pango pango.fonts ;
 IN: pango.cairo
 
@@ -111,9 +112,11 @@ M: pango-layout dispose ( alien -- ) alien>> g_object_unref ;
     0 <int> 0 <int> [ pango_layout_get_pixel_size ] 2keep
     [ *int ] bi@ ;
 
+MEMO: dummy-cairo ( -- cr )
+    CAIRO_FORMAT_ARGB32 0 0 cairo_image_surface_create cairo_create ;
+
 : dummy-pango ( quot -- )
-    >r CAIRO_FORMAT_ARGB32 0 0 cairo_image_surface_create
-    r> [ with-pango ] curry with-cairo-from-surface ; inline
+    >r dummy-cairo cairo r> [ with-pango ] curry with-variable ; inline
 
 : layout-size ( quot -- dim )
     [ layout pango-layout-get-pixel-size 2array ] compose dummy-pango ; inline
@@ -127,5 +130,8 @@ M: pango-layout dispose ( alien -- ) alien>> g_object_unref ;
 : 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 ;

diff --git a/extra/pango/cairo/gadgets/gadgets.factor b/extra/pango/cairo/gadgets/gadgets.factor
index 9e8a99515e42167ef510844ab551a33bfebb78fa..4c46b4e5015fb36a472efa4cd67d80cc90b4bc70 100644 (file)
--- a/extra/pango/cairo/gadgets/gadgets.factor
+++ b/extra/pango/cairo/gadgets/gadgets.factor
@@ -1,30 +1,64 @@
 ! 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 ;
-
-: <pango-gadget> ( quot -- gadget )
-    [ cr layout pango_cairo_show_layout ] (pango-gadget) ;
-
-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. ;
-
-MAIN: hello-pango
+SYMBOL: textures
+SYMBOL: dims
+SYMBOL: refcounts
+
+: init-cache ( symbol -- )
+    dup get [ drop ] [ H{ } clone swap set-global ] if ;
+
+textures init-cache
+dims init-cache
+refcounts init-cache
+
+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 ;
+
+: release-texture ( gadget -- )
+    cache-key textures get delete-at* [ delete-texture ] [ drop ] if ;
+
+M: pango-gadget ungraft* ( gadget -- )
+    dup [ 1- ] refcount-change
+    dup cache-key refcounts get at
+    zero? [ release-texture ] [ drop ] if ;
+
+M: pango-gadget render* ( gadget -- ) 
+    [ gen-texture ] [ cache-key textures get set-at ] bi
+    call-next-method ;
+
+M: pango-gadget tex>> ( gadget -- texture )
+    dup cache-key textures get at 
+    [ nip ] [ dup render* tex>> ] if* ;
+
+USE: ui.gadgets.panes
+: hello "Sans 50" "hello" <pango-gadget> gadget. ;

diff --git a/extra/pango/cairo/samples/samples.factor b/extra/pango/cairo/samples/samples.factor
new file mode 100644 (file)
index 0000000..644d731
--- /dev/null
+++ b/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