chiark / gitweb /
Added GFFI to the list of used packages
[clg] / cairo / cairo.lisp
CommitLineData
1ed0a2c5 1;; Common Lisp bindings for Cairo
2;; Copyright 2005 Espen S. Johnsen <espen@users.sf.net>
3;;
4;; Permission is hereby granted, free of charge, to any person obtaining
5;; a copy of this software and associated documentation files (the
6;; "Software"), to deal in the Software without restriction, including
7;; without limitation the rights to use, copy, modify, merge, publish,
8;; distribute, sublicense, and/or sell copies of the Software, and to
9;; permit persons to whom the Software is furnished to do so, subject to
10;; the following conditions:
11;;
12;; The above copyright notice and this permission notice shall be
13;; included in all copies or substantial portions of the Software.
14;;
15;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
16;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
17;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
18;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
19;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
20;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
21;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
22
c1a5cdbb 23;; $Id: cairo.lisp,v 1.5 2006-02-09 22:30:39 espen Exp $
1ed0a2c5 24
25(in-package "CAIRO")
26
27(eval-when (:compile-toplevel :load-toplevel :execute)
28 (define-enum-type surface-format :argb32 :rgb24 :a8 :a1)
29
30 (define-enum-type status
31 :success :no-memory :invalid-restore :invalid-pop-group
32 :no-current-point :invalid-matrix :invalid-status :null-pointer
33 :invalid-string :invalid-path-data :read-error :write-error
34 :surface-finished :surface-type-mismatch :pattern-type-mismatch
35 :invalid-content :invalid-format :invalid-visual :file-not-found
36 :invalid-dash)
37
38 (define-enum-type fill-rule :winding :even-odd)
39 (define-enum-type line-cap :butt :round :square)
40 (define-enum-type line-join :miter :round :bevel)
41 (define-enum-type font-slant :normal :itaic :oblique)
42 (define-enum-type font-weight :normal :bold)
43
44 (define-enum-type operator
45 :clear :source :over :in :out :atop :dest :dest-over
46 :dest-in :dest-out :dest-atop :xor :add :saturate)
47
48 (define-enum-type antialias :default :none :gray :subpixel)
49 (define-enum-type extend :none :repeat :reflect)
50 (define-enum-type filter :fast :good :best :nearest :bilinear :gaussian)
51 (define-enum-type subpixel-order :default :rgb :bgr :vrgb :vbgr)
52 (define-enum-type hint-style :default :none :slight :medium :full)
53 (define-enum-type hint-metrics :default :off :on)
54
c7d11ab8 55 (defclass glyph (struct)
1ed0a2c5 56 ((index
57 :allocation :alien
58 :initarg :index
59 :accessor glyph-index
60 :type unsigned-long)
61 (x
62 :allocation :alien
63 :initarg :x
64 :accessor glyph-x
65 :type double-float)
66 (y
67 :allocation :alien
68 :initarg :y
69 :accessor glyph-y
70 :type double-float))
71 (:metaclass struct-class))
72
73 (defclass font-face (proxy)
74 ()
75 (:metaclass proxy-class))
76
77 (defclass font-options (proxy)
78 ((antialias
79 :allocation :virtual
80 :getter "font_options_get_antialias"
81 :setter "font_options_set_antialias"
82 :accessor font-options-antialias
83 :type antialias)
84 (subpixel-order
85 :allocation :virtual
86 :getter "font_options_get_subpixel_order"
87 :setter "font_options_set_subpixel_order"
88 :accessor font-options-subpixel-order
89 :type subpixel-order)
90 (hint-style
91 :allocation :virtual
92 :getter "font_options_get_hint_style"
93 :setter "font_options_set_hint_style"
94 :accessor font-options-hint-style
95 :type hint-style)
96 (hint-metrics
97 :allocation :virtual
98 :getter "font_options_get_hint_metrics"
99 :setter "font_options_set_hint_metrics"
100 :accessor font-options-hint-metrics
101 :type hint-metrics))
102 (:metaclass proxy-class))
103
104 (defclass scaled-font (proxy)
105 ()
106 (:metaclass proxy-class))
107
108 (defclass matrix (struct)
109 ((xx :allocation :alien :initarg :xx :initform 1.0
110 :accessor matrix-xx :type double-float)
111 (yx :allocation :alien :initarg :yx :initform 0.0
112 :accessor matrix-yx :type double-float)
113 (xy :allocation :alien :initarg :xy :initform 1.0
114 :accessor matrix-xy :type double-float)
115 (yy :allocation :alien :initarg :yy :initform 0.0
116 :accessor matrix-yy :type double-float)
117 (x0 :allocation :alien :initarg :x0 :initform 0.0
118 :accessor matrix-x0 :type double-float)
119 (y0 :allocation :alien :initarg :y0 :initform 0.0
120 :accessor matrix-y0 :type double-float))
121 (:metaclass struct-class))
122
123
124 (defclass text-extents (struct)
125 ((x-bearing :allocation :alien :reader text-extents-x-bearing :type double-float)
126 (y-bearing :allocation :alien :reader text-extents-y-bearing :type double-float)
127 (width :allocation :alien :reader text-extents-width :type double-float)
128 (height :allocation :alien :reader text-extents-height :type double-float)
129 (x-advance :allocation :alien :reader text-extents-x-advance :type double-float)
130 (y-advance :allocation :alien :reader text-extents-y-advance :type double-float))
131 (:metaclass struct-class))
132
133 (defclass pattern (proxy)
134 ((extend
135 :allocation :virtual
136 :getter "cairo_pattern_get_extend"
137 :setter "cairo_pattern_set_extend"
138 :accessor pattern-extend
139 :type extend)
140 (filter
141 :allocation :virtual
142 :getter "cairo_pattern_get_filter"
143 :setter "cairo_pattern_set_filter"
144 :accessor pattern-filter
145 :type filter)
146 (matrix
147 :allocation :virtual
148 :getter "cairo_pattern_get_matrix"
149 :setter "cairo_pattern_set_matrix"
150 :accessor pattern-matrix
151 :type matrix))
152 (:metaclass proxy-class))
153
154 (defclass context (proxy)
155 ((target
156 :allocation :virtual
157 :getter "cairo_get_target"
158 :reader target
159 :type surface)
160 (source
161 :allocation :virtual
162 :getter "cairo_get_source"
163 :setter "cairo_set_source"
164 :accessor source
165 :type pattern)
166 (antialias
167 :allocation :virtual
168 :getter "cairo_get_antialias"
169 :setter "cairo_set_antialias"
170 :accessor antialias
171 :type antialias)
172 (tolerance
173 :allocation :virtual
174 :getter "cairo_get_tolerance"
175 :setter "cairo_set_tolerance"
176 :accessor tolerance
177 :type double-float)
178 (fill-rule
179 :allocation :virtual
180 :getter "cairo_get_fill_rule"
181 :setter "cairo_set_fill_rule"
182 :accessor fill-rule
183 :type fill-rule)
184 (line-width
185 :allocation :virtual
186 :getter "cairo_get_line_width"
187 :setter "cairo_set_line_width"
188 :accessor line-width
189 :type double-float)
190 (line-cap
191 :allocation :virtual
192 :getter "cairo_get_line_cap"
193 :setter "cairo_set_line_cap"
194 :accessor line-cap
195 :type line-cap)
196 (line-join
197 :allocation :virtual
198 :getter "cairo_get_line_join"
199 :setter "cairo_set_line_join"
200 :accessor line-join
201 :type line-join)
202 (miter-limit
203 :allocation :virtual
204 :getter "cairo_get_miter_limit"
205 :setter "cairo_set_miter_limit"
206 :accessor miter-limit
207 :type double-float)
208 (font-matrix
209 :allocation :virtual
210 :getter "cairo_get_font_matrix"
211 :setter "cairo_set_font_matrix"
212 :accessor font-matrix
213 :type matrix)
214 (font-options
215 :allocation :virtual
216 :getter "cairo_get_font_options"
217 :setter "cairo_set_font_options"
218 :accessor font-options
219 :type font-options)
220 (font-face
221 :allocation :virtual
222 :getter "cairo_get_font_face"
223 :setter "cairo_set_font_face"
224 :accessor font-face
225 :type font-face)
226 (operator
227 :allocation :virtual
228 :getter "cairo_get_operator"
229 :setter "cairo_set_operator"
230 :accessor operator
231 :type operator)
232 (matrix
233 :allocation :virtual
234 :getter matrix
235 :setter "cairo_set_matrix"
236 :writer (setf matrix)
237 :type matrix)
238 )
239 (:metaclass proxy-class))
240
241 (defclass surface (proxy)
242 ()
243 (:metaclass proxy-class))
244
245 (defclass image-surface (surface)
246 ((width
247 :allocation :virtual
248 :getter "cairo_image_surface_get_width"
249 :reader surface-width
250 :type int)
251 (height
252 :allocation :virtual
253 :getter "cairo_image_surface_get_height"
254 :reader surface-height
255 :type int))
256 (:metaclass proxy-class))
257
258;; (defclass path (proxy)
259;; ()
260;; (:metaclass proxy-class))
261
262)
263
264
265;;; Cairo context
266
267(defbinding %reference () nil
268 (location pointer))
269
270(defbinding %destroy () nil
271 (location pointer))
272
273(defmethod reference-foreign ((class (eql (find-class 'context))) location)
274 (%reference location))
275
276(defmethod unreference-foreign ((class (eql (find-class 'context))) location)
277 (%destroy location))
278
279(defbinding (save-context "cairo_save") () nil
280 (cr context))
281
282(defbinding (restore-context "cairo_restore") () nil
283 (cr context))
284
285(defmacro with-context ((cr) &body body)
286 (let ((context (make-symbol "CONTEXT")))
287 `(let ((,context ,cr))
288 (save-context ,context)
289 (unwind-protect
290 (progn ,@body)
291 (restore-context ,context)))))
292
293(defbinding status () status
294 (cr context))
295
296(defbinding (set-source-color "cairo_set_source_rgba") (cr red green blue &optional (alpha 1.0)) nil
297 (cr context)
298 (red double-float)
299 (green double-float)
300 (blue double-float)
301 (alpha double-float))
302
303(defbinding set-source-surface () nil
304 (cr context)
305 (surface surface)
306 (x double-float)
307 (y double-float))
308
309(defbinding set-dash (cr dashes &optional (offset 0.0)) nil
310 (cr context)
311 (dashes (vector double-float))
312 ((length dashes) int)
313 (offset double-float))
314
315(defbinding (paint "cairo_paint_with_alpha") (cr &optional (alpha 1.0)) nil
316 (cr context)
317 (alpha double-float))
318
319(defbinding mask () nil
320 (cr context)
321 (pattern pattern))
322
323(defbinding mask-surface () nil
324 (cr context)
325 (surface surface)
326 (surface-x double-float)
327 (surface-y double-float))
328
329(defmacro defoperator (name &optional clip-p)
330 (let ((iname (intern (format nil "%~A" name)))
331 (pname (intern (format nil "%~A-PRESERVE" name))))
332 `(progn
333 (defbinding ,iname () nil
334 (cr context))
335 (defbinding ,pname () nil
336 (cr context))
337 (defun ,name (cr &optional preserve)
338 (if preserve
339 (,pname cr)
340 (,iname cr)))
341 ,(unless clip-p
2f60440d 342 (let ((tname (intern (format nil "IN-~A-P" name)))
1ed0a2c5 343 (ename (intern (format nil "~A-EXTENTS" name))))
344 `(progn
345 (defbinding ,tname () boolean
346 (cr context)
347 (x double-float)
348 (y double-float))
349 (defbinding ,ename () boolean
350 (cr context)
351 (x1 double-float :out)
352 (y1 double-float :out)
353 (x2 double-float :out)
354 (y2 double-float :out))))))))
355
356(defoperator clip t)
357(defoperator stroke)
358(defoperator fill)
359
360(defbinding reset-clip () nil
361 (cr context))
362
363(defbinding copy-page () nil
364 (cr context))
365
366(defbinding show-page () nil
367 (cr context))
368
369
370;;; Paths
371
372(defbinding get-current-point () nil
373 (cr context)
374 (x double-float :out)
375 (y double-float :out))
376
377(defbinding new-path () nil
378 (cr context))
379
380(defbinding close-path () nil
381 (cr context))
382
383(defbinding arc () nil
384 (cr context)
385 (xc double-float)
386 (yc double-float)
387 (radius double-float)
388 (angle1 double-float)
389 (angle2 double-float))
390
391(defbinding arc-negative () nil
392 (cr context)
393 (xc double-float)
394 (yc double-float)
395 (radius double-float)
396 (angle1 double-float)
397 (angle2 double-float))
398
399(defun circle (cr x y radius)
400 (arc cr x y radius 0.0 (* pi 2)))
401
402(defmacro defpath (name &rest args)
403 (let ((relname (intern (format nil "REL-~A" name))))
404 `(progn
405 (defbinding ,name () nil
406 (cr context)
407 ,@args)
408 (defbinding ,relname () nil
409 (cr context)
410 ,@args))))
411
412(defpath curve-to
413 (x1 double-float)
414 (y1 double-float)
415 (x2 double-float)
416 (y2 double-float)
417 (x3 double-float)
418 (y3 double-float))
419
420(defpath line-to
421 (x double-float)
422 (y double-float))
423
424(defpath move-to
425 (x double-float)
426 (y double-float))
427
428(defbinding rectangle () nil
429 (cr context)
430 (x double-float)
431 (y double-float)
432 (width double-float)
433 (height double-float))
434
435(defbinding glyph-path (cr glyphs) nil
436 (cr context)
437 (glyphs (vector glyph))
438 ((length glyphs) int))
439
440(defbinding text-path () nil
441 (cr context)
442 (text string))
443
444
445
446;;; Patterns
447
448(defbinding (pattern-add-color-stop "cairo_pattern_add_color_stop_rgba")
449 (pattern offset red green blue &optional (alpha 1.0)) nil
450 (pattern pattern)
451 (offset double-float)
452 (red double-float)
453 (green double-float)
454 (blue double-float)
455 (alpha double-float))
456
457(defbinding (pattern-create "cairo_pattern_create_rgba")
458 (red green blue &optional (alpha 1.0)) pattern
459 (red double-float)
460 (green double-float)
461 (blue double-float)
462 (alpha double-float))
463
464(defbinding pattern-create-for-surface () pattern
465 (surface surface))
466
467(defbinding pattern-create-linear () pattern
468 (x0 double-float)
469 (y0 double-float)
470 (x1 double-float)
471 (y1 double-float))
472
473(defbinding pattern-create-radial () pattern
474 (cx0 double-float)
475 (cy0 double-float)
476 (radius0 double-float)
477 (cx1 double-float)
478 (cy1 double-float)
479 (radius1 double-float))
480
481(defbinding %pattern-reference () nil
482 (location pointer))
483
484(defbinding %pattern-destroy () nil
485 (location pointer))
486
487(defmethod reference-foreign ((class (eql (find-class 'pattern))) location)
488 (%pattern-reference location))
489
490(defmethod unreference-foreign ((class (eql (find-class 'pattern))) location)
491 (%pattern-destroy location))
492
493(defbinding pattern-status () status
494 (pattern pattern))
495
496
497
498;;; Transformations
499
500(defbinding translate () nil
501 (cr context)
502 (tx double-float)
503 (ty double-float))
504
505(defbinding scale () nil
506 (cr context)
507 (sx double-float)
508 (sy double-float))
509
510(defbinding rotate () nil
511 (cr context)
512 (angle double-float))
513
514(defbinding transform () nil
515 (cr context)
516 (matrix matrix))
517
518(defbinding (matrix "cairo_get_matrix") () nil
519 (cr context)
520 ((make-instance 'matrix) matrix :return))
521
522(defbinding identity-matrix () nil
523 (cr context))
524
525(defbinding user-to-device () nil
526 (cr context)
527 (x double-float :in-out)
528 (y double-float :in-out))
529
530(defbinding user-to-device-distance () nil
531 (cr context)
532 (dx double-float :in-out)
533 (dy double-float :in-out))
534
535(defbinding device-to-user () nil
536 (cr context)
537 (x double-float :in-out)
538 (y double-float :in-out))
539
540(defbinding device-to-user-distance () nil
541 (cr context)
542 (dx double-float :in-out)
543 (dy double-float :in-out))
544
545
546;;; Text
547
548(defbinding select-font-face () nil
549 (cr context)
550 (family string)
551 (slant font-slant)
552 (weight font-weight))
553
554(defbinding set-font-size () nil
555 (cr context)
556 (size double-float))
557
558(defbinding show-text () nil
559 (cr context)
560 (text string))
561
562(defbinding show-glyphs () nil
563 (cr context)
564 (glyphs (vector glyph))
565 ((length glyphs) int))
566
567(defbinding font-extents () boolean
568 (cr context))
569
570(defbinding text-extents (cr text &optional (extents (make-instance 'text-extents))) nil
571 (cr context)
572 (text string)
573 (extents text-extents :return))
574
575(defbinding glyph-extents (cr glyphs &optional (extents (make-instance 'text-extents))) nil
576 (cr context)
577 (glyphs (vector glyph))
578 ((length glyphs) int)
579 (extents text-extents :return))
580
581
582;;; Fonts
583
584(defbinding %font-face-reference () nil
585 (location pointer))
586
587(defbinding %font-face-destroy () nil
588 (location pointer))
589
590(defmethod reference-foreign ((class (eql (find-class 'font-face))) location)
591 (%font-face-reference location))
592
593(defmethod unreference-foreign ((class (eql (find-class 'font-face))) location)
594 (%font-face-destroy location))
595
596(defbinding font-face-status () status
597 (font-face font-face))
598
599
600
601;;; Scaled Fonts
602
603(defbinding %scaled-font-reference () nil
604 (location pointer))
605
606(defbinding %scaled-font-destroy () nil
607 (location pointer))
608
609(defmethod reference-foreign ((class (eql (find-class 'scaled-font))) location)
610 (%scaled-font-reference location))
611
612(defmethod unreference-foreign ((class (eql (find-class 'scaled-font))) location)
613 (%scaled-font-destroy location))
614
615(defbinding scaled-font-status () status
616 (scaled-font scaled-font))
617
618(defbinding scaled-font-extents (scaled-font &optional (extents (make-instance 'text-extents))) nil
619 (scaled-font scaled-font)
620 (extents text-extents :return))
621
622(defbinding scaled-font-glyph-extents (scaled-font glyphs &optional (extents (make-instance 'text-extents))) nil
623 (scaled-font scaled-font)
624 (glyphs (vector glyph))
625 ((length glyphs) int)
626 (extents text-extents :return))
627
628(defbinding %scaled-font-create () pointer
629 (font-face font-face)
630 (font-matrix matrix)
631 (ctm matrix)
632 (options font-options))
633
c1a5cdbb 634(defmethod allocate-foreign ((scaled-font scaled-font) &key font-face font-matrix cmt options)
635 (%scaled-font-create font-face font-matrix cmt options))
1ed0a2c5 636
637
638
639;;; Font Options
640
641
642(defbinding %font-options-copy () nil
643 (location pointer))
644
645(defbinding %font-options-destroy () nil
646 (location pointer))
647
648(defmethod reference-foreign ((class (eql (find-class 'font-options))) location)
c7d11ab8 649 (%font-options-copy location))
1ed0a2c5 650
651(defmethod unreference-foreign ((class (eql (find-class 'font-options))) location)
652 (%font-options-destroy location))
653
654(defbinding font-options-status () status
655 (font-options font-options))
656
657(defbinding %font-options-create () pointer)
658
c1a5cdbb 659(defmethod allocate-foreign ((font-options font-options) &rest initargs)
1ed0a2c5 660 (declare (ignore initargs))
c1a5cdbb 661 (%font-options-create))
1ed0a2c5 662
663(defbinding font-options-merge () nil
664 (options1 font-options :return)
665 (options2 font-options))
666
667(defbinding font-options-hash () unsigned-int
668 (options font-options))
669
670(defbinding font-options-equal-p () boolean
671 (options1 font-options)
672 (options2 font-options))
673
674
675
676;;; Surfaces
677
678(defbinding %surface-reference () nil
679 (location pointer))
680
681(defbinding %surface-destroy () nil
682 (location pointer))
683
684(defmethod reference-foreign ((class (eql (find-class 'surface))) location)
685 (%surface-reference location))
686
687(defmethod unreference-foreign ((class (eql (find-class 'surface))) location)
688 (%surface-destroy location))
689
690(defbinding surface-create-similar () surface
691 (other surface)
692 (format surface-format )
693 (width int)
694 (height int))
695
696(defbinding surface-finish () nil
697 (surface surface))
698
699(defbinding surface-flush () nil
700 (surface surface))
701
702(defbinding surface-get-font-options () nil
703 (surface surface)
704 ((make-instance 'font-options) font-options :return))
705
706(defbinding surface-set-device-offset () nil
707 (surface surface)
708 (x-offset double-float)
709 (y-offset double-float))
710
711(defbinding surface-status () status
712 (surface surface))
713
714(defbinding %surface-mark-dirty () nil
715 (surface surface))
716
717(defbinding %surface-mark-dirty-rectangle () nil
718 (surface surface)
719 (x int)
720 (y int)
721 (width int)
722 (height int))
723
724(defun surface-mark-dirty (surface &optional x y width height)
725 (if x
726 (%surface-mark-dirty-rectangle surface x y width height)
727 (%surface-mark-dirty surface)))
728
729
730
731;; Image Surface
732
733;; Should data be automatically freed when the surface is GCed?
c1a5cdbb 734(defmethod allocate-foreign ((surface image-surface)
735 &key width height stride format data)
736 (if (not data)
737 (%image-surface-create format width height)
738 (%image-surface-create-for-data data format width height
739 (or
740 stride
741 (let ((element-size (cdr (assoc format '((:argb32 . 4) (:rgb24 . 4) (:a8 . 1) (:a1 1/8))))))
742 (ceiling (* width element-size)))))))
1ed0a2c5 743
744
745(defbinding %image-surface-create () image-surface
746 (format surface-format)
747 (width int)
748 (hegit int))
749
750(defbinding %image-surface-create-for-data () image-surface
751 (data pointer)
752 (format surface-format)
753 (width int)
754 (hegit int)
755 (stride int))
756
757
758
759;;; PNG Surface
760
761(defbinding image-surface-create-from-png (filename) image-surface
762 ((truename filename) pathname))
763
764
765
766
767;;; Matrices
768
769(defbinding matrix-init () nil
770 (matrix matrix :return)
771 (xx double-float) (yx double-float)
772 (xy double-float) (yy double-float)
773 (x0 double-float) (y0 double-float))
774
775(defbinding matrix-init-identity () nil
776 (matrix matrix :return))
777
778(defbinding matrix-init-translate () nil
779 (matrix matrix :return)
780 (tx double-float)
781 (ty double-float))
782
783(defbinding matrix-init-scale () nil
784 (matrix matrix :return)
785 (sx double-float)
786 (sy double-float))
787
788(defbinding matrix-init-rotate () nil
789 (matrix matrix :return)
790 (radians double-float))
791
792(defbinding matrix-translate () nil
793 (matrix matrix :return)
794 (tx double-float)
795 (ty double-float))
796
797(defbinding matrix-scale () nil
798 (matrix matrix :return)
799 (sx double-float)
800 (sy double-float))
801
802(defbinding matrix-rotate () nil
803 (matrix matrix :return)
804 (radians double-float))
805
806(defbinding matrix-invert () nil
807 (matrix matrix :return))
808
809(defbinding matrix-multiply () nil
810 (result matrix :out)
811 (a matrix)
812 (b matrix))
813
814(defbinding matrix-transform-distance () nil
815 (matrix matrix :return)
816 (dx double-float)
817 (dy double-float))
818
819(defbinding matrix-transform-point () nil
820 (matrix matrix :return)
821 (x double-float)
822 (y double-float))
823
824
825