AtlatestRepositorysigil-cairo

sigil-cairo / tree / examplesdemo.sgl

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)))
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))
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)
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)
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)
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)
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)
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)
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)
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)
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)
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)
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)
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")
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!")
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!")
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))
113 (cairo-destroy cr))
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"))