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