src/plugins/old/cairo.slate

   1 "Many functions that deal with cairo_surface_t* are problematic.
   2  Ex: cairo_set_source_surface.  Do not attempt to add additional
   3  bindings to this code if you don't understand why, otherwise
   4  Cairo will write into freed memory."
   5
   6 lobby ensureNamespace: #Cairo &delegate: True.
   7
   8 Cairo define: #Lib
   9   &builder: [ExternalInterface newForLibrary: 'slate-cairo' primitives:
  10     q{
  11         "Construction / Destruction"
  12     (Pointer image_surface_create_for_data(Pointer Int Int Int Int))
  13     (Void surface_destroy(Pointer))
  14     (Pointer create(Pointer))
  15     (Void destroy(Pointer))
  16
  17     "Context"
  18     (Void clip(Pointer))
  19     (Void clip_preserve(Pointer))
  20     (Void fill(Pointer))
  21     (Void fill_preserve(Pointer))
  22     (Void restore(Pointer))
  23     (Void save(Pointer))
  24     (Float get_line_width(Pointer))
  25     (Void set_line_width(Pointer Float))
  26     (Void set_source_rgb(Pointer Float Float Float))
  27     (Void set_source_rgba(Pointer Float Float Float Float))
  28     (Void stroke(Pointer))
  29     (Void stroke_preserve(Pointer))
  30
  31         "Path"
  32     (Void close_path(Pointer))
  33     (Void line_to(Pointer Float Float))
  34     (Void move_to(Pointer Float Float))
  35     (Void new_path(Pointer))
  36     (Void rectangle(Pointer Float Float Float Float))
  37
  38     "Transformation"
  39     (Void translate(Pointer Float Float))
  40     (Void scale(Pointer Float Float))
  41
  42     "Text"
  43     (Void select_font_face(Pointer CString Int Int))
  44     (Void set_font_size(Pointer Float))
  45     (Void show_text(Pointer CString))
  46   } "&leader: 'cairo_'"].
  47
  48 Cairo Lib enable.
  49
  50 Cairo ensureNamespace: #formats.
  51 [| :entry | Cairo formats addSlot: entry key valued: entry value] for: #{
  52   #argb32 -> 0.
  53   #rgb24 -> 1.
  54   #a8 -> 2.
  55   #a1 -> 3.
  56 }.
  57
  58 Cairo define: #Context &slots: {#surfacePointer. #contextPointer. #bitmapAddress. #bitmapHandle}.
  59
  60 Cairo define: #FormContext &slots: {#form} &parents: {Cairo Context}.
  61
  62 _@(Cairo FormContext traits) newForm: form@(Form traits)
  63 [| surface |
  64   form depth == 32
  65     ifFalse: [error: 'Only depth-32 currently supported'].
  66   surface := Cairo FormContext clone.
  67   surface form := form.
  68   surface bitmapAddress := form bits bytes address.
  69   surface bitmapHandle := form bits bytes handle.
  70   ByteArray noteNewReferenceTo: surface bitmapHandle.
  71   (surface surfacePointer := Cairo Lib primitives image_surface_create_for_data applyTo:
  72      {surface bitmapAddress. Cairo formats argb32. form width. form height. form width * 4})
  73      ifNil: [error: 'image_surface_create_for_data_failed'].
  74   (surface contextPointer := Cairo Lib primitives create applyTo: {surface surfacePointer})
  75     ifNil: [error: 'create_failed'].
  76   surface
  77 ].
  78
  79 surface@(Cairo Context traits) destroy
  80 [
  81     surface contextPointer ifNil: [ContextIsInvalid].
  82     surface surfacePointer ifNil: [ContextIsInvalid].
  83     Cairo Lib primitives destroy applyTo: {surface contextPointer.}.
  84     Cairo Lib primitives surface_destroy applyTo: {surface surfacePointer}.
  85     ByteArray close: surface bitmapHandle.
  86     surface contextPointer := Nil.
  87     surface surfacePointer := Nil.
  88 ].
  89
  90 "Context"
  91 "============================================================================"
  92
  93 surface@(Cairo Context traits) clip
  94 [
  95     Cairo Lib primitives clip applyTo: {surface contextPointer.}.
  96 ].
  97
  98 surface@(Cairo Context traits) clip_preserve
  99 [
 100     Cairo Lib primitives clip_preserve applyTo: {surface contextPointer.}.
 101 ].
 102
 103 surface@(Cairo Context traits) fill
 104 [
 105     Cairo Lib primitives fill applyTo: {surface contextPointer.}.
 106 ].
 107
 108 surface@(Cairo Context traits) fill_preserve
 109 [
 110     Cairo Lib primitives fill_preserve applyTo: {surface contextPointer.}.
 111 ].
 112
 113 surface@(Cairo Context traits) restore
 114 [
 115     Cairo Lib primitives restore applyTo: {surface contextPointer.}.
 116 ].
 117
 118 surface@(Cairo Context traits) save
 119 [
 120     Cairo Lib primitives save applyTo: {surface contextPointer.}.
 121 ].
 122
 123 surface@(Cairo Context traits) lineWidth
 124 [
 125     Cairo Lib primitives get_line_width applyTo: {surface contextPointer.}.
 126 ].
 127
 128 surface@(Cairo Context traits) lineWidth: width
 129 [
 130     Cairo Lib primitives set_line_width applyTo: {surface contextPointer. width.}.
 131 ].
 132
 133 surface@(Cairo Context traits) sourceRGB: color@(RGBColor traits)
 134 [
 135     Cairo Lib primitives set_source_rgb applyTo: {surface contextPointer. color red. color green. color blue.}.
 136 ].
 137
 138 surface@(Cairo Context traits) sourceRGB: color@(RGBColor traits) alpha: alpha
 139 [
 140     Cairo Lib primitives set_source_rgba applyTo: {surface contextPointer. color red. color green. color blue. alpha.}.
 141 ].
 142
 143 surface@(Cairo Context traits) stroke
 144 [
 145     Cairo Lib primitives stroke applyTo: {surface contextPointer.}.
 146 ].
 147
 148 surface@(Cairo Context traits) stroke_preserve
 149 [
 150     Cairo Lib primitives stroke_preserve applyTo: {surface contextPointer.}.
 151 ].
 152
 153 "Path"
 154 "============================================================================"
 155
 156 surface@(Cairo Context traits) closePath
 157 [
 158     Cairo Lib primitives close_path applyTo: {surface contextPointer.}.
 159 ].
 160
 161 surface@(Cairo Context traits) lineTo: point@(Point traits)
 162 [
 163     Cairo Lib primitives line_to applyTo: {surface contextPointer. point x. point y.}.
 164 ].
 165
 166 surface@(Cairo Context traits) moveTo: point@(Point traits)
 167 [
 168     Cairo Lib primitives move_to applyTo: {surface contextPointer. point x. point y.}.
 169 ].
 170
 171 surface@(Cairo Context traits) newPath
 172 [
 173     Cairo Lib primitives new_path applyTo: {surface contextPointer.}.
 174 ].
 175
 176 surface@(Cairo Context traits) rectangle: rectangle@(Rectangle traits)
 177 [
 178     Cairo Lib primitives rectangle applyTo: {surface contextPointer. rectangle left. rectangle top. rectangle width. rectangle height.}.
 179 ].
 180
 181 "Transformation"
 182 "============================================================================"
 183
 184 surface@(Cairo Context traits) translate: offset@(Point traits)
 185 [
 186     Cairo Lib primitives translate applyTo: {surface contextPointer. offset x. offset y.}.
 187 ].
 188
 189 surface@(Cairo Context traits) scale: offset@(Point traits)
 190 [
 191     Cairo Lib primitives scale applyTo: {surface contextPointer. offset x. offset y.}.
 192 ].
 193
 194 "Text"
 195 "============================================================================"
 196
 197 surface@(Cairo Context traits) font: font &italic: italic &bold: bold
 198 [
 199     italic `defaultsTo: False.
 200     bold `defaultsTo: False.
 201     Cairo Lib primitives select_font_face applyTo: {
 202         surface contextPointer.
 203         font.
 204         italic ifTrue: [1] ifFalse: [0].
 205         bold ifTrue: [1] ifFalse: [0]}.
 206 ].
 207
 208 surface@(Cairo Context traits) fontSize: size
 209 [
 210     Cairo Lib primitives set_font_size applyTo: {surface contextPointer. size}.
 211 ].
 212
 213 surface@(Cairo Context traits) showText: text
 214 [
 215     Cairo Lib primitives show_text applyTo: {surface contextPointer. text}.
 216 ].
 217