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.2 2005/11/15 10:03:04 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 (proxy)
71 (:metaclass struct-class))
73 (defclass font-face (proxy)
75 (:metaclass proxy-class))
77 (defclass font-options (proxy)
80 :getter "font_options_get_antialias"
81 :setter "font_options_set_antialias"
82 :accessor font-options-antialias
86 :getter "font_options_get_subpixel_order"
87 :setter "font_options_set_subpixel_order"
88 :accessor font-options-subpixel-order
92 :getter "font_options_get_hint_style"
93 :setter "font_options_set_hint_style"
94 :accessor font-options-hint-style
98 :getter "font_options_get_hint_metrics"
99 :setter "font_options_set_hint_metrics"
100 :accessor font-options-hint-metrics
102 (:metaclass proxy-class))
104 (defclass scaled-font (proxy)
106 (:metaclass proxy-class))
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))
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))
133 (defclass pattern (proxy)
136 :getter "cairo_pattern_get_extend"
137 :setter "cairo_pattern_set_extend"
138 :accessor pattern-extend
142 :getter "cairo_pattern_get_filter"
143 :setter "cairo_pattern_set_filter"
144 :accessor pattern-filter
148 :getter "cairo_pattern_get_matrix"
149 :setter "cairo_pattern_set_matrix"
150 :accessor pattern-matrix
152 (:metaclass proxy-class))
154 (defclass context (proxy)
157 :getter "cairo_get_target"
162 :getter "cairo_get_source"
163 :setter "cairo_set_source"
168 :getter "cairo_get_antialias"
169 :setter "cairo_set_antialias"
174 :getter "cairo_get_tolerance"
175 :setter "cairo_set_tolerance"
180 :getter "cairo_get_fill_rule"
181 :setter "cairo_set_fill_rule"
186 :getter "cairo_get_line_width"
187 :setter "cairo_set_line_width"
192 :getter "cairo_get_line_cap"
193 :setter "cairo_set_line_cap"
198 :getter "cairo_get_line_join"
199 :setter "cairo_set_line_join"
204 :getter "cairo_get_miter_limit"
205 :setter "cairo_set_miter_limit"
206 :accessor miter-limit
210 :getter "cairo_get_font_matrix"
211 :setter "cairo_set_font_matrix"
212 :accessor font-matrix
216 :getter "cairo_get_font_options"
217 :setter "cairo_set_font_options"
218 :accessor font-options
222 :getter "cairo_get_font_face"
223 :setter "cairo_set_font_face"
228 :getter "cairo_get_operator"
229 :setter "cairo_set_operator"
235 :setter "cairo_set_matrix"
236 :writer (setf matrix)
239 (:metaclass proxy-class))
241 (defclass surface (proxy)
243 (:metaclass proxy-class))
245 (defclass image-surface (surface)
248 :getter "cairo_image_surface_get_width"
249 :reader surface-width
253 :getter "cairo_image_surface_get_height"
254 :reader surface-height
256 (:metaclass proxy-class))
258 ;; (defclass path (proxy)
260 ;; (:metaclass proxy-class))
267 (defbinding %reference () nil
270 (defbinding %destroy () nil
273 (defmethod reference-foreign ((class (eql (find-class 'context))) location)
274 (%reference location))
276 (defmethod unreference-foreign ((class (eql (find-class 'context))) location)
279 (defbinding (save-context "cairo_save") () nil
282 (defbinding (restore-context "cairo_restore") () nil
285 (defmacro with-context ((cr) &body body)
286 (let ((context (make-symbol "CONTEXT")))
287 `(let ((,context ,cr))
288 (save-context ,context)
291 (restore-context ,context)))))
293 (defbinding status () status
296 (defbinding (set-source-color "cairo_set_source_rgba") (cr red green blue &optional (alpha 1.0)) nil
301 (alpha double-float))
303 (defbinding set-source-surface () nil
309 (defbinding set-dash (cr dashes &optional (offset 0.0)) nil
311 (dashes (vector double-float))
312 ((length dashes) int)
313 (offset double-float))
315 (defbinding (paint "cairo_paint_with_alpha") (cr &optional (alpha 1.0)) nil
317 (alpha double-float))
319 (defbinding mask () nil
323 (defbinding mask-surface () nil
326 (surface-x double-float)
327 (surface-y double-float))
329 (defmacro defoperator (name &optional clip-p)
330 (let ((iname (intern (format nil "%~A" name)))
331 (pname (intern (format nil "%~A-PRESERVE" name))))
333 (defbinding ,iname () nil
335 (defbinding ,pname () nil
337 (defun ,name (cr &optional preserve)
342 (let ((tname (intern (format nil "IN-~A-P" name)))
343 (ename (intern (format nil "~A-EXTENTS" name))))
345 (defbinding ,tname () boolean
349 (defbinding ,ename () boolean
351 (x1 double-float :out)
352 (y1 double-float :out)
353 (x2 double-float :out)
354 (y2 double-float :out))))))))
360 (defbinding reset-clip () nil
363 (defbinding copy-page () nil
366 (defbinding show-page () nil
372 (defbinding get-current-point () nil
374 (x double-float :out)
375 (y double-float :out))
377 (defbinding new-path () nil
380 (defbinding close-path () nil
383 (defbinding arc () nil
387 (radius double-float)
388 (angle1 double-float)
389 (angle2 double-float))
391 (defbinding arc-negative () nil
395 (radius double-float)
396 (angle1 double-float)
397 (angle2 double-float))
399 (defun circle (cr x y radius)
400 (arc cr x y radius 0.0 (* pi 2)))
402 (defmacro defpath (name &rest args)
403 (let ((relname (intern (format nil "REL-~A" name))))
405 (defbinding ,name () nil
408 (defbinding ,relname () nil
428 (defbinding rectangle () nil
433 (height double-float))
435 (defbinding glyph-path (cr glyphs) nil
437 (glyphs (vector glyph))
438 ((length glyphs) int))
440 (defbinding text-path () nil
448 (defbinding (pattern-add-color-stop "cairo_pattern_add_color_stop_rgba")
449 (pattern offset red green blue &optional (alpha 1.0)) nil
451 (offset double-float)
455 (alpha double-float))
457 (defbinding (pattern-create "cairo_pattern_create_rgba")
458 (red green blue &optional (alpha 1.0)) pattern
462 (alpha double-float))
464 (defbinding pattern-create-for-surface () pattern
467 (defbinding pattern-create-linear () pattern
473 (defbinding pattern-create-radial () pattern
476 (radius0 double-float)
479 (radius1 double-float))
481 (defbinding %pattern-reference () nil
484 (defbinding %pattern-destroy () nil
487 (defmethod reference-foreign ((class (eql (find-class 'pattern))) location)
488 (%pattern-reference location))
490 (defmethod unreference-foreign ((class (eql (find-class 'pattern))) location)
491 (%pattern-destroy location))
493 (defbinding pattern-status () status
500 (defbinding translate () nil
505 (defbinding scale () nil
510 (defbinding rotate () nil
512 (angle double-float))
514 (defbinding transform () nil
518 (defbinding (matrix "cairo_get_matrix") () nil
520 ((make-instance 'matrix) matrix :return))
522 (defbinding identity-matrix () nil
525 (defbinding user-to-device () nil
527 (x double-float :in-out)
528 (y double-float :in-out))
530 (defbinding user-to-device-distance () nil
532 (dx double-float :in-out)
533 (dy double-float :in-out))
535 (defbinding device-to-user () nil
537 (x double-float :in-out)
538 (y double-float :in-out))
540 (defbinding device-to-user-distance () nil
542 (dx double-float :in-out)
543 (dy double-float :in-out))
548 (defbinding select-font-face () nil
552 (weight font-weight))
554 (defbinding set-font-size () nil
558 (defbinding show-text () nil
562 (defbinding show-glyphs () nil
564 (glyphs (vector glyph))
565 ((length glyphs) int))
567 (defbinding font-extents () boolean
570 (defbinding text-extents (cr text &optional (extents (make-instance 'text-extents))) nil
573 (extents text-extents :return))
575 (defbinding glyph-extents (cr glyphs &optional (extents (make-instance 'text-extents))) nil
577 (glyphs (vector glyph))
578 ((length glyphs) int)
579 (extents text-extents :return))
584 (defbinding %font-face-reference () nil
587 (defbinding %font-face-destroy () nil
590 (defmethod reference-foreign ((class (eql (find-class 'font-face))) location)
591 (%font-face-reference location))
593 (defmethod unreference-foreign ((class (eql (find-class 'font-face))) location)
594 (%font-face-destroy location))
596 (defbinding font-face-status () status
597 (font-face font-face))
603 (defbinding %scaled-font-reference () nil
606 (defbinding %scaled-font-destroy () nil
609 (defmethod reference-foreign ((class (eql (find-class 'scaled-font))) location)
610 (%scaled-font-reference location))
612 (defmethod unreference-foreign ((class (eql (find-class 'scaled-font))) location)
613 (%scaled-font-destroy location))
615 (defbinding scaled-font-status () status
616 (scaled-font scaled-font))
618 (defbinding scaled-font-extents (scaled-font &optional (extents (make-instance 'text-extents))) nil
619 (scaled-font scaled-font)
620 (extents text-extents :return))
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))
628 (defbinding %scaled-font-create () pointer
629 (font-face font-face)
632 (options font-options))
634 (defmethod initialize-instance ((scaled-font scaled-font) &key font-face font-matrix cmt options)
636 (slot-value scaled-font 'location)
637 (%scaled-font-create font-face font-matrix cmt options))
645 (defbinding %font-options-copy () nil
648 (defbinding %font-options-destroy () nil
651 (defmethod reference-foreign ((class (eql (find-class 'font-options))) location)
652 (%font-options-reference location))
654 (defmethod unreference-foreign ((class (eql (find-class 'font-options))) location)
655 (%font-options-destroy location))
657 (defbinding font-options-status () status
658 (font-options font-options))
660 (defbinding %font-options-create () pointer)
662 (defmethod initialize-instance ((font-options font-options) &rest initargs)
663 (declare (ignore initargs))
664 (setf (slot-value font-options 'location) (%font-options-create))
667 (defbinding font-options-merge () nil
668 (options1 font-options :return)
669 (options2 font-options))
671 (defbinding font-options-hash () unsigned-int
672 (options font-options))
674 (defbinding font-options-equal-p () boolean
675 (options1 font-options)
676 (options2 font-options))
682 (defbinding %surface-reference () nil
685 (defbinding %surface-destroy () nil
688 (defmethod reference-foreign ((class (eql (find-class 'surface))) location)
689 (%surface-reference location))
691 (defmethod unreference-foreign ((class (eql (find-class 'surface))) location)
692 (%surface-destroy location))
694 (defbinding surface-create-similar () surface
696 (format surface-format )
700 (defbinding surface-finish () nil
703 (defbinding surface-flush () nil
706 (defbinding surface-get-font-options () nil
708 ((make-instance 'font-options) font-options :return))
710 (defbinding surface-set-device-offset () nil
712 (x-offset double-float)
713 (y-offset double-float))
715 (defbinding surface-status () status
718 (defbinding %surface-mark-dirty () nil
721 (defbinding %surface-mark-dirty-rectangle () nil
728 (defun surface-mark-dirty (surface &optional x y width height)
730 (%surface-mark-dirty-rectangle surface x y width height)
731 (%surface-mark-dirty surface)))
737 ;; Should data be automatically freed when the surface is GCed?
738 (defmethod initialize-instance ((surface image-surface)
739 &key width height stride format data)
741 (slot-value surface 'location)
743 (%image-surface-create format width height)
744 (%image-surface-create-for-data data format width height
747 (let ((element-size (cdr (assoc format '((:argb32 . 4) (:rgb24 . 4) (:a8 . 1) (:a1 1/8))))))
748 (ceiling (* width element-size)))))))
752 (defbinding %image-surface-create () image-surface
753 (format surface-format)
757 (defbinding %image-surface-create-for-data () image-surface
759 (format surface-format)
768 (defbinding image-surface-create-from-png (filename) image-surface
769 ((truename filename) pathname))
776 (defbinding matrix-init () nil
777 (matrix matrix :return)
778 (xx double-float) (yx double-float)
779 (xy double-float) (yy double-float)
780 (x0 double-float) (y0 double-float))
782 (defbinding matrix-init-identity () nil
783 (matrix matrix :return))
785 (defbinding matrix-init-translate () nil
786 (matrix matrix :return)
790 (defbinding matrix-init-scale () nil
791 (matrix matrix :return)
795 (defbinding matrix-init-rotate () nil
796 (matrix matrix :return)
797 (radians double-float))
799 (defbinding matrix-translate () nil
800 (matrix matrix :return)
804 (defbinding matrix-scale () nil
805 (matrix matrix :return)
809 (defbinding matrix-rotate () nil
810 (matrix matrix :return)
811 (radians double-float))
813 (defbinding matrix-invert () nil
814 (matrix matrix :return))
816 (defbinding matrix-multiply () nil
821 (defbinding matrix-transform-distance () nil
822 (matrix matrix :return)
826 (defbinding matrix-transform-point () nil
827 (matrix matrix :return)