chiark / gitweb /
Infra: Rudimentary setup system.
[clg] / pango / pango.lisp
CommitLineData
112ac1d3 1;; Common Lisp bindings for GTK+ v2.x
8aa46cc4 2;; Copyright 2001-2006 Espen S. Johnsen <espen@users.sf.net>
80abc067 3;;
112ac1d3 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:
80abc067 11;;
112ac1d3 12;; The above copyright notice and this permission notice shall be
13;; included in all copies or substantial portions of the Software.
80abc067 14;;
112ac1d3 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.
80abc067 22
233850de 23;; $Id: pango.lisp,v 1.16 2007-10-17 18:07:32 espen Exp $
80abc067 24
25(in-package "PANGO")
26
233850de 27(defconstant +pango-scale+ 1024)
28
29(defun device-to-pango-units (device-units)
30 (round (* device-units +pango-scale+)))
31
80abc067 32(eval-when (:compile-toplevel :load-toplevel :execute)
8f12a0ff 33 (init-types-in-library pango "libpango-1.0" :prefix "pango_")
34 (init-types-in-library pango "libpangoxft-1.0" :prefix "pango_xft")
35 (init-types-in-library pango "libpangoft2-1.0" :prefix "pango_fc")
36 (init-types-in-library pango "libpangocairo-1.0" :prefix "pango_cairo"))
8aa46cc4 37
80abc067 38
d9c8ae6d 39(eval-when (:compile-toplevel :load-toplevel :execute)
0411aa67 40 (define-types-by-introspection "Pango"))
41
42(defclass font-description (boxed)
43 ((family
44 :allocation :virtual
acbc115a 45 :initarg :family :initform "Sans"
0411aa67 46 :getter "pango_font_description_get_family"
47 :setter "pango_font_description_set_family"
48 :boundp %font-description-family-boundp
49 :makunbound %font-description-family-makunbound
50 :accessor font-description-family
acbc115a 51 :type (static string))
0411aa67 52 (style
53 :allocation :virtual
acbc115a 54 :initarg :style :initform :normal
0411aa67 55 :getter "pango_font_description_get_style"
56 :setter "pango_font_description_set_style"
57 :boundp %font-description-style-boundp
58 :makunbound %font-description-style-makunbound
59 :accessor font-description-style
60 :type style)
61 (variant
62 :allocation :virtual
acbc115a 63 :initarg :variant :initform :normal
0411aa67 64 :getter "pango_font_description_get_variant"
65 :setter "pango_font_description_set_variant"
66 :boundp %font-description-variant-boundp
67 :makunbound %font-description-variant-makunbound
68 :accessor font-description-variant
69 :type variant)
70 (weight
acbc115a 71 :allocation :virtual :initform :normal
0411aa67 72 :initarg :weight
73 :getter "pango_font_description_get_weight"
74 :setter "pango_font_description_set_weight"
75 :boundp %font-description-weight-boundp
76 :makunbound %font-description-weight-makunbound
77 :accessor font-description-weight
78 :type weight)
79 (stretch
acbc115a 80 :allocation :virtual :initform :normal
0411aa67 81 :initarg :stretch
82 :getter "pango_font_description_get_stretch"
83 :setter "pango_font_description_set_stretch"
84 :boundp %font-description-stretch-boundp
85 :makunbound %font-description-stretch-makbound
86 :accessor font-description-stretch
87 :type stretch)
88 (size
89 :allocation :virtual
acbc115a 90; :initarg :size :initform 16 ; handled by initialize instance
91; :setter (setf font-description-size)
92 :setter %set-font-description-size
0411aa67 93 :getter "pango_font_description_get_size"
94 :boundp %font-description-size-boundp
95 :makunbound %font-description-size-makunbound
96 :reader font-description-size
97 :type integer)
98 #?(pkg-exists-p "pango" :atleast-version "1.8.0")
acbc115a 99 (size-is-absolute-p
0411aa67 100 :allocation :virtual
acbc115a 101; :initarg :size-is-absolute :initform nil ; handled by initialize instance
0411aa67 102 :getter "pango_font_description_get_size_is_absolute"
103 :boundp %font-description-size-boundp
104 :reader font-description-size-is-absolute-p
105 :type boolean))
106 (:metaclass boxed-class))
107
108(defclass layout (gobject)
109 ((context
110 :allocation :virtual
111 :getter "pango_layout_get_context"
112 :reader layout-context
113 :type context)
114 (text
115 :allocation :virtual
acbc115a 116 :initarg :text
0411aa67 117 :getter "pango_layout_get_text"
118 :setter %layout-set-text
119 :accessor layout-text
acbc115a 120 :type (static string))
0411aa67 121 (attributes
122 :allocation :virtual
123 :initarg :attributes
124 :getter "pango_layout_get_attributes"
125 :setter "pango_layout_set_attributes"
126 :accessor layout-attributes
127 :type attr-list)
128 (font-description
129 :allocation :virtual
130 :initarg :font-description
131 :getter "pango_layout_get_font_description"
132 :setter "pango_layout_set_font_description"
133 :accessor layout-font-description
134 :type font-description)
135 (width
136 :allocation :virtual
137 :initarg :width
138 :getter "pango_layout_get_width"
139 :setter "pango_layout_set_width"
acbc115a 140 :unbound -1
0411aa67 141 :accessor layout-width
142 :type int)
143 (wrap
144 :allocation :virtual
145 :initarg :wrap
146 :getter "pango_layout_get_wrap"
147 :setter "pango_layout_set_wrap"
148 :accessor layout-wrap
149 :type wrap-mode)
150 (ellipsize
151 :allocation :virtual
152 :initarg :ellipsize
153 :getter "pango_layout_get_ellipsize"
154 :setter "pango_layout_set_ellipsize"
155 :accessor layout-ellipsize
156 :type ellipsize-mode)
157 (indent
158 :allocation :virtual
159 :initarg :indent
160 :getter "pango_layout_get_indent"
233850de 161 :setter "pango_layout_set_indent"
0411aa67 162 :accessor layout-indent
163 :type int)
164 (spacing
165 :allocation :virtual
166 :initarg :spacing
167 :getter "pango_layout_get_spacing"
168 :setter "pango_layout_set_spacing"
169 :accessor layout-spacing
170 :type int)
171 (justify
172 :allocation :virtual
173 :initarg :justify
174 :getter "pango_layout_get_justify"
175 :setter "pango_layout_set_justify"
176 :accessor layout-justify-p
177 :type boolean)
178 (auto-dir
179 :allocation :virtual
180 :initarg :auto-dir
181 :getter "pango_layout_get_auto_dir"
182 :setter "pango_layout_set_auto_dir"
183 :accessor layout-auto-dir-p
184 :type boolean)
185 (alignment
186 :allocation :virtual
187 :initarg :alignment
188 :getter "pango_layout_get_alignment"
189 :setter "pango_layout_set_alignment"
190 :accessor layout-alignment
191 :type alignment)
acbc115a 192 (tabs
0411aa67 193 :allocation :virtual
acbc115a 194 :initarg :tabs
195 :getter "pango_layout_get_tabs"
196 :setter "pango_layout_set_tabs"
197 :accessor layout-tabs
0411aa67 198 :type tab-array)
199 (single-paragraph
200 :allocation :virtual
201 :initarg :single-paragraph
202 :getter "pango_layout_get_single_paragraph_mode"
203 :setter "pango_layout_set_single_paragraph_mode"
204 :accessor layout-single-paragraph-p
205 :type boolean))
206 (:metaclass gobject-class))
207
208(defclass cairo-font-map (interface)
209 ((resolution
210 :allocation :virtual
211 :getter "pango_cairo_font_map_get_resolution"
212 :setter "pango_cairo_font_map_set_resolution"
213 :accessor cairo-font-map-resolution
214 :type double-float))
215 (:metaclass interface-class))
216
8aa46cc4 217
0411aa67 218;;;; Font description
8aa46cc4 219
acbc115a 220(defmethod initialize-instance ((desc font-description) &key (size 16) size-is-absolute)
8aa46cc4 221 (call-next-method)
acbc115a 222 (setf (font-description-size desc size-is-absolute) size))
8aa46cc4 223
224(defbinding %font-description-new () pointer)
225
226(defmethod allocate-foreign ((desc font-description) &rest initargs)
227 (declare (ignore initargs))
228 (%font-description-new))
229
230(defbinding %font-description-get-set-fields () font-mask
231 (desc font-description))
232
233(defun %font-description-family-boundp (desc)
234 (find :family (%font-description-get-set-fields desc)))
235
236(defun %font-description-style-boundp (desc)
237 (find :style (%font-description-get-set-fields desc)))
238
239(defun %font-description-variant-boundp (desc)
240 (find :variant (%font-description-get-set-fields desc)))
241
242(defun %font-description-weight-boundp (desc)
243 (find :weight (%font-description-get-set-fields desc)))
244
245(defun %font-description-stretch-boundp (desc)
246 (find :stretch (%font-description-get-set-fields desc)))
247
248(defun %font-description-size-boundp (desc)
249 (find :size (%font-description-get-set-fields desc)))
250
251(defbinding %font-description-unset-fields () nil
252 (desc font-description)
253 (mask font-mask))
254
255(defun %font-description-family-makunbound (desc)
256 (%font-description-unset-fields desc :family))
257
258(defun %font-description-style-makunbound (desc)
259 (%font-description-unset-fields desc :style))
260
261(defun %font-description-variant-makunbound (desc)
262 (%font-description-unset-fields desc :variant))
263
264(defun %font-description-weight-makunbound (desc)
265 (%font-description-unset-fields desc :weight))
266
267(defun %font-description-stretch-makunbound (desc)
268 (%font-description-unset-fields desc :stretch))
269
270(defun %font-description-size-makunbound (desc)
271 (%font-description-unset-fields desc :size))
272
273(defbinding %font-description-set-size () nil
274 (desc font-description)
275 (size int))
276
277#?(pkg-exists-p "pango" :atleast-version "1.8.0")
278(defbinding %font-description-set-absolute-size () nil
279 (desc font-description)
280 (size double-float))
281
acbc115a 282(defun (setf font-description-size) (size desc &optional (absolute-p nil absolute-given-p))
283 (cond
284 (absolute-p
8aa46cc4 285 #?(pkg-exists-p "pango" :atleast-version "1.8.0")
286 (%font-description-set-absolute-size desc size)
287 #?-(pkg-exists-p "pango" :atleast-version "1.8.0")
acbc115a 288 (error "Setting of absolute font size requires at least Pango 1.8.0"))
289 (#?(pkg-exists-p "pango" :atleast-version "1.8.0") absolute-given-p
290 #?-(pkg-exists-p "pango" :atleast-version "1.8.0") t
291 (%font-description-set-size desc size))
292 #?(pkg-exists-p "pango" :atleast-version "1.8.0")
293 (t (if (font-description-size-is-absolute-p desc)
294 (%font-description-set-absolute-size desc size)
295 (%font-description-set-size desc size))))
296 size)
297
298(defun %set-font-description-size (size desc)
299 (setf (font-description-size desc) size))
8aa46cc4 300
301(defbinding font-description-merge (desc merge-desc &optional replace-p) nil
302 (desc font-description)
303 (merge-desc font-description)
304 (replace-p boolean))
305
306(defbinding font-description-better-match () boolean
307 (desc font-description)
308 (old-math font-description)
309 (new-math font-description))
d9c8ae6d 310
311(defbinding font-description-from-string () font-description
312 (desc string))
313
8aa46cc4 314(defbinding font-description-to-string () string
315 (desc font-description))
0411aa67 316
acbc115a 317(defbinding font-description-copy () font-description
318 (font-description font-description))
319
320(defun ensure-font-description (font-description &optional copy-p)
321 (etypecase font-description
322 (font-description (if copy-p
323 (font-description-copy font-description)
324 font-description))
325 (string (font-description-from-string font-description))
326 (list (apply #'make-instance 'font-description font-description))))
327
0411aa67 328
329;;;; Layout
330
331(defmethod initialize-instance ((layout layout) &key markup)
332 (call-next-method)
333 (when markup
334 (layout-set-markup layout markup)))
335
336(defmethod allocate-foreign ((layout layout) &key context)
337 (etypecase context
338 (context (%layout-new context))
339 (cairo:context (%cairo-create-layout context))))
340
341(defbinding %layout-new () pointer
342 (context context))
343
344(defbinding layout-copy () (referenced layout)
345 (layout layout))
346
347(defbinding layout-context-changed () nil
348 (layout layout))
349
acbc115a 350(defbinding %layout-set-text (text layout) nil
0411aa67 351 (layout layout)
352 (text string)
353 (-1 int))
354
355(defbinding layout-set-markup () nil
356 (layout layout)
357 (markup string)
358 (-1 int))
359
acbc115a 360(defbinding layout-get-size () nil
361 (layout layout)
362 (width int :out)
363 (height int :out))
364
365(defbinding layout-get-pixel-size () nil
366 (layout layout)
367 (width int :out)
368 (height int :out))
369
0411aa67 370
371
372;;; Cairo Rendering
373
374(defbinding (cairo-create-font-map "pango_cairo_font_map_new")
375 () (referenced font-map))
376
377(defbinding cairo-font-map-get-default () font-map)
378
379(defbinding cairo-font-map-create-context () (referenced context)
380 (font-map cairo-font-map))
381
382(defbinding (cairo-context-resolution "pango_cairo_context_get_resolution")
383 () double-float
384 (context context))
385
386(defbinding %cairo-context-set-resolution () nil
387 (context context)
388 (dpi double-float))
389
390(defun (setf cairo-context-resolution) (dpi context)
391 (%cairo-context-set-resolution context dpi))
392
393(defbinding (cairo-context-font-options "pango_cairo_context_get_font_options")
394 () cairo:font-options
395 (context context))
396
397(defbinding %cairo-context-set-font-options () nil
398 (context context)
399 (font-options cairo:font-options))
400
401(defun (setf cairo-context-font-options) (font-options context)
402 (%cairo-context-set-font-options context font-options))
403
404(defbinding %cairo-create-layout () pointer
405 (cr cairo:context))
406
407(defbinding cairo-update-layout () nil
408 (cr cairo:context)
409 (layout layout))
410
411(defbinding cairo-show-glyph-string () nil
412 (cr cairo:context)
413 (font font)
414 (glyphs glyph-string))
415
416(defbinding cairo-show-layout-line () nil
417 (cr cairo:context)
418 (line layout-line))
419
420(defbinding cairo-show-layout () nil
421 (cr cairo:context)
422 (layout layout))
423
424(defbinding cairo-show-error-underline () nil
425 (cr cairo:context)
426 (x double-float)
427 (y double-float)
428 (width double-float)
429 (height double-float))
430
431(defbinding cairo-glyph-string-path () nil
432 (cr cairo:context)
433 (font font)
434 (glyphs glyph-string))
435
436(defbinding cairo-layout-line-path () nil
437 (cr cairo:context)
438 (line layout-line))
439
440(defbinding cairo-layout-path () nil
441 (cr cairo:context)
442 (layout layout))
443
444(defbinding cairo-error-underline-path () nil
445 (cr cairo:context)
446 (x double-float)
447 (y double-float)
448 (width double-float)
449 (height double-float))
450