Merge remote-tracking branch 'andy128k/master'
[cl-gtk2.git] / gtk-glext / gtkglext.lisp
blobf6b8434ebb164a0e2043556ab09b7e4bbc3cba3e
1 (in-package :gtkglext)
3 ;; Initialization
5 (defcfun gtk-gl-init :void
6 (argc :pointer)
7 (argv :pointer))
9 (defun gl-init ()
10 (gtk-gl-init (null-pointer) (null-pointer))
11 (glut:init))
13 (at-init () (gl-init))
14 (at-finalize () (setf cl-glut::*glut-initialized-p* nil))
16 ;; Query
18 (defcfun (%gdk-gl-query-extension "gdk_gl_query_extension") :boolean)
19 (defcfun (%gdk-gl-query-extension-for-display "gdk_gl_query_extension_for_display") :boolean
20 (display (g-object display)))
22 (defun gdk-gl-query-extension (&optional (display nil display-provided-p))
23 (if display-provided-p
24 (%gdk-gl-query-extension-for-display display)
25 (%gdk-gl-query-extension)))
27 (export 'gdk-gl-query-extension)
29 (defcfun (%gdk-gl-query-version "gdk_gl_query_version") :boolean
30 (major (:pointer :int))
31 (minor (:pointer :int)))
33 (defcfun (%gdk-gl-query-version-for-display "gdk_gl_query_version_for_display") :boolean
34 (display (g-object display))
35 (major (:pointer :int))
36 (minor (:pointer :int)))
38 (defun gdk-gl-query-version (&optional (display nil display-provided-p))
39 (with-foreign-objects ((major :int) (minor :int))
40 (if display-provided-p
41 (%gdk-gl-query-version-for-display display major minor)
42 (%gdk-gl-query-version major minor))
43 (list (mem-ref major :int) (mem-ref minor :int))))
45 (export 'gdk-gl-query-version)
47 (defcfun gdk-gl-query-gl-extension :boolean
48 (extension-name :string))
50 (export 'gdk-gl-query-gl-extension)
52 ;; Tokens
54 (define-g-enum "GdkGLConfigAttrib" gdk-gl-config-attrib (:export t :type-initializer "gdk_gl_config_attrib_get_type")
55 (:use-gl 1) (:buffer-size 2) (:level 3)
56 (:rgba 4) (:doublebuffer 5) (:stereo 6)
57 (:aux-buffers 7) (:red-size 8) (:green-size 9)
58 (:blue-size 10) (:alpha-size 11) (:depth-size 12)
59 (:stencil-size 13) (:accum-red-size 14)
60 (:accum-green-size 15) (:accum-blue-size 16)
61 (:accum-alpha-size 17) (:config-caveat 32)
62 (:x-visual-type 34) (:transparent-type 35)
63 (:transparent-index-value 36)
64 (:transparent-red-value 37)
65 (:transparent-green-value 38)
66 (:transparent-blue-value 39)
67 (:transparent-alpha-value 40)
68 (:drawable-type 32784) (:render-type 32785)
69 (:x-renderable 32786) (:fbconfig-id 32787)
70 (:max-pbuffer-width 32790)
71 (:max-pbuffer-height 32791)
72 (:max-pbuffer-pixels 32792) (:visual-id 32779)
73 (:screen 32780) (:sample-buffers 100000)
74 (:samples 100001))
76 (define-g-enum "GdkGLRenderType" gdk-gl-render-type (:export t :type-initializer "gdk_gl_render_type_get_type")
77 (:rgba-type 32788) (:color-index-type 32789))
79 ;; Frame buffer configuration
81 (define-g-flags "GdkGLConfigMode" gdk-gl-config-mode (:export t :type-initializer "gdk_gl_config_mode_get_type")
82 (:rgb 0) (:rgba 0) (:index 1) (:single 0)
83 (:double 2) (:stereo 4) (:alpha 8) (:depth 16)
84 (:stencil 32) (:accum 64) (:multisample 128))
86 (define-g-object-class "GdkGLConfig" gdk-gl-config (:export t :type-initializer "gdk_gl_config_get_type")
87 ((:cffi screen gdk-gl-config-screen (g-object screen) "gdk_gl_config_get_screen" nil)
88 (:cffi colormap gdk-gl-config-colormap (g-object colormap) "gdk_gl_config_get_colormap" nil)
89 (:cffi visual gdk-gl-config-visual (g-object visual) "gdk_gl_config_get_visual" nil)
90 (:cffi depth gdk-gl-config-depth :int "gdk_gl_config_get_depth" nil)
91 (:cffi layer-plane gdk-gl-config-layer-plane :int "gdk_gl_config_get_layer_plane" nil)
92 (:cffi n-aux-buffers gdk-gl-config-n-aux-buffers :int "gdk_gl_config_get_n_aux_buffers" nil)
93 (:cffi n-sample-buffers gdk-gl-config-n-sample-buffers :int "gdk_gl_config_get_n_sample_buffers" nil)
94 (:cffi is-rgba gdk-gl-config-is-rgba :boolean "gdk_gl_config_is_rgba" nil)
95 (:cffi is-double-buffered gdk-gl-config-is-double-buffered :boolean "gdk_gl_config_is_double_buffered" nil)
96 (:cffi is-stereo gdk-gl-config-is-stereo :boolean "gdk_gl_config_is_stereo" nil)
97 (:cffi has-alpha gdk-gl-config-has-alpha :boolean "gdk_gl_config_has_alpha" nil)
98 (:cffi has-depth-buffer gdk-gl-config-has-depth-buffer :boolean "gdk_gl_config_has_depth_buffer" nil)
99 (:cffi has-stencil-buffer gdk-gl-config-has-stencil-buffer :boolean "gdk_gl_config_has_stencil_buffer" nil)
100 (:cffi has-accum-buffer gdk-gl-config-has-accum-buffer :boolean "gdk_gl_config_has_accum_buffer" nil)))
102 (defcfun (%gdk-gl-config-get-attrib "gdk_gl_config_get_attrib") :boolean
103 (gl-config (g-object gdk-gl-config))
104 (attribute gdk-gl-config-attrib)
105 (return-value (:pointer :int)))
107 (defun gdk-gl-config-attrib (gl-config attribute)
108 (with-foreign-object (v :int)
109 (when (%gdk-gl-config-get-attrib gl-config attribute v)
110 (mem-ref v :int))))
112 (defcfun gdk-gl-config-new-by-mode :pointer
113 (mode gdk-gl-config-mode))
115 (defcfun gdk-gl-config-new-by-mode-for-screen :pointer
116 (screen (g-object screen))
117 (mode gdk-gl-config-mode))
119 (defcfun (%gdk-gl-config-new-for-screen "gdk_gl_config_new_for_screen") :pointer
120 (screen (g-object screen))
121 (attrib-list (:pointer :int)))
123 (defun gdk-gl-config-new-for-screen (screen attrib-plist)
124 (with-foreign-object (attributes :int (+ (length attrib-plist) 2))
125 (iter (for (attr value) on attrib-plist by #'cddr)
126 (for i from 0 by 2)
127 (setf (mem-aref attributes 'gdk-gl-config-attrib i) attr
128 (mem-aref attributes :int (1+ i)) value))
129 (%gdk-gl-config-new-for-screen screen attributes)))
131 (defmethod make-instance ((config-class (eql (find-class 'gdk-gl-config)))
132 &rest initargs
133 &key pointer screen mode attrib-plist)
134 (cond
135 (pointer (call-next-method))
136 (mode (assert (not attrib-plist) nil "MODE and ATTRIB-LIST initargs can not be combined")
137 (let ((p (if screen
138 (gdk-gl-config-new-by-mode-for-screen screen mode)
139 (gdk-gl-config-new-by-mode mode))))
140 (apply #'call-next-method config-class :pointer p initargs)))
141 (attrib-plist (assert screen nil "SCREEN initargs must be specified when ATTRIB-LIST is specified")
142 (let ((p (gdk-gl-config-new-for-screen screen attrib-plist)))
143 (apply #'call-next-method config-class :pointer p initargs)))
144 (t (error "MODE or (MODE and SCREEN) or (SCREEN and ATTRIB-PLIST) initargs must be specified"))))
146 ;; Render context
148 (define-g-object-class "GdkGLContext" gdk-gl-context (:export t :type-initializer "gdk_gl_context_get_type")
149 ((:cffi drawable gdk-gl-context-drawable (g-object gdk-gl-drawable) "gdk_gl_context_get_gl_drawable" nil)
150 (:cffi gl-config gdk-gl-context-config (g-object gdk-gl-config) "gdk_gl_context_get_gl_config" nil)
151 (:cffi share-list gdk-gl-context-share-list (g-object gdk-gl-context) "gdk_gl_context_get_share_list" nil)
152 (:cffi is-direct gdk-gl-context-is-direct :boolean "gdk_gl_context_is_direct" nil)
153 (:cffi render-type gdk-gl-context-get-render-type gdk-gl-render-type "gdk_gl_context_get_render_type" nil)))
155 (defcfun (gdk-gl-context-current "gdk_gl_context_get_current") (g-object gdk-gl-context))
157 (export 'gdk-gl-context-current)
159 (defcfun gdk-gl-context-new :pointer
160 (gl-drawable (g-object gdk-gl-drawable))
161 (share-list (g-object gdk-gl-context))
162 (direct-p :boolean)
163 (render-type gdk-gl-render-type))
165 (defmethod make-instance ((context-class (eql (find-class 'gdk-gl-context)))
166 &rest initargs
167 &key pointer gl-drawable share-list direct-p (render-type :rgba-type))
168 (cond
169 (pointer (call-next-method))
170 (gl-drawable (let ((p (gdk-gl-context-new gl-drawable share-list direct-p render-type)))
171 (apply #'call-next-method context-class :pointer p initargs)))
172 (t (error "At least GL-DRAWABLE initarg must be specified"))))
174 (defcfun (gdk-gl-context-copy-state "gdk_gl_context_copy") :boolean
175 (dst-gl-context (g-object gdk-gl-context))
176 (src-gl-context (g-object gdk-gl-context))
177 (attribs-mask :int)) ;;TODO: more specific enum type
179 (export 'gdk-gl-context-copy-state)
181 ;; Rendering surface
183 (define-g-interface "GdkGLDrawable" gdk-gl-drawable (:export t :type-initializer "gdk_gl_drawable_get_type")
184 (:cffi is-double-buffered gdk-gl-drawable-is-double-buffered :boolean "gdk_gl_drawable_is_double_buffered" nil)
185 (:cffi config gdk-gl-drawable-config (g-object gdk-gl-config) "gdk_gl_drawable_get_gl_config" nil)
186 (:cffi size gdk-gl-drawable-size list gdk-gl-drawable-size nil))
188 (defcfun (%gdk-gl-drawable-get-size "gdk_gl_drawable_get_size") :void
189 (gl-drawable (g-object gl-drawable))
190 (width (:pointer :int))
191 (height (:pointer :int)))
193 (defun gdk-gl-drawable-get-size (gl-drawable)
194 (with-foreign-objects ((width :int) (height :int))
195 (%gdk-gl-drawable-get-size gl-drawable width height)
196 (list (mem-ref width :int) (mem-ref height :int))))
198 (defcfun (gdk-gl-drawable-current "gdk_gl_drawable_get_current") (g-object gdk-gl-drawable))
200 (export 'gdk-gl-drawable-current)
202 (defcfun gdk-gl-drawable-swap-buffers :void
203 (gl-drawable (g-object gdk-gl-drawable)))
205 (export 'gdk-gl-drawable-swap-buffers)
207 (defcfun gdk-gl-drawable-wait-gl :void
208 (gl-drawable (g-object gdk-gl-drawable)))
210 (export 'gdk-gl-drawable-wait-gl)
212 (defcfun gdk-gl-drawable-wait-gdk :void
213 (gl-drawable (g-object gdk-gl-drawable)))
215 (export 'gdk-gl-drawable-wait-gdk)
217 (defcfun gdk-gl-drawable-gl-begin :boolean
218 (gl-drawable (g-object gdk-gl-drawable))
219 (gl-context (g-object gdk-gl-context)))
221 (export 'gdk-gl-drawable-gl-begin)
223 (defcfun gdk-gl-drawable-gl-end :void
224 (gl-drawable (g-object gdk-gl-drawable)))
226 (export 'gdk-gl-drawable-gl-end)
228 ;; OpenGL Pixmap
230 (define-g-object-class "GdkGLPixmap" gdk-gl-pixmap (:superclass drawable :export t :interfaces ("GdkGLDrawable"))
233 (defcfun gdk-gl-pixmap-new :pointer
234 (gl-config (g-object gdk-gl-config))
235 (pixmap (g-object pixmap))
236 (attrib-list-unused (:pointer :int)))
238 (defmethod make-instance ((pixmap-class (eql (find-class 'gdk-gl-pixmap))) &rest initargs &key pointer gl-config pixmap)
239 (cond
240 (pointer (call-next-method))
241 ((and gl-config pixmap) (let ((p (gdk-gl-pixmap-new gl-config pixmap (null-pointer))))
242 (apply #'call-next-method pixmap-class :pointer p initargs)))
243 (t (error "POINTER or (GL-CONFIG and PIXMAP) initargs must be specified"))))
245 (defcfun (%gdk-pixmap-set-gl-capability "gdk_pixmap_set_gl_capability") (g-object gdk-gl-pixmap)
246 (pixmap (g-object pixmap))
247 (gl-config (g-object gdk-gl-config))
248 (attrib-list-unused (:pointer :int)))
250 (defun pixmap-set-gl-capability (pixmap gl-config)
251 (%gdk-pixmap-set-gl-capability pixmap gl-config (null-pointer)))
253 (export 'pixmap-set-gl-capability)
255 (defcfun (pixmap-unset-gl-capability "gdk_pixmap_unset_gl_capability") :void
256 (pixmap (g-object pixmap)))
258 (export 'pixmap-unset-gl-capability)
260 (defcfun (pixmap-is-gl-capable "gdk_pixmap_is_gl_capable") :boolean
261 (pixmap (g-object pixmap)))
263 (export 'pixmap-is-gl-capable)
265 (defcfun (pixmap-gl-pixmap "gdk_pixmap_get_gl_pixmap") (g-object gdk-gl-pixmap)
266 (pixmap (g-object pixmap)))
268 (export 'pixmap-gl-pixmap)
270 ;; OpenGL Window
272 (define-g-object-class "GdkGLWindow" gdk-gl-window (:superclass drawable :export t :interfaces ("GdkGLDrawable"))
273 ((:cffi window gdk-gl-window-gdk-window (g-object gdk-window) "gdk_gl_window_get_type" nil)))
275 (defcfun gdk-gl-window-new :pointer
276 (gl-config (g-object gdk-gl-config))
277 (window (g-object gdk-window))
278 (attrib-list-unused (:pointer :int)))
280 (defmethod make-instance ((window-class (eql (find-class 'gdk-gl-window)))
281 &rest initargs
282 &key pointer gl-config window)
283 (cond
284 (pointer (call-next-method))
285 ((and gl-config window) (let ((p (gdk-gl-window-new gl-config window (null-pointer))))
286 (apply #'call-next-method window-class :pointer p initargs)))
287 (t (error "POINTER or (GL-CONFIG and WINDOW) initargs must be specified"))))
289 (defcfun (%gdk-window-set-gl-capability "gdk_window_set_gl_capability") (g-object gdk-gl-window)
290 (window (g-object gdk-window))
291 (gl-config (g-object gdk-gl-config))
292 (attrib-list-unused (:pointer :int)))
294 (defun gdk-window-set-gl-capability (window gl-config)
295 (%gdk-window-set-gl-capability window gl-config (null-pointer)))
297 (export 'gdk-window-set-gl-capability)
299 (defcfun gdk-window-unset-gl-capability :void
300 (window (g-object gdk-window)))
302 (export 'gdk-window-unset-gl-capability)
304 (defcfun gdk-window-is-gl-capable :boolean
305 (window (g-object gdk-window)))
307 (export 'gdk-window-is-gl-capable)
309 (defcfun (gdk-window-gl-window "gdk_window_get_gl_window") (g-object gdk-gl-window)
310 (window (g-object gdk-window)))
312 (export 'gdk-window-gl-window)
314 ;; Font Rendering
316 ;; TODO: gdk_gl_font_use_pango_font
318 ;; TODO: gdk_gl_font_use_pango_font_for_display
320 ;; Geometric Object Rendering
322 (defcfun gdk-gl-draw-cube :void
323 (solid-p :boolean)
324 (size :double))
326 (export 'gdk-gl-draw-cube)
328 (defcfun gdk-gl-draw-sphere :void
329 (solid-p :boolean)
330 (radius :double)
331 (slices :int)
332 (stacks :int))
334 (export 'gdk-gl-draw-sphere)
336 (defcfun gdk-gl-draw-cone :void
337 (solid-p :boolean)
338 (base :double)
339 (height :double)
340 (slices :int)
341 (stacks :int))
343 (export 'gdk-gl-draw-cone)
345 (defcfun gdk-gl-draw-torus :void
346 (solid-p :boolean)
347 (inner-radius :double)
348 (outer-radius :double)
349 (n-sides :int)
350 (n-rings :int))
352 (export 'gdk-gl-draw-torus)
354 (defcfun gdk-gl-draw-tetrahedron :void
355 (solid-p :boolean))
357 (export 'gdk-gl-draw-tetrahedron)
359 (defcfun gdk-gl-draw-octahedron :void
360 (solid-p :boolean))
362 (export 'gdk-gl-draw-octahedron)
364 (defcfun gdk-gl-draw-dodecahedron :void
365 (solid-p :boolean))
367 (export 'gdk-gl-draw-dodecahedron)
369 (defcfun gdk-gl-draw-icosahedron :void
370 (solid-p :boolean))
372 (export 'gdk-gl-draw-icosahedron)
374 (defcfun gdk-gl-draw-teapot :void
375 (solid-p :boolean)
376 (scale :double))
378 (export 'gdk-gl-draw-teapot)
380 ;; OpenGL-Capable Widget
382 (defcfun gtk-widget-set-gl-capability :boolean
383 (widget (g-object widget))
384 (gl-config (g-object gdk-gl-config))
385 (share-list (g-object gdk-gl-config))
386 (direct-p :boolean)
387 (render-type gdk-gl-render-type))
389 (export 'gtk-widget-set-gl-capability)
391 (defcfun gtk-widget-is-gl-capable :boolean
392 (widget (g-object widget)))
394 (export 'gtk-widget-is-gl-capable)
396 (defcfun (gtk-widget-gl-config "gtk_widget_get_gl_config") (g-object gdk-gl-config)
397 (widget (g-object widget)))
399 (export 'gtk-widget-gl-config)
401 (defcfun gtk-widget-create-gl-context (g-object gdk-gl-context)
402 (widget (g-object widget))
403 (share-list (g-object gdk-gl-context))
404 (direct-p :boolean)
405 (render-type gdk-gl-render-type))
407 (export 'gtk-widget-create-gl-context)
409 (defcfun (gtk-widget-gl-context "gtk_widget_get_gl_context") (g-object gdk-gl-context)
410 (widget (g-object widget)))
412 (export 'gtk-widget-gl-context)
414 (defcfun (gtk-widget-gl-window "gtk_widget_get_gl_window") (g-object gdk-gl-window)
415 (widget (g-object widget)))
417 (export 'gtk-widget-gl-window)
419 (defun get-gl-config-ptr ()
420 (let ((cfg (gdk-gl-config-new-by-mode '(:rgba :depth :double))))
421 (if (null-pointer-p cfg)
422 (let ((cfg (gdk-gl-config-new-by-mode '(:rgba :depth))))
423 (warn "No double buffered visual found. Trying single-buffered.")
424 (if (null-pointer-p cfg)
425 (error "No OpenGL capable visual found.")
426 cfg))
427 cfg)))
429 (defun get-gl-config ()
430 (make-instance 'gdk-gl-config :pointer (get-gl-config-ptr)))
432 (defvar *gl-config* nil)
434 (at-init () (setf *gl-config* (get-gl-config)))
436 (defmacro with-gensyms (syms &body body)
437 "Paul Graham ON LISP pg 145. Used in macros to avoid variable capture."
438 `(let ,(mapcar #'(lambda (s)
439 `(,s (gensym)))
440 syms)
441 ,@body))
443 (defmacro bwhen ((bindvar boundform) &body body)
444 `(let ((,bindvar ,boundform))
445 (when ,bindvar
446 ,@body)))
448 (defmacro with-gl-context ((widget &key (swap-buffers-p t)) &rest body)
449 (with-gensyms (drawable context swap-p w)
450 `(let ((,swap-p ,swap-buffers-p)
451 (,w ,widget))
452 (let ((,context (gtk-widget-gl-context ,w))
453 (,drawable (gtk-widget-gl-window ,w)))
454 (if (and ,context ,drawable (gdk-gl-drawable-gl-begin ,drawable ,context))
455 (unwind-protect
456 (progn
457 ,@body)
458 (progn
459 (when ,swap-p
460 (when (gdk-gl-drawable-is-double-buffered ,drawable)
461 (gdk-gl-drawable-swap-buffers ,drawable)))
462 (gdk-gl-drawable-gl-end ,drawable)))
463 (format t "gl-begin failed ~A ~A ~A~%" ,w ,drawable ,context))))))
465 (defmacro with-matrix-mode ((mode) &body body)
466 `(progn
467 (gl:matrix-mode ,mode)
468 (gl:load-identity)
469 ,@body
470 (gl:matrix-mode :modelview)
471 (gl:load-identity)))