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.15 2007-09-07 07:39:59 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 :initform "Sans"
  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 (static string))
  47    (style
  48     :allocation :virtual
  49     :initarg :style :initform :normal
  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 :initform :normal
  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 :initform :normal
  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 :initform :normal
  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 :initform 16 ; handled by initialize instance
  86 ;   :setter (setf font-description-size)
  87    :setter %set-font-description-size
  88    :getter "pango_font_description_get_size"
  89    :boundp %font-description-size-boundp
  90    :makunbound %font-description-size-makunbound
  91    :reader font-description-size
  92    :type integer)
  93    #?(pkg-exists-p "pango" :atleast-version "1.8.0")
  94    (size-is-absolute-p
  95    :allocation :virtual
  96 ;   :initarg :size-is-absolute :initform nil ; handled by initialize instance
  97    :getter "pango_font_description_get_size_is_absolute"
  98    :boundp %font-description-size-boundp
  99    :reader font-description-size-is-absolute-p
 100    :type boolean))
 101   (:metaclass boxed-class))
 102
 103 (defclass layout (gobject)
 104   ((context
 105     :allocation :virtual
 106     :getter "pango_layout_get_context"
 107     :reader layout-context
 108     :type context)
 109    (text
 110     :allocation :virtual
 111     :initarg :text
 112     :getter "pango_layout_get_text"
 113     :setter %layout-set-text
 114     :accessor layout-text
 115     :type (static string))
 116    (attributes
 117     :allocation :virtual
 118     :initarg :attributes
 119     :getter "pango_layout_get_attributes"
 120     :setter "pango_layout_set_attributes"
 121     :accessor layout-attributes
 122     :type attr-list)
 123    (font-description
 124     :allocation :virtual
 125     :initarg :font-description
 126     :getter "pango_layout_get_font_description"
 127     :setter "pango_layout_set_font_description"
 128     :accessor layout-font-description
 129     :type font-description)
 130    (width
 131     :allocation :virtual
 132     :initarg :width
 133     :getter "pango_layout_get_width"
 134     :setter "pango_layout_set_width"
 135     :unbound -1
 136     :accessor layout-width
 137     :type int)
 138    (wrap
 139     :allocation :virtual
 140     :initarg :wrap
 141     :getter "pango_layout_get_wrap"
 142     :setter "pango_layout_set_wrap"
 143     :accessor layout-wrap
 144     :type wrap-mode)
 145    (ellipsize
 146     :allocation :virtual
 147     :initarg :ellipsize
 148     :getter "pango_layout_get_ellipsize"
 149     :setter "pango_layout_set_ellipsize"
 150     :accessor layout-ellipsize
 151     :type ellipsize-mode)
 152    (indent
 153     :allocation :virtual
 154     :initarg :indent
 155     :getter "pango_layout_get_indent"
 156     :setter "pango_layout_set_indetn"
 157     :accessor layout-indent
 158     :type int)
 159    (spacing
 160     :allocation :virtual
 161     :initarg :spacing
 162     :getter "pango_layout_get_spacing"
 163     :setter "pango_layout_set_spacing"
 164     :accessor layout-spacing
 165     :type int)
 166    (justify
 167     :allocation :virtual
 168     :initarg :justify
 169     :getter "pango_layout_get_justify"
 170     :setter "pango_layout_set_justify"
 171     :accessor layout-justify-p
 172     :type boolean)
 173    (auto-dir
 174     :allocation :virtual
 175     :initarg :auto-dir
 176     :getter "pango_layout_get_auto_dir"
 177     :setter "pango_layout_set_auto_dir"
 178     :accessor layout-auto-dir-p
 179     :type boolean)
 180    (alignment
 181     :allocation :virtual
 182     :initarg :alignment
 183     :getter "pango_layout_get_alignment"
 184     :setter "pango_layout_set_alignment"
 185     :accessor layout-alignment
 186     :type alignment)
 187    (tabs
 188     :allocation :virtual
 189     :initarg :tabs
 190     :getter "pango_layout_get_tabs"
 191     :setter "pango_layout_set_tabs"
 192     :accessor layout-tabs
 193     :type tab-array)
 194    (single-paragraph
 195     :allocation :virtual
 196     :initarg :single-paragraph
 197     :getter "pango_layout_get_single_paragraph_mode"
 198     :setter "pango_layout_set_single_paragraph_mode"
 199     :accessor layout-single-paragraph-p
 200     :type boolean))
 201   (:metaclass gobject-class))
 202
 203 (defclass cairo-font-map (interface)
 204   ((resolution
 205     :allocation :virtual
 206     :getter "pango_cairo_font_map_get_resolution"
 207     :setter "pango_cairo_font_map_set_resolution"
 208     :accessor cairo-font-map-resolution
 209     :type double-float))
 210   (:metaclass interface-class))
 211
 212
 213 ;;;; Font description
 214
 215 (defmethod initialize-instance ((desc font-description) &key (size 16) size-is-absolute)
 216   (call-next-method)
 217   (setf (font-description-size desc size-is-absolute) size))
 218
 219 (defbinding %font-description-new () pointer)
 220
 221 (defmethod allocate-foreign ((desc font-description) &rest initargs)
 222   (declare (ignore initargs))
 223   (%font-description-new))
 224
 225 (defbinding %font-description-get-set-fields () font-mask
 226   (desc font-description))
 227
 228 (defun %font-description-family-boundp (desc)
 229   (find :family (%font-description-get-set-fields desc)))
 230
 231 (defun %font-description-style-boundp (desc)
 232   (find :style (%font-description-get-set-fields desc)))
 233
 234 (defun %font-description-variant-boundp (desc)
 235   (find :variant (%font-description-get-set-fields desc)))
 236
 237 (defun %font-description-weight-boundp (desc)
 238   (find :weight (%font-description-get-set-fields desc)))
 239
 240 (defun %font-description-stretch-boundp (desc)
 241   (find :stretch (%font-description-get-set-fields desc)))
 242
 243 (defun %font-description-size-boundp (desc)
 244   (find :size (%font-description-get-set-fields desc)))
 245
 246 (defbinding %font-description-unset-fields () nil
 247   (desc font-description)
 248   (mask font-mask))
 249
 250 (defun %font-description-family-makunbound (desc)
 251   (%font-description-unset-fields desc :family))
 252
 253 (defun %font-description-style-makunbound (desc)
 254   (%font-description-unset-fields desc :style))
 255
 256 (defun %font-description-variant-makunbound (desc)
 257   (%font-description-unset-fields desc :variant))
 258
 259 (defun %font-description-weight-makunbound (desc)
 260   (%font-description-unset-fields desc :weight))
 261
 262 (defun %font-description-stretch-makunbound (desc)
 263   (%font-description-unset-fields desc :stretch))
 264
 265 (defun %font-description-size-makunbound (desc)
 266   (%font-description-unset-fields desc :size))
 267
 268 (defbinding %font-description-set-size () nil
 269   (desc font-description)
 270   (size int))
 271
 272 #?(pkg-exists-p "pango" :atleast-version "1.8.0")
 273 (defbinding %font-description-set-absolute-size () nil
 274   (desc font-description)
 275   (size double-float))
 276
 277 (defun (setf font-description-size) (size desc &optional (absolute-p nil absolute-given-p))
 278   (cond
 279     (absolute-p
 280       #?(pkg-exists-p "pango" :atleast-version "1.8.0")
 281       (%font-description-set-absolute-size desc size)
 282       #?-(pkg-exists-p "pango" :atleast-version "1.8.0")
 283       (error "Setting of absolute font size requires at least Pango 1.8.0"))
 284     (#?(pkg-exists-p "pango" :atleast-version "1.8.0") absolute-given-p
 285      #?-(pkg-exists-p "pango" :atleast-version "1.8.0") t
 286      (%font-description-set-size desc size))
 287     #?(pkg-exists-p "pango" :atleast-version "1.8.0")
 288     (t (if (font-description-size-is-absolute-p desc)
 289            (%font-description-set-absolute-size desc size)
 290          (%font-description-set-size desc size))))
 291   size)
 292
 293 (defun %set-font-description-size (size desc)
 294   (setf (font-description-size desc) size))
 295
 296 (defbinding font-description-merge (desc merge-desc &optional replace-p) nil
 297   (desc font-description)
 298   (merge-desc font-description)
 299   (replace-p boolean))
 300
 301 (defbinding font-description-better-match () boolean
 302   (desc font-description)
 303   (old-math font-description)
 304   (new-math font-description))
 305
 306 (defbinding font-description-from-string () font-description
 307   (desc string))
 308
 309 (defbinding font-description-to-string () string
 310   (desc font-description))
 311
 312 (defbinding font-description-copy () font-description
 313   (font-description font-description))
 314
 315 (defun ensure-font-description (font-description &optional copy-p)
 316   (etypecase font-description
 317     (font-description (if copy-p
 318                           (font-description-copy font-description)
 319                         font-description))
 320     (string (font-description-from-string font-description))
 321     (list (apply #'make-instance 'font-description font-description))))
 322
 323
 324 ;;;; Layout
 325
 326 (defmethod initialize-instance ((layout layout) &key markup)
 327   (call-next-method)
 328   (when markup
 329     (layout-set-markup layout markup)))
 330
 331 (defmethod allocate-foreign ((layout layout) &key context)
 332   (etypecase context
 333     (context (%layout-new context))
 334     (cairo:context (%cairo-create-layout context))))
 335
 336 (defbinding %layout-new () pointer
 337   (context context))
 338
 339 (defbinding layout-copy () (referenced layout)
 340   (layout layout))
 341
 342 (defbinding layout-context-changed () nil
 343   (layout layout))
 344
 345 (defbinding %layout-set-text (text layout) nil
 346   (layout layout)
 347   (text string)
 348   (-1 int))
 349
 350 (defbinding layout-set-markup () nil
 351   (layout layout)
 352   (markup string)
 353   (-1 int))
 354
 355 (defbinding layout-get-size () nil
 356   (layout layout)
 357   (width int :out)
 358   (height int :out))
 359
 360 (defbinding layout-get-pixel-size () nil
 361   (layout layout)
 362   (width int :out)
 363   (height int :out))
 364
 365
 366
 367 ;;; Cairo Rendering
 368
 369 (defbinding (cairo-create-font-map "pango_cairo_font_map_new")
 370     () (referenced font-map))
 371
 372 (defbinding cairo-font-map-get-default () font-map)
 373
 374 (defbinding cairo-font-map-create-context () (referenced context)
 375   (font-map cairo-font-map))
 376
 377 (defbinding (cairo-context-resolution "pango_cairo_context_get_resolution")
 378     () double-float
 379   (context context))
 380
 381 (defbinding %cairo-context-set-resolution () nil
 382   (context context)
 383   (dpi double-float))
 384
 385 (defun (setf cairo-context-resolution) (dpi context)
 386   (%cairo-context-set-resolution context dpi))
 387
 388 (defbinding (cairo-context-font-options "pango_cairo_context_get_font_options")
 389     () cairo:font-options
 390   (context context))
 391
 392 (defbinding %cairo-context-set-font-options () nil
 393   (context context)
 394   (font-options cairo:font-options))
 395
 396 (defun (setf cairo-context-font-options) (font-options context)
 397   (%cairo-context-set-font-options context font-options))
 398
 399 (defbinding %cairo-create-layout () pointer
 400   (cr cairo:context))
 401
 402 (defbinding cairo-update-layout () nil
 403   (cr cairo:context)
 404   (layout layout))
 405
 406 (defbinding cairo-show-glyph-string () nil
 407   (cr cairo:context)
 408   (font font)
 409   (glyphs glyph-string))
 410
 411 (defbinding cairo-show-layout-line () nil
 412   (cr cairo:context)
 413   (line layout-line))
 414
 415 (defbinding cairo-show-layout () nil
 416   (cr cairo:context)
 417   (layout layout))
 418
 419 (defbinding cairo-show-error-underline () nil
 420   (cr cairo:context)
 421   (x double-float)
 422   (y double-float)
 423   (width double-float)
 424   (height double-float))
 425
 426 (defbinding cairo-glyph-string-path () nil
 427   (cr cairo:context)
 428   (font font)
 429   (glyphs glyph-string))
 430
 431 (defbinding cairo-layout-line-path () nil
 432   (cr cairo:context)
 433   (line layout-line))
 434
 435 (defbinding cairo-layout-path () nil
 436   (cr cairo:context)
 437   (layout layout))
 438
 439 (defbinding cairo-error-underline-path () nil
 440   (cr cairo:context)
 441   (x double-float)
 442   (y double-float)
 443   (width double-float)
 444   (height double-float))
 445