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.11 2006-04-26 12:40:39 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.so") :prefix "pango_")
  31   (init-types-in-library #.(concatenate 'string
  32                             (pkg-variable "pango" "libdir")
  33                             "/libpangoxft-1.0.so") :prefix "pango_xft")
  34   (init-types-in-library #.(concatenate 'string
  35                             (pkg-variable "pango" "libdir")
  36                             "/libpangoft2-1.0.so") :prefix "pango_fc"))
  37
  38
  39 (eval-when (:compile-toplevel :load-toplevel :execute)
  40   (define-types-by-introspection "Pango")
  41
  42   (defclass font-description (boxed)
  43     ((family
  44       :allocation :virtual
  45       :initarg :family
  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 string)
  52      (style
  53       :allocation :virtual
  54       :initarg :style
  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
  63       :initarg :variant
  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
  71       :allocation :virtual
  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
  80       :allocation :virtual
  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
  90       :initarg :size
  91       :setter (setf font-description-size)
  92       :getter "pango_font_description_get_size"
  93       :boundp %font-description-size-boundp
  94       :makunbound %font-description-size-makunbound
  95       :reader font-description-size
  96       :type integer)
  97      #?(pkg-exists-p "pango" :atleast-version "1.8.0")
  98      (absolute-size-p
  99       :allocation :virtual
 100       :getter "pango_font_description_get_size_is_absolute"
 101       :boundp %font-description-size-boundp
 102       :reader font-description-size-is-absolute-p
 103       :type boolean))
 104     (:metaclass boxed-class)))
 105
 106
 107 (defmethod initialize-instance ((desc font-description) &key absolute-size)
 108   (call-next-method)
 109   (when absolute-size
 110     (setf (font-description-size desc t) absolute-size)))
 111
 112 (defbinding %font-description-new () pointer)
 113
 114 (defmethod allocate-foreign ((desc font-description) &rest initargs)
 115   (declare (ignore initargs))
 116   (%font-description-new))
 117
 118 (defbinding %font-description-get-set-fields () font-mask
 119   (desc font-description))
 120
 121 (defun %font-description-family-boundp (desc)
 122   (find :family (%font-description-get-set-fields desc)))
 123
 124 (defun %font-description-style-boundp (desc)
 125   (find :style (%font-description-get-set-fields desc)))
 126
 127 (defun %font-description-variant-boundp (desc)
 128   (find :variant (%font-description-get-set-fields desc)))
 129
 130 (defun %font-description-weight-boundp (desc)
 131   (find :weight (%font-description-get-set-fields desc)))
 132
 133 (defun %font-description-stretch-boundp (desc)
 134   (find :stretch (%font-description-get-set-fields desc)))
 135
 136 (defun %font-description-size-boundp (desc)
 137   (find :size (%font-description-get-set-fields desc)))
 138
 139 (defbinding %font-description-unset-fields () nil
 140   (desc font-description)
 141   (mask font-mask))
 142
 143 (defun %font-description-family-makunbound (desc)
 144   (%font-description-unset-fields desc :family))
 145
 146 (defun %font-description-style-makunbound (desc)
 147   (%font-description-unset-fields desc :style))
 148
 149 (defun %font-description-variant-makunbound (desc)
 150   (%font-description-unset-fields desc :variant))
 151
 152 (defun %font-description-weight-makunbound (desc)
 153   (%font-description-unset-fields desc :weight))
 154
 155 (defun %font-description-stretch-makunbound (desc)
 156   (%font-description-unset-fields desc :stretch))
 157
 158 (defun %font-description-size-makunbound (desc)
 159   (%font-description-unset-fields desc :size))
 160
 161 (defbinding %font-description-set-size () nil
 162   (desc font-description)
 163   (size int))
 164
 165 #?(pkg-exists-p "pango" :atleast-version "1.8.0")
 166 (defbinding %font-description-set-absolute-size () nil
 167   (desc font-description)
 168   (size double-float))
 169
 170 (defun (setf font-description-size) (size desc &optional absolute-p)
 171   (if absolute-p
 172       #?(pkg-exists-p "pango" :atleast-version "1.8.0")
 173       (%font-description-set-absolute-size desc size)
 174       #?-(pkg-exists-p "pango" :atleast-version "1.8.0")
 175       (error "Setting of absolute font size requires at least Pango 1.8.0")
 176     (%font-description-set-size desc size)))
 177
 178 (defbinding font-description-merge (desc merge-desc &optional replace-p) nil
 179   (desc font-description)
 180   (merge-desc font-description)
 181   (replace-p boolean))
 182
 183 (defbinding font-description-better-match () boolean
 184   (desc font-description)
 185   (old-math font-description)
 186   (new-math font-description))
 187
 188 (defbinding font-description-from-string () font-description
 189   (desc string))
 190
 191 (defbinding font-description-to-string () string
 192   (desc font-description))