chiark / gitweb /
489ef4cfe6d41bebfbb84c37d87a6f45099316e2
[clg] / rsvg / rsvg.lisp
1 ;; Common Lisp bindings for librsvg
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
23 ;; $Id: rsvg.lisp,v 1.2 2006-02-08 22:21:26 espen Exp $
24
25 (in-package "RSVG")
26
27
28 (eval-when (:compile-toplevel :load-toplevel :execute)
29   
30   (defclass dimension-data (struct)
31     ((width
32       :allocation :alien 
33       :initarg :width
34       :accessor dimension-data-width
35       :type int)
36      (height
37       :allocation :alien 
38       :initarg :height
39       :accessor dimension-data-height
40       :type int)
41      (em
42       :allocation :alien 
43       :initarg :em
44       :accessor dimension-data-em
45       :type double-float)
46      (ex
47       :allocation :alien 
48       :initarg :ex
49       :accessor dimension-data-ex
50       :type double-float))
51     (:metaclass struct-class))
52
53
54   (defclass handle (proxy)
55     ((base-uri
56       :allocation :virtual 
57       :getter "rsvg_handle_get_base_uri"
58       :setter "rsvg_handle_set_base_uri"
59       :accessor handle-base-uri
60       :type string)
61      (dimensions
62       :allocation :virtual 
63       :getter handle-get-dimensions
64       :reader handle-dimensions
65       :type dimension-data)
66      (title
67       :allocation :virtual 
68       :getter "rsvg_handle_get_title"
69       :reader handle-title
70       :type string)
71      (description
72       :allocation :virtual 
73       :getter "rsvg_handle_get_desc"
74       :reader handle-description
75       :type string)
76      (metadata
77       :allocation :virtual 
78       :getter "rsvg_handle_get_metadata"
79       :reader handle-metadata
80       :type string))
81     (:metaclass proxy-class))
82
83 )
84
85 (defbinding init () nil)
86 (defbinding term () nil)
87
88 (defbinding set-default-dpi () nil
89   (dpi-x double-float)
90   (dpi-y double-float))
91
92 (defbinding handle-set-dpi () nil
93   (handle handle)
94   (dpi-x double-float)
95   (dpi-y double-float))
96
97
98 (defbinding handle-get-dimensions (handle &optional (dimensions (make-instance 'dimension-data))) nil
99   (handle handle)
100   (dimensions dimension-data :return))
101
102
103
104 (defbinding handle-close () boolean
105   (handle handle)
106   (nil gerror :out))
107
108 (defbinding %handle-new () pointer)
109
110 (defbinding %handle-new-from-file () pointer
111   (filename pathname)
112   (nil gerror :out))
113
114 (defmethod initialize-instance ((handle handle) &key filename)
115   (multiple-value-bind (location gerror)
116       (cond 
117        (filename (%handle-new-from-file filename))
118        (t (%handle-new)))
119     (if gerror 
120         (signal-gerror gerror)
121       (setf (foreign-location handle) location)))
122   (call-next-method))
123
124
125 (defbinding %handle-free () nil
126   (location pointer))
127
128 (defmethod unreference-foreign ((class (eql (find-class 'handle))) location)
129   (%handle-free location))
130
131
132
133
134 ;;; Cairo interface
135
136 (defbinding cairo-render () nil
137   (cr cairo:context)
138   (handle handle))