source: trunk/ccl/examples/rubix/opengl.lisp @ 844

Last change on this file since 844 was 844, checked in by gb, 15 years ago

newer code from Hamilton

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.3 KB
Line 
1(eval-when (:compile-toplevel :load-toplevel :execute)
2  (ccl:use-interface-dir :GL))
3
4;;; Cocoa-based OpenGL package, for handy macros and classes of common
5;;; things like transformations, lights, cameras, quaternions, etc.
6;;; (note not all of this has been consolidated into this package yet)
7
8#|
9
10To use this functionality from cocoa, subclass NSOpenGLView,
11specialize drawRect on your class to render whatever you like,
12and make an intance in a window.
13
14|#
15
16#|
17;;; Some design notes for OpenGL programming in lisp...
18
19OpenGL is a very stateful API. with-X macros are invaluable for
20managing OpenGL's stacks and modes.
21
22The rubix demo is not set up this way, but really the main
23objects in a scene need to contain references to their structure,
24so that the structure can be reused between identical objects.
25For large objects that are not always going to be present, the
26structure could be compiled into a fasl and loaded only when
27necessary using a sentinel in place of the structure reference.
28
29Objects should capture the instance-specific state of objects in
30a scene and be used to parameterize the drawing of skeleton-based
31things. This can get tricky, but generic functions that draw
32skeleton structures when passed specific data about the object's
33state and the object's structure are probably the way to go.
34
35Display lists are handy for static models. Something that loaded
36easily-edited display list descriptions and turned them into fasl
37data that rebuilt the display lists would be useful... if I can
38find some EBNF and regexp forms my parser would build the ASTs
39that could be turned into objects easily enough and from there
40fasl data is easy to generate and save. If the file created a
41fasl that set a hash entry from a structure id to a usable opengl
42display list that would be good. A function that requested a
43structure by id that loaded a file if there was no hash entry
44would be slick.
45
46Since this is lisp, it should be possible to create a display
47list or an analogous lexical closure depending on what you want
48from the same model information (to be later rendered as a static
49object or rendered with a instance-state-driven function). I
50don't know how many DLs OpenGL can have at one time or how big
51they can be, it'd be good to know.
52
53|#
54
55(defpackage "OPENGL"
56  (:nicknames :opengl :gl)
57  (:export ;; Cocoa helpers
58           "WITH-OPENGL-CONTEXT"
59           "NEW-PIXEL-FORMAT"
60           ;; OpenGL helpers
61           "WITH-MATRIX-MODE"
62           "WITH-RENDER-MODE"
63           "WITH-ROTATION"
64           "WITH-GL"
65           "WITH-CULLING"
66           "WITH-MATRIX"
67           "UNPROJECT"
68           ))
69
70(in-package :opengl)
71
72;; WITH-OPENGL-CONTEXT is not needed in the PREPARE-OPENGL
73;; and DRAW-RECT functions of a specialized NS-OPENGL-VIEW
74(defparameter *opengl-context* nil)
75(defmacro with-opengl-context (context &body body)
76  (let ((contextsym (gensym)))
77    `(let ((,contextsym ,context))
78       (unwind-protect
79           (let ((*opengl-context* ,contextsym))
80             (send ,contextsym 'make-current-context)
81             ,@body)
82         ;; the following resets the current context to what it was
83         ;; previously as far as the special bindings are concerned
84         (if *opengl-context*
85             (send *opengl-context* 'make-current-context)
86           (send (@class ns-opengl-context) 'clear-current-context))))))
87
88(defun new-pixel-format (&rest attributes)
89  ;; take a list of opengl pixel format attributes (enums and other
90  ;; small ints), make an array (character array?), and create and
91  ;; return an NSOpenGLPixelFormat
92  (let* ((attribute-size (ccl::foreign-size :<NSO>pen<GLP>ixel<F>ormat<A>ttribute :bytes)))
93    (ccl::%stack-block ((objc-attributes (* attribute-size (1+ (length attributes)))))
94      (loop for i from 0 to (* (1- (length attributes)) attribute-size) by attribute-size
95            for attribute in attributes do
96            (setf (%get-long objc-attributes i) attribute) ; <- autocoerced?
97            finally (let ((lastpos (* (length attributes) attribute-size)))
98                      (setf (%get-long objc-attributes lastpos) 0))) ; <- objc nil = null ptr
99      (let* ((pixelformat (ccl::send (ccl::send (ccl::@class ns-opengl-pixel-format) 'alloc)
100                                     :init-with-attributes objc-attributes)))
101        pixelformat))))
102
103#|
104(setf pf (opengl:new-pixel-format #$NSOpenGLPFADoubleBuffer #$NSOpenGLPFADepthSize 32))
105(%stack-block ((a-long 4))
106  (send pf :get-values a-long :for-attribute #$NSOpenGLPFADepthSize :for-virtual-screen 0)
107  (%get-long a-long))
108|#
109
110(defparameter *matrix-mode* #$GL_MODELVIEW)
111(defmacro with-matrix-mode ((mode) &body body)
112  `(unwind-protect
113       (let ((*matrix-mode* ,mode))
114         (#_glMatrixMode *matrix-mode*)
115         ,@body)
116     (#_glMatrixMode *matrix-mode*)))
117
118(defparameter *render-mode* #$GL_RENDER)
119(defmacro with-render-mode ((mode) &body body)
120  `(block nil
121     (unwind-protect
122         (let ((*render-mode* ,mode))
123           (#_glRenderMode *render-mode*)
124           ,@body)
125       (return (#_glRenderMode *render-mode*)))))
126
127(defmacro with-rotation ((angle axis) &body body)
128  (let ((anglesym (gensym))
129        (axissym (gensym)))
130    `(let ((,anglesym ,angle)
131           (,axissym ,axis))
132       (unwind-protect
133           (with-matrix-mode (#$GL_MODELVIEW)
134             (#_glPushMatrix)
135             (#_glRotatef ,anglesym (aref ,axissym 0) (aref ,axissym 1) (aref ,axissym 2))
136             ,@body)
137         (#_glPopMatrix)))))
138
139(defmacro with-gl ((value) &body body)
140  `(progn (#_glBegin ,value)
141          ,@body
142          (#_glEnd)))
143
144(defmacro with-culling ((cull-face) &body body)
145  `(progn (#_glEnable #$GL_CULL_FACE)
146          (#_glCullFace ,cull-face)
147          ,@body
148          (#_glDisable #$GL_CULL_FACE)))
149
150(defmacro with-matrix ((load-identity-p) &body body)
151  `(progn (#_glPushMatrix)
152          ,@(when load-identity-p `((#_glLoadIdentity)))
153          ,@body
154          (#_glPopMatrix)))
155
156(defun unproject (x y)
157  (let (;; yeah, yeah... I think I know how big these are...
158        (gl-int-size (ccl::foreign-size :<GL>int :bytes))
159        (gl-double-size (ccl::foreign-size :<GL>double :bytes)))
160    (ccl::%stack-block ((viewport (* gl-int-size 4))
161                        (modelview-matrix (* gl-double-size 16))
162                        (projection-matrix (* gl-double-size 16))
163                        (wx gl-double-size)
164                        (wy gl-double-size)
165                        (wz gl-double-size))
166      (#_glGetIntegerv #$GL_VIEWPORT viewport)
167      (#_glGetDoublev #$GL_MODELVIEW_MATRIX modelview-matrix)
168      (#_glGetDoublev #$GL_PROJECTION_MATRIX projection-matrix)
169      (#_gluUnProject (ccl::%double-float x) (ccl::%double-float y) 0.0d0
170                      modelview-matrix projection-matrix viewport
171                      wx wy wz)
172      (coerce (list (ccl::%get-double-float wx)
173                    (ccl::%get-double-float wy)
174                    (ccl::%get-double-float wz))
175              'vector))))
Note: See TracBrowser for help on using the repository browser.