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
)