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

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