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.12 2006-08-30 11:08:13 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
  41
  42 (eval-when (:compile-toplevel :load-toplevel :execute)
  43   (define-types-by-introspection "Pango")
  44
  45   (defclass font-description (boxed)
  46     ((family
  47       :allocation :virtual
  48       :initarg :family
  49       :getter "pango_font_description_get_family"
  50       :setter "pango_font_description_set_family"
  51       :boundp %font-description-family-boundp
  52       :makunbound %font-description-family-makunbound
  53       :accessor font-description-family
  54       :type string)
  55      (style
  56       :allocation :virtual
  57       :initarg :style
  58       :getter "pango_font_description_get_style"
  59       :setter "pango_font_description_set_style"
  60       :boundp %font-description-style-boundp
  61       :makunbound %font-description-style-makunbound
  62       :accessor font-description-style
  63       :type style)
  64      (variant
  65       :allocation :virtual
  66       :initarg :variant
  67       :getter "pango_font_description_get_variant"
  68       :setter "pango_font_description_set_variant"
  69       :boundp %font-description-variant-boundp
  70       :makunbound %font-description-variant-makunbound
  71       :accessor font-description-variant
  72       :type variant)
  73      (weight
  74       :allocation :virtual
  75       :initarg :weight
  76       :getter "pango_font_description_get_weight"
  77       :setter "pango_font_description_set_weight"
  78       :boundp %font-description-weight-boundp
  79       :makunbound %font-description-weight-makunbound
  80       :accessor font-description-weight
  81       :type weight)
  82      (stretch
  83       :allocation :virtual
  84       :initarg :stretch
  85       :getter "pango_font_description_get_stretch"
  86       :setter "pango_font_description_set_stretch"
  87       :boundp %font-description-stretch-boundp
  88       :makunbound %font-description-stretch-makbound
  89       :accessor font-description-stretch
  90       :type stretch)
  91      (size
  92       :allocation :virtual
  93       :initarg :size
  94       :setter (setf font-description-size)
  95       :getter "pango_font_description_get_size"
  96       :boundp %font-description-size-boundp
  97       :makunbound %font-description-size-makunbound
  98       :reader font-description-size
  99       :type integer)
 100      #?(pkg-exists-p "pango" :atleast-version "1.8.0")
 101      (absolute-size-p
 102       :allocation :virtual
 103       :getter "pango_font_description_get_size_is_absolute"
 104       :boundp %font-description-size-boundp
 105       :reader font-description-size-is-absolute-p
 106       :type boolean))
 107     (:metaclass boxed-class)))
 108
 109
 110 (defmethod initialize-instance ((desc font-description) &key absolute-size)
 111   (call-next-method)
 112   (when absolute-size
 113     (setf (font-description-size desc t) absolute-size)))
 114
 115 (defbinding %font-description-new () pointer)
 116
 117 (defmethod allocate-foreign ((desc font-description) &rest initargs)
 118   (declare (ignore initargs))
 119   (%font-description-new))
 120
 121 (defbinding %font-description-get-set-fields () font-mask
 122   (desc font-description))
 123
 124 (defun %font-description-family-boundp (desc)
 125   (find :family (%font-description-get-set-fields desc)))
 126
 127 (defun %font-description-style-boundp (desc)
 128   (find :style (%font-description-get-set-fields desc)))
 129
 130 (defun %font-description-variant-boundp (desc)
 131   (find :variant (%font-description-get-set-fields desc)))
 132
 133 (defun %font-description-weight-boundp (desc)
 134   (find :weight (%font-description-get-set-fields desc)))
 135
 136 (defun %font-description-stretch-boundp (desc)
 137   (find :stretch (%font-description-get-set-fields desc)))
 138
 139 (defun %font-description-size-boundp (desc)
 140   (find :size (%font-description-get-set-fields desc)))
 141
 142 (defbinding %font-description-unset-fields () nil
 143   (desc font-description)
 144   (mask font-mask))
 145
 146 (defun %font-description-family-makunbound (desc)
 147   (%font-description-unset-fields desc :family))
 148
 149 (defun %font-description-style-makunbound (desc)
 150   (%font-description-unset-fields desc :style))
 151
 152 (defun %font-description-variant-makunbound (desc)
 153   (%font-description-unset-fields desc :variant))
 154
 155 (defun %font-description-weight-makunbound (desc)
 156   (%font-description-unset-fields desc :weight))
 157
 158 (defun %font-description-stretch-makunbound (desc)
 159   (%font-description-unset-fields desc :stretch))
 160
 161 (defun %font-description-size-makunbound (desc)
 162   (%font-description-unset-fields desc :size))
 163
 164 (defbinding %font-description-set-size () nil
 165   (desc font-description)
 166   (size int))
 167
 168 #?(pkg-exists-p "pango" :atleast-version "1.8.0")
 169 (defbinding %font-description-set-absolute-size () nil
 170   (desc font-description)
 171   (size double-float))
 172
 173 (defun (setf font-description-size) (size desc &optional absolute-p)
 174   (if absolute-p
 175       #?(pkg-exists-p "pango" :atleast-version "1.8.0")
 176       (%font-description-set-absolute-size desc size)
 177       #?-(pkg-exists-p "pango" :atleast-version "1.8.0")
 178       (error "Setting of absolute font size requires at least Pango 1.8.0")
 179     (%font-description-set-size desc size)))
 180
 181 (defbinding font-description-merge (desc merge-desc &optional replace-p) nil
 182   (desc font-description)
 183   (merge-desc font-description)
 184   (replace-p boolean))
 185
 186 (defbinding font-description-better-match () boolean
 187   (desc font-description)
 188   (old-math font-description)
 189   (new-math font-description))
 190
 191 (defbinding font-description-from-string () font-description
 192   (desc string))
 193
 194 (defbinding font-description-to-string () string
 195   (desc font-description))