1 ;; Common Lisp bindings for GTK+ v2.x
2 ;; Copyright 2001-2006 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: pango.lisp,v 1.16 2007-10-17 18:07:32 espen Exp $
27 (defconstant +pango-scale+ 1024)
29 (defun device-to-pango-units (device-units)
30 (round (* device-units +pango-scale+)))
32 (eval-when (:compile-toplevel :load-toplevel :execute)
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"))
39 (eval-when (:compile-toplevel :load-toplevel :execute)
40 (define-types-by-introspection "Pango"))
42 (defclass font-description (boxed)
45 :initarg :family :initform "Sans"
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
51 :type (static string))
54 :initarg :style :initform :normal
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
63 :initarg :variant :initform :normal
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
71 :allocation :virtual :initform :normal
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
80 :allocation :virtual :initform :normal
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
90 ; :initarg :size :initform 16 ; handled by initialize instance
91 ; :setter (setf font-description-size)
92 :setter %set-font-description-size
93 :getter "pango_font_description_get_size"
94 :boundp %font-description-size-boundp
95 :makunbound %font-description-size-makunbound
96 :reader font-description-size
98 #?(pkg-exists-p "pango" :atleast-version "1.8.0")
101 ; :initarg :size-is-absolute :initform nil ; handled by initialize instance
102 :getter "pango_font_description_get_size_is_absolute"
103 :boundp %font-description-size-boundp
104 :reader font-description-size-is-absolute-p
106 (:metaclass boxed-class))
108 (defclass layout (gobject)
111 :getter "pango_layout_get_context"
112 :reader layout-context
117 :getter "pango_layout_get_text"
118 :setter %layout-set-text
119 :accessor layout-text
120 :type (static string))
124 :getter "pango_layout_get_attributes"
125 :setter "pango_layout_set_attributes"
126 :accessor layout-attributes
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)
138 :getter "pango_layout_get_width"
139 :setter "pango_layout_set_width"
141 :accessor layout-width
146 :getter "pango_layout_get_wrap"
147 :setter "pango_layout_set_wrap"
148 :accessor layout-wrap
153 :getter "pango_layout_get_ellipsize"
154 :setter "pango_layout_set_ellipsize"
155 :accessor layout-ellipsize
156 :type ellipsize-mode)
160 :getter "pango_layout_get_indent"
161 :setter "pango_layout_set_indent"
162 :accessor layout-indent
167 :getter "pango_layout_get_spacing"
168 :setter "pango_layout_set_spacing"
169 :accessor layout-spacing
174 :getter "pango_layout_get_justify"
175 :setter "pango_layout_set_justify"
176 :accessor layout-justify-p
181 :getter "pango_layout_get_auto_dir"
182 :setter "pango_layout_set_auto_dir"
183 :accessor layout-auto-dir-p
188 :getter "pango_layout_get_alignment"
189 :setter "pango_layout_set_alignment"
190 :accessor layout-alignment
195 :getter "pango_layout_get_tabs"
196 :setter "pango_layout_set_tabs"
197 :accessor layout-tabs
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
206 (:metaclass gobject-class))
208 (defclass cairo-font-map (interface)
211 :getter "pango_cairo_font_map_get_resolution"
212 :setter "pango_cairo_font_map_set_resolution"
213 :accessor cairo-font-map-resolution
215 (:metaclass interface-class))
218 ;;;; Font description
220 (defmethod initialize-instance ((desc font-description) &key (size 16) size-is-absolute)
222 (setf (font-description-size desc size-is-absolute) size))
224 (defbinding %font-description-new () pointer)
226 (defmethod allocate-foreign ((desc font-description) &rest initargs)
227 (declare (ignore initargs))
228 (%font-description-new))
230 (defbinding %font-description-get-set-fields () font-mask
231 (desc font-description))
233 (defun %font-description-family-boundp (desc)
234 (find :family (%font-description-get-set-fields desc)))
236 (defun %font-description-style-boundp (desc)
237 (find :style (%font-description-get-set-fields desc)))
239 (defun %font-description-variant-boundp (desc)
240 (find :variant (%font-description-get-set-fields desc)))
242 (defun %font-description-weight-boundp (desc)
243 (find :weight (%font-description-get-set-fields desc)))
245 (defun %font-description-stretch-boundp (desc)
246 (find :stretch (%font-description-get-set-fields desc)))
248 (defun %font-description-size-boundp (desc)
249 (find :size (%font-description-get-set-fields desc)))
251 (defbinding %font-description-unset-fields () nil
252 (desc font-description)
255 (defun %font-description-family-makunbound (desc)
256 (%font-description-unset-fields desc :family))
258 (defun %font-description-style-makunbound (desc)
259 (%font-description-unset-fields desc :style))
261 (defun %font-description-variant-makunbound (desc)
262 (%font-description-unset-fields desc :variant))
264 (defun %font-description-weight-makunbound (desc)
265 (%font-description-unset-fields desc :weight))
267 (defun %font-description-stretch-makunbound (desc)
268 (%font-description-unset-fields desc :stretch))
270 (defun %font-description-size-makunbound (desc)
271 (%font-description-unset-fields desc :size))
273 (defbinding %font-description-set-size () nil
274 (desc font-description)
277 #?(pkg-exists-p "pango" :atleast-version "1.8.0")
278 (defbinding %font-description-set-absolute-size () nil
279 (desc font-description)
282 (defun (setf font-description-size) (size desc &optional (absolute-p nil absolute-given-p))
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")
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))))
298 (defun %set-font-description-size (size desc)
299 (setf (font-description-size desc) size))
301 (defbinding font-description-merge (desc merge-desc &optional replace-p) nil
302 (desc font-description)
303 (merge-desc font-description)
306 (defbinding font-description-better-match () boolean
307 (desc font-description)
308 (old-math font-description)
309 (new-math font-description))
311 (defbinding font-description-from-string () font-description
314 (defbinding font-description-to-string () string
315 (desc font-description))
317 (defbinding font-description-copy () font-description
318 (font-description font-description))
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)
325 (string (font-description-from-string font-description))
326 (list (apply #'make-instance 'font-description font-description))))
331 (defmethod initialize-instance ((layout layout) &key markup)
334 (layout-set-markup layout markup)))
336 (defmethod allocate-foreign ((layout layout) &key context)
338 (context (%layout-new context))
339 (cairo:context (%cairo-create-layout context))))
341 (defbinding %layout-new () pointer
344 (defbinding layout-copy () (referenced layout)
347 (defbinding layout-context-changed () nil
350 (defbinding %layout-set-text (text layout) nil
355 (defbinding layout-set-markup () nil
360 (defbinding layout-get-size () nil
365 (defbinding layout-get-pixel-size () nil
374 (defbinding (cairo-create-font-map "pango_cairo_font_map_new")
375 () (referenced font-map))
377 (defbinding cairo-font-map-get-default () font-map)
379 (defbinding cairo-font-map-create-context () (referenced context)
380 (font-map cairo-font-map))
382 (defbinding (cairo-context-resolution "pango_cairo_context_get_resolution")
386 (defbinding %cairo-context-set-resolution () nil
390 (defun (setf cairo-context-resolution) (dpi context)
391 (%cairo-context-set-resolution context dpi))
393 (defbinding (cairo-context-font-options "pango_cairo_context_get_font_options")
394 () cairo:font-options
397 (defbinding %cairo-context-set-font-options () nil
399 (font-options cairo:font-options))
401 (defun (setf cairo-context-font-options) (font-options context)
402 (%cairo-context-set-font-options context font-options))
404 (defbinding %cairo-create-layout () pointer
407 (defbinding cairo-update-layout () nil
411 (defbinding cairo-show-glyph-string () nil
414 (glyphs glyph-string))
416 (defbinding cairo-show-layout-line () nil
420 (defbinding cairo-show-layout () nil
424 (defbinding cairo-show-error-underline () nil
429 (height double-float))
431 (defbinding cairo-glyph-string-path () nil
434 (glyphs glyph-string))
436 (defbinding cairo-layout-line-path () nil
440 (defbinding cairo-layout-path () nil
444 (defbinding cairo-error-underline-path () nil
449 (height double-float))