5 (defcfun gtk-gl-init :void
10 (gtk-gl-init (null-pointer) (null-pointer))
13 (at-init () (gl-init))
17 (defcfun (%gdk-gl-query-extension "gdk_gl_query_extension") :boolean)
18 (defcfun (%gdk-gl-query-extension-for-display "gdk_gl_query_extension_for_display") :boolean
19 (display (g-object display)))
21 (defun gdk-gl-query-extension (&optional (display nil display-provided-p))
22 (if display-provided-p
23 (%gdk-gl-query-extension-for-display display)
24 (%gdk-gl-query-extension)))
26 (export 'gdk-gl-query-extension)
28 (defcfun (%gdk-gl-query-version "gdk_gl_query_version") :boolean
29 (major (:pointer :int))
30 (minor (:pointer :int)))
32 (defcfun (%gdk-gl-query-version-for-display "gdk_gl_query_version_for_display") :boolean
33 (display (g-object display))
34 (major (:pointer :int))
35 (minor (:pointer :int)))
37 (defun gdk-gl-query-version (&optional (display nil display-provided-p))
38 (with-foreign-objects ((major :int) (minor :int))
39 (if display-provided-p
40 (%gdk-gl-query-version-for-display display major minor)
41 (%gdk-gl-query-version major minor))
42 (list (mem-ref major :int) (mem-ref minor :int))))
44 (export 'gdk-gl-query-version)
46 (defcfun gdk-gl-query-gl-extension :boolean
47 (extension-name :string))
49 (export 'gdk-gl-query-gl-extension)
53 (define-g-enum "GdkGLConfigAttrib" gdk-gl-config-attrib (:export t :type-initializer "gdk_gl_config_attrib_get_type")
54 (:use-gl 1) (:buffer-size 2) (:level 3)
55 (:rgba 4) (:doublebuffer 5) (:stereo 6)
56 (:aux-buffers 7) (:red-size 8) (:green-size 9)
57 (:blue-size 10) (:alpha-size 11) (:depth-size 12)
58 (:stencil-size 13) (:accum-red-size 14)
59 (:accum-green-size 15) (:accum-blue-size 16)
60 (:accum-alpha-size 17) (:config-caveat 32)
61 (:x-visual-type 34) (:transparent-type 35)
62 (:transparent-index-value 36)
63 (:transparent-red-value 37)
64 (:transparent-green-value 38)
65 (:transparent-blue-value 39)
66 (:transparent-alpha-value 40)
67 (:drawable-type 32784) (:render-type 32785)
68 (:x-renderable 32786) (:fbconfig-id 32787)
69 (:max-pbuffer-width 32790)
70 (:max-pbuffer-height 32791)
71 (:max-pbuffer-pixels 32792) (:visual-id 32779)
72 (:screen 32780) (:sample-buffers 100000)
75 (define-g-enum "GdkGLRenderType" gdk-gl-render-type (:export t :type-initializer "gdk_gl_render_type_get_type")
76 (:rgba-type 32788) (:color-index-type 32789))
78 ;; Frame buffer configuration
80 (define-g-flags "GdkGLConfigMode" gdk-gl-config-mode (:export t :type-initializer "gdk_gl_config_mode_get_type")
81 (:rgb 0) (:rgba 0) (:index 1) (:single 0)
82 (:double 2) (:stereo 4) (:alpha 8) (:depth 16)
83 (:stencil 32) (:accum 64) (:multisample 128))
85 (define-g-object-class "GdkGLConfig" gdk-gl-config (:export t :type-initializer "gdk_gl_config_get_type")
86 ((:cffi screen gdk-gl-config-screen (g-object screen) "gdk_gl_config_get_screen" nil)
87 (:cffi colormap gdk-gl-config-colormap (g-object colormap) "gdk_gl_config_get_colormap" nil)
88 (:cffi visual gdk-gl-config-visual (g-object visual) "gdk_gl_config_get_visual" nil)
89 (:cffi depth gdk-gl-config-depth :int "gdk_gl_config_get_depth" nil)
90 (:cffi layer-plane gdk-gl-config-layer-plane :int "gdk_gl_config_get_layer_plane" nil)
91 (:cffi n-aux-buffers gdk-gl-config-n-aux-buffers :int "gdk_gl_config_get_n_aux_buffers" nil)
92 (:cffi n-sample-buffers gdk-gl-config-n-sample-buffers :int "gdk_gl_config_get_n_sample_buffers" nil)
93 (:cffi is-rgba gdk-gl-config-is-rgba :boolean "gdk_gl_config_is_rgba" nil)
94 (:cffi is-double-buffered gdk-gl-config-is-double-buffered :boolean "gdk_gl_config_is_double_buffered" nil)
95 (:cffi is-stereo gdk-gl-config-is-stereo :boolean "gdk_gl_config_is_stereo" nil)
96 (:cffi has-alpha gdk-gl-config-has-alpha :boolean "gdk_gl_config_has_alpha" nil)
97 (:cffi has-depth-buffer gdk-gl-config-has-depth-buffer :boolean "gdk_gl_config_has_depth_buffer" nil)
98 (:cffi has-stencil-buffer gdk-gl-config-has-stencil-buffer :boolean "gdk_gl_config_has_stencil_buffer" nil)
99 (:cffi has-accum-buffer gdk-gl-config-has-accum-buffer :boolean "gdk_gl_config_has_accum_buffer" nil)))
101 (defcfun (%gdk-gl-config-get-attrib "gdk_gl_config_get_attrib") :boolean
102 (gl-config (g-object gdk-gl-config))
103 (attribute gdk-gl-config-attrib)
104 (return-value (:pointer :int)))
106 (defun gdk-gl-config-attrib (gl-config attribute)
107 (with-foreign-object (v :int)
108 (when (%gdk-gl-config-get-attrib gl-config attribute v)
111 (defcfun gdk-gl-config-new-by-mode :pointer
112 (mode gdk-gl-config-mode))
114 (defcfun gdk-gl-config-new-by-mode-for-screen :pointer
115 (screen (g-object screen))
116 (mode gdk-gl-config-mode))
118 (defcfun (%gdk-gl-config-new-for-screen "gdk_gl_config_new_for_screen") :pointer
119 (screen (g-object screen))
120 (attrib-list (:pointer :int)))
122 (defun gdk-gl-config-new-for-screen (screen attrib-plist)
123 (with-foreign-object (attributes :int (+ (length attrib-plist) 2))
124 (iter (for (attr value) on attrib-plist by #'cddr)
126 (setf (mem-aref attributes 'gdk-gl-config-attrib i) attr
127 (mem-aref attributes :int (1+ i)) value))
128 (%gdk-gl-config-new-for-screen screen attributes)))
130 (defmethod make-instance ((config-class (eql (find-class 'gdk-gl-config)))
132 &key pointer screen mode attrib-plist)
134 (pointer (call-next-method))
135 (mode (assert (not attrib-plist) nil "MODE and ATTRIB-LIST initargs can not be combined")
137 (gdk-gl-config-new-by-mode-for-screen screen mode)
138 (gdk-gl-config-new-by-mode mode))))
139 (apply #'call-next-method config-class :pointer p initargs)))
140 (attrib-plist (assert screen nil "SCREEN initargs must be specified when ATTRIB-LIST is specified")
141 (let ((p (gdk-gl-config-new-for-screen screen attrib-plist)))
142 (apply #'call-next-method config-class :pointer p initargs)))
143 (t (error "MODE or (MODE and SCREEN) or (SCREEN and ATTRIB-PLIST) initargs must be specified"))))
147 (define-g-object-class "GdkGLContext" gdk-gl-context (:export t :type-initializer "gdk_gl_context_get_type")
148 ((:cffi drawable gdk-gl-context-drawable (g-object gdk-gl-drawable) "gdk_gl_context_get_gl_drawable" nil)
149 (:cffi gl-config gdk-gl-context-config (g-object gdk-gl-config) "gdk_gl_context_get_gl_config" nil)
150 (:cffi share-list gdk-gl-context-share-list (g-object gdk-gl-context) "gdk_gl_context_get_share_list" nil)
151 (:cffi is-direct gdk-gl-context-is-direct :boolean "gdk_gl_context_is_direct" nil)
152 (:cffi render-type gdk-gl-context-get-render-type gdk-gl-render-type "gdk_gl_context_get_render_type" nil)))
154 (defcfun (gdk-gl-context-current "gdk_gl_context_get_current") (g-object gdk-gl-context))
156 (export 'gdk-gl-context-current)
158 (defcfun gdk-gl-context-new :pointer
159 (gl-drawable (g-object gdk-gl-drawable))
160 (share-list (g-object gdk-gl-context))
162 (render-type gdk-gl-render-type))
164 (defmethod make-instance ((context-class (eql (find-class 'gdk-gl-context)))
166 &key pointer gl-drawable share-list direct-p (render-type :rgba-type))
168 (pointer (call-next-method))
169 (gl-drawable (let ((p (gdk-gl-context-new gl-drawable share-list direct-p render-type)))
170 (apply #'call-next-method context-class :pointer p initargs)))
171 (t (error "At least GL-DRAWABLE initarg must be specified"))))
173 (defcfun (gdk-gl-context-copy-state "gdk_gl_context_copy") :boolean
174 (dst-gl-context (g-object gdk-gl-context))
175 (src-gl-context (g-object gdk-gl-context))
176 (attribs-mask :int)) ;;TODO: more specific enum type
178 (export 'gdk-gl-context-copy-state)
182 (define-g-interface "GdkGLDrawable" gdk-gl-drawable (:export t :type-initializer "gdk_gl_drawable_get_type")
183 (:cffi is-double-buffered gdk-gl-drawable-is-double-buffered :boolean "gdk_gl_drawable_is_double_buffered" nil)
184 (:cffi config gdk-gl-drawable-config (g-object gdk-gl-config) "gdk_gl_drawable_get_gl_config" nil)
185 (:cffi size gdk-gl-drawable-size list gdk-gl-drawable-size nil))
187 (defcfun (%gdk-gl-drawable-get-size "gdk_gl_drawable_get_size") :void
188 (gl-drawable (g-object gl-drawable))
189 (width (:pointer :int))
190 (height (:pointer :int)))
192 (defun gdk-gl-drawable-get-size (gl-drawable)
193 (with-foreign-objects ((width :int) (height :int))
194 (%gdk-gl-drawable-get-size gl-drawable width height)
195 (list (mem-ref width :int) (mem-ref height :int))))
197 (defcfun (gdk-gl-drawable-current "gdk_gl_drawable_get_current") (g-object gdk-gl-drawable))
199 (export 'gdk-gl-drawable-current)
201 (defcfun gdk-gl-drawable-swap-buffers :void
202 (gl-drawable (g-object gdk-gl-drawable)))
204 (export 'gdk-gl-drawable-swap-buffers)
206 (defcfun gdk-gl-drawable-wait-gl :void
207 (gl-drawable (g-object gdk-gl-drawable)))
209 (export 'gdk-gl-drawable-wait-gl)
211 (defcfun gdk-gl-drawable-wait-gdk :void
212 (gl-drawable (g-object gdk-gl-drawable)))
214 (export 'gdk-gl-drawable-wait-gdk)
216 (defcfun gdk-gl-drawable-gl-begin :boolean
217 (gl-drawable (g-object gdk-gl-drawable))
218 (gl-context (g-object gdk-gl-context)))
220 (export 'gdk-gl-drawable-gl-begin)
222 (defcfun gdk-gl-drawable-gl-end :void
223 (gl-drawable (g-object gdk-gl-drawable)))
225 (export 'gdk-gl-drawable-gl-end)
229 (define-g-object-class "GdkGLPixmap" gdk-gl-pixmap (:superclass drawable :export t :interfaces ("GdkGLDrawable"))
232 (defcfun gdk-gl-pixmap-new :pointer
233 (gl-config (g-object gdk-gl-config))
234 (pixmap (g-object pixmap))
235 (attrib-list-unused (:pointer :int)))
237 (defmethod make-instance ((pixmap-class (eql (find-class 'gdk-gl-pixmap))) &rest initargs &key pointer gl-config pixmap)
239 (pointer (call-next-method))
240 ((and gl-config pixmap) (let ((p (gdk-gl-pixmap-new gl-config pixmap (null-pointer))))
241 (apply #'call-next-method pixmap-class :pointer p initargs)))
242 (t (error "POINTER or (GL-CONFIG and PIXMAP) initargs must be specified"))))
244 (defcfun (%gdk-pixmap-set-gl-capability "gdk_pixmap_set_gl_capability") (g-object gdk-gl-pixmap)
245 (pixmap (g-object pixmap))
246 (gl-config (g-object gdk-gl-config))
247 (attrib-list-unused (:pointer :int)))
249 (defun pixmap-set-gl-capability (pixmap gl-config)
250 (%gdk-pixmap-set-gl-capability pixmap gl-config (null-pointer)))
252 (export 'pixmap-set-gl-capability)
254 (defcfun (pixmap-unset-gl-capability "gdk_pixmap_unset_gl_capability") :void
255 (pixmap (g-object pixmap)))
257 (export 'pixmap-unset-gl-capability)
259 (defcfun (pixmap-is-gl-capable "gdk_pixmap_is_gl_capable") :boolean
260 (pixmap (g-object pixmap)))
262 (export 'pixmap-is-gl-capable)
264 (defcfun (pixmap-gl-pixmap "gdk_pixmap_get_gl_pixmap") (g-object gdk-gl-pixmap)
265 (pixmap (g-object pixmap)))
267 (export 'pixmap-gl-pixmap)
271 (define-g-object-class "GdkGLWindow" gdk-gl-window (:superclass drawable :export t :interfaces ("GdkGLDrawable"))
272 ((:cffi window gdk-gl-window-gdk-window (g-object gdk-window) "gdk_gl_window_get_type" nil)))
274 (defcfun gdk-gl-window-new :pointer
275 (gl-config (g-object gdk-gl-config))
276 (window (g-object gdk-window))
277 (attrib-list-unused (:pointer :int)))
279 (defmethod make-instance ((window-class (eql (find-class 'gdk-gl-window)))
281 &key pointer gl-config window)
283 (pointer (call-next-method))
284 ((and gl-config window) (let ((p (gdk-gl-window-new gl-config window (null-pointer))))
285 (apply #'call-next-method window-class :pointer p initargs)))
286 (t (error "POINTER or (GL-CONFIG and WINDOW) initargs must be specified"))))
288 (defcfun (%gdk-window-set-gl-capability "gdk_window_set_gl_capability") (g-object gdk-gl-window)
289 (window (g-object gdk-window))
290 (gl-config (g-object gdk-gl-config))
291 (attrib-list-unused (:pointer :int)))
293 (defun gdk-window-set-gl-capability (window gl-config)
294 (%gdk-window-set-gl-capability window gl-config (null-pointer)))
296 (export 'gdk-window-set-gl-capability)
298 (defcfun gdk-window-unset-gl-capability :void
299 (window (g-object gdk-window)))
301 (export 'gdk-window-unset-gl-capability)
303 (defcfun gdk-window-is-gl-capable :boolean
304 (window (g-object gdk-window)))
306 (export 'gdk-window-is-gl-capable)
308 (defcfun (gdk-window-gl-window "gdk_window_get_gl_window") (g-object gdk-gl-window)
309 (window (g-object gdk-window)))
311 (export 'gdk-window-gl-window)
315 ;; TODO: gdk_gl_font_use_pango_font
317 ;; TODO: gdk_gl_font_use_pango_font_for_display
319 ;; Geometric Object Rendering
321 (defcfun gdk-gl-draw-cube :void
325 (export 'gdk-gl-draw-cube)
327 (defcfun gdk-gl-draw-sphere :void
333 (export 'gdk-gl-draw-sphere)
335 (defcfun gdk-gl-draw-cone :void
342 (export 'gdk-gl-draw-cone)
344 (defcfun gdk-gl-draw-torus :void
346 (inner-radius :double)
347 (outer-radius :double)
351 (export 'gdk-gl-draw-torus)
353 (defcfun gdk-gl-draw-tetrahedron :void
356 (export 'gdk-gl-draw-tetrahedron)
358 (defcfun gdk-gl-draw-octahedron :void
361 (export 'gdk-gl-draw-octahedron)
363 (defcfun gdk-gl-draw-dodecahedron :void
366 (export 'gdk-gl-draw-dodecahedron)
368 (defcfun gdk-gl-draw-icosahedron :void
371 (export 'gdk-gl-draw-icosahedron)
373 (defcfun gdk-gl-draw-teapot :void
377 (export 'gdk-gl-draw-teapot)
379 ;; OpenGL-Capable Widget
381 (defcfun gtk-widget-set-gl-capability :boolean
382 (widget (g-object widget))
383 (gl-config (g-object gdk-gl-config))
384 (share-list (g-object gdk-gl-config))
386 (render-type gdk-gl-render-type))
388 (export 'gtk-widget-set-gl-capability)
390 (defcfun gtk-widget-is-gl-capable :boolean
391 (widget (g-object widget)))
393 (export 'gtk-widget-is-gl-capable)
395 (defcfun (gtk-widget-gl-config "gtk_widget_get_gl_config") (g-object gdk-gl-config)
396 (widget (g-object widget)))
398 (export 'gtk-widget-gl-config)
400 (defcfun gtk-widget-create-gl-context (g-object gdk-gl-context)
401 (widget (g-object widget))
402 (share-list (g-object gdk-gl-context))
404 (render-type gdk-gl-render-type))
406 (export 'gtk-widget-create-gl-context)
408 (defcfun (gtk-widget-gl-context "gtk_widget_get_gl_context") (g-object gdk-gl-context)
409 (widget (g-object widget)))
411 (export 'gtk-widget-gl-context)
413 (defcfun (gtk-widget-gl-window "gtk_widget_get_gl_window") (g-object gdk-gl-window)
414 (widget (g-object widget)))
416 (export 'gtk-widget-gl-window)
418 (defun get-gl-config-ptr ()
419 (let ((cfg (gdk-gl-config-new-by-mode '(:rgba :depth :double))))
420 (if (null-pointer-p cfg)
421 (let ((cfg (gdk-gl-config-new-by-mode '(:rgba :depth))))
422 (warn "No double buffered visual found. Trying single-buffered.")
423 (if (null-pointer-p cfg)
424 (error "No OpenGL capable visual found.")
428 (defun get-gl-config ()
429 (make-instance 'gdk-gl-config :pointer (get-gl-config-ptr)))
431 (defvar *gl-config* nil)
433 (at-init () (setf *gl-config* (get-gl-config)))
435 (defmacro with-gensyms (syms &body body)
436 "Paul Graham ON LISP pg 145. Used in macros to avoid variable capture."
437 `(let ,(mapcar #'(lambda (s)
442 (defmacro bwhen ((bindvar boundform) &body body)
443 `(let ((,bindvar ,boundform))
447 (defmacro with-gl-context ((widget &key (swap-buffers-p t)) &rest body)
448 (with-gensyms (drawable context swap-p w)
449 `(let ((,swap-p ,swap-buffers-p)
451 (let ((,context (gtk-widget-gl-context ,w))
452 (,drawable (gtk-widget-gl-window ,w)))
453 (if (and ,context ,drawable (gdk-gl-drawable-gl-begin ,drawable ,context))
458 (when (gdk-gl-drawable-is-double-buffered ,drawable)
459 (gdk-gl-drawable-swap-buffers ,drawable)))
460 (gdk-gl-drawable-gl-end ,drawable)))
461 (format t "gl-begin failed ~A ~A ~A~%" ,w ,drawable ,context))))))
463 (defmacro with-matrix-mode ((mode) &body body)
465 (gl:matrix-mode ,mode)
468 (gl:matrix-mode :modelview)