factor/extra/cairo-demo/cairo-demo.factor

84 lines
2.2 KiB
Factor
Raw Permalink Normal View History

2007-09-25 15:06:28 -04:00
! Cairo "Hello World" demo
! Copyright (c) 2007 Sampo Vuori
! License: http://factorcode.org/license.txt
!
! This example is an adaptation of the following cairo sample code:
! http://cairographics.org/samples/text/
2009-02-23 17:53:05 -05:00
USING: cairo.ffi math math.constants byte-arrays kernel ui
ui.render combinators ui.gadgets opengl.gl accessors
namespaces opengl sequences ;
2007-09-25 15:06:28 -04:00
IN: cairo-demo
: make-image-array ( -- array )
2009-02-23 17:47:07 -05:00
384 256 4 * * <byte-array> ;
2007-09-25 15:06:28 -04:00
: convert-array-to-surface ( array -- cairo_surface_t )
2009-02-23 17:47:07 -05:00
CAIRO_FORMAT_ARGB32 384 256 over 4 *
cairo_image_surface_create_for_data ;
2007-09-25 15:06:28 -04:00
TUPLE: cairo-demo-gadget < gadget image-array cairo-t ;
2007-09-25 15:06:28 -04:00
USE: io
USE: formatting
M: cairo-demo-gadget draw-gadget* ( gadget -- )
0 0 glRasterPos2i
1.0 -1.0 glPixelZoom
[ 384 256 GL_RGBA GL_UNSIGNED_BYTE ] dip
image-array>> glDrawPixels ;
2007-09-25 15:06:28 -04:00
: create-surface ( gadget -- cairo_surface_t )
make-image-array [ swap image-array<< ] keep
2008-03-15 20:36:40 -04:00
convert-array-to-surface ;
2007-09-25 15:06:28 -04:00
: init-cairo ( gadget -- cairo_t )
2009-02-23 17:47:07 -05:00
create-surface cairo_create ;
2007-09-25 15:06:28 -04:00
2009-02-23 17:53:05 -05:00
M: cairo-demo-gadget pref-dim* drop { 384 256 } ;
2007-09-25 15:06:28 -04:00
2009-02-23 17:47:07 -05:00
ERROR: no-cairo-t ;
<PRIVATE
2007-09-25 15:06:28 -04:00
: draw-hello-world ( gadget -- )
cairo-t>> [ no-cairo-t ] unless*
2009-02-23 17:47:07 -05:00
{
[
"Sans" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_BOLD
cairo_select_font_face
]
[ 90.0 cairo_set_font_size ]
[ 10.0 135.0 cairo_move_to ]
[ "Hello" cairo_show_text ]
[ 70.0 165.0 cairo_move_to ]
[ "World" cairo_text_path ]
[ 0.5 0.5 1 cairo_set_source_rgb ]
[ cairo_fill_preserve ]
[ 0 0 0 cairo_set_source_rgb ]
[ 2.56 cairo_set_line_width ]
[ cairo_stroke ]
[ 1 0.2 0.2 0.6 cairo_set_source_rgba ]
[ 10.0 135.0 5.12 0 pi 2 * cairo_arc ]
[ cairo_close_path ]
[ 70.0 165.0 5.12 0 pi 2 * cairo_arc ]
[ cairo_fill ]
} cleave ;
PRIVATE>
2007-09-25 15:06:28 -04:00
M: cairo-demo-gadget graft* ( gadget -- )
dup dup init-cairo swap cairo-t<< draw-hello-world ;
2007-09-25 15:06:28 -04:00
M: cairo-demo-gadget ungraft* ( gadget -- )
2009-02-23 17:47:07 -05:00
cairo-t>> cairo_destroy ;
2007-09-25 15:06:28 -04:00
: <cairo-demo-gadget> ( -- gadget )
cairo-demo-gadget new ;
2007-09-25 15:06:28 -04:00
2016-04-21 20:00:06 -04:00
MAIN-WINDOW: run-cairo-demo
{ { title "Hello World from Factor!" } }
<cairo-demo-gadget> >>gadgets ;