bring cairo bindings back from the dead

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 ;
 

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 )

unmaintained/cairo/cairo.factor

@@ -33,4 +33,4 @@ SYMBOL: cairo
     >r <cairo-surface-t> 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

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 >>
 

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 ;
 
-: <cairo-gadget> ( dim quot -- gadget )
+: <cairo-gadget> ( dim -- gadget )
-    cairo-gadget construct-gadget
+    cairo-gadget new-gadget
-        swap >>quot
         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*
+GENERIC: render-cairo* ( gadget -- )
-!     [ dim>> dup ] [ quot>> ] bi
+
-!     render-cairo render-bytes* ;
+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 ;
 : <png> ( path -- gadget )
-    png-gadget construct-gadget
+    png-gadget new-gadget
         swap >>path ;
 
 M: png-gadget render*

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 <cairo-gadget> 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