chiark - git - mdw - clg/blob - pango/pango.lisp

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