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