extra/cairo/samples/samples.factor

   1 ! Copyright (C) 2008 Matthew Willis
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 !
   4 ! these samples are a subset of the samples on
   5 ! http://cairographics.org/samples/
   6 USING: cairo locals math.constants math
   7 io.backend kernel alien.c-types libc ;
   8
   9 IN: cairo.samples
  10
  11 SYMBOL: cr
  12 :: arc ( cr -- )
  13     [let | xc [ 128.0 ]
  14            yc [ 128.0 ]
  15            radius [ 100.0 ]
  16            angle1 [ pi 1/4 * ]
  17            angle2 [ pi ] |
  18         cr 10.0 cairo_set_line_width
  19         cr xc yc radius angle1 angle2 cairo_arc
  20         cr cairo_stroke
  21
  22         ! draw helping lines
  23         cr 1 0.2 0.2 0.6 cairo_set_source_rgba
  24         cr 6.0 cairo_set_line_width
  25
  26         cr xc yc 10.0 0 2 pi * cairo_arc
  27         cr cairo_fill
  28
  29         cr xc yc radius angle1 angle1 cairo_arc
  30         cr xc yc cairo_line_to
  31         cr xc yc radius angle2 angle2 cairo_arc
  32         cr xc yc cairo_line_to
  33         cr cairo_stroke
  34     ] ;
  35
  36 :: clip ( cr -- )
  37     cr 128 128 76.8 0 2 pi * cairo_arc
  38     cr cairo_clip
  39     cr cairo_new_path
  40
  41     cr 0 0 256 256 cairo_rectangle
  42     cr cairo_fill
  43     cr 0 1 0 cairo_set_source_rgb
  44     cr 0 0 cairo_move_to
  45     cr 256 256 cairo_line_to
  46     cr 256 0 cairo_move_to
  47     cr 0 256 cairo_line_to
  48     cr 10 cairo_set_line_width
  49     cr cairo_stroke ;
  50
  51 :: clip-image ( cr -- )
  52     [let* | png [ "resource:misc/icons/Factor_128x128.png"
  53                   normalize-path cairo_image_surface_create_from_png ]
  54             w [ png cairo_image_surface_get_width ]
  55             h [ png cairo_image_surface_get_height ] |
  56         cr 128 128 76.8 0 2 pi * cairo_arc
  57         cr cairo_clip
  58         cr cairo_new_path
  59
  60         cr 192.0 w / 192.0 h / cairo_scale
  61         cr png 32 32 cairo_set_source_surface
  62         cr cairo_paint
  63         png cairo_surface_destroy
  64     ] ;
  65
  66 :: dash ( cr -- )
  67     [let | dashes [ { 50 10 10 10 } >c-double-array ]
  68            ndash [ 4 ] |
  69         cr dashes ndash -50 cairo_set_dash
  70         cr 10 cairo_set_line_width
  71         cr 128.0 25.6 cairo_move_to
  72         cr 230.4 230.4 cairo_line_to
  73         cr -102.4 0 cairo_rel_line_to
  74         cr 51.2 230.4 51.2 128.0 128.0 128.0 cairo_curve_to
  75         cr cairo_stroke
  76     ] ;
  77
  78 :: gradient ( cr -- )
  79     [let | pat [ 0 0 0 256 cairo_pattern_create_linear ]
  80            radial [ 115.2 102.4 25.6 102.4 102.4 128.0
  81                     cairo_pattern_create_radial ] |
  82         pat 1 0 0 0 1 cairo_pattern_add_color_stop_rgba
  83         pat 0 1 1 1 1 cairo_pattern_add_color_stop_rgba
  84         cr 0 0 256 256 cairo_rectangle
  85         cr pat cairo_set_source
  86         cr cairo_fill
  87         pat cairo_pattern_destroy
  88
  89         radial 0 1 1 1 1 cairo_pattern_add_color_stop_rgba
  90         radial 1 0 0 0 1 cairo_pattern_add_color_stop_rgba
  91         cr radial cairo_set_source
  92         cr 128.0 128.0 76.8 0 2 pi * cairo_arc
  93         cr cairo_fill
  94         radial cairo_pattern_destroy
  95     ] ;
  96
  97 :: text ( cr -- )
  98     cr "Serif" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_BOLD
  99     cairo_select_font_face
 100     cr 50 cairo_set_font_size
 101     cr 10 135 cairo_move_to
 102     cr "Hello" cairo_show_text
 103
 104     cr 70 165 cairo_move_to
 105     cr "factor" cairo_text_path
 106     cr 0.5 0.5 1 cairo_set_source_rgb
 107     cr cairo_fill_preserve
 108     cr 0 0 0 cairo_set_source_rgb
 109     cr 2.56 cairo_set_line_width
 110     cr cairo_stroke
 111
 112     ! draw helping lines
 113     cr 1 0.2 0.2 0.6 cairo_set_source_rgba
 114     cr 10 135 5.12 0 2 pi * cairo_arc
 115     cr cairo_close_path
 116     cr 70 165 5.12 0 2 pi * cairo_arc
 117     cr cairo_fill ;
 118
 119 :: utf8 ( cr -- )
 120     cr "Serif" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_NORMAL
 121     cairo_select_font_face
 122     cr 50 cairo_set_font_size
 123     "cairo_text_extents_t" malloc-object
 124     cr B{ 230 151 165 230 156 172 232 170 158 } pick cairo_text_extents
 125     cr over
 126     [ cairo_text_extents_t-width 2 / ]
 127     [ cairo_text_extents_t-x_bearing ] bi +
 128     128 swap - pick
 129     [ cairo_text_extents_t-height 2 / ]
 130     [ cairo_text_extents_t-y_bearing ] bi +
 131     128 swap - cairo_move_to
 132     free
 133     cr B{ 230 151 165 230 156 172 232 170 158 } cairo_show_text
 134
 135     cr 1 0.2 0.2 0.6 cairo_set_source_rgba
 136     cr 6 cairo_set_line_width
 137     cr 128 0 cairo_move_to
 138     cr 0 256 cairo_rel_line_to
 139     cr 0 128 cairo_move_to
 140     cr 256 0 cairo_rel_line_to
 141     cr cairo_stroke ;