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.10 2007/01/13 00:15:36 espen Exp $
27 (eval-when (:compile-toplevel :load-toplevel :execute)
28 (define-enum-type surface-format :argb32 :rgb24 :a8 :a1)
29 #?(pkg-exists-p "cairo" :atleast-version "1.2")
30 (define-enum-type content :color :alpha :color-alpha)
31 #?(pkg-exists-p "cairo" :atleast-version "1.2")
32 (define-enum-type surface-type
33 :image :pdf :ps :xlib :xcb :glitz :quartz :win32 :beos :directfb
37 (define-enum-type status
38 :success :no-memory :invalid-restore :invalid-pop-group
39 :no-current-point :invalid-matrix :invalid-status :null-pointer
40 :invalid-string :invalid-path-data :read-error :write-error
41 :surface-finished :surface-type-mismatch :pattern-type-mismatch
42 :invalid-content :invalid-format :invalid-visual :file-not-found
45 (define-enum-type fill-rule :winding :even-odd)
46 (define-enum-type line-cap :butt :round :square)
47 (define-enum-type line-join :miter :round :bevel)
48 (define-enum-type font-slant :normal :itaic :oblique)
49 (define-enum-type font-weight :normal :bold)
51 (define-enum-type operator
52 :clear :source :over :in :out :atop :dest :dest-over
53 :dest-in :dest-out :dest-atop :xor :add :saturate)
55 (define-enum-type antialias :default :none :gray :subpixel)
56 (define-enum-type extend :none :repeat :reflect)
57 (define-enum-type filter :fast :good :best :nearest :bilinear :gaussian)
58 (define-enum-type subpixel-order :default :rgb :bgr :vrgb :vbgr)
59 (define-enum-type hint-style :default :none :slight :medium :full)
60 (define-enum-type hint-metrics :default :off :on)
62 (defclass glyph (struct)
78 (:metaclass struct-class))
80 (defclass font-face (ref-counted-object)
82 (:metaclass proxy-class)
83 (:ref %font-face-reference)
84 (:unref %font-face-destroy))
86 (defclass font-options (ref-counted-object)
89 :getter "font_options_get_antialias"
90 :setter "font_options_set_antialias"
91 :accessor font-options-antialias
95 :getter "font_options_get_subpixel_order"
96 :setter "font_options_set_subpixel_order"
97 :accessor font-options-subpixel-order
101 :getter "font_options_get_hint_style"
102 :setter "font_options_set_hint_style"
103 :accessor font-options-hint-style
107 :getter "font_options_get_hint_metrics"
108 :setter "font_options_set_hint_metrics"
109 :accessor font-options-hint-metrics
111 (:metaclass proxy-class)
112 (:ref %font-options-reference)
113 (:unref %font-options-destroy))
115 (defclass scaled-font (ref-counted-object)
117 (:metaclass proxy-class)
118 (:ref %scaled-font-reference)
119 (:unref %scaled-font-destroy))
121 (defclass matrix (struct)
122 ((xx :allocation :alien :initarg :xx :initform 1.0
123 :accessor matrix-xx :type double-float)
124 (yx :allocation :alien :initarg :yx :initform 0.0
125 :accessor matrix-yx :type double-float)
126 (xy :allocation :alien :initarg :xy :initform 1.0
127 :accessor matrix-xy :type double-float)
128 (yy :allocation :alien :initarg :yy :initform 0.0
129 :accessor matrix-yy :type double-float)
130 (x0 :allocation :alien :initarg :x0 :initform 0.0
131 :accessor matrix-x0 :type double-float)
132 (y0 :allocation :alien :initarg :y0 :initform 0.0
133 :accessor matrix-y0 :type double-float))
134 (:metaclass struct-class))
137 (defclass text-extents (struct)
138 ((x-bearing :allocation :alien :reader text-extents-x-bearing :type double-float)
139 (y-bearing :allocation :alien :reader text-extents-y-bearing :type double-float)
140 (width :allocation :alien :reader text-extents-width :type double-float)
141 (height :allocation :alien :reader text-extents-height :type double-float)
142 (x-advance :allocation :alien :reader text-extents-x-advance :type double-float)
143 (y-advance :allocation :alien :reader text-extents-y-advance :type double-float))
144 (:metaclass struct-class))
146 (defclass pattern (ref-counted-object)
149 :getter "cairo_pattern_get_extend"
150 :setter "cairo_pattern_set_extend"
151 :accessor pattern-extend
155 :getter "cairo_pattern_get_filter"
156 :setter "cairo_pattern_set_filter"
157 :accessor pattern-filter
161 :getter "cairo_pattern_get_matrix"
162 :setter "cairo_pattern_set_matrix"
163 :accessor pattern-matrix
165 (:metaclass proxy-class)
166 (:ref %pattern-reference)
167 (:unref %pattern-destroy))
170 (defclass surface (ref-counted-object)
171 (#?(pkg-exists-p "cairo" :atleast-version "1.2")
174 :getter "cairo_surface_get_type"
177 #?(pkg-exists-p "cairo" :atleast-version "1.2")
180 :getter "cairo_surface_get_content"
181 :reader surface-content
183 (:metaclass proxy-class)
184 (:ref %surface-reference)
185 (:unref %surface-destroy))
187 (defclass context (ref-counted-object)
190 :getter "cairo_get_target"
195 :getter "cairo_get_source"
196 :setter "cairo_set_source"
201 :getter "cairo_get_antialias"
202 :setter "cairo_set_antialias"
207 :getter "cairo_get_tolerance"
208 :setter "cairo_set_tolerance"
213 :getter "cairo_get_fill_rule"
214 :setter "cairo_set_fill_rule"
219 :getter "cairo_get_line_width"
220 :setter "cairo_set_line_width"
225 :getter "cairo_get_line_cap"
226 :setter "cairo_set_line_cap"
231 :getter "cairo_get_line_join"
232 :setter "cairo_set_line_join"
237 :getter "cairo_get_miter_limit"
238 :setter "cairo_set_miter_limit"
239 :accessor miter-limit
243 :getter "cairo_get_font_matrix"
244 :setter "cairo_set_font_matrix"
245 :accessor font-matrix
249 :getter "cairo_get_font_options"
250 :setter "cairo_set_font_options"
251 :accessor font-options
255 :getter "cairo_get_font_face"
256 :setter "cairo_set_font_face"
261 :getter "cairo_get_operator"
262 :setter "cairo_set_operator"
268 :setter "cairo_set_matrix"
269 :writer (setf matrix)
272 (:metaclass proxy-class)
276 (defclass image-surface (surface)
277 (#?(pkg-exists-p "cairo" :atleast-version "1.2")
280 :getter "cairo_image_surface_get_data"
283 #?(pkg-exists-p "cairo" :atleast-version "1.2")
286 :getter "cairo_image_surface_get_format"
287 :reader surface-format
288 :type surface-format)
291 :getter "cairo_image_surface_get_width"
292 :reader surface-width
296 :getter "cairo_image_surface_get_height"
297 :reader surface-height
299 #?(pkg-exists-p "cairo" :atleast-version "1.2")
302 :getter "cairo_image_surface_get_stride"
303 :reader surface-height
305 (:metaclass proxy-class))
307 #?(pkg-exists-p "cairo" :atleast-version "1.2")
309 (defclass xlib-surface (surface)
312 :getter "cairo_xlib_surface_get_width"
313 :reader surface-width
317 :getter "cairo_xlib_surface_get_height"
318 :reader surface-height
320 (:metaclass proxy-class))
322 (defclass pdf-surface (surface)
324 (:metaclass proxy-class))
326 (defclass ps-surface (surface)
328 (:metaclass proxy-class))
330 (defclass svg-surface (surface)
332 (:metaclass proxy-class)))
336 ;; (defclass path (proxy)
338 ;; (:metaclass proxy-class))
345 (defbinding %reference () pointer
348 (defbinding %destroy () nil
351 (defbinding (save-context "cairo_save") () nil
354 (defbinding (restore-context "cairo_restore") () nil
357 (defmacro with-context ((cr) &body body)
358 (let ((context (make-symbol "CONTEXT")))
359 `(let ((,context ,cr))
360 (save-context ,context)
363 (restore-context ,context)))))
365 (defbinding status () status
368 (defun ensure-color-component (component)
371 (integer (/ component 256.0))))
373 (defbinding (set-source-color "cairo_set_source_rgba") (cr red green blue &optional (alpha 1.0)) nil
375 ((ensure-color-component red) double-float)
376 ((ensure-color-component green) double-float)
377 ((ensure-color-component blue) double-float)
378 ((ensure-color-component alpha) double-float))
380 (defbinding set-source-surface (cr surface &optional (x 0.0) (y 0.0)) nil
386 (defun set-source (cr source)
388 (pattern (setf (source cr) source))
389 (surface (set-source-surface cr source))
390 (list (apply #'set-source-color cr source))
391 (vector (apply #'set-source-color cr (coerce source 'list)))
392 (null (set-source-color cr 0.0 0.0 0.0))))
394 (defbinding set-dash (cr dashes &optional (offset 0.0)) nil
396 (dashes (vector double-float))
397 ((length dashes) int)
398 (offset double-float))
400 (defbinding (paint "cairo_paint_with_alpha") (cr &optional (alpha 1.0)) nil
402 (alpha double-float))
404 (defbinding mask () nil
408 (defbinding mask-surface () nil
411 (surface-x double-float)
412 (surface-y double-float))
414 (defmacro defoperator (name &optional clip-p)
415 (let ((iname (intern (format nil "%~A" name)))
416 (pname (intern (format nil "%~A-PRESERVE" name))))
418 (defbinding ,iname () nil
420 (defbinding ,pname () nil
422 (defun ,name (cr &optional preserve)
427 (let ((tname (intern (format nil "IN-~A-P" name)))
428 (ename (intern (format nil "~A-EXTENTS" name))))
430 (defbinding ,tname () boolean
434 (defbinding ,ename () nil
436 (x1 double-float :out)
437 (y1 double-float :out)
438 (x2 double-float :out)
439 (y2 double-float :out))))))))
445 (defbinding reset-clip () nil
448 (defbinding copy-page () nil
451 (defbinding show-page () nil
457 (defbinding get-current-point () nil
459 (x double-float :out)
460 (y double-float :out))
462 (defbinding new-path () nil
465 #?(pkg-exists-p "cairo" :atleast-version "1.2")
466 (defbinding new-sub-path () nil
469 (defbinding close-path () nil
472 (defmacro defpath (name args &optional relative-p)
473 (flet ((def (name type)
475 ,(when (eq type 'optimized-double-float)
476 `(declaim (ftype (function (context ,@(loop repeat (length args) collect 'double-float))) ,(first name))))
477 (defbinding ,name () nil
479 ,@(mapcar #'(lambda (arg) (list arg type)) args)))))
482 ,(def name 'double-float)
483 ,(let ((name (intern (format nil "FAST-~A" name)))
484 (cname (gffi::default-alien-fname name)))
485 (def (list name cname) 'optimized-double-float))
487 (let* ((rel-name (intern (format nil "REL-~A" name)))
488 (fast-rel-name (intern (format nil "FAST-REL-~A" name)))
489 (cname (gffi::default-alien-fname rel-name)))
491 (def rel-name 'double-float)
492 (def (list fast-rel-name cname) 'optimized-double-float)))))))
495 (defpath arc (xc yc radius angle1 angle2))
496 (defpath arc-negative (xc yc radius angle1 angle2))
497 (defpath curve-to (x1 y1 x2 y2 x3 y3) t)
498 (defpath line-to (x y) t)
499 (defpath move-to (x y) t)
500 (defpath rectangle (x y width height))
502 (defun circle (cr x y radius)
503 (arc cr x y radius 0.0 (* pi 2)))
505 (defbinding glyph-path (cr glyphs) nil
507 (glyphs (vector glyph))
508 ((length glyphs) int))
510 (defbinding text-path () nil
518 (defbinding (pattern-add-color-stop "cairo_pattern_add_color_stop_rgba")
519 (pattern offset red green blue &optional (alpha 1.0)) nil
521 (offset double-float)
522 ((ensure-color-component red) double-float)
523 ((ensure-color-component green) double-float)
524 ((ensure-color-component blue) double-float)
525 ((ensure-color-component alpha) double-float))
527 (defbinding (pattern-create "cairo_pattern_create_rgba")
528 (red green blue &optional (alpha 1.0)) pattern
529 ((ensure-color-component red) double-float)
530 ((ensure-color-component green) double-float)
531 ((ensure-color-component blue) double-float)
532 ((ensure-color-component alpha) double-float))
534 (defbinding pattern-create-for-surface () pattern
537 (defbinding pattern-create-linear () pattern
543 (defbinding pattern-create-radial () pattern
546 (radius0 double-float)
549 (radius1 double-float))
551 (defbinding %pattern-reference () pointer
554 (defbinding %pattern-destroy () nil
557 (defbinding pattern-status () status
564 (defbinding translate () nil
569 (defbinding scale (cr sx &optional (sy sx)) nil
574 (defun scale-to-device (cr &optional keep-rotation-p)
576 (multiple-value-call #'scale cr (device-to-user-distance cr 1.0))
577 (multiple-value-bind (x y)
578 (multiple-value-call #'user-to-device cr (get-current-point cr))
580 (translate cr x y))))
582 (defbinding rotate () nil
584 (angle double-float))
586 (defbinding transform () nil
590 (defbinding (matrix "cairo_get_matrix") () nil
592 ((make-instance 'matrix) matrix :in/return))
594 (defbinding identity-matrix () nil
597 (defbinding user-to-device () nil
599 (x double-float :in/out)
600 (y double-float :in/out))
602 (defbinding user-to-device-distance (cr dx &optional (dy dx)) nil
604 (dx double-float :in/out)
605 (dy double-float :in/out))
607 (defbinding device-to-user () nil
609 (x double-float :in/out)
610 (y double-float :in/out))
612 (defbinding device-to-user-distance (cr dx &optional (dy dx)) nil
614 (dx double-float :in/out)
615 (dy double-float :in/out))
620 (defbinding select-font-face () nil
624 (weight font-weight))
626 (defbinding set-font-size () nil
630 (defbinding show-text () nil
634 (defbinding show-glyphs () nil
636 (glyphs (vector glyph))
637 ((length glyphs) int))
639 (defbinding font-extents () boolean
642 (defbinding text-extents (cr text &optional (extents (make-instance 'text-extents))) nil
645 (extents text-extents :in/return))
647 (defbinding glyph-extents (cr glyphs &optional (extents (make-instance 'text-extents))) nil
649 (glyphs (vector glyph))
650 ((length glyphs) int)
651 (extents text-extents :in/return))
656 (defbinding %font-face-reference () pointer
659 (defbinding %font-face-destroy () nil
662 (defbinding font-face-status () status
663 (font-face font-face))
669 (defbinding %scaled-font-reference () pointer
672 (defbinding %scaled-font-destroy () nil
675 (defbinding scaled-font-status () status
676 (scaled-font scaled-font))
678 (defbinding scaled-font-extents (scaled-font &optional (extents (make-instance 'text-extents))) nil
679 (scaled-font scaled-font)
680 (extents text-extents :in/return))
682 (defbinding scaled-font-glyph-extents (scaled-font glyphs &optional (extents (make-instance 'text-extents))) nil
683 (scaled-font scaled-font)
684 (glyphs (vector glyph))
685 ((length glyphs) int)
686 (extents text-extents :in/return))
688 (defbinding %scaled-font-create () pointer
689 (font-face font-face)
692 (options font-options))
694 (defmethod allocate-foreign ((scaled-font scaled-font) &key font-face font-matrix cmt options)
695 (%scaled-font-create font-face font-matrix cmt options))
702 (defbinding %font-options-copy () nil
705 (defbinding %font-options-destroy () nil
708 (defbinding font-options-status () status
709 (font-options font-options))
711 (defbinding %font-options-create () pointer)
713 (defmethod allocate-foreign ((font-options font-options) &rest initargs)
714 (declare (ignore initargs))
715 (%font-options-create))
717 (defbinding font-options-merge () nil
718 (options1 font-options :in/return)
719 (options2 font-options))
721 (defbinding font-options-hash () unsigned-int
722 (options font-options))
724 (defbinding font-options-equal-p () boolean
725 (options1 font-options)
726 (options2 font-options))
732 (defbinding %surface-reference () pointer
735 (defbinding %surface-destroy () nil
738 (defbinding surface-create-similar () surface
740 (format surface-format )
744 (defbinding surface-finish () nil
747 (defbinding surface-flush () nil
750 (defbinding surface-get-font-options () nil
752 ((make-instance 'font-options) font-options :in/return))
754 (defbinding surface-set-device-offset () nil
756 (x-offset double-float)
757 (y-offset double-float))
759 (defbinding surface-status () status
762 (defbinding %surface-mark-dirty () nil
765 (defbinding %surface-mark-dirty-rectangle () nil
772 (defun surface-mark-dirty (surface &optional x y width height)
774 (%surface-mark-dirty-rectangle surface x y width height)
775 (%surface-mark-dirty surface)))
777 #?(pkg-exists-p "cairo" :atleast-version "1.2")
778 (defbinding surface-set-fallback-resolution () nil
780 (x-pixels-per-inch double-float)
781 (y-pixels-per-inch double-float))
786 ;; Should data be automatically freed when the surface is GCed?
787 (defmethod allocate-foreign ((surface image-surface)
788 &key width height stride format data)
790 (%image-surface-create format width height)
791 (%image-surface-create-for-data data format width height
794 (let ((element-size (cdr (assoc format '((:argb32 . 4) (:rgb24 . 4) (:a8 . 1) (:a1 1/8))))))
795 (ceiling (* width element-size)))))))
798 (defbinding %image-surface-create () image-surface
799 (format surface-format)
803 (defbinding %image-surface-create-for-data () image-surface
805 (format surface-format)
814 (defbinding image-surface-create-from-png (filename) image-surface
815 ((truename filename) pathname))
822 (defbinding matrix-init () nil
823 (matrix matrix :in/return)
824 (xx double-float) (yx double-float)
825 (xy double-float) (yy double-float)
826 (x0 double-float) (y0 double-float))
828 (defbinding matrix-init-identity () nil
829 (matrix matrix :in/return))
831 (defbinding matrix-init-translate () nil
832 (matrix matrix :in/return)
836 (defbinding matrix-init-scale () nil
837 (matrix matrix :in/return)
841 (defbinding matrix-init-rotate () nil
842 (matrix matrix :in/return)
843 (radians double-float))
845 (defbinding matrix-translate () nil
846 (matrix matrix :in/return)
850 (defbinding matrix-scale () nil
851 (matrix matrix :in/return)
855 (defbinding matrix-rotate () nil
856 (matrix matrix :in/return)
857 (radians double-float))
859 (defbinding matrix-invert () nil
860 (matrix matrix :in/return))
862 (defbinding matrix-multiply () nil
867 (defbinding matrix-transform-distance () nil
868 (matrix matrix :in/return)
872 (defbinding matrix-transform-point () nil
873 (matrix matrix :in/return)