diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index bae05f4244..5d9baf644d 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -16,17 +16,17 @@ IN: opengl : fix-coordinates ( point1 point2 -- x1 y2 x2 y2 ) [ first2 [ >fixnum ] bi@ ] bi@ ; -: gl-color ( color -- ) first4 glColor4d ; inline +: color>raw ( object -- r g b a ) + >rgba { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave ; + +: gl-color ( color -- ) color>raw glColor4d ; inline : gl-clear-color ( color -- ) - first4 glClearColor ; + color>raw glClearColor ; : gl-clear ( color -- ) gl-clear-color GL_COLOR_BUFFER_BIT glClear ; -: color>raw ( object -- r g b a ) - >rgba { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave ; - : set-color ( object -- ) color>raw glColor4d ; : set-clear-color ( object -- ) color>raw glClearColor ; diff --git a/extra/opengl/gadgets/gadgets.factor b/extra/opengl/gadgets/gadgets.factor index 9e670c04ab..cfedf32079 100644 --- a/extra/opengl/gadgets/gadgets.factor +++ b/extra/opengl/gadgets/gadgets.factor @@ -6,7 +6,7 @@ fry assocs destructors sequences ui.render colors ; IN: opengl.gadgets -TUPLE: texture-gadget ; +TUPLE: texture-gadget < gadget ; GENERIC: render* ( gadget -- texture dims ) GENERIC: cache-key* ( gadget -- key ) diff --git a/unmaintained/cairo/cairo.factor b/unmaintained/cairo/cairo.factor index 46d3e42c2b..aa7d1159a6 100755 --- a/unmaintained/cairo/cairo.factor +++ b/unmaintained/cairo/cairo.factor @@ -33,4 +33,4 @@ SYMBOL: cairo >r r> [ (with-surface) ] curry with-disposal ; inline : with-cairo-from-surface ( cairo_surface quot -- ) - '[ cairo_create , with-cairo ] with-surface ; inline + '[ cairo_create _ with-cairo ] with-surface ; inline diff --git a/unmaintained/cairo/ffi/ffi.factor b/unmaintained/cairo/ffi/ffi.factor index 451806c0a7..db18320fee 100644 --- a/unmaintained/cairo/ffi/ffi.factor +++ b/unmaintained/cairo/ffi/ffi.factor @@ -10,7 +10,7 @@ alien.c-types accessors sequences arrays ui.gadgets ; IN: cairo.ffi << "cairo" { { [ os winnt? ] [ "libcairo-2.dll" ] } - { [ os macosx? ] [ "libcairo.dylib" ] } + { [ os macosx? ] [ "/opt/local/lib/libcairo.dylib" ] } { [ os unix? ] [ "libcairo.so.2" ] } } cond "cdecl" add-library >> diff --git a/unmaintained/cairo/gadgets/gadgets.factor b/unmaintained/cairo/gadgets/gadgets.factor index c9fef618f8..d160740c44 100644 --- a/unmaintained/cairo/gadgets/gadgets.factor +++ b/unmaintained/cairo/gadgets/gadgets.factor @@ -3,7 +3,7 @@ USING: sequences math opengl.gadgets kernel byte-arrays cairo.ffi cairo io.backend ui.gadgets accessors opengl.gl -arrays ; +arrays fry classes ; IN: cairo.gadgets @@ -15,21 +15,22 @@ IN: cairo.gadgets [ cairo_image_surface_create_for_data ] 3bi r> with-cairo-from-surface ; inline -TUPLE: cairo-gadget < texture-gadget dim quot ; +TUPLE: cairo-gadget < texture-gadget ; -: ( dim quot -- gadget ) - cairo-gadget construct-gadget - swap >>quot +: ( dim -- gadget ) + cairo-gadget new-gadget swap >>dim ; -M: cairo-gadget cache-key* [ dim>> ] [ quot>> ] bi 2array ; +M: cairo-gadget cache-key* [ dim>> ] [ class ] bi 2array ; : render-cairo ( dim quot -- bytes format ) >r 2^-bounds r> copy-cairo GL_BGRA ; inline -! M: cairo-gadget render* -! [ dim>> dup ] [ quot>> ] bi -! render-cairo render-bytes* ; +GENERIC: render-cairo* ( gadget -- ) + +M: cairo-gadget render* + [ dim>> dup ] [ '[ _ render-cairo* ] ] bi + render-cairo render-bytes* ; ! maybe also texture>png ! : cairo>png ( gadget path -- ) @@ -44,7 +45,7 @@ M: cairo-gadget cache-key* [ dim>> ] [ quot>> ] bi 2array ; TUPLE: png-gadget < texture-gadget path ; : ( path -- gadget ) - png-gadget construct-gadget + png-gadget new-gadget swap >>path ; M: png-gadget render* diff --git a/unmaintained/cairo/samples/samples.factor b/unmaintained/cairo/samples/samples.factor index 0e83381349..0f21142f2a 100644 --- a/unmaintained/cairo/samples/samples.factor +++ b/unmaintained/cairo/samples/samples.factor @@ -4,11 +4,13 @@ ! these samples are a subset of the samples on ! http://cairographics.org/samples/ USING: cairo cairo.ffi locals math.constants math -io.backend kernel alien.c-types libc namespaces ; +io.backend kernel alien.c-types libc namespaces +cairo.gadgets ui.gadgets accessors ; IN: cairo.samples -:: arc ( -- ) +TUPLE: arc-gadget < cairo-gadget ; +M:: arc-gadget render-cairo* ( gadget -- ) [let | xc [ 128.0 ] yc [ 128.0 ] radius [ 100.0 ] @@ -32,7 +34,9 @@ IN: cairo.samples cr cairo_stroke ] ; -: clip ( -- ) +TUPLE: clip-gadget < cairo-gadget ; +M: clip-gadget render-cairo* ( gadget -- ) + drop cr 128 128 76.8 0 2 pi * cairo_arc cr cairo_clip cr cairo_new_path @@ -47,7 +51,8 @@ IN: cairo.samples cr 10 cairo_set_line_width cr cairo_stroke ; -:: clip-image ( -- ) +TUPLE: clip-image-gadget < cairo-gadget ; +M:: clip-image-gadget render-cairo* ( gadget -- ) [let* | png [ "resource:misc/icons/Factor_128x128.png" normalize-path cairo_image_surface_create_from_png ] w [ png cairo_image_surface_get_width ] @@ -62,7 +67,8 @@ IN: cairo.samples png cairo_surface_destroy ] ; -:: dash ( -- ) +TUPLE: dash-gadget < cairo-gadget ; +M:: dash-gadget render-cairo* ( gadget -- ) [let | dashes [ { 50 10 10 10 } >c-double-array ] ndash [ 4 ] | cr dashes ndash -50 cairo_set_dash @@ -74,7 +80,8 @@ IN: cairo.samples cr cairo_stroke ] ; -:: gradient ( -- ) +TUPLE: gradient-gadget < cairo-gadget ; +M:: gradient-gadget render-cairo* ( gadget -- ) [let | pat [ 0 0 0 256 cairo_pattern_create_linear ] radial [ 115.2 102.4 25.6 102.4 102.4 128.0 cairo_pattern_create_radial ] | @@ -93,7 +100,9 @@ IN: cairo.samples radial cairo_pattern_destroy ] ; -: text ( -- ) +TUPLE: text-gadget < cairo-gadget ; +M: text-gadget render-cairo* ( gadget -- ) + drop cr "Serif" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_BOLD cairo_select_font_face cr 50 cairo_set_font_size @@ -115,7 +124,9 @@ IN: cairo.samples cr 70 165 5.12 0 2 pi * cairo_arc cr cairo_fill ; -: utf8 ( -- ) +TUPLE: utf8-gadget < cairo-gadget ; +M: utf8-gadget render-cairo* ( gadget -- ) + drop cr "Sans" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_NORMAL cairo_select_font_face cr 50 cairo_set_font_size @@ -141,7 +152,10 @@ IN: cairo.samples USING: quotations cairo.gadgets ui.gadgets.panes sequences ; : samples ( -- ) - { arc clip clip-image dash gradient text utf8 } - [ { 256 256 } swap 1quotation gadget. ] each ; + { + arc-gadget clip-gadget clip-image-gadget dash-gadget + gradient-gadget text-gadget utf8-gadget + } + [ new-gadget { 256 256 } >>dim gadget. ] each ; MAIN: samples