factor/extra/cairo/gadgets/gadgets.factor

USING: cairo ui.render kernel opengl.gl opengl
math byte-arrays ui.gadgets accessors arrays 
namespaces io.backend ;

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 ;
: <cairo-gadget> ( width height quot -- cairo-gadget )
    cairo-gadget construct-gadget 
    swap >>quot
    swap >>height
    swap >>width ;

: (with-surface) ( surface quot -- surface )
    >r dup cairo_create dup r> call cairo_destroy ;
    
: with-surface ( surface quot -- )
    (with-surface) cairo_surface_destroy ;

: cairo>bytes ( width height quot -- byte-array )
    >r over 4 *
    [ * nip <byte-array> dup CAIRO_FORMAT_ARGB32 ]
    [ cairo_image_surface_create_for_data ] 3bi
    r> with-surface ;

: cairo>png ( width height quot path -- )
    >r >r CAIRO_FORMAT_ARGB32 -rot
    cairo_image_surface_create
    r> (with-surface) dup r> cairo_surface_write_to_png
    drop cairo_surface_destroy ;

M: cairo-gadget draw-gadget* ( gadget -- )
    origin get [
        0 0 glRasterPos2i
        1.0 -1.0 glPixelZoom
        [ width>> ] [ height>> ] [ quot>> ] tri
        [ drop GL_BGRA GL_UNSIGNED_BYTE ] [ cairo>bytes ] 3bi
        glDrawPixels
    ] with-translation ;
    
M: cairo-gadget pref-dim* ( gadget -- rect )
    [ width>> ] [ height>> ] bi 2array ;

TUPLE: pixels-gadget width height bytes ;
: <pixels-gadget> ( width height bytes -- pixel-gadget )
    pixels-gadget construct-gadget
    swap >>bytes
    swap >>height
    swap >>width ;
    
M: pixels-gadget draw-gadget* ( gadget -- )
    origin get [
        0 0 glRasterPos2i
        1.0 -1.0 glPixelZoom
        [ width>> ] [ height>> ] [ bytes>> ] tri
        GL_BGRA GL_UNSIGNED_BYTE rot glDrawPixels
    ] with-translation ;

M: pixels-gadget pref-dim* ( gadget -- rect )
    [ width>> ] [ height>> ] bi 2array ;

: <png-gadget> ( path -- gadget )
    normalize-path cairo_image_surface_create_from_png
    [ cairo_image_surface_get_width ] [ cairo_image_surface_get_height 2dup ]
    [ [ dupd 0 0 cairo_set_source_surface cairo_paint ]  curry cairo>bytes ] tri
    <pixels-gadget> ;