Major refactor of pango/cairo gadgets. Added freetype backend.

extra/cairo/gadgets/gadgets.factor

@@ -13,21 +13,23 @@ IN: cairo.gadgets
     >r first2 over width>stride
     [ * nip <byte-array> dup CAIRO_FORMAT_ARGB32 ]
     [ cairo_image_surface_create_for_data ] 3bi
-    r> with-cairo-from-surface ;
+    r> with-cairo-from-surface ; inline
 
-TUPLE: cairo-gadget < texture-gadget quot ;
+TUPLE: cairo-gadget < texture-gadget dim quot ;
 
 : <cairo-gadget> ( dim quot -- gadget )
     cairo-gadget construct-gadget
         swap >>quot
         swap >>dim ;
 
-M: cairo-gadget format>> drop GL_BGRA ;
+M: cairo-gadget cache-key* [ dim>> ] [ quot>> ] bi 2array ;
 
-M: cairo-gadget render* ( gadget -- )
+: render-cairo ( dim quot -- bytes format )
-    dup
+    >r 2^-bounds r> copy-cairo GL_BGRA ;
-    [ dim>> 2^-bounds ] [ quot>> copy-cairo ] bi
+
-    >>bytes call-next-method ;
+M: cairo-gadget render*
+    [ dim>> dup ] [ quot>> ] bi
+    render-cairo render-bytes* ;
 
 ! maybe also texture>png
 ! : cairo>png ( gadget path -- )
@@ -40,11 +42,16 @@ M: cairo-gadget render* ( gadget -- )
     cr swap 0 0 cairo_set_source_surface
     cr cairo_paint ;
 
-: <png-gadget> ( path -- gadget )
+TUPLE: png-gadget < texture-gadget path ;
-    normalize-path cairo_image_surface_create_from_png
+: <png> ( path -- gadget )
+    png-gadget construct-gadget
+        swap >>path ;
+
+M: png-gadget render*
+    path>> normalize-path cairo_image_surface_create_from_png
     [ cairo_image_surface_get_width ]
     [ cairo_image_surface_get_height 2array dup 2^-bounds ]
     [ [ copy-surface ] curry copy-cairo ] tri
-    GL_BGRA rot <texture-gadget> ;
+    GL_BGRA render-bytes* ;
-
 
+M: png-gadget cache-key* path>> ;

extra/freetype/freetype.factor

@@ -155,6 +155,16 @@ C-STRUCT: face
     { "face-size*" "size" }
     { "void*" "charmap" } ;
 
+C-STRUCT: FT_Bitmap
+    { "int" "rows" }
+    { "int" "width" }
+    { "int" "pitch" }
+    { "void*" "buffer" }
+    { "short" "num_grays" }
+    { "char" "pixel_mode" }
+    { "char" "palette_mode" }
+    { "void*" "palette" } ;
+
 FUNCTION: FT_Error FT_New_Face ( void* library, FT_Char* font, FT_Long index, face* face ) ;
 
 FUNCTION: FT_Error FT_New_Memory_Face ( void* library, FT_Byte* file_base, FT_Long file_size, FT_Long face_index, FT_Face* aface ) ;
@@ -170,6 +180,15 @@ C-ENUM:
     FT_RENDER_MODE_LCD
     FT_RENDER_MODE_LCD_V ;
 
+C-ENUM:
+    FT_PIXEL_MODE_NONE
+    FT_PIXEL_MODE_MONO
+    FT_PIXEL_MODE_GRAY
+    FT_PIXEL_MODE_GRAY2
+    FT_PIXEL_MODE_GRAY4
+    FT_PIXEL_MODE_LCD
+    FT_PIXEL_MODE_LCD_V ;
+
 FUNCTION: int FT_Render_Glyph ( glyph* slot, int render_mode ) ;
 
 FUNCTION: void FT_Done_Face ( face* face ) ;
@@ -177,3 +196,4 @@ FUNCTION: void FT_Done_Face ( face* face ) ;
 FUNCTION: void FT_Done_FreeType ( void* library ) ;
 
 FUNCTION: FT_Long FT_MulFix ( FT_Long a, FT_Long b ) ;
+

extra/opengl/gadgets/gadgets.factor

@@ -2,10 +2,57 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: locals math.functions math namespaces
 opengl.gl accessors kernel opengl ui.gadgets
+fry assocs
 destructors sequences ui.render colors ;
 IN: opengl.gadgets
 
