Commitd4992e7cRecorded2 Mar 2026Repositorysigil-cairo

Add Cairo 2D graphics bindings (sigil-cairo)

Message

Pure-Scheme FFI bindings to libcairo via (sigil ffi). No native C code.

Provides ~85 functions covering surfaces (image, PDF, SVG), drawing context, paths, drawing ops, text, transforms, and patterns. Uses finalizer-based resource management with safe explicit destroy (clears finalizer first to prevent double-free).

Module name: (cairo)

Changed
 examples/demo.sgl   |  117 ++++++++++++++++++
 package.sgl         |   11 ++
 src/cairo.sgl       | 1139 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 test/test-cairo.sgl |  192 +++++++++++++++++++++++++++++
 4 files changed, 1459 insertions(+)
Diff
examples/demo.sgladded
@@ -0,0 +1,117 @@
+1
(import (sigil core)
+2
(sigil math)
+3
(cairo))
+4
+5
(define PI 3.14159265358979)
+6
(define width 600)
+7
(define height 400)
+8
+9
(let ((surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 width height)))
+10
(let ((cr (cairo-create surface)))
+11
+12
;; Background gradient
+13
(let ((bg (cairo-pattern-create-linear 0.0 0.0 0.0 (* 1.0 height))))
+14
(cairo-pattern-add-color-stop-rgb bg 0.0 0.12 0.12 0.18)
+15
(cairo-pattern-add-color-stop-rgb bg 1.0 0.08 0.08 0.14)
+16
(cairo-set-source cr bg)
+17
(cairo-paint cr)
+18
(cairo-pattern-destroy bg))
+19
+20
;; Decorative circles
+21
(cairo-set-source-rgba cr 0.2 0.8 0.3 0.6)
+22
(cairo-arc cr 80.0 180.0 30.0 0.0 (* 2.0 PI))
+23
(cairo-fill cr)
+24
+25
(cairo-set-source-rgba cr 0.35 0.7 0.4 0.6)
+26
(cairo-arc cr 190.0 180.0 35.0 0.0 (* 2.0 PI))
+27
(cairo-fill cr)
+28
+29
(cairo-set-source-rgba cr 0.5 0.6 0.5 0.6)
+30
(cairo-arc cr 300.0 180.0 40.0 0.0 (* 2.0 PI))
+31
(cairo-fill cr)
+32
+33
(cairo-set-source-rgba cr 0.65 0.5 0.6 0.6)
+34
(cairo-arc cr 410.0 180.0 45.0 0.0 (* 2.0 PI))
+35
(cairo-fill cr)
+36
+37
(cairo-set-source-rgba cr 0.8 0.4 0.7 0.6)
+38
(cairo-arc cr 520.0 180.0 50.0 0.0 (* 2.0 PI))
+39
(cairo-fill cr)
+40
+41
;; Overlapping rectangles
+42
(cairo-set-source-rgba cr 0.9 0.3 0.2 0.7)
+43
(cairo-rectangle cr 50.0 240.0 200.0 100.0)
+44
(cairo-fill cr)
+45
+46
(cairo-set-source-rgba cr 0.2 0.6 0.9 0.7)
+47
(cairo-rectangle cr 150.0 270.0 200.0 80.0)
+48
(cairo-fill cr)
+49
+50
(cairo-set-source-rgba cr 0.3 0.8 0.4 0.7)
+51
(cairo-rectangle cr 250.0 250.0 180.0 90.0)
+52
(cairo-fill cr)
+53
+54
;; Bezier curves
+55
(cairo-set-source-rgba cr 1.0 0.8 0.2 0.9)
+56
(cairo-set-line-width cr 3.0)
+57
(cairo-move-to cr 400.0 300.0)
+58
(cairo-curve-to cr 450.0 200.0 500.0 350.0 570.0 260.0)
+59
(cairo-stroke cr)
+60
+61
(cairo-set-source-rgba cr 0.8 0.3 0.9 0.9)
+62
(cairo-set-line-width cr 2.5)
+63
(cairo-move-to cr 420.0 330.0)
+64
(cairo-curve-to cr 470.0 230.0 520.0 370.0 580.0 290.0)
+65
(cairo-stroke cr)
+66
+67
;; Star shape
+68
(cairo-set-source-rgba cr 1.0 0.9 0.3 0.9)
+69
(let ((cx 500.0) (cy 130.0) (r 40.0))
+70
(cairo-move-to cr (+ cx (* r (cos (- (* 0.0 (/ (* 4.0 PI) 5.0)) (/ PI 2.0)))))
+71
(+ cy (* r (sin (- (* 0.0 (/ (* 4.0 PI) 5.0)) (/ PI 2.0))))))
+72
(cairo-line-to cr (+ cx (* r (cos (- (* 1.0 (/ (* 4.0 PI) 5.0)) (/ PI 2.0)))))
+73
(+ cy (* r (sin (- (* 1.0 (/ (* 4.0 PI) 5.0)) (/ PI 2.0))))))
+74
(cairo-line-to cr (+ cx (* r (cos (- (* 2.0 (/ (* 4.0 PI) 5.0)) (/ PI 2.0)))))
+75
(+ cy (* r (sin (- (* 2.0 (/ (* 4.0 PI) 5.0)) (/ PI 2.0))))))
+76
(cairo-line-to cr (+ cx (* r (cos (- (* 3.0 (/ (* 4.0 PI) 5.0)) (/ PI 2.0)))))
+77
(+ cy (* r (sin (- (* 3.0 (/ (* 4.0 PI) 5.0)) (/ PI 2.0))))))
+78
(cairo-line-to cr (+ cx (* r (cos (- (* 4.0 (/ (* 4.0 PI) 5.0)) (/ PI 2.0)))))
+79
(+ cy (* r (sin (- (* 4.0 (/ (* 4.0 PI) 5.0)) (/ PI 2.0)))))))
+80
(cairo-close-path cr)
+81
(cairo-fill cr)
+82
+83
;; Title text
+84
(cairo-select-font-face cr "Sans" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_BOLD)
+85
(cairo-set-font-size cr 32.0)
+86
(cairo-set-source-rgb cr 1.0 1.0 1.0)
+87
(cairo-move-to cr 40.0 55.0)
+88
(cairo-show-text cr "Sigil + Cairo")
+89
+90
;; Subtitle
+91
(cairo-select-font-face cr "Sans" CAIRO_FONT_SLANT_ITALIC CAIRO_FONT_WEIGHT_NORMAL)
+92
(cairo-set-font-size cr 18.0)
+93
(cairo-set-source-rgba cr 0.7 0.8 0.9 0.9)
+94
(cairo-move-to cr 40.0 85.0)
+95
(cairo-show-text cr "Pure-Scheme FFI bindings - no C glue code!")
+96
+97
;; Bottom label
+98
(cairo-select-font-face cr "Monospace" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_NORMAL)
+99
(cairo-set-font-size cr 13.0)
+100
(cairo-set-source-rgba cr 0.5 0.6 0.7 0.8)
+101
(cairo-move-to cr 40.0 380.0)
+102
(cairo-show-text cr "(import (cairo)) ;; That's it!")
+103
+104
;; Radial gradient circle
+105
(let ((pat (cairo-pattern-create-radial 500.0 300.0 5.0 500.0 300.0 50.0)))
+106
(cairo-pattern-add-color-stop-rgba pat 0.0 1.0 0.6 0.0 0.9)
+107
(cairo-pattern-add-color-stop-rgba pat 1.0 0.8 0.1 0.1 0.0)
+108
(cairo-set-source cr pat)
+109
(cairo-arc cr 500.0 300.0 50.0 0.0 (* 2.0 PI))
+110
(cairo-fill cr)
+111
(cairo-pattern-destroy pat))
+112
+113
(cairo-destroy cr))
+114
+115
(cairo-surface-write-to-png surface "/tmp/sigil-cairo-demo.png")
+116
(cairo-surface-destroy surface)
+117
(display "Wrote /tmp/sigil-cairo-demo.png"))
package.sgladded
@@ -0,0 +1,11 @@
+1
(package
+2
name: "sigil-cairo"
+3
version: "0.7.0"
+4
description: "Cairo 2D graphics bindings for Sigil"
+5
url: "https://codeberg.org/sigil/sigil"
+6
license: "BSD-3-Clause"
+7
authors: (list "David Wilson <[email protected]>")
+8
+9
dependencies: (list
+10
(from-workspace name: "sigil-stdlib")
+11
(from-workspace name: "sigil-ffi")))
src/cairo.sgladded
@@ -0,0 +1,1139 @@
+1
;;; (cairo) — Cairo 2D graphics bindings for Sigil
+2
;;;
+3
;;; Pure-Scheme bindings using the dynamic FFI. No native C code required.
+4
;;; Requires libcairo.so / libcairo.dylib to be installed on the system.
+5
+6
(define-library (cairo)
+7
(import (sigil core)
+8
(sigil ffi))
+9
+10
(export
+11
;; Library handle
+12
cairo-lib
+13
+14
;; Constants — Format
+15
CAIRO_FORMAT_INVALID
+16
CAIRO_FORMAT_ARGB32
+17
CAIRO_FORMAT_RGB24
+18
CAIRO_FORMAT_A8
+19
CAIRO_FORMAT_A1
+20
+21
;; Constants — Status
+22
CAIRO_STATUS_SUCCESS
+23
CAIRO_STATUS_NO_MEMORY
+24
CAIRO_STATUS_INVALID_RESTORE
+25
CAIRO_STATUS_INVALID_POP_GROUP
+26
CAIRO_STATUS_NO_CURRENT_POINT
+27
CAIRO_STATUS_INVALID_MATRIX
+28
CAIRO_STATUS_INVALID_STATUS
+29
CAIRO_STATUS_NULL_POINTER
+30
CAIRO_STATUS_INVALID_STRING
+31
CAIRO_STATUS_INVALID_PATH_DATA
+32
CAIRO_STATUS_READ_ERROR
+33
CAIRO_STATUS_WRITE_ERROR
+34
CAIRO_STATUS_SURFACE_FINISHED
+35
CAIRO_STATUS_SURFACE_TYPE_MISMATCH
+36
CAIRO_STATUS_PATTERN_TYPE_MISMATCH
+37
+38
;; Constants — Operator
+39
CAIRO_OPERATOR_CLEAR
+40
CAIRO_OPERATOR_SOURCE
+41
CAIRO_OPERATOR_OVER
+42
CAIRO_OPERATOR_IN
+43
CAIRO_OPERATOR_OUT
+44
CAIRO_OPERATOR_ATOP
+45
CAIRO_OPERATOR_DEST
+46
CAIRO_OPERATOR_DEST_OVER
+47
CAIRO_OPERATOR_DEST_IN
+48
CAIRO_OPERATOR_DEST_OUT
+49
CAIRO_OPERATOR_DEST_ATOP
+50
CAIRO_OPERATOR_XOR
+51
CAIRO_OPERATOR_ADD
+52
CAIRO_OPERATOR_SATURATE
+53
+54
;; Constants — Line cap/join
+55
CAIRO_LINE_CAP_BUTT
+56
CAIRO_LINE_CAP_ROUND
+57
CAIRO_LINE_CAP_SQUARE
+58
CAIRO_LINE_JOIN_MITER
+59
CAIRO_LINE_JOIN_ROUND
+60
CAIRO_LINE_JOIN_BEVEL
+61
+62
;; Constants — Fill rule
+63
CAIRO_FILL_RULE_WINDING
+64
CAIRO_FILL_RULE_EVEN_ODD
+65
+66
;; Constants — Antialias
+67
CAIRO_ANTIALIAS_DEFAULT
+68
CAIRO_ANTIALIAS_NONE
+69
CAIRO_ANTIALIAS_GRAY
+70
CAIRO_ANTIALIAS_SUBPIXEL
+71
CAIRO_ANTIALIAS_FAST
+72
CAIRO_ANTIALIAS_GOOD
+73
CAIRO_ANTIALIAS_BEST
+74
+75
;; Constants — Font
+76
CAIRO_FONT_SLANT_NORMAL
+77
CAIRO_FONT_SLANT_ITALIC
+78
CAIRO_FONT_SLANT_OBLIQUE
+79
CAIRO_FONT_WEIGHT_NORMAL
+80
CAIRO_FONT_WEIGHT_BOLD
+81
+82
;; Constants — Extend
+83
CAIRO_EXTEND_NONE
+84
CAIRO_EXTEND_REPEAT
+85
CAIRO_EXTEND_REFLECT
+86
CAIRO_EXTEND_PAD
+87
+88
;; Constants — Content
+89
CAIRO_CONTENT_COLOR
+90
CAIRO_CONTENT_ALPHA
+91
CAIRO_CONTENT_COLOR_ALPHA
+92
+93
;; Struct layouts
+94
cairo-text-extents-layout
+95
cairo-font-extents-layout
+96
cairo-matrix-layout
+97
+98
;; Surfaces
+99
cairo-image-surface-create
+100
cairo-surface-destroy
+101
cairo-surface-write-to-png
+102
cairo-surface-flush
+103
cairo-surface-finish
+104
cairo-surface-status
+105
cairo-surface-create-similar
+106
cairo-image-surface-get-width
+107
cairo-image-surface-get-height
+108
cairo-image-surface-get-stride
+109
cairo-image-surface-get-format
+110
cairo-image-surface-get-data
+111
cairo-pdf-surface-create
+112
cairo-svg-surface-create
+113
cairo-pdf-surface-set-size
+114
+115
;; Context
+116
cairo-create
+117
cairo-destroy
+118
cairo-save
+119
cairo-restore
+120
cairo-status
+121
cairo-status-to-string
+122
cairo-push-group
+123
cairo-pop-group
+124
cairo-pop-group-to-source
+125
cairo-get-target
+126
+127
;; Drawing state
+128
cairo-set-source-rgb
+129
cairo-set-source-rgba
+130
cairo-set-source-surface
+131
cairo-set-source
+132
cairo-set-line-width
+133
cairo-get-line-width
+134
cairo-set-line-cap
+135
cairo-set-line-join
+136
cairo-set-miter-limit
+137
cairo-set-dash
+138
cairo-set-fill-rule
+139
cairo-set-operator
+140
cairo-set-antialias
+141
+142
;; Paths
+143
cairo-new-path
+144
cairo-new-sub-path
+145
cairo-close-path
+146
cairo-move-to
+147
cairo-line-to
+148
cairo-curve-to
+149
cairo-arc
+150
cairo-arc-negative
+151
cairo-rectangle
+152
cairo-rel-move-to
+153
cairo-rel-line-to
+154
cairo-rel-curve-to
+155
+156
;; Drawing ops
+157
cairo-stroke
+158
cairo-fill
+159
cairo-paint
+160
cairo-stroke-preserve
+161
cairo-fill-preserve
+162
cairo-paint-with-alpha
+163
cairo-clip
+164
cairo-clip-preserve
+165
cairo-reset-clip
+166
cairo-mask
+167
cairo-mask-surface
+168
+169
;; Text
+170
cairo-select-font-face
+171
cairo-set-font-size
+172
cairo-show-text
+173
cairo-text-extents
+174
cairo-font-extents
+175
+176
;; Transforms
+177
cairo-translate
+178
cairo-scale
+179
cairo-rotate
+180
cairo-identity-matrix
+181
+182
;; Patterns
+183
cairo-pattern-create-rgb
+184
cairo-pattern-create-rgba
+185
cairo-pattern-create-linear
+186
cairo-pattern-create-radial
+187
cairo-pattern-add-color-stop-rgb
+188
cairo-pattern-add-color-stop-rgba
+189
cairo-pattern-destroy
+190
cairo-pattern-set-extend
+191
cairo-pattern-create-for-surface
+192
+193
;; Convenience
+194
with-cairo-surface
+195
with-cairo-context)
+196
+197
(begin
+198
+199
;; ============================================================
+200
;; Library Loading
+201
;; ============================================================
+202
+203
(define cairo-lib (c-library "libcairo"))
+204
+205
;; ============================================================
+206
;; Constants
+207
;; ============================================================
+208
+209
;; Format
+210
(define CAIRO_FORMAT_INVALID -1)
+211
(define CAIRO_FORMAT_ARGB32 0)
+212
(define CAIRO_FORMAT_RGB24 1)
+213
(define CAIRO_FORMAT_A8 2)
+214
(define CAIRO_FORMAT_A1 3)
+215
+216
;; Status
+217
(define CAIRO_STATUS_SUCCESS 0)
+218
(define CAIRO_STATUS_NO_MEMORY 1)
+219
(define CAIRO_STATUS_INVALID_RESTORE 2)
+220
(define CAIRO_STATUS_INVALID_POP_GROUP 3)
+221
(define CAIRO_STATUS_NO_CURRENT_POINT 4)
+222
(define CAIRO_STATUS_INVALID_MATRIX 5)
+223
(define CAIRO_STATUS_INVALID_STATUS 6)
+224
(define CAIRO_STATUS_NULL_POINTER 7)
+225
(define CAIRO_STATUS_INVALID_STRING 8)
+226
(define CAIRO_STATUS_INVALID_PATH_DATA 9)
+227
(define CAIRO_STATUS_READ_ERROR 10)
+228
(define CAIRO_STATUS_WRITE_ERROR 11)
+229
(define CAIRO_STATUS_SURFACE_FINISHED 12)
+230
(define CAIRO_STATUS_SURFACE_TYPE_MISMATCH 13)
+231
(define CAIRO_STATUS_PATTERN_TYPE_MISMATCH 14)
+232
+233
;; Operator
+234
(define CAIRO_OPERATOR_CLEAR 0)
+235
(define CAIRO_OPERATOR_SOURCE 1)
+236
(define CAIRO_OPERATOR_OVER 2)
+237
(define CAIRO_OPERATOR_IN 3)
+238
(define CAIRO_OPERATOR_OUT 4)
+239
(define CAIRO_OPERATOR_ATOP 5)
+240
(define CAIRO_OPERATOR_DEST 6)
+241
(define CAIRO_OPERATOR_DEST_OVER 7)
+242
(define CAIRO_OPERATOR_DEST_IN 8)
+243
(define CAIRO_OPERATOR_DEST_OUT 9)
+244
(define CAIRO_OPERATOR_DEST_ATOP 10)
+245
(define CAIRO_OPERATOR_XOR 11)
+246
(define CAIRO_OPERATOR_ADD 12)
+247
(define CAIRO_OPERATOR_SATURATE 13)
+248
+249
;; Line cap
+250
(define CAIRO_LINE_CAP_BUTT 0)
+251
(define CAIRO_LINE_CAP_ROUND 1)
+252
(define CAIRO_LINE_CAP_SQUARE 2)
+253
+254
;; Line join
+255
(define CAIRO_LINE_JOIN_MITER 0)
+256
(define CAIRO_LINE_JOIN_ROUND 1)
+257
(define CAIRO_LINE_JOIN_BEVEL 2)
+258
+259
;; Fill rule
+260
(define CAIRO_FILL_RULE_WINDING 0)
+261
(define CAIRO_FILL_RULE_EVEN_ODD 1)
+262
+263
;; Antialias
+264
(define CAIRO_ANTIALIAS_DEFAULT 0)
+265
(define CAIRO_ANTIALIAS_NONE 1)
+266
(define CAIRO_ANTIALIAS_GRAY 2)
+267
(define CAIRO_ANTIALIAS_SUBPIXEL 3)
+268
(define CAIRO_ANTIALIAS_FAST 4)
+269
(define CAIRO_ANTIALIAS_GOOD 5)
+270
(define CAIRO_ANTIALIAS_BEST 6)
+271
+272
;; Font slant/weight
+273
(define CAIRO_FONT_SLANT_NORMAL 0)
+274
(define CAIRO_FONT_SLANT_ITALIC 1)
+275
(define CAIRO_FONT_SLANT_OBLIQUE 2)
+276
(define CAIRO_FONT_WEIGHT_NORMAL 0)
+277
(define CAIRO_FONT_WEIGHT_BOLD 1)
+278
+279
;; Extend
+280
(define CAIRO_EXTEND_NONE 0)
+281
(define CAIRO_EXTEND_REPEAT 1)
+282
(define CAIRO_EXTEND_REFLECT 2)
+283
(define CAIRO_EXTEND_PAD 3)
+284
+285
;; Content
+286
(define CAIRO_CONTENT_COLOR #x1000)
+287
(define CAIRO_CONTENT_ALPHA #x2000)
+288
(define CAIRO_CONTENT_COLOR_ALPHA #x3000)
+289
+290
;; ============================================================
+291
;; Struct Layouts
+292
;; ============================================================
+293
+294
(define cairo-text-extents-layout
+295
(c-struct-layout
+296
x-bearing: ffi/double
+297
y-bearing: ffi/double
+298
width: ffi/double
+299
height: ffi/double
+300
x-advance: ffi/double
+301
y-advance: ffi/double))
+302
+303
(define cairo-font-extents-layout
+304
(c-struct-layout
+305
ascent: ffi/double
+306
descent: ffi/double
+307
height: ffi/double
+308
max-x-advance: ffi/double
+309
max-y-advance: ffi/double))
+310
+311
(define cairo-matrix-layout
+312
(c-struct-layout
+313
xx: ffi/double
+314
yx: ffi/double
+315
xy: ffi/double
+316
yy: ffi/double
+317
x0: ffi/double
+318
y0: ffi/double))
+319
+320
;; ============================================================
+321
;; Finalizer Pointers (looked up once)
+322
;; ============================================================
+323
+324
(define %cairo-destroy-ptr (c-symbol cairo-lib "cairo_destroy"))
+325
(define %surface-destroy-ptr (c-symbol cairo-lib "cairo_surface_destroy"))
+326
(define %pattern-destroy-ptr (c-symbol cairo-lib "cairo_pattern_destroy"))
+327
+328
;; ============================================================
+329
;; Raw Function Bindings
+330
;; ============================================================
+331
+332
;; Surfaces
+333
(define %image-surface-create
+334
(c-function cairo-lib "cairo_image_surface_create"
+335
(list ffi/int ffi/int ffi/int) ffi/pointer))
+336
+337
(define %surface-destroy
+338
(c-function cairo-lib "cairo_surface_destroy"
+339
(list ffi/pointer) ffi/void))
+340
+341
(define %surface-write-to-png
+342
(c-function cairo-lib "cairo_surface_write_to_png"
+343
(list ffi/pointer ffi/string) ffi/int))
+344
+345
(define %surface-flush
+346
(c-function cairo-lib "cairo_surface_flush"
+347
(list ffi/pointer) ffi/void))
+348
+349
(define %surface-finish
+350
(c-function cairo-lib "cairo_surface_finish"
+351
(list ffi/pointer) ffi/void))
+352
+353
(define %surface-status
+354
(c-function cairo-lib "cairo_surface_status"
+355
(list ffi/pointer) ffi/int))
+356
+357
(define %surface-create-similar
+358
(c-function cairo-lib "cairo_surface_create_similar"
+359
(list ffi/pointer ffi/int ffi/int ffi/int) ffi/pointer))
+360
+361
(define %image-surface-get-width
+362
(c-function cairo-lib "cairo_image_surface_get_width"
+363
(list ffi/pointer) ffi/int))
+364
+365
(define %image-surface-get-height
+366
(c-function cairo-lib "cairo_image_surface_get_height"
+367
(list ffi/pointer) ffi/int))
+368
+369
(define %image-surface-get-stride
+370
(c-function cairo-lib "cairo_image_surface_get_stride"
+371
(list ffi/pointer) ffi/int))
+372
+373
(define %image-surface-get-format
+374
(c-function cairo-lib "cairo_image_surface_get_format"
+375
(list ffi/pointer) ffi/int))
+376
+377
(define %image-surface-get-data
+378
(c-function cairo-lib "cairo_image_surface_get_data"
+379
(list ffi/pointer) ffi/pointer))
+380
+381
;; PDF/SVG surfaces (may not be available on all systems)
+382
(define %pdf-surface-create
+383
(c-function cairo-lib "cairo_pdf_surface_create"
+384
(list ffi/string ffi/double ffi/double) ffi/pointer))
+385
+386
(define %svg-surface-create
+387
(c-function cairo-lib "cairo_svg_surface_create"
+388
(list ffi/string ffi/double ffi/double) ffi/pointer))
+389
+390
(define %pdf-surface-set-size
+391
(c-function cairo-lib "cairo_pdf_surface_set_size"
+392
(list ffi/pointer ffi/double ffi/double) ffi/void))
+393
+394
;; Context
+395
(define %cairo-create
+396
(c-function cairo-lib "cairo_create"
+397
(list ffi/pointer) ffi/pointer))
+398
+399
(define %cairo-destroy
+400
(c-function cairo-lib "cairo_destroy"
+401
(list ffi/pointer) ffi/void))
+402
+403
(define %cairo-save
+404
(c-function cairo-lib "cairo_save"
+405
(list ffi/pointer) ffi/void))
+406
+407
(define %cairo-restore
+408
(c-function cairo-lib "cairo_restore"
+409
(list ffi/pointer) ffi/void))
+410
+411
(define %cairo-status
+412
(c-function cairo-lib "cairo_status"
+413
(list ffi/pointer) ffi/int))
+414
+415
(define %cairo-status-to-string
+416
(c-function cairo-lib "cairo_status_to_string"
+417
(list ffi/int) ffi/string))
+418
+419
(define %cairo-push-group
+420
(c-function cairo-lib "cairo_push_group"
+421
(list ffi/pointer) ffi/void))
+422
+423
(define %cairo-pop-group
+424
(c-function cairo-lib "cairo_pop_group"
+425
(list ffi/pointer) ffi/pointer))
+426
+427
(define %cairo-pop-group-to-source
+428
(c-function cairo-lib "cairo_pop_group_to_source"
+429
(list ffi/pointer) ffi/void))
+430
+431
(define %cairo-get-target
+432
(c-function cairo-lib "cairo_get_target"
+433
(list ffi/pointer) ffi/pointer))
+434
+435
;; Drawing state
+436
(define %set-source-rgb
+437
(c-function cairo-lib "cairo_set_source_rgb"
+438
(list ffi/pointer ffi/double ffi/double ffi/double) ffi/void))
+439
+440
(define %set-source-rgba
+441
(c-function cairo-lib "cairo_set_source_rgba"
+442
(list ffi/pointer ffi/double ffi/double ffi/double ffi/double) ffi/void))
+443
+444
(define %set-source-surface
+445
(c-function cairo-lib "cairo_set_source_surface"
+446
(list ffi/pointer ffi/pointer ffi/double ffi/double) ffi/void))
+447
+448
(define %set-source
+449
(c-function cairo-lib "cairo_set_source"
+450
(list ffi/pointer ffi/pointer) ffi/void))
+451
+452
(define %set-line-width
+453
(c-function cairo-lib "cairo_set_line_width"
+454
(list ffi/pointer ffi/double) ffi/void))
+455
+456
(define %get-line-width
+457
(c-function cairo-lib "cairo_get_line_width"
+458
(list ffi/pointer) ffi/double))
+459
+460
(define %set-line-cap
+461
(c-function cairo-lib "cairo_set_line_cap"
+462
(list ffi/pointer ffi/int) ffi/void))
+463
+464
(define %set-line-join
+465
(c-function cairo-lib "cairo_set_line_join"
+466
(list ffi/pointer ffi/int) ffi/void))
+467
+468
(define %set-miter-limit
+469
(c-function cairo-lib "cairo_set_miter_limit"
+470
(list ffi/pointer ffi/double) ffi/void))
+471
+472
(define %set-dash
+473
(c-function cairo-lib "cairo_set_dash"
+474
(list ffi/pointer ffi/pointer ffi/int ffi/double) ffi/void))
+475
+476
(define %set-fill-rule
+477
(c-function cairo-lib "cairo_set_fill_rule"
+478
(list ffi/pointer ffi/int) ffi/void))
+479
+480
(define %set-operator
+481
(c-function cairo-lib "cairo_set_operator"
+482
(list ffi/pointer ffi/int) ffi/void))
+483
+484
(define %set-antialias
+485
(c-function cairo-lib "cairo_set_antialias"
+486
(list ffi/pointer ffi/int) ffi/void))
+487
+488
;; Paths
+489
(define %new-path
+490
(c-function cairo-lib "cairo_new_path"
+491
(list ffi/pointer) ffi/void))
+492
+493
(define %new-sub-path
+494
(c-function cairo-lib "cairo_new_sub_path"
+495
(list ffi/pointer) ffi/void))
+496
+497
(define %close-path
+498
(c-function cairo-lib "cairo_close_path"
+499
(list ffi/pointer) ffi/void))

Showing the first 500 of 1140 diff lines for this file. This diff is INCOMPLETE; read the file or clone the repository for the rest.

test/test-cairo.sgladded
@@ -0,0 +1,192 @@
+1
;;; Cairo test suite
+2
;;; Requires libcairo to be installed on the system.
+3
+4
(import (sigil core)
+5
(sigil test)
+6
(sigil ffi)
+7
(cairo))
+8
+9
(test-group "cairo"
+10
+11
(test-group "Image surfaces"
+12
(test "create image surface" (fn ()
+13
(let ((surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 100 100)))
+14
(assert (pointer? surface))
+15
(assert-equal CAIRO_STATUS_SUCCESS (cairo-surface-status surface))
+16
(cairo-surface-destroy surface))))
+17
+18
(test "surface dimensions" (fn ()
+19
(let ((surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 200 150)))
+20
(assert-equal 200 (cairo-image-surface-get-width surface))
+21
(assert-equal 150 (cairo-image-surface-get-height surface))
+22
(assert-equal CAIRO_FORMAT_ARGB32 (cairo-image-surface-get-format surface))
+23
(assert (> (cairo-image-surface-get-stride surface) 0))
+24
(cairo-surface-destroy surface)))))
+25
+26
(test-group "Context"
+27
(test "create and destroy context" (fn ()
+28
(let* ((surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 100 100))
+29
(cr (cairo-create surface)))
+30
(assert (pointer? cr))
+31
(assert-equal CAIRO_STATUS_SUCCESS (cairo-status cr))
+32
(cairo-destroy cr)
+33
(cairo-surface-destroy surface))))
+34
+35
(test "save and restore" (fn ()
+36
(let* ((surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 100 100))
+37
(cr (cairo-create surface)))
+38
(cairo-set-line-width cr 5.0)
+39
(cairo-save cr)
+40
(cairo-set-line-width cr 10.0)
+41
(cairo-restore cr)
+42
(assert-equal 5.0 (cairo-get-line-width cr))
+43
(cairo-destroy cr)
+44
(cairo-surface-destroy surface))))
+45
+46
(test "status-to-string" (fn ()
+47
(assert (string? (cairo-status-to-string CAIRO_STATUS_SUCCESS))))))
+48
+49
(test-group "Drawing"
+50
(test "set-source-rgb and rectangle" (fn ()
+51
(let* ((surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 200 200))
+52
(cr (cairo-create surface)))
+53
(cairo-set-source-rgb cr 0.2 0.3 0.8)
+54
(cairo-rectangle cr 10.0 10.0 180.0 180.0)
+55
(cairo-fill cr)
+56
(assert-equal CAIRO_STATUS_SUCCESS (cairo-status cr))
+57
(cairo-destroy cr)
+58
(cairo-surface-destroy surface))))
+59
+60
(test "arc drawing" (fn ()
+61
(let* ((surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 200 200))
+62
(cr (cairo-create surface)))
+63
(cairo-set-source-rgba cr 1.0 0.0 0.0 0.8)
+64
(cairo-arc cr 100.0 100.0 50.0 0.0 6.283185)
+65
(cairo-fill cr)
+66
(assert-equal CAIRO_STATUS_SUCCESS (cairo-status cr))
+67
(cairo-destroy cr)
+68
(cairo-surface-destroy surface))))
+69
+70
(test "curve-to drawing" (fn ()
+71
(let* ((surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 200 200))
+72
(cr (cairo-create surface)))
+73
(cairo-set-source-rgb cr 0.0 0.0 0.0)
+74
(cairo-set-line-width cr 2.0)
+75
(cairo-move-to cr 10.0 100.0)
+76
(cairo-curve-to cr 50.0 10.0 150.0 190.0 190.0 100.0)
+77
(cairo-stroke cr)
+78
(assert-equal CAIRO_STATUS_SUCCESS (cairo-status cr))
+79
(cairo-destroy cr)
+80
(cairo-surface-destroy surface))))
+81
+82
(test "line drawing" (fn ()
+83
(let* ((surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 200 200))
+84
(cr (cairo-create surface)))
+85
(cairo-set-source-rgb cr 0.0 0.5 0.0)
+86
(cairo-set-line-width cr 3.0)
+87
(cairo-move-to cr 10.0 10.0)
+88
(cairo-line-to cr 190.0 190.0)
+89
(cairo-stroke cr)
+90
(assert-equal CAIRO_STATUS_SUCCESS (cairo-status cr))
+91
(cairo-destroy cr)
+92
(cairo-surface-destroy surface)))))
+93
+94
(test-group "PNG output"
+95
(test "write to PNG" (fn ()
+96
(let* ((surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 200 200))
+97
(cr (cairo-create surface)))
+98
(cairo-set-source-rgb cr 0.2 0.3 0.8)
+99
(cairo-rectangle cr 10.0 10.0 180.0 180.0)
+100
(cairo-fill cr)
+101
(cairo-destroy cr)
+102
(let ((status (cairo-surface-write-to-png surface "/tmp/test-cairo.png")))
+103
(assert-equal CAIRO_STATUS_SUCCESS status))
+104
(cairo-surface-destroy surface)
+105
(assert (file-exists? "/tmp/test-cairo.png"))))))
+106
+107
(test-group "Text"
+108
(test "text extents" (fn ()
+109
(let* ((surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 400 200))
+110
(cr (cairo-create surface)))
+111
(cairo-select-font-face cr "Sans" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_NORMAL)
+112
(cairo-set-font-size cr 20.0)
+113
(let ((extents (cairo-text-extents cr "Hello, Cairo!")))
+114
(assert (dict? extents))
+115
(assert (> (dict-ref extents 'width) 0))
+116
(assert (> (dict-ref extents 'height) 0)))
+117
(cairo-destroy cr)
+118
(cairo-surface-destroy surface))))
+119
+120
(test "font extents" (fn ()
+121
(let* ((surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 400 200))
+122
(cr (cairo-create surface)))
+123
(cairo-select-font-face cr "Sans" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_NORMAL)
+124
(cairo-set-font-size cr 20.0)
+125
(let ((extents (cairo-font-extents cr)))
+126
(assert (dict? extents))
+127
(assert (> (dict-ref extents 'ascent) 0))
+128
(assert (> (dict-ref extents 'height) 0)))
+129
(cairo-destroy cr)
+130
(cairo-surface-destroy surface)))))
+131
+132
(test-group "Transforms"
+133
(test "translate and scale" (fn ()
+134
(let* ((surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 200 200))
+135
(cr (cairo-create surface)))
+136
(cairo-translate cr 100.0 100.0)
+137
(cairo-scale cr 2.0 2.0)
+138
(cairo-rotate cr 0.5)
+139
(cairo-identity-matrix cr)
+140
(assert-equal CAIRO_STATUS_SUCCESS (cairo-status cr))
+141
(cairo-destroy cr)
+142
(cairo-surface-destroy surface)))))
+143
+144
(test-group "Patterns"
+145
(test "linear gradient" (fn ()
+146
(let* ((surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 200 200))
+147
(cr (cairo-create surface))
+148
(pat (cairo-pattern-create-linear 0.0 0.0 200.0 200.0)))
+149
(cairo-pattern-add-color-stop-rgb pat 0.0 1.0 0.0 0.0)
+150
(cairo-pattern-add-color-stop-rgb pat 1.0 0.0 0.0 1.0)
+151
(cairo-set-source cr pat)
+152
(cairo-paint cr)
+153
(assert-equal CAIRO_STATUS_SUCCESS (cairo-status cr))
+154
(cairo-pattern-destroy pat)
+155
(cairo-destroy cr)
+156
(cairo-surface-destroy surface))))
+157
+158
(test "radial gradient" (fn ()
+159
(let* ((surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 200 200))
+160
(cr (cairo-create surface))
+161
(pat (cairo-pattern-create-radial 100.0 100.0 10.0 100.0 100.0 90.0)))
+162
(cairo-pattern-add-color-stop-rgba pat 0.0 1.0 1.0 0.0 1.0)
+163
(cairo-pattern-add-color-stop-rgba pat 1.0 0.0 0.0 1.0 0.5)
+164
(cairo-set-source cr pat)
+165
(cairo-paint cr)
+166
(assert-equal CAIRO_STATUS_SUCCESS (cairo-status cr))
+167
(cairo-pattern-destroy pat)
+168
(cairo-destroy cr)
+169
(cairo-surface-destroy surface)))))
+170
+171
(test-group "Convenience"
+172
(test "with-cairo-context" (fn ()
+173
(let ((surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 100 100)))
+174
(with-cairo-context surface
+175
(lambda (cr)
+176
(cairo-set-source-rgb cr 1.0 1.0 1.0)
+177
(cairo-paint cr)
+178
(assert-equal CAIRO_STATUS_SUCCESS (cairo-status cr))))
+179
(cairo-surface-destroy surface))))
+180
+181
(test "set-dash" (fn ()
+182
(let* ((surface (cairo-image-surface-create CAIRO_FORMAT_ARGB32 200 100))
+183
(cr (cairo-create surface)))
+184
(cairo-set-source-rgb cr 0.0 0.0 0.0)
+185
(cairo-set-line-width cr 2.0)
+186
(cairo-set-dash cr '(10.0 5.0) 0.0)
+187
(cairo-move-to cr 10.0 50.0)
+188
(cairo-line-to cr 190.0 50.0)
+189
(cairo-stroke cr)
+190
(assert-equal CAIRO_STATUS_SUCCESS (cairo-status cr))
+191
(cairo-destroy cr)
+192
(cairo-surface-destroy surface))))))