diff --git a/extra/cairo/gadgets/gadgets.factor b/extra/cairo/gadgets/gadgets.factor index e0daefd63c..f5f4d3e965 100644 --- a/extra/cairo/gadgets/gadgets.factor +++ b/extra/cairo/gadgets/gadgets.factor @@ -1,73 +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 ; +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? bytes ; -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 ; -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 [ - 0 0 glRasterPos2i - 1.0 -1.0 glPixelZoom - [ width>> ] [ height>> GL_BGRA GL_UNSIGNED_BYTE ] - [ cairo>bytes ] tri glDrawPixels - ] with-translation ; - -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> >>bytes ; - : ( 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 - ; \ No newline at end of file + GL_BGRA rot ; + + diff --git a/extra/cairo/pango/gadgets/gadgets.factor b/extra/cairo/pango/gadgets/gadgets.factor deleted file mode 100644 index 780881e872..0000000000 --- a/extra/cairo/pango/gadgets/gadgets.factor +++ /dev/null @@ -1,20 +0,0 @@ -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 ; - -: ( quot -- gadget ) - [ cr layout pango_cairo_show_layout ] (pango-gadget) ; - -USING: prettyprint sequences ui.gadgets.panes ; -: hello-pango ( -- ) - 50 [ 6 + ] map [ - "Sans Bold " swap unparse append - [ layout-font "Hello, Pango!" layout-text ] curry - gadget. - ] each ; - -MAIN: hello-pango 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/memoize/memoize.factor b/extra/memoize/memoize.factor index 7da2ee0f0d..1c0491a7ab 100755 --- a/extra/memoize/memoize.factor +++ b/extra/memoize/memoize.factor @@ -58,3 +58,6 @@ M: memoized reset-word : reset-memoized ( word -- ) "memoize" word-prop clear-assoc ; + +: invalidate-memoized ! ( inputs... word ) + [ #in packer call ] [ "memoize" word-prop delete-at ] bi ; 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>> ; diff --git a/extra/cairo/pango/pango.factor b/extra/pango/cairo/cairo.factor similarity index 72% rename from extra/cairo/pango/pango.factor rename to extra/pango/cairo/cairo.factor index 789044f6e1..889052c385 100644 --- a/extra/cairo/pango/pango.factor +++ b/extra/pango/cairo/cairo.factor @@ -2,10 +2,10 @@ ! 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 ; -IN: cairo.pango +alien.syntax system combinators alien +arrays pango pango.fonts ; +IN: pango.cairo << "pangocairo" { ! { [ os winnt? ] [ "libpangocairo-1.dll" ] } @@ -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 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -162,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 @@ -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/cairo/gadgets/gadgets.factor b/extra/pango/cairo/gadgets/gadgets.factor new file mode 100644 index 0000000000..9e8a99515e --- /dev/null +++ b/extra/pango/cairo/gadgets/gadgets.factor @@ -0,0 +1,30 @@ +! Copyright (C) 2008 Matthew Willis. +! See http://factorcode.org/license.txt for BSD license. +USING: pango.cairo cairo cairo.ffi cairo.gadgets +alien.c-types kernel math ; +IN: pango.cairo.gadgets + +: (pango-gadget) ( setup show -- gadget ) + [ drop layout-size ] + [ compose [ with-pango ] curry ] 2bi ; + +: ( 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 + gadget. yield + ] each + [ + "resource:extra/pango/cairo/gadgets/gadgets.factor" + normalize-path utf8 file-contents layout-text + ] gadget. ; + +MAIN: hello-pango diff --git a/extra/pango/fonts/fonts.factor b/extra/pango/fonts/fonts.factor new file mode 100644 index 0000000000..d07c71226a --- /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 swap *void* [ swap c-void*-array> ] [ g_free ] bi ; + +: list-faces ( PangoFontFamily* -- PangoFontFace*-seq ) + 0 0 [ pango_font_family_list_faces ] 2keep + *int swap *void* [ swap c-void*-array> ] [ g_free ] bi ; + +: list-sizes ( PangoFontFace* -- ints ) + 0 0 [ pango_font_face_list_sizes ] 2keep + *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 new file mode 100644 index 0000000000..3549d9abb4 --- /dev/null +++ b/extra/pango/pango.factor @@ -0,0 +1,59 @@ +! 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 ) ; + +! glib functions + +TYPEDEF: void* gpointer + +FUNCTION: void +g_object_unref ( gpointer object ) ; + +FUNCTION: void +g_free ( gpointer mem ) ;