1 ;; Common Lisp bindings for Cairo
2 ;; Copyright 2005 Espen S. Johnsen <espen@users.sf.net>
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:
12 ;; The above copyright notice and this permission notice shall be
13 ;; included in all copies or substantial portions of the Software.
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.
23 ;; $Id: cairo.lisp,v 1.6 2006-04-26 12:37:48 espen Exp $
27 (eval-when (:compile-toplevel :load-toplevel :execute)
28 (define-enum-type surface-format :argb32 :rgb24 :a8 :a1)
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
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)
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)
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)
55 (defclass glyph (struct)
71 (:metaclass struct-class))
73 (defclass font-face (proxy)
75 (:metaclass proxy-class)
76 (:ref %font-face-reference)
77 (:unref %font-face-destroy))
79 (defclass font-options (proxy)
82 :getter "font_options_get_antialias"
83 :setter "font_options_set_antialias"
84 :accessor font-options-antialias
88 :getter "font_options_get_subpixel_order"
89 :setter "font_options_set_subpixel_order"
90 :accessor font-options-subpixel-order
94 :getter "font_options_get_hint_style"
95 :setter "font_options_set_hint_style"
96 :accessor font-options-hint-style
100 :getter "font_options_get_hint_metrics"
101 :setter "font_options_set_hint_metrics"
102 :accessor font-options-hint-metrics
104 (:metaclass proxy-class)
105 (:ref %font-options-reference)
106 (:unref %font-options-destroy))
108 (defclass scaled-font (proxy)
110 (:metaclass proxy-class)
111 (:ref %scaled-font-reference)
112 (:unref %scaled-font-destroy))
114 (defclass matrix (struct)
115 ((xx :allocation :alien :initarg :xx :initform 1.0
116 :accessor matrix-xx :type double-float)
117 (yx :allocation :alien :initarg :yx :initform 0.0
118 :accessor matrix-yx :type double-float)
119 (xy :allocation :alien :initarg :xy :initform 1.0
120 :accessor matrix-xy :type double-float)
121 (yy :allocation :alien :initarg :yy :initform 0.0
122 :accessor matrix-yy :type double-float)
123 (x0 :allocation :alien :initarg :x0 :initform 0.0
124 :accessor matrix-x0 :type double-float)
125 (y0 :allocation :alien :initarg :y0 :initform 0.0
126 :accessor matrix-y0 :type double-float))
127 (:metaclass struct-class))
130 (defclass text-extents (struct)
131 ((x-bearing :allocation :alien :reader text-extents-x-bearing :type double-float)
132 (y-bearing :allocation :alien :reader text-extents-y-bearing :type double-float)
133 (width :allocation :alien :reader text-extents-width :type double-float)
134 (height :allocation :alien :reader text-extents-height :type double-float)
135 (x-advance :allocation :alien :reader text-extents-x-advance :type double-float)
136 (y-advance :allocation :alien :reader text-extents-y-advance :type double-float))
137 (:metaclass struct-class))
139 (defclass pattern (proxy)
142 :getter "cairo_pattern_get_extend"
143 :setter "cairo_pattern_set_extend"
144 :accessor pattern-extend
148 :getter "cairo_pattern_get_filter"
149 :setter "cairo_pattern_set_filter"
150 :accessor pattern-filter
154 :getter "cairo_pattern_get_matrix"
155 :setter "cairo_pattern_set_matrix"
156 :accessor pattern-matrix
158 (:metaclass proxy-class)
159 (:ref %pattern-reference)
160 (:unref %pattern-destroy))
163 (defclass surface (proxy)
165 (:metaclass proxy-class)
166 (:ref %surface-reference)
167 (:unref %surface-destroy))
169 (defclass context (proxy)
172 :getter "cairo_get_target"
177 :getter "cairo_get_source"
178 :setter "cairo_set_source"
183 :getter "cairo_get_antialias"
184 :setter "cairo_set_antialias"
189 :getter "cairo_get_tolerance"
190 :setter "cairo_set_tolerance"
195 :getter "cairo_get_fill_rule"
196 :setter "cairo_set_fill_rule"
201 :getter "cairo_get_line_width"
202 :setter "cairo_set_line_width"
207 :getter "cairo_get_line_cap"
208 :setter "cairo_set_line_cap"
213 :getter "cairo_get_line_join"
214 :setter "cairo_set_line_join"
219 :getter "cairo_get_miter_limit"
220 :setter "cairo_set_miter_limit"
221 :accessor miter-limit
225 :getter "cairo_get_font_matrix"
226 :setter "cairo_set_font_matrix"
227 :accessor font-matrix
231 :getter "cairo_get_font_options"
232 :setter "cairo_set_font_options"
233 :accessor font-options
237 :getter "cairo_get_font_face"
238 :setter "cairo_set_font_face"
243 :getter "cairo_get_operator"
244 :setter "cairo_set_operator"
250 :setter "cairo_set_matrix"
251 :writer (setf matrix)
254 (:metaclass proxy-class)
258 (defclass image-surface (surface)
261 :getter "cairo_image_surface_get_width"
262 :reader surface-width
266 :getter "cairo_image_surface_get_height"
267 :reader surface-height
269 (:metaclass proxy-class)
270 (:ref %surface-reference)
271 (:unref %surface-destroy))
274 ;; (defclass path (proxy)
276 ;; (:metaclass proxy-class))
283 (defbinding %reference () nil
286 (defbinding %destroy () nil
289 (defbinding (save-context "cairo_save") () nil
292 (defbinding (restore-context "cairo_restore") () nil
295 (defmacro with-context ((cr) &body body)
296 (let ((context (make-symbol "CONTEXT")))
297 `(let ((,context ,cr))
298 (save-context ,context)
301 (restore-context ,context)))))
303 (defbinding status () status
306 (defbinding (set-source-color "cairo_set_source_rgba") (cr red green blue &optional (alpha 1.0)) nil
311 (alpha double-float))
313 (defbinding set-source-surface () nil
319 (defbinding set-dash (cr dashes &optional (offset 0.0)) nil
321 (dashes (vector double-float))
322 ((length dashes) int)
323 (offset double-float))
325 (defbinding (paint "cairo_paint_with_alpha") (cr &optional (alpha 1.0)) nil
327 (alpha double-float))
329 (defbinding mask () nil
333 (defbinding mask-surface () nil
336 (surface-x double-float)
337 (surface-y double-float))
339 (defmacro defoperator (name &optional clip-p)
340 (let ((iname (intern (format nil "%~A" name)))
341 (pname (intern (format nil "%~A-PRESERVE" name))))
343 (defbinding ,iname () nil
345 (defbinding ,pname () nil
347 (defun ,name (cr &optional preserve)
352 (let ((tname (intern (format nil "IN-~A-P" name)))
353 (ename (intern (format nil "~A-EXTENTS" name))))
355 (defbinding ,tname () boolean
359 (defbinding ,ename () boolean
361 (x1 double-float :out)
362 (y1 double-float :out)
363 (x2 double-float :out)
364 (y2 double-float :out))))))))
370 (defbinding reset-clip () nil
373 (defbinding copy-page () nil
376 (defbinding show-page () nil
382 (defbinding get-current-point () nil
384 (x double-float :out)
385 (y double-float :out))
387 (defbinding new-path () nil
390 (defbinding close-path () nil
393 (defbinding arc () nil
397 (radius double-float)
398 (angle1 double-float)
399 (angle2 double-float))
401 (defbinding arc-negative () nil
405 (radius double-float)
406 (angle1 double-float)
407 (angle2 double-float))
409 (defun circle (cr x y radius)
410 (arc cr x y radius 0.0 (* pi 2)))
412 (defmacro defpath (name &rest args)
413 (let ((relname (intern (format nil "REL-~A" name))))
415 (defbinding ,name () nil
418 (defbinding ,relname () nil
438 (defbinding rectangle () nil
443 (height double-float))
445 (defbinding glyph-path (cr glyphs) nil
447 (glyphs (vector glyph))
448 ((length glyphs) int))
450 (defbinding text-path () nil
458 (defbinding (pattern-add-color-stop "cairo_pattern_add_color_stop_rgba")
459 (pattern offset red green blue &optional (alpha 1.0)) nil
461 (offset double-float)
465 (alpha double-float))
467 (defbinding (pattern-create "cairo_pattern_create_rgba")
468 (red green blue &optional (alpha 1.0)) pattern
472 (alpha double-float))
474 (defbinding pattern-create-for-surface () pattern
477 (defbinding pattern-create-linear () pattern
483 (defbinding pattern-create-radial () pattern
486 (radius0 double-float)
489 (radius1 double-float))
491 (defbinding %pattern-reference () nil
494 (defbinding %pattern-destroy () nil
497 (defbinding pattern-status () status
504 (defbinding translate () nil
509 (defbinding scale () nil
514 (defbinding rotate () nil
516 (angle double-float))
518 (defbinding transform () nil
522 (defbinding (matrix "cairo_get_matrix") () nil
524 ((make-instance 'matrix) matrix :in/return))
526 (defbinding identity-matrix () nil
529 (defbinding user-to-device () nil
531 (x double-float :in/out)
532 (y double-float :in/out))
534 (defbinding user-to-device-distance () nil
536 (dx double-float :in/out)
537 (dy double-float :in/out))
539 (defbinding device-to-user () nil
541 (x double-float :in/out)
542 (y double-float :in/out))
544 (defbinding device-to-user-distance () nil
546 (dx double-float :in/out)
547 (dy double-float :in/out))
552 (defbinding select-font-face () nil
556 (weight font-weight))
558 (defbinding set-font-size () nil
562 (defbinding show-text () nil
566 (defbinding show-glyphs () nil
568 (glyphs (vector glyph))
569 ((length glyphs) int))
571 (defbinding font-extents () boolean
574 (defbinding text-extents (cr text &optional (extents (make-instance 'text-extents))) nil
577 (extents text-extents :in/return))
579 (defbinding glyph-extents (cr glyphs &optional (extents (make-instance 'text-extents))) nil
581 (glyphs (vector glyph))
582 ((length glyphs) int)
583 (extents text-extents :in/return))
588 (defbinding %font-face-reference () nil
591 (defbinding %font-face-destroy () nil
594 (defbinding font-face-status () status
595 (font-face font-face))
601 (defbinding %scaled-font-reference () nil
604 (defbinding %scaled-font-destroy () nil
607 (defbinding scaled-font-status () status
608 (scaled-font scaled-font))
610 (defbinding scaled-font-extents (scaled-font &optional (extents (make-instance 'text-extents))) nil
611 (scaled-font scaled-font)
612 (extents text-extents :in/return))
614 (defbinding scaled-font-glyph-extents (scaled-font glyphs &optional (extents (make-instance 'text-extents))) nil
615 (scaled-font scaled-font)
616 (glyphs (vector glyph))
617 ((length glyphs) int)
618 (extents text-extents :in/return))
620 (defbinding %scaled-font-create () pointer
621 (font-face font-face)
624 (options font-options))
626 (defmethod allocate-foreign ((scaled-font scaled-font) &key font-face font-matrix cmt options)
627 (%scaled-font-create font-face font-matrix cmt options))
634 (defbinding %font-options-copy () nil
637 (defbinding %font-options-destroy () nil
640 (defbinding font-options-status () status
641 (font-options font-options))
643 (defbinding %font-options-create () pointer)
645 (defmethod allocate-foreign ((font-options font-options) &rest initargs)
646 (declare (ignore initargs))
647 (%font-options-create))
649 (defbinding font-options-merge () nil
650 (options1 font-options :in/return)
651 (options2 font-options))
653 (defbinding font-options-hash () unsigned-int
654 (options font-options))
656 (defbinding font-options-equal-p () boolean
657 (options1 font-options)
658 (options2 font-options))
664 (defbinding %surface-reference () nil
667 (defbinding %surface-destroy () nil
670 (defbinding surface-create-similar () surface
672 (format surface-format )
676 (defbinding surface-finish () nil
679 (defbinding surface-flush () nil
682 (defbinding surface-get-font-options () nil
684 ((make-instance 'font-options) font-options :in/return))
686 (defbinding surface-set-device-offset () nil
688 (x-offset double-float)
689 (y-offset double-float))
691 (defbinding surface-status () status
694 (defbinding %surface-mark-dirty () nil
697 (defbinding %surface-mark-dirty-rectangle () nil
704 (defun surface-mark-dirty (surface &optional x y width height)
706 (%surface-mark-dirty-rectangle surface x y width height)
707 (%surface-mark-dirty surface)))
713 ;; Should data be automatically freed when the surface is GCed?
714 (defmethod allocate-foreign ((surface image-surface)
715 &key width height stride format data)
717 (%image-surface-create format width height)
718 (%image-surface-create-for-data data format width height
721 (let ((element-size (cdr (assoc format '((:argb32 . 4) (:rgb24 . 4) (:a8 . 1) (:a1 1/8))))))
722 (ceiling (* width element-size)))))))
725 (defbinding %image-surface-create () image-surface
726 (format surface-format)
730 (defbinding %image-surface-create-for-data () image-surface
732 (format surface-format)
741 (defbinding image-surface-create-from-png (filename) image-surface
742 ((truename filename) pathname))
749 (defbinding matrix-init () nil
750 (matrix matrix :in/return)
751 (xx double-float) (yx double-float)
752 (xy double-float) (yy double-float)
753 (x0 double-float) (y0 double-float))
755 (defbinding matrix-init-identity () nil
756 (matrix matrix :in/return))
758 (defbinding matrix-init-translate () nil
759 (matrix matrix :in/return)
763 (defbinding matrix-init-scale () nil
764 (matrix matrix :in/return)
768 (defbinding matrix-init-rotate () nil
769 (matrix matrix :in/return)
770 (radians double-float))
772 (defbinding matrix-translate () nil
773 (matrix matrix :in/return)
777 (defbinding matrix-scale () nil
778 (matrix matrix :in/return)
782 (defbinding matrix-rotate () nil
783 (matrix matrix :in/return)
784 (radians double-float))
786 (defbinding matrix-invert () nil
787 (matrix matrix :in/return))
789 (defbinding matrix-multiply () nil
794 (defbinding matrix-transform-distance () nil
795 (matrix matrix :in/return)
799 (defbinding matrix-transform-point () nil
800 (matrix matrix :in/return)