chiark - git - mdw - clg/blob - gdk/gdktypes.lisp

   1 ;; Common Lisp bindings for GTK+ v2.x
   2 ;; Copyright 2000-2005 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: gdktypes.lisp,v 1.22 2006-02-26 23:47:50 espen Exp $
  24
  25 (in-package "GDK")
  26
  27 (eval-when (:compile-toplevel :load-toplevel :execute)
  28   (init-types-in-library #.(concatenate 'string
  29                             (pkg-config:pkg-variable "gtk+-2.0" "libdir")
  30                             "/libgdk-x11-2.0.so") :prefix ("gdk_" "_gdk_"))
  31   (init-types-in-library #.(concatenate 'string
  32                             (pkg-config:pkg-variable "gtk+-2.0" "libdir")
  33                             "/libgdk_pixbuf-2.0.so") :prefix "gdk_"))
  34
  35
  36 (defclass color (boxed)
  37   ((pixel
  38     :allocation :alien
  39     :type unsigned-long)
  40    (red
  41     :allocation :alien
  42     :accessor color-red
  43     :type unsigned-short)
  44    (green
  45     :allocation :alien :offset 6
  46     :accessor color-green
  47     :type unsigned-short)
  48    (blue
  49     :allocation :alien  :offset 8
  50     :accessor color-blue
  51     :type unsigned-short))
  52   (:metaclass boxed-class))
  53
  54
  55 (deftype point () '(vector int 2))
  56 (deftype segment () '(vector int 4))
  57 (deftype trapezoid () '(vector double-float 6))
  58 (deftype atom () 'unsigned-int)
  59
  60
  61 ;; Could this just as well have been a vector?
  62 (defclass rectangle (boxed)
  63   ((x
  64     :allocation :alien
  65     :accessor rectangle-x
  66     :initarg :x
  67     :type int)
  68    (y
  69     :allocation :alien
  70     :accessor rectangle-y
  71     :initarg :y
  72     :type int)
  73    (width
  74     :allocation :alien
  75     :accessor rectangle-width
  76     :initarg :width
  77     :type int)
  78    (height
  79     :allocation :alien
  80     :accessor rectangle-height
  81     :initarg :height
  82     :type int))
  83   (:metaclass boxed-class))
  84
  85
  86
  87
  88 (define-types-by-introspection "Gdk"
  89   ("GdkFunction" :type gc-function)
  90   ("GdkWMDecoration" :type wm-decoration)
  91   ("GdkWMFunction" :type wm-function)
  92   ("GdkGC" :type gc)
  93   ("GdkGCX11" :type gc-x11)
  94   ("GdkGCValuesMask" :type gc-values-mask)
  95   ("GdkDrawableImplX11" :ignore t)
  96   ("GdkWindowImplX11" :ignore t)
  97   ("GdkPixmapImplX11" :ignore t)
  98   ("GdkGCX11" :ignore t)
  99   ("GdkColor" :ignore t)
 100   ("GdkEvent" :ignore t)
 101   ("GdkRectangle" :ignore t)
 102   ("GdkCursor" :ignore t)
 103   ("GdkFont" :ignore t) ; deprecated
 104   ("GdkEventMask" :ignore t) ; manually defined
 105   ("GdkModifierType" :ignore t) ; manually defined
 106
 107   ("GdkDisplay"
 108    :slots
 109    ((name
 110      :allocation :virtual
 111      :getter "gdk_display_get_name"
 112      :reader display-name
 113      :type (copy-of string))
 114     (screens
 115      :allocation :virtual
 116      :getter display-screens)
 117     (devices
 118      :allocation :virtual
 119      :getter "gdk_display_list_devices"
 120      :reader display-devices
 121      :type (copy-of (glist device)))))
 122
 123   ("GdkDrawable"
 124    :slots
 125    ((display
 126      :allocation :virtual
 127      :getter "gdk_drawable_get_display"
 128      :reader drawable-display
 129      :type display)
 130     (screen
 131      :allocation :virtual
 132      :getter "gdk_drawable_get_screen"
 133      :reader drawable-screen
 134      :type screen)
 135     (visual
 136      :allocation :virtual
 137      :getter "gdk_drawable_get_visual"
 138      :reader drawable-visual
 139      :type visual)
 140     (colormap
 141      :allocation :virtual
 142      :getter "gdk_drawable_get_colormap"
 143      :setter "gdk_drawable_set_colormap"
 144      :unbound nil
 145      :accessor drawable-colormap
 146      :initarg :colormap
 147      :type colormap)
 148     (depth
 149      :allocation :virtual
 150      :getter "gdk_drawable_get_depth"
 151      :reader drawable-depth
 152      :type int)
 153     (with
 154      :allocation :virtual
 155      :getter drawable-width)
 156     (height
 157      :allocation :virtual
 158      :getter drawable-height)))
 159
 160   ("GdkWindow"
 161    :slots
 162    ((state
 163      :allocation :virtual
 164      :getter "gdk_window_get_state"
 165      :reader window-state
 166      :type window-state)
 167     (parent
 168      :allocation :virtual
 169      :getter "gdk_window_get_parent"
 170      :reader window-parent
 171      :type window)
 172     (toplevel
 173      :allocation :virtual
 174      :getter "gdk_window_get_toplevel"
 175      :reader window-toplevel
 176      :type window)
 177     (children
 178      :allocation :virtual
 179      :getter "gdk_window_get_children"
 180      :reader window-children
 181      :type (glist window))
 182     (events
 183      :allocation :virtual
 184      :getter "gdk_window_get_events"
 185      :setter "gdk_window_set_events"
 186      :accessor window-events
 187      :type event-mask)
 188     (group
 189      :allocation :virtual
 190      :getter "gdk_window_get_group"
 191      :setter "gdk_window_set_group"
 192      :unbound nil
 193      :accessor window-group
 194      :type window))))
 195
 196
 197 (deftype bitmap () 'pixmap)
 198
 199 (defclass cursor (boxed)
 200   ((type
 201     :allocation :alien
 202     :reader cursor-type
 203     :type cursor-type)
 204    (ref-count
 205     :allocation :alien
 206     :type unsigned-int)
 207    (display
 208     :allocation :virtual
 209     :getter "gdk_cursor_get_display"
 210     :reader cursor-display
 211     :type display))
 212   (:metaclass boxed-class))
 213
 214
 215 (defclass geometry (struct)
 216   ((min-width
 217     :allocation :alien
 218     :accessor geometry-min-width
 219     :initarg :min-width
 220     :type int)
 221    (min-height
 222     :allocation :alien
 223     :accessor geometry-min-height
 224     :initarg :min-height
 225     :type int)
 226    (max-width
 227     :allocation :alien
 228     :accessor geometry-max-width
 229     :initarg :max-width
 230     :type int)
 231    (max-height
 232     :allocation :alien
 233     :accessor geometry-max-height
 234     :initarg :max-height
 235     :type int)
 236    (base-width
 237     :allocation :alien
 238     :accessor geometry-base-width
 239     :initarg :base-width
 240     :type int)
 241    (base-height
 242     :allocation :alien
 243     :accessor geometry-base-height
 244     :initarg :base-height
 245     :type int)
 246    (width-inc
 247     :allocation :alien
 248     :accessor geometry-width-inc
 249     :initarg :width-inc
 250     :type int)
 251    (height-inc
 252     :allocation :alien
 253     :accessor geometry-height-inc
 254     :initarg :height-inc
 255     :type int)
 256    (min-aspect
 257     :allocation :alien
 258     :accessor geometry-min-aspect
 259     :initarg :min-aspect
 260     :type double-float)
 261    (max-aspect
 262     :allocation :alien
 263     :accessor geometry-max-aspect
 264     :initarg :max-aspect
 265     :type double-float)
 266    (gravity
 267     :allocation :alien
 268     :accessor geometry-gravity
 269     :initarg :gravity
 270     :type gravity))
 271   (:metaclass struct-class))
 272
 273 (define-flags-type modifier-type
 274   :shift :lock :control :mod1 :mod2 :mod3 :mod4 :mod5
 275   :button1 :button2 :button3 :button4 :button5
 276   (:release #.(ash 1 30)))
 277
 278 (deftype native-window () '(unsigned 32))