chiark / gitweb /
Changed to use of settable FOREIGN-LOCATION
[clg] / rsvg / rsvg.lisp
CommitLineData
1ed0a2c5 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
cc74b2c9 23;; $Id: rsvg.lisp,v 1.2 2006-02-08 22:21:26 espen Exp $
1ed0a2c5 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)
cc74b2c9 121 (setf (foreign-location handle) location)))
1ed0a2c5 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))