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 accessors ;
  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-demo-gadget < gadget image-array cairo-t ;
  24
  25 M: cairo-demo-gadget draw-gadget* ( gadget -- )
  26     0 0 glRasterPos2i
  27     1.0 -1.0 glPixelZoom
  28     [ 384 256 GL_RGBA GL_UNSIGNED_BYTE ] dip
  29     image-array>> glDrawPixels ;
  30
  31 : create-surface ( gadget -- cairo_surface_t )
  32     make-image-array [ swap (>>image-array) ] keep
  33     convert-array-to-surface ;
  34
  35 : init-cairo ( gadget -- cairo_t )
  36    create-surface cairo_create ;
  37
  38 M: cairo-demo-gadget pref-dim* drop { 384 256 0 } ;
  39
  40 : draw-hello-world ( gadget -- )
  41   cairo-t>>
  42   dup "Sans" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_BOLD cairo_select_font_face
  43   dup 90.0 cairo_set_font_size
  44   dup 10.0 135.0 cairo_move_to
  45   dup "Hello" cairo_show_text
  46   dup 70.0 165.0 cairo_move_to
  47   dup "World" cairo_text_path
  48   dup 0.5 0.5 1 cairo_set_source_rgb
  49   dup cairo_fill_preserve
  50   dup 0 0 0 cairo_set_source_rgb
  51   dup 2.56 cairo_set_line_width
  52   dup cairo_stroke
  53   dup 1 0.2 0.2 0.6 cairo_set_source_rgba
  54   dup 10.0 135.0 5.12 0 pi 2 * cairo_arc
  55   dup cairo_close_path
  56   dup 70.0 165.0 5.12 0 pi 2 * cairo_arc
  57   cairo_fill ;
  58
  59 M: cairo-demo-gadget graft* ( gadget -- )
  60   dup dup init-cairo swap (>>cairo-t) draw-hello-world ;
  61
  62 M: cairo-demo-gadget ungraft* ( gadget -- )
  63    cairo-t>> cairo_destroy ;
  64
  65 : <cairo-demo-gadget> ( -- gadget )
  66   cairo-demo-gadget new-gadget ;
  67
  68 : run ( -- )
  69   [
  70         <cairo-demo-gadget> "Hello World from Factor!" open-window
  71   ] with-ui ;
  72
  73 MAIN: run