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