-TUPLE: texture-gadget bytes format dim tex ;
+TUPLE: texture-gadget ;
+
+GENERIC: render* ( gadget -- texture dims )
+GENERIC: cache-key* ( gadget -- key )
+
+M: texture-gadget cache-key* ;
+
+SYMBOL: textures
+SYMBOL: refcounts
+
+: init-cache ( symbol -- )
+    dup get [ drop ] [ H{ } clone swap set-global ] if ;
+
+textures init-cache
+refcounts init-cache
+
+: refcount-change ( gadget quot -- )
+    >r cache-key* refcounts get
+    [ [ 0 ] unless* ] r> compose change-at ;
+
+TUPLE: cache-entry tex dims ;
+C: <entry> cache-entry
+
+: make-entry ( gadget -- entry )
+    dup render* <entry>
+    [ swap cache-key* textures get set-at ] keep ;
+
+: get-entry ( gadget -- {texture,dims} )
+    dup cache-key* textures get at
+    [ nip ] [ make-entry ] if* ;
+
+: get-dims ( gadget -- dims )
+    get-entry dims>> ;
+
+: get-texture ( gadget -- texture )
+    get-entry tex>> ;
+
+: release-texture ( gadget -- )
+    cache-key* textures get delete-at*
+    [ tex>> delete-texture ] [ drop ] if ;
+
+M: texture-gadget graft* ( gadget -- ) [ 1+ ] refcount-change ;
+
+M: texture-gadget ungraft* ( gadget -- )
+    dup [ 1- ] refcount-change
+    dup cache-key* refcounts get at
+    zero? [ release-texture ] [ drop ] if ;
 
 : 2^-ceil ( x -- y )
     dup 2 < [ 2 * ] [ 1- log2 1+ 2^ ] if ; foldable flushable
@@ -13,31 +60,29 @@ TUPLE: texture-gadget bytes format dim tex ;
 : 2^-bounds ( dim -- dim' )
     [ 2^-ceil ] map ; foldable flushable
 
-: <texture-gadget> ( bytes format dim -- gadget )
+:: (render-bytes) ( dims bytes format texture -- )
-    texture-gadget construct-gadget
-        swap >>dim
-        swap >>format
-        swap >>bytes ;
-
-GENERIC: render* ( texture-gadget -- )
-
-M:: texture-gadget render* ( gadget -- )
     GL_ENABLE_BIT [
         GL_TEXTURE_2D glEnable
-        GL_TEXTURE_2D gadget tex>> glBindTexture
+        GL_TEXTURE_2D texture glBindTexture
         GL_TEXTURE_2D
         0
         GL_RGBA
-        gadget dim>> 2^-bounds first2
+        dims 2^-bounds first2
         0
-        gadget format>>
+        format
         GL_UNSIGNED_BYTE
-        gadget bytes>>
+        bytes
         glTexImage2D
         init-texture
         GL_TEXTURE_2D 0 glBindTexture
     ] do-attribs ;
 
+: render-bytes ( dims bytes format -- texture )
+    gen-texture [ (render-bytes) ] keep ;
+
+: render-bytes* ( dims bytes format -- texture dims )
+    pick >r render-bytes r> ;
+
 :: four-corners ( dim -- )
     [let* | w [ dim first ]
             h [ dim second ]
@@ -56,19 +101,12 @@ M: texture-gadget draw-gadget* ( gadget -- )
             white gl-color
             1.0 -1.0 glPixelZoom
             GL_TEXTURE_2D glEnable
-            GL_TEXTURE_2D over tex>> glBindTexture
+            GL_TEXTURE_2D over get-texture glBindTexture
             GL_QUADS [
-                dim>> four-corners
+                get-dims four-corners
             ] do-state
             GL_TEXTURE_2D 0 glBindTexture
         ] do-attribs
     ] with-translation ;
 
-M: texture-gadget graft* ( gadget -- )
+M: texture-gadget pref-dim* ( gadget -- dim ) get-dims ;
-    gen-texture >>tex [ render* ]
-    [ f >>bytes drop ] bi ;
-
-M: texture-gadget ungraft* ( gadget -- )
-    tex>> delete-texture ;
-
-M: texture-gadget pref-dim* ( gadget -- dim ) dim>> ;

extra/pango/cairo/cairo.factor

@@ -93,43 +93,24 @@ pango_cairo_error_underline_path ( cairo_t* cr, double x, double y, double width
 ! Higher level words and combinators
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-USING: destructors accessors namespaces kernel cairo ;
+USING: pango.layouts
-
+destructors accessors namespaces kernel cairo ;
-TUPLE: pango-layout alien ;
-C: <pango-layout> pango-layout
-M: pango-layout dispose ( alien -- ) alien>> g_object_unref ;
-
-: layout ( -- pango-layout ) pango-layout get ;
 
 : (with-pango) ( layout quot -- )
     >r alien>> pango-layout r> with-variable ; inline
 
-: with-pango ( quot -- )
+: with-pango-cairo ( quot -- )
-    cr pango_cairo_create_layout <pango-layout> swap
+    cr pango_cairo_create_layout swap with-layout ;
-    [ (with-pango) ] curry with-disposal ; inline
-
-: pango-layout-get-pixel-size ( layout -- width height )
-    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 dummy-cairo cairo r> [ with-pango ] curry with-variable ; inline
+    >r dummy-cairo cairo r> [ with-pango-cairo ] curry with-variable ; inline
 
 : layout-size ( quot -- dim )
     [ layout pango-layout-get-pixel-size 2array ] compose dummy-pango ; inline
 
-: layout-font ( str -- )
-    pango_font_description_from_string
-    dup zero? [ "pango: not a valid font." throw ] when
-    layout over pango_layout_set_font_description
-    pango_font_description_free ;
-
-: layout-text ( str -- )
-    layout swap -1 pango_layout_set_text ;
-
 : show-layout ( -- )
     cr layout pango_cairo_show_layout ;
 

extra/pango/cairo/gadgets/gadgets.factor

@@ -1,64 +1,27 @@
 ! Copyright (C) 2008 Matthew Willis.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: pango.cairo cairo cairo.ffi
+USING: pango.cairo pango.gadgets
-cairo.gadgets namespaces arrays
+cairo.gadgets arrays namespaces
-fry accessors ui.gadgets assocs
+fry accessors ui.gadgets
-sequences shuffle opengl opengl.gadgets
+sequences opengl.gadgets
-alien.c-types kernel math ;
+kernel pango.layouts ;
+
 IN: pango.cairo.gadgets
 
-SYMBOL: textures
+TUPLE: pango-cairo-gadget < pango-gadget ;
-SYMBOL: dims
-SYMBOL: refcounts
 
-: init-cache ( symbol -- )
+SINGLETON: pango-cairo-backend
-    dup get [ drop ] [ H{ } clone swap set-global ] if ;
+pango-cairo-backend pango-backend set-global
 
-textures init-cache
+M: pango-cairo-backend construct-pango
-dims init-cache
+    pango-cairo-gadget construct-gadget ;
-refcounts init-cache
 
-TUPLE: pango-gadget < cairo-gadget text font ;
+: setup-layout ( gadget -- quot )
+    [ font>> ] [ text>> ] bi
+    '[ , layout-font , layout-text ] ;
 
-: cache-key ( gadget -- key )
+M: pango-cairo-gadget render* ( gadget -- ) 
-    [ font>> ] [ text>> ] bi 2array ;
+    setup-layout [ layout-size dup ]
-
+    [ 
-: refcount-change ( gadget quot -- )
+        '[ [ @ show-layout ] with-pango-cairo ]
-    >r cache-key refcounts get
+    ] bi render-cairo render-bytes* ;
-    [ [ 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. ;

extra/pango/ft2/ft2.factor

@@ -0,0 +1,56 @@
+USING: alien alien.c-types
+math kernel byte-arrays freetype
+opengl.gadgets accessors pango
+ui.gadgets memoize
+arrays sequences libc opengl.gl
+system combinators alien.syntax
+pango.layouts ;
+IN: pango.ft2
+
+<< "pangoft2" {
+!    { [ os winnt? ] [ "libpangocairo-1.dll" ] }
+!    { [ os macosx? ] [ "libpangocairo.dylib" ] }
+    { [ os unix? ] [ "libpangoft2-1.0.so" ] }
+} cond "cdecl" add-library >>
+
+LIBRARY: pangoft2
+
+FUNCTION: PangoFontMap*
+pango_ft2_font_map_new ( ) ;
+
+FUNCTION: PangoContext*
+pango_ft2_font_map_create_context ( PangoFT2FontMap* fontmap ) ;
+
+FUNCTION: void
+pango_ft2_render_layout ( FT_Bitmap* bitmap, PangoLayout* layout, int x, int y ) ;
+
+: 4*-ceil ( n -- k*4 )
+    3 + 4 /i 4 * ;
+
+: <ft-bitmap> ( width height -- ft-bitmap )
+    swap dup
+    2dup * 4*-ceil
+    "uchar" malloc-array
+    256
+    FT_PIXEL_MODE_GRAY
+    "FT_Bitmap" <c-object> dup >r
+    {
+        set-FT_Bitmap-rows
+        set-FT_Bitmap-width
+        set-FT_Bitmap-pitch
+        set-FT_Bitmap-buffer
+        set-FT_Bitmap-num_grays
+        set-FT_Bitmap-pixel_mode
+    } set-slots r> ;
+
+: render-layout ( layout -- dims alien )
+    [ 
+        pango-layout-get-pixel-size
+        2array dup 2^-bounds first2 <ft-bitmap> dup
+    ] [ 0 0 pango_ft2_render_layout ] bi FT_Bitmap-buffer ;
+
+MEMO: ft2-context ( -- PangoContext* )
+    pango_ft2_font_map_new pango_ft2_font_map_create_context ;
+
+: with-ft2-layout ( quot -- )
+    ft2-context pango_layout_new swap with-layout ; inline

extra/pango/ft2/gadgets/gadgets.factor

@@ -0,0 +1,20 @@
+! Copyright (C) 2008 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: pango.ft2 pango.gadgets opengl.gadgets
+accessors kernel opengl.gl libc
+sequences namespaces ui.gadgets pango.layouts ;
+IN: pango.ft2.gadgets
+
+TUPLE: pango-ft2-gadget < pango-gadget ;
+
+SINGLETON: pango-ft2-backend
+pango-ft2-backend pango-backend set-global
+
+M: pango-ft2-backend construct-pango
+    pango-ft2-gadget construct-gadget ;
+
+M: pango-ft2-gadget render*
+    [
+        [ text>> layout-text ] [ font>> layout-font ] bi
+        layout render-layout
+    ] with-ft2-layout [ GL_ALPHA render-bytes* ] keep free ;

extra/pango/gadgets/gadgets.factor

@@ -0,0 +1,19 @@
+! Copyright (C) 2008 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: opengl.gadgets kernel
+arrays
+accessors ;
+
+IN: pango.gadgets
+
+TUPLE: pango-gadget < texture-gadget text font ;
+
+M: pango-gadget cache-key* [ font>> ] [ text>> ] bi 2array ;
+
+SYMBOL: pango-backend
+HOOK: construct-pango pango-backend ( -- gadget )
+
+: <pango> ( font text -- gadget )
+    construct-pango
+        swap >>text
+        swap >>font ;

extra/pango/layouts/layouts.factor

@@ -0,0 +1,30 @@
+USING: alien alien.c-types 
+math
+destructors accessors namespaces
+pango kernel ;
+IN: pango.layouts
+
+: pango-layout-get-pixel-size ( layout -- width height )
+    0 <int> 0 <int> [ pango_layout_get_pixel_size ] 2keep
+    [ *int ] bi@ ;
+
+TUPLE: pango-layout alien ;
+C: <pango-layout> pango-layout
+M: pango-layout dispose ( alien -- ) alien>> g_object_unref ;
+
+: layout ( -- pango-layout ) pango-layout get ;
+
+: (with-layout) ( pango-layout quot -- )
+    >r alien>> pango-layout r> with-variable ; inline
+
+: with-layout ( layout quot -- )
+    >r <pango-layout> r> [ (with-layout) ] curry with-disposal ; inline
+
+: layout-font ( str -- )
+    pango_font_description_from_string
+    dup zero? [ "pango: not a valid font." throw ] when
+    layout over pango_layout_set_font_description
+    pango_font_description_free ;
+
+: layout-text ( str -- )
+    layout swap -1 pango_layout_set_text ;

extra/pango/pango.factor

@@ -18,6 +18,9 @@ LIBRARY: pango
 
 : PANGO_SCALE 1024 ;
 
+FUNCTION: PangoLayout*
+pango_layout_new ( PangoContext* context ) ;
+
 FUNCTION: void
 pango_layout_set_text ( PangoLayout* layout, char* text, int length ) ;