From 0c8d14537879f577904dc7c7dbe78b8636c2cc89 Mon Sep 17 00:00:00 2001 From: Matthew Willis Date: Sat, 24 May 2008 20:03:31 -0700 Subject: [PATCH 01/10] changed "cairo.pango.gadgets" run to use Japanese --- extra/cairo/pango/gadgets/gadgets.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/cairo/pango/gadgets/gadgets.factor b/extra/cairo/pango/gadgets/gadgets.factor index 780881e872..48e5e683a9 100644 --- a/extra/cairo/pango/gadgets/gadgets.factor +++ b/extra/cairo/pango/gadgets/gadgets.factor @@ -12,8 +12,8 @@ IN: cairo.pango.gadgets USING: prettyprint sequences ui.gadgets.panes ; : hello-pango ( -- ) 50 [ 6 + ] map [ - "Sans Bold " swap unparse append - [ layout-font "Hello, Pango!" layout-text ] curry + "Sans " swap unparse append + [ layout-font "今日は、 Pango!" layout-text ] curry gadget. ] each ; From d5f6cf4d057cd4e9d9ddaa4658bbb3cfde0b594b Mon Sep 17 00:00:00 2001 From: Matthew Willis Date: Sat, 24 May 2008 20:04:12 -0700 Subject: [PATCH 02/10] Initial commit of GL texture gadgets --- extra/cairo/gadgets/gadgets.factor | 59 +++++++++++++++++++++--------- 1 file changed, 42 insertions(+), 17 deletions(-) diff --git a/extra/cairo/gadgets/gadgets.factor b/extra/cairo/gadgets/gadgets.factor index e0daefd63c..fa5364557e 100644 --- a/extra/cairo/gadgets/gadgets.factor +++ b/extra/cairo/gadgets/gadgets.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: cairo cairo.ffi ui.render kernel opengl.gl opengl math byte-arrays ui.gadgets accessors arrays -namespaces io.backend ; +namespaces io.backend memoize ; IN: cairo.gadgets @@ -10,7 +10,7 @@ IN: cairo.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? bytes ; +TUPLE: cairo-gadget width height quot cache? texture ; PREDICATE: cached-cairo < cairo-gadget cache?>> ; : ( width height quot -- cairo-gadget ) cairo-gadget construct-gadget @@ -29,31 +29,54 @@ PREDICATE: cached-cairo < cairo-gadget cache?>> ; [ cairo_image_surface_create_for_data ] 3bi r> with-cairo-from-surface ; -: (cairo>bytes) ( gadget -- byte-array ) +: cairo>bytes ( gadget -- byte-array ) [ width>> ] [ height>> ] [ quot>> ] tri copy-cairo ; -GENERIC: cairo>bytes -M: cairo-gadget cairo>bytes ( gadget -- byte-array ) - (cairo>bytes) ; - -M: cached-cairo cairo>bytes ( gadget -- byte-array ) - dup bytes>> [ ] [ - dup (cairo>bytes) [ >>bytes drop ] keep - ] ?if ; - : cairo>png ( gadget path -- ) >r [ cairo>bytes CAIRO_FORMAT_ARGB32 ] [ width>> ] [ height>> ] tri over width>stride cairo_image_surface_create_for_data r> [ cairo_surface_write_to_png check-cairo ] curry with-surface ; -M: cairo-gadget draw-gadget* ( gadget -- ) - origin get [ +: 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-translation ; + ] 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 + 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 ; M: cairo-gadget pref-dim* ( gadget -- rect ) [ width>> ] [ height>> ] bi 2array ; @@ -63,11 +86,13 @@ M: cairo-gadget pref-dim* ( gadget -- rect ) cr cairo_paint ; : ( width height bytes -- cairo-gadget ) - >r [ ] r> >>bytes ; + >r [ ] r> >>texture ; : ( path -- gadget ) normalize-path cairo_image_surface_create_from_png [ cairo_image_surface_get_width ] [ cairo_image_surface_get_height 2dup ] [ [ copy-surface ] curry copy-cairo ] tri - ; \ No newline at end of file + ; + + From 87b6cb5d404861ccbe78abbb199f1d803cc85f98 Mon Sep 17 00:00:00 2001 From: Matthew Willis Date: Sun, 25 May 2008 11:59:41 -0700 Subject: [PATCH 03/10] fixed a color issue in texture rendering --- extra/cairo/gadgets/gadgets.factor | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/extra/cairo/gadgets/gadgets.factor b/extra/cairo/gadgets/gadgets.factor index fa5364557e..bda18d04b4 100644 --- a/extra/cairo/gadgets/gadgets.factor +++ b/extra/cairo/gadgets/gadgets.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: cairo cairo.ffi ui.render kernel opengl.gl opengl math byte-arrays ui.gadgets accessors arrays -namespaces io.backend memoize ; +namespaces io.backend memoize colors ; IN: cairo.gadgets @@ -64,6 +64,7 @@ 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 @@ -76,7 +77,8 @@ M: cached-cairo graft* ( gadget -- ) gen-texture >>texture drop ; M: cached-cairo ungraft* ( gadget -- ) - texture>> delete-texture ; + [ texture>> delete-texture ] + [ \ render-to-texture invalidate-memoized ] bi ; M: cairo-gadget pref-dim* ( gadget -- rect ) [ width>> ] [ height>> ] bi 2array ; From e1669916f60d279ec1edd3e7edd95b960ea2840a Mon Sep 17 00:00:00 2001 From: Matthew Willis Date: Sun, 25 May 2008 12:00:55 -0700 Subject: [PATCH 04/10] add invalidate-memoized to extra/memoize so that specific entries can be removed from the memoization cache. This is used in cached-cairo ungraft* to ensure that textures re-rendered. --- extra/memoize/memoize.factor | 3 +++ 1 file changed, 3 insertions(+) diff --git a/extra/memoize/memoize.factor b/extra/memoize/memoize.factor index 4136f9eaff..6a223fdc7e 100755 --- a/extra/memoize/memoize.factor +++ b/extra/memoize/memoize.factor @@ -52,3 +52,6 @@ M: memoized definition "memo-quot" word-prop ; : reset-memoized ( word -- ) "memoize" word-prop clear-assoc ; + +: invalidate-memoized ! ( inputs... word ) + [ #in packer call ] [ "memoize" word-prop delete-at ] bi ; From 383784d09ed2061e9f1e8267fabc7df877d1f9d5 Mon Sep 17 00:00:00 2001 From: Matthew Willis Date: Sun, 25 May 2008 12:03:26 -0700 Subject: [PATCH 05/10] incorporate color into "cairo.pango.gadgets" run for testing purposes. --- extra/cairo/pango/gadgets/gadgets.factor | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/extra/cairo/pango/gadgets/gadgets.factor b/extra/cairo/pango/gadgets/gadgets.factor index 48e5e683a9..0ba901d453 100644 --- a/extra/cairo/pango/gadgets/gadgets.factor +++ b/extra/cairo/pango/gadgets/gadgets.factor @@ -9,12 +9,16 @@ IN: cairo.pango.gadgets : ( quot -- gadget ) [ cr layout pango_cairo_show_layout ] (pango-gadget) ; -USING: prettyprint sequences ui.gadgets.panes ; +USING: prettyprint sequences ui.gadgets.panes +threads ; : hello-pango ( -- ) 50 [ 6 + ] map [ "Sans " swap unparse append - [ layout-font "今日は、 Pango!" layout-text ] curry - gadget. + [ + cr 0 1 0.2 0.6 cairo_set_source_rgba + layout-font "今日は、 Pango!" layout-text + ] curry + gadget. yield ] each ; MAIN: hello-pango From 03ceb011259add3a688a9550a4165b72eb080acf Mon Sep 17 00:00:00 2001 From: Matthew Willis Date: Sun, 25 May 2008 13:24:56 -0700 Subject: [PATCH 06/10] Add a larger text section example to "cairo.pango.gadgets" run --- extra/cairo/pango/gadgets/gadgets.factor | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/extra/cairo/pango/gadgets/gadgets.factor b/extra/cairo/pango/gadgets/gadgets.factor index 0ba901d453..fa12f96622 100644 --- a/extra/cairo/pango/gadgets/gadgets.factor +++ b/extra/cairo/pango/gadgets/gadgets.factor @@ -10,7 +10,7 @@ IN: cairo.pango.gadgets [ cr layout pango_cairo_show_layout ] (pango-gadget) ; USING: prettyprint sequences ui.gadgets.panes -threads ; +threads io.backend io.encodings.utf8 io.files ; : hello-pango ( -- ) 50 [ 6 + ] map [ "Sans " swap unparse append @@ -19,6 +19,10 @@ threads ; layout-font "今日は、 Pango!" layout-text ] curry gadget. yield - ] each ; + ] each + [ + "resource:extra/cairo/pango/gadgets/gadgets.factor" + normalize-path utf8 file-contents layout-text + ] gadget. ; MAIN: hello-pango From 683ba1a7634106a9ce3174d330e555c8d85da14f Mon Sep 17 00:00:00 2001 From: Matthew Willis Date: Tue, 27 May 2008 20:18:31 -0700 Subject: [PATCH 07/10] Separated out cairo.pango into extra/pango and pango.fonts --- extra/cairo/pango/pango.factor | 54 ++++------------------------------ extra/pango/fonts/fonts.factor | 40 +++++++++++++++++++++++++ extra/pango/pango.factor | 54 ++++++++++++++++++++++++++++++++++ 3 files changed, 99 insertions(+), 49 deletions(-) create mode 100644 extra/pango/fonts/fonts.factor create mode 100644 extra/pango/pango.factor diff --git a/extra/cairo/pango/pango.factor b/extra/cairo/pango/pango.factor index 789044f6e1..3f702769d8 100644 --- a/extra/cairo/pango/pango.factor +++ b/extra/cairo/pango/pango.factor @@ -2,9 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. ! ! pangocairo bindings, from pango/pangocairo.h - USING: cairo.ffi alien.c-types math -alien.syntax system combinators alien ; +alien.syntax system combinators alien +pango pango.fonts ; IN: cairo.pango << "pangocairo" { @@ -15,10 +15,6 @@ IN: cairo.pango LIBRARY: pangocairo -TYPEDEF: void* PangoCairoFont -TYPEDEF: void* PangoCairoFontMap -TYPEDEF: void* PangoFontMap - FUNCTION: PangoFontMap* pango_cairo_font_map_new ( ) ; @@ -92,49 +88,6 @@ pango_cairo_layout_path ( cairo_t* cr, PangoLayout* layout ) ; FUNCTION: void pango_cairo_error_underline_path ( cairo_t* cr, double x, double y, double width, double height ) ; -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Helpful functions from other parts of pango -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: PANGO_SCALE 1024 ; - -FUNCTION: void -pango_layout_set_text ( PangoLayout* layout, char* text, int length ) ; - -FUNCTION: char* -pango_layout_get_text ( PangoLayout* layout ) ; - -FUNCTION: void -pango_layout_get_size ( PangoLayout* layout, int* width, int* height ) ; - -TYPEDEF: void* PangoFontDescription - -FUNCTION: PangoFontDescription* -pango_font_description_from_string ( char* str ) ; - -FUNCTION: char* -pango_font_description_to_string ( PangoFontDescription* desc ) ; - -FUNCTION: char* -pango_font_description_to_filename ( PangoFontDescription* desc ) ; - -FUNCTION: void -pango_layout_set_font_description ( PangoLayout* layout, PangoFontDescription* desc ) ; - -FUNCTION: PangoFontDescription* -pango_layout_get_font_description ( PangoLayout* layout ) ; - -FUNCTION: void -pango_layout_get_pixel_size ( PangoLayout* layout, int* width, int* height ) ; - -FUNCTION: void -pango_font_description_free ( PangoFontDescription* desc ) ; - -TYPEDEF: void* gpointer - -FUNCTION: void -g_object_unref ( gpointer object ) ; - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Higher level words and combinators ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -173,3 +126,6 @@ M: pango-layout dispose ( alien -- ) alien>> g_object_unref ; : layout-text ( str -- ) layout swap -1 pango_layout_set_text ; + +: families ( -- families ) + pango_cairo_font_map_get_default list-families ; diff --git a/extra/pango/fonts/fonts.factor b/extra/pango/fonts/fonts.factor new file mode 100644 index 0000000000..6076b6a254 --- /dev/null +++ b/extra/pango/fonts/fonts.factor @@ -0,0 +1,40 @@ +! Copyright (C) 2008 Matthew Willis. +! See http://factorcode.org/license.txt for BSD license +USING: pango alien.syntax alien.c-types +kernel ; +IN: pango.fonts + +LIBRARY: pango + +FUNCTION: void +pango_font_map_list_families ( PangoFontMap* fontmap, PangoFontFamily*** families, int* n_families ) ; + +FUNCTION: char* +pango_font_family_get_name ( PangoFontFamily* family ) ; + +FUNCTION: int +pango_font_family_is_monospace ( PangoFontFamily* family ) ; + +FUNCTION: void +pango_font_family_list_faces ( PangoFontFamily* family, PangoFontFace*** faces, int* n_faces ) ; + +FUNCTION: char* +pango_font_face_get_face_name ( PangoFontFace* face ) ; + +FUNCTION: void +pango_font_face_list_sizes ( PangoFontFace* face, int** sizes, int* n_sizes ) ; + +: list-families ( PangoFontMap* -- PangoFontFamily*-seq ) + 0 0 [ pango_font_map_list_families ] 2keep + *int >r *void* r> c-void*-array> ; + +: list-faces ( PangoFontFamily* -- PangoFontFace*-seq ) + 0 0 [ pango_font_family_list_faces ] 2keep + *int >r *void* r> c-void*-array> ; + +: list-sizes ( PangoFontFace* -- ints ) + 0 0 [ pango_font_face_list_sizes ] 2keep + *int >r *void* r> c-int-array> ; + +: monospace? ( PangoFontFamily* -- ? ) + pango_font_family_is_monospace 1 = ; diff --git a/extra/pango/pango.factor b/extra/pango/pango.factor new file mode 100644 index 0000000000..3836a43e3f --- /dev/null +++ b/extra/pango/pango.factor @@ -0,0 +1,54 @@ +! Copyright (C) 2008 Matthew Willis. +! See http://factorcode.org/license.txt for BSD license +USING: system +alien.c-types alien.syntax alien combinators ; +IN: pango + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Helpful functions from other parts of pango +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +<< "pango" { +! { [ os winnt? ] [ "libpango-1.dll" ] } +! { [ os macosx? ] [ "libpango.dylib" ] } + { [ os unix? ] [ "libpango-1.0.so" ] } +} cond "cdecl" add-library >> + +LIBRARY: pango + +: PANGO_SCALE 1024 ; + +FUNCTION: void +pango_layout_set_text ( PangoLayout* layout, char* text, int length ) ; + +FUNCTION: char* +pango_layout_get_text ( PangoLayout* layout ) ; + +FUNCTION: void +pango_layout_get_size ( PangoLayout* layout, int* width, int* height ) ; + +FUNCTION: PangoFontDescription* +pango_font_description_from_string ( char* str ) ; + +FUNCTION: char* +pango_font_description_to_string ( PangoFontDescription* desc ) ; + +FUNCTION: char* +pango_font_description_to_filename ( PangoFontDescription* desc ) ; + +FUNCTION: void +pango_layout_set_font_description ( PangoLayout* layout, PangoFontDescription* desc ) ; + +FUNCTION: PangoFontDescription* +pango_layout_get_font_description ( PangoLayout* layout ) ; + +FUNCTION: void +pango_layout_get_pixel_size ( PangoLayout* layout, int* width, int* height ) ; + +FUNCTION: void +pango_font_description_free ( PangoFontDescription* desc ) ; + +TYPEDEF: void* gpointer + +FUNCTION: void +g_object_unref ( gpointer object ) ; From 610c47eb183272b293c5069c9189277b399c5c7c Mon Sep 17 00:00:00 2001 From: Matthew Willis Date: Fri, 30 May 2008 10:42:06 -0700 Subject: [PATCH 08/10] Refactored cairo gadgets, basing them on the texture-gadget in opengl.gadgets --- extra/cairo/gadgets/gadgets.factor | 93 ++++-------------------- extra/cairo/pango/gadgets/gadgets.factor | 4 +- extra/cairo/pango/pango.factor | 6 +- extra/cairo/samples/samples.factor | 4 +- extra/opengl/gadgets/gadgets.factor | 72 ++++++++++++++++++ 5 files changed, 96 insertions(+), 83 deletions(-) create mode 100644 extra/opengl/gadgets/gadgets.factor diff --git a/extra/cairo/gadgets/gadgets.factor b/extra/cairo/gadgets/gadgets.factor index bda18d04b4..f5f4d3e965 100644 --- a/extra/cairo/gadgets/gadgets.factor +++ b/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 -math byte-arrays ui.gadgets accessors arrays -namespaces io.backend memoize colors ; +USING: sequences math opengl.gadgets kernel +byte-arrays cairo.ffi cairo io.backend +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?>> ; -: ( width height quot -- cairo-gadget ) - cairo-gadget construct-gadget - swap >>quot - swap >>height - swap >>width ; - -: ( width height quot -- cairo-gadget ) - t >>cache? ; - : width>stride ( width -- stride ) 4 * ; -: copy-cairo ( width height quot -- byte-array ) - >r over width>stride +: copy-cairo ( dim quot -- byte-array ) + >r first2 over width>stride [ * nip dup CAIRO_FORMAT_ARGB32 ] [ cairo_image_surface_create_for_data ] 3bi r> with-cairo-from-surface ; -: cairo>bytes ( gadget -- byte-array ) - [ width>> ] [ height>> ] [ quot>> ] tri copy-cairo ; +: ( dim quot -- ) + over 2^-bounds swap copy-cairo + GL_BGRA rot ; -: cairo>png ( gadget path -- ) - >r [ cairo>bytes CAIRO_FORMAT_ARGB32 ] [ width>> ] - [ height>> ] tri over width>stride - 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 ; +! maybe also texture>png +! : cairo>png ( gadget path -- ) +! >r [ cairo>bytes CAIRO_FORMAT_ARGB32 ] [ width>> ] +! [ height>> ] tri over width>stride +! cairo_image_surface_create_for_data +! r> [ cairo_surface_write_to_png check-cairo ] curry with-surface ; : copy-surface ( surface -- ) cr swap 0 0 cairo_set_source_surface cr cairo_paint ; -: ( width height bytes -- cairo-gadget ) - >r [ ] r> >>texture ; - : ( 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 - ; + GL_BGRA rot ; diff --git a/extra/cairo/pango/gadgets/gadgets.factor b/extra/cairo/pango/gadgets/gadgets.factor index fa12f96622..44ebfc30a5 100644 --- a/extra/cairo/pango/gadgets/gadgets.factor +++ b/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 ] 2bi ; + [ compose [ with-pango ] curry ] 2bi ; : ( quot -- gadget ) [ cr layout pango_cairo_show_layout ] (pango-gadget) ; diff --git a/extra/cairo/pango/pango.factor b/extra/cairo/pango/pango.factor index 3f702769d8..bb9c473047 100644 --- a/extra/cairo/pango/pango.factor +++ b/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 pango-layout-get-pixel-size ] compose dummy-pango ; inline +: layout-size ( quot -- dim ) + [ layout pango-layout-get-pixel-size 2array ] compose dummy-pango ; inline : layout-font ( str -- ) pango_font_description_from_string diff --git a/extra/cairo/samples/samples.factor b/extra/cairo/samples/samples.factor index 3cc63922f8..0e83381349 100644 --- a/extra/cairo/samples/samples.factor +++ b/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 gadget. ] each ; + [ { 256 256 } swap 1quotation gadget. ] each ; - MAIN: samples \ No newline at end of file + MAIN: samples diff --git a/extra/opengl/gadgets/gadgets.factor b/extra/opengl/gadgets/gadgets.factor new file mode 100644 index 0000000000..1a15283048 --- /dev/null +++ b/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 + +: ( 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>> ; From 1c8b5728754ab4b79aff7fafbf79ef37936ffdc1 Mon Sep 17 00:00:00 2001 From: Matthew Willis Date: Sat, 31 May 2008 01:11:47 -0700 Subject: [PATCH 09/10] cairo.pango renamed to pango.cairo --- .../{cairo/pango/pango.factor => pango/cairo/cairo.factor} | 2 +- extra/{cairo/pango => pango/cairo}/gadgets/gadgets.factor | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) rename extra/{cairo/pango/pango.factor => pango/cairo/cairo.factor} (99%) rename extra/{cairo/pango => pango/cairo}/gadgets/gadgets.factor (85%) diff --git a/extra/cairo/pango/pango.factor b/extra/pango/cairo/cairo.factor similarity index 99% rename from extra/cairo/pango/pango.factor rename to extra/pango/cairo/cairo.factor index bb9c473047..889052c385 100644 --- a/extra/cairo/pango/pango.factor +++ b/extra/pango/cairo/cairo.factor @@ -5,7 +5,7 @@ USING: cairo.ffi alien.c-types math alien.syntax system combinators alien arrays pango pango.fonts ; -IN: cairo.pango +IN: pango.cairo << "pangocairo" { ! { [ os winnt? ] [ "libpangocairo-1.dll" ] } diff --git a/extra/cairo/pango/gadgets/gadgets.factor b/extra/pango/cairo/gadgets/gadgets.factor similarity index 85% rename from extra/cairo/pango/gadgets/gadgets.factor rename to extra/pango/cairo/gadgets/gadgets.factor index 44ebfc30a5..9e8a99515e 100644 --- a/extra/cairo/pango/gadgets/gadgets.factor +++ b/extra/pango/cairo/gadgets/gadgets.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Matthew Willis. ! See http://factorcode.org/license.txt for BSD license. -USING: cairo.pango cairo cairo.ffi cairo.gadgets +USING: pango.cairo cairo cairo.ffi cairo.gadgets alien.c-types kernel math ; -IN: cairo.pango.gadgets +IN: pango.cairo.gadgets : (pango-gadget) ( setup show -- gadget ) [ drop layout-size ] @@ -23,7 +23,7 @@ threads io.backend io.encodings.utf8 io.files ; gadget. yield ] each [ - "resource:extra/cairo/pango/gadgets/gadgets.factor" + "resource:extra/pango/cairo/gadgets/gadgets.factor" normalize-path utf8 file-contents layout-text ] gadget. ; From 8c686c67f9ae3da30e0231ef4ec1e8e5117d3944 Mon Sep 17 00:00:00 2001 From: Matthew Willis Date: Sat, 31 May 2008 13:41:54 -0700 Subject: [PATCH 10/10] pango.fonts: make sure to free arrays with g_free --- extra/pango/fonts/fonts.factor | 6 +++--- extra/pango/pango.factor | 5 +++++ 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/extra/pango/fonts/fonts.factor b/extra/pango/fonts/fonts.factor index 6076b6a254..d07c71226a 100644 --- a/extra/pango/fonts/fonts.factor +++ b/extra/pango/fonts/fonts.factor @@ -26,15 +26,15 @@ pango_font_face_list_sizes ( PangoFontFace* face, int** sizes, int* n_sizes ) ; : list-families ( PangoFontMap* -- PangoFontFamily*-seq ) 0 0 [ pango_font_map_list_families ] 2keep - *int >r *void* r> c-void*-array> ; + *int swap *void* [ swap c-void*-array> ] [ g_free ] bi ; : list-faces ( PangoFontFamily* -- PangoFontFace*-seq ) 0 0 [ pango_font_family_list_faces ] 2keep - *int >r *void* r> c-void*-array> ; + *int swap *void* [ swap c-void*-array> ] [ g_free ] bi ; : list-sizes ( PangoFontFace* -- ints ) 0 0 [ pango_font_face_list_sizes ] 2keep - *int >r *void* r> c-int-array> ; + *int swap *void* [ swap c-int-array> ] [ g_free ] bi ; : monospace? ( PangoFontFamily* -- ? ) pango_font_family_is_monospace 1 = ; diff --git a/extra/pango/pango.factor b/extra/pango/pango.factor index 3836a43e3f..3549d9abb4 100644 --- a/extra/pango/pango.factor +++ b/extra/pango/pango.factor @@ -48,7 +48,12 @@ pango_layout_get_pixel_size ( PangoLayout* layout, int* width, int* height ) ; FUNCTION: void pango_font_description_free ( PangoFontDescription* desc ) ; +! glib functions + TYPEDEF: void* gpointer FUNCTION: void g_object_unref ( gpointer object ) ; + +FUNCTION: void +g_free ( gpointer mem ) ;