! 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 ;
+
+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. ;
--- /dev/null
+! 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