extra/cairo-demo/cairo-demo.factor

   1 ! Cairo "Hello World" demo
   2 !  Copyright (c) 2007 Sampo Vuori
   3 !    License: http://factorcode.org/license.txt
   4 !
   5 ! This example is an adaptation of the following cairo sample code:
   6 !  http://cairographics.org/samples/text/
   7
   8
   9 USING: cairo.ffi math math.constants byte-arrays kernel ui ui.render
  10            ui.gadgets opengl.gl ;
  11
  12 IN: cairo-demo
  13
  14
  15 : make-image-array ( -- array )
  16   384 256 4 * * <byte-array> ;
  17
  18 : convert-array-to-surface ( array -- cairo_surface_t )
  19   CAIRO_FORMAT_ARGB32 384 256 over 4 *
  20   cairo_image_surface_create_for_data ;
  21
  22
  23 TUPLE: cairo-gadget image-array cairo-t ;
  24
  25 M: cairo-gadget draw-gadget* ( gadget -- )
  26     0 0 glRasterPos2i
  27     1.0 -1.0 glPixelZoom
  28     >r 384 256 GL_RGBA GL_UNSIGNED_BYTE r>
  29     cairo-gadget-image-array glDrawPixels ;
  30
  31 : create-surface ( gadget -- cairo_surface_t )
  32     make-image-array
  33     [ swap set-cairo-gadget-image-array ] keep
  34     convert-array-to-surface ;
  35
  36 : init-cairo ( gadget -- cairo_t )
  37    create-surface cairo_create ;
  38
  39 M: cairo-gadget pref-dim* drop { 384 256 0 } ;
  40
  41 : draw-hello-world ( gadget -- )
  42   cairo-gadget-cairo-t
  43   dup "Sans" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_BOLD cairo_select_font_face
  44   dup 90.0 cairo_set_font_size
  45   dup 10.0 135.0 cairo_move_to
  46   dup "Hello" cairo_show_text
  47   dup 70.0 165.0 cairo_move_to
  48   dup "World" cairo_text_path
  49   dup 0.5 0.5 1 cairo_set_source_rgb
  50   dup cairo_fill_preserve
  51   dup 0 0 0 cairo_set_source_rgb
  52   dup 2.56 cairo_set_line_width
  53   dup cairo_stroke
  54   dup 1 0.2 0.2 0.6 cairo_set_source_rgba
  55   dup 10.0 135.0 5.12 0 pi 2 * cairo_arc
  56   dup cairo_close_path
  57   dup 70.0 165.0 5.12 0 pi 2 * cairo_arc
  58   cairo_fill ;
  59
  60 M: cairo-gadget graft* ( gadget -- )
  61   dup dup init-cairo swap set-cairo-gadget-cairo-t draw-hello-world ;
  62
  63 M: cairo-gadget ungraft* ( gadget -- )
  64    cairo-gadget-cairo-t cairo_destroy ;
  65
  66 : <cairo-gadget> ( -- gadget )
  67   cairo-gadget construct-gadget ;
  68
  69 : run ( -- )
  70   [
  71         <cairo-gadget> "Hello World from Factor!" open-window
  72   ] with-ui ;
  73
  74 MAIN: run