/[corman-sdl]/corman-sdl/examples/SDL_examples_1_4 (gears).lisp
ViewVC logotype

Contents of /corman-sdl/examples/SDL_examples_1_4 (gears).lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Wed Apr 14 00:55:47 2004 UTC (10 years ago) by lcrook
Branch: MAIN
CVS Tags: lush_v1, HEAD
Branch point for: lush
Changes since 1.1: +51 -358 lines
*** empty log message ***
1 ;;; The famous OpenGL gears example, by Brian Paul.
2 ;;; Corman Common Lisp and SDL Conversion by: Luke J Crook, luke@balooga.com
3 ;;; 06 December, 2003 Version 1.1
4 ;;; 15 January, 2004 Version 1.2
5 ;;; - Replaced the with-sdl-events macro with a much better version.
6 ;;;
7 ;;; The Author is not responsible for
8 ;;; any damage to hardware, loss of data, weight gain, hair loss etc. Use at your own risk.
9 ;;;
10 ;;; Operation:
11 ;;; - Click & hold left mouse button and move mouse to rotate the gears in the x/y planes
12 ;;;
13 ;;; Issues:
14 ;;; - The movement of the gears is independent of frame rate. Hardware speed only effects
15 ;;; the frames per second, so the faster the hardware the smoother the animation.
16 ;;; - Do NOT attempt to run two instances of this program from within Corman Lisp simultaneously.
17 ;;; The SDL library is currently limited to a single instance only. Only a single OpenGL window may
18 ;;; be open at any one time. SDL is a GAMES library, not a general purpose windowing library.
19
20 (require :mp)
21 (require :sdl)
22 (require :sdl-util)
23 (require :opengl)
24 (require :opengl_)
25 (in-package :win)
26
27 (ct:defctype GLfloat-4 (GLfloat 4))
28
29 ;; Generic parameters
30 (defparameter *world-ticks* 15) ; decouples any rotation or movement from the speed of the hardware.
31 (defparameter *timescale* 1)
32 (defparameter *fps-display-interval* 1000) ; print the average frames per second to the CCL console.
33 ; (in milliseconds. 0 == do not print)
34 (defparameter *move-delay* 0) ; Inserts a delay of n milliseconds between each draw cycle. For testing.
35 ;(0 == no delay)
36
37 ;; Application specific parameters
38 (defparameter *screen-width* 640)
39 (defparameter *screen-height* 480)
40 (defparameter *opengl-attributes*
41 (list
42 (list sdl:SDL_GL_RED_SIZE 5)
43 (list sdl:SDL_GL_GREEN_SIZE 5)
44 (list sdl:SDL_GL_BLUE_SIZE 5)
45 (list sdl:SDL_GL_DEPTH_SIZE 16)
46 (list sdl:SDL_GL_DOUBLEBUFFER 1)))
47 (defparameter *gear1* nil)
48 (defparameter *gear2* nil)
49 (defparameter *gear3* nil)
50 (defparameter *angle* 0) ; Stores the angle of rotation for the gears.
51 (defparameter *view_rotx* 20.0)
52 (defparameter *view_roty* 30.0)
53 (defparameter *view_rotz* 0.0)
54 (defparameter *draw-outline* nil) ; Draws a white wireframe outline around each polygon
55
56 ;;; Begin macro definitions.
57 ; Many thanks, Chris Double
58 (defmacro with-glBegin (type &body body)
59 `(progn
60 (glBegin ,type)
61 (unwind-protect
62 (progn ,@body)
63 (glEnd))))
64
65 (defmacro with-glPushMatrix (&body body)
66 `(progn
67 (glPushMatrix)
68 (unwind-protect
69 (progn ,@body)
70 (glPopMatrix))))
71
72 ;;; End macro definitions
73 ;;;
74
75 (defun opengl-set-attribute (attribute)
76 (apply #'sdl:SDL_GL_SetAttribute attribute))
77
78 (defun opengl-set-attributes (attributes)
79 (mapcar #'opengl-set-attribute attributes))
80
81 ;;;
82 ;;; End SDL Events
83
84 (defun create-gear (inner_radius outer_radius width teeth tooth_depth)
85 (let* (
86 (M_PI (/ 22 7))
87 (r0 inner_radius)
88 (r1 (/ (- outer_radius tooth_depth) 2.0))
89 (r2 (/ (+ outer_radius tooth_depth) 2.0))
90 (angle 0.0)
91 (da (/ (/ (* 2.0 M_PI) teeth) 4.0))
92 (u 0.0)
93 (v 0.0)
94 (len 0.0))
95
96 (glShadeModel GL_FLAT)
97
98 (glNormal3f 0.0 0.0 1.0)
99
100 ;draw front face
101 (with-glBegin GL_QUAD_STRIP
102 (sdl:for i 0 teeth
103 (setf angle (/ (* i 2.0 M_PI) teeth))
104 (glVertex3f
105 (coerce (* r0 (cos angle)) 'single-float)
106 (coerce (* r0 (sin angle)) 'single-float)
107 (coerce (* width 0.5) 'single-float))
108 (glVertex3f
109 (coerce (* r1 (cos angle)) 'single-float)
110 (coerce (* r1 (sin angle)) 'single-float)
111 (coerce (* width 0.5) 'single-float))
112 (if (< i teeth)
113 (progn
114 (glVertex3f
115 (coerce (* r0 (cos angle)) 'single-float)
116 (coerce (* r0 (sin angle)) 'single-float)
117 (coerce (* width 0.5) 'single-float))
118 (glVertex3f
119 (coerce (* r1 (cos (+ (* 3 da) angle))) 'single-float)
120 (coerce (* r1 (sin (+ (* 3 da) angle))) 'single-float)
121 (coerce (* width 0.5) 'single-float))))))
122
123 ;draw front sides of teeth
124 (with-glBegin GL_QUADS
125 (setf da
126 (/ (/ (* 2.0 M_PI) teeth)
127 4.0))
128 (sdl:for i 0 teeth
129 (setf angle (/ (* i 2.0 M_PI) teeth))
130 (glVertex3f
131 (coerce (* r1 (cos angle)) 'single-float)
132 (coerce (* r1 (sin angle)) 'single-float)
133 (coerce (* width 0.5) 'single-float))
134 (glVertex3f
135 (coerce (* r2 (cos (+ angle da))) 'single-float)
136 (coerce (* r2 (sin (+ angle da))) 'single-float)
137 (coerce (* width 0.5) 'single-float))
138 (glVertex3f
139 (coerce (* r2 (cos (+ angle (* 2 da)))) 'single-float)
140 (coerce (* r2 (sin (+ angle (* 2 da)))) 'single-float)
141 (coerce (* width 0.5) 'single-float))
142 (glVertex3f
143 (coerce (* r1 (cos (+ angle (* 3 da)))) 'single-float)
144 (coerce (* r1 (sin (+ angle (* 3 da)))) 'single-float)
145 (coerce (* width 0.5) 'single-float))))
146
147 (glNormal3f 0.0 0.0 (- 1.0))
148
149 ;draw back face
150 (with-glBegin GL_QUAD_STRIP
151 (sdl:for i 0 teeth
152 (setf angle (/ (* i 2.0 M_PI) teeth))
153 (glVertex3f
154 (coerce (* r1 (cos angle)) 'single-float)
155 (coerce (* r1 (sin angle)) 'single-float)
156 (coerce (* (- width) 0.5) 'single-float))
157 (glVertex3f
158 (coerce (* r0 (cos angle)) 'single-float)
159 (coerce (* r0 (sin angle)) 'single-float)
160 (coerce (* (- width) 0.5) 'single-float))
161 (if (< i teeth)
162 (progn
163 (glVertex3f
164 (coerce (* r1 (cos (+ (* 3 da) angle))) 'single-float)
165 (coerce (* r1 (sin (+ (* 3 da) angle))) 'single-float)
166 (coerce (* (- width) 0.5) 'single-float))
167 (glVertex3f
168 (coerce (* r0 (cos angle)) 'single-float)
169 (coerce (* r0 (sin angle)) 'single-float)
170 (coerce (* (- width) 0.5) 'single-float))))))
171
172 ;draw back sides of teeth
173 (with-glBegin GL_QUADS
174 (setf da
175 (/ (/ (* 2.0 M_PI) teeth)
176 4.0))
177 (sdl:for i 0 teeth
178 (setf angle (/ (* i 2.0 M_PI) teeth))
179 (glVertex3f
180 (coerce (* r1 (cos (+ angle (* 3 da)))) 'single-float)
181 (coerce (* r1 (sin (+ angle (* 3 da)))) 'single-float)
182 (coerce (* (- width) 0.5) 'single-float))
183 (glVertex3f
184 (coerce (* r2 (cos (+ angle (* 2 da)))) 'single-float)
185 (coerce (* r2 (sin (+ angle (* 2 da)))) 'single-float)
186 (coerce (* (- width) 0.5) 'single-float))
187 (glVertex3f
188 (coerce (* r2 (cos (+ angle da))) 'single-float)
189 (coerce (* r2 (sin (+ angle da))) 'single-float)
190 (coerce (* (- width) 0.5) 'single-float))
191 (glVertex3f
192 (coerce (* r1 (cos angle)) 'single-float)
193 (coerce (* r1 (sin angle)) 'single-float)
194 (coerce (* (- width) 0.5) 'single-float))))
195
196 ;draw outward faces of teeth
197 (with-glBegin GL_QUAD_STRIP
198 (sdl:for i 0 teeth
199 (setf angle (/ (* i 2.0 M_PI) teeth))
200 (glVertex3f
201 (coerce (* r1 (cos angle)) 'single-float)
202 (coerce (* r1 (sin angle)) 'single-float)
203 (coerce (* width 0.5) 'single-float))
204 (glVertex3f
205 (coerce (* r1 (cos angle)) 'single-float)
206 (coerce (* r1 (sin angle)) 'single-float)
207 (coerce (* (- width) 0.5) 'single-float))
208 (setf u (-
209 (* r2 (cos (+ angle da)))
210 (* r1 (cos angle))))
211 (setf v (-
212 (* r2 (sin (+ angle da)))
213 (* r1 (sin angle))))
214
215 (setf len (sqrt (+
216 (* u u)
217 (* v v))))
218 (setf u (/ u len))
219 (setf v (/ v len))
220
221 (glNormal3f
222 (coerce v 'single-float)
223 (coerce (- u) 'single-float)
224 (coerce 0.0 'single-float))
225 (glVertex3f
226 (coerce (* r2 (cos (+ angle da))) 'single-float)
227 (coerce (* r2 (sin (+ angle da))) 'single-float)
228 (coerce (* width 0.5) 'single-float))
229 (glVertex3f
230 (coerce (* r2 (cos (+ angle da))) 'single-float)
231 (coerce (* r2 (sin (+ angle da))) 'single-float)
232 (coerce (* (- width) 0.5) 'single-float))
233 (glNormal3f
234 (coerce (cos angle) 'single-float)
235 (coerce (sin angle) 'single-float)
236 (coerce 0.0 'single-float))
237 (glVertex3f
238 (coerce (* r2 (cos (+ angle (* 2 da)))) 'single-float)
239 (coerce (* r2 (sin (+ angle (* 2 da)))) 'single-float)
240 (coerce (* width 0.5) 'single-float))
241 (glVertex3f
242 (coerce (* r2 (cos (+ angle (* 2 da)))) 'single-float)
243 (coerce (* r2 (sin (+ angle (* 2 da)))) 'single-float)
244 (coerce (* (- width) 0.5) 'single-float))
245 (setf u (-
246 (* r1 (cos (+ angle (* 3 da))))
247 (* r2 (cos (+ angle (* 2 da))))))
248 (setf v (-
249 (* r1 (sin (+ angle (* 3 da))))
250 (* r2 (sin (+ angle (* 2 da))))))
251 (glNormal3f
252 (coerce v 'single-float)
253 (coerce (- u) 'single-float)
254 (coerce 0.0 'single-float))
255 (glVertex3f
256 (coerce (* r1 (cos (+ angle (* 3 da)))) 'single-float)
257 (coerce (* r1 (sin (+ angle (* 3 da)))) 'single-float)
258 (coerce (* width 0.5) 'single-float))
259 (glVertex3f
260 (coerce (* r1 (cos (+ angle (* 3 da)))) 'single-float)
261 (coerce (* r1 (sin (+ angle (* 3 da)))) 'single-float)
262 (coerce (* (- width) 0.5) 'single-float))
263 (glNormal3f
264 (coerce (cos angle) 'single-float)
265 (coerce (sin angle) 'single-float)
266 (coerce 0.0 'single-float)))
267
268 (glVertex3f
269 (coerce (* r1 (cos 0)) 'single-float)
270 (coerce (* r1 (sin 0)) 'single-float)
271 (coerce (* width 0.5) 'single-float))
272 (glVertex3f
273 (coerce (* r1 (cos 0)) 'single-float)
274 (coerce (* r1 (sin 0)) 'single-float)
275 (coerce (* (- width) 0.5) 'single-float)))
276
277 (glShadeModel GL_SMOOTH)
278
279 ;draw inside radius cylinder */
280 (with-glBegin GL_QUAD_STRIP
281 (sdl:for i 0 teeth
282 (setf angle (/ (* i 2.0 M_PI) teeth))
283 (glNormal3f
284 (coerce (- (cos angle)) 'single-float)
285 (coerce (- (sin angle)) 'single-float)
286 (coerce 0.0 'single-float))
287 (glVertex3f
288 (coerce (* r0 (cos angle)) 'single-float)
289 (coerce (* r0 (sin angle)) 'single-float)
290 (coerce (* (- width) 0.5) 'single-float))
291 (glVertex3f
292 (coerce (* r0 (cos angle)) 'single-float)
293 (coerce (* r0 (sin angle)) 'single-float)
294 (coerce (* width 0.5) 'single-float))))))
295
296 (defun move-objects ()
297 ; Insert a delay between screen updates. Used in testing to simulate
298 ; heavy processor load / varying frame rates.
299 (when (> *move-delay* 0)
300 (sdl:SDL_Delay *move-delay*))
301
302 (incf *angle* (* 1 *timescale*)))
303
304 (defun draw-objects ()
305 (with-glPushMatrix
306 ; (glRotatef (coerce *view_rotx* 'single-float) 1.0 0.0 0.0)
307 ; (glRotatef (coerce *view_roty* 'single-float) 0.0 1.0 0.0)
308 (glRotatef (coerce *view_rotx* 'single-float) 0.0 1.0 0.0)
309 (glRotatef (coerce *view_roty* 'single-float) 1.0 0.0 0.0)
310 (glRotatef (coerce *view_rotz* 'single-float) 0.0 0.0 1.0)
311
312 (with-glPushMatrix
313 (glTranslatef (- 3.0) (- 2.0) 0.0)
314 (glRotatef (coerce *angle* 'single-float) 0.0 0.0 1.0)
315 (glCallList *gear1*))
316
317 (with-glPushMatrix
318 (glTranslatef 3.1 (- 2.0) 0.0)
319 (glRotatef (coerce (- (* (- 2.0) *angle*) 9.0) 'single-float) 0.0 0.0 1.0)
320 (glCallList *gear2*))
321
322 (with-glPushMatrix
323 (glTranslatef (- 3.1) 4.2 0.0)
324 (glRotatef (coerce (- (* (- 2.0) *angle*) 25.0) 'single-float) 0.0 0.0 1.0)
325 (glCallList *gear3*))))
326
327 (defun draw-screen ()
328 (glClear (sdl:set-flags GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
329
330 (glEnable GL_LIGHTING)
331 (glEnable GL_LIGHT0)
332
333 (when *draw-outline*
334 (glEnable GL_POLYGON_OFFSET_FILL)
335 (glPolygonOffset 1.0 1.0))
336
337 (draw-objects)
338
339 (when *draw-outline*
340 (glDisable GL_POLYGON_OFFSET_FILL)
341 (glDisable GL_LIGHTING)
342 (glDisable GL_LIGHT0)
343 (glColor3f 1.0 1.0 1.0)
344 (glPolygonMode GL_FRONT_AND_BACK GL_LINE)
345
346 (draw-objects)
347
348 (glPolygonMode GL_FRONT_AND_BACK GL_FILL))
349
350 (sdl:SDL_GL_SwapBuffers))
351
352 (defun setup-opengl (width height)
353 (let
354 ((screen-ratio (coerce (/ height width) 'double-float)))
355
356 (glViewport 0 0 width height)
357 (glMatrixMode GL_PROJECTION)
358 (glLoadIdentity)
359 (glFrustum
360 (- 1.0d0)
361 1.0d0
362 (- screen-ratio)
363 screen-ratio
364 5.0d0
365 60.0d0)
366 (glMatrixMode GL_MODELVIEW)
367 (glLoadIdentity)
368 (glTranslatef 0.0 0.0 (- 40.0))))
369
370 (defun create-display-lists ()
371 (let (
372 (light-position (ct:malloc (ct:sizeof 'GLfloat-4)))
373 (red (ct:malloc (ct:sizeof 'GLfloat-4)))
374 (green (ct:malloc (ct:sizeof 'GLfloat-4)))
375 (blue (ct:malloc (ct:sizeof 'GLfloat-4))))
376
377 (setf (ct:cref GLFloat-4 light-position 0) 5.0)
378 (setf (ct:cref GLFloat-4 light-position 1) 5.0)
379 (setf (ct:cref GLFloat-4 light-position 2) 10.0)
380 (setf (ct:cref GLFloat-4 light-position 3) 0.0)
381
382 (setf (ct:cref GLfloat-4 red 0) 0.8)
383 (setf (ct:cref GLfloat-4 red 1) 0.1)
384 (setf (ct:cref GLfloat-4 red 2) 0.0)
385 (setf (ct:cref GLfloat-4 red 3) 1.0)
386
387 (setf (ct:cref GLfloat-4 green 0) 0.0)
388 (setf (ct:cref GLfloat-4 green 1) 0.8)
389 (setf (ct:cref GLfloat-4 green 2) 0.2)
390 (setf (ct:cref GLfloat-4 green 3) 1.0)
391
392 (setf (ct:cref GLfloat-4 blue 0) 0.2)
393 (setf (ct:cref GLfloat-4 blue 1) 0.2)
394 (setf (ct:cref GLfloat-4 blue 2) 1.0)
395 (setf (ct:cref GLfloat-4 blue 3) 1.0)
396
397 (glLightfv GL_LIGHT0 GL_POSITION light-position)
398
399 (glEnable GL_CULL_FACE)
400 (glEnable GL_DEPTH_TEST)
401
402 ;Create the gears
403 (setf *gear1* (glGenLists 1))
404 (glNewList *gear1* GL_COMPILE)
405 (glMaterialfv GL_FRONT GL_AMBIENT_AND_DIFFUSE red)
406 (create-gear 1.0 8.0 1.0 20 0.7)
407 (glEndList)
408
409 (setf *gear2* (glGenLists 1))
410 (glNewList *gear2* GL_COMPILE)
411 (glMaterialfv GL_FRONT GL_AMBIENT_AND_DIFFUSE green)
412 (create-gear 0.5 4.0 2.0 10 0.7)
413 (glEndList)
414
415 (setf *gear3* (glGenLists 1))
416 (glNewList *gear3* GL_COMPILE)
417 (glMaterialfv GL_FRONT GL_AMBIENT_AND_DIFFUSE blue)
418 (create-gear 1.3 4.0 0.5 10 0.7)
419 (glEndList)
420
421 (glEnable GL_NORMALIZE)))
422
423 (defun openGL-example-1 ()
424 (let (
425 (video-flags (list sdl:SDL_OPENGL)))
426
427 (sdl:with-init (sdl:SDL_INIT_VIDEO)
428 (opengl-set-attributes *opengl-attributes*)
429 (unless (sdl:set-videomode *screen-width* *screen-height* :flags video-flags)
430 (sdl:fformat "FAILED: set-videomode, cannot set the video mode")
431 (return))
432
433 (setup-opengl *screen-width* *screen-height*)
434
435 (create-display-lists)
436
437 (sdl:with-events
438 (:quit t)
439 (:keydown (state keysym)
440 (when (eql (sdl:get-key keysym) sdl:SDLK_ESCAPE)
441 (sdl:push-quitevent)))
442 (:mousemotion (state x y xrel yrel)
443 (cond
444 ((eql state 1)
445 (setf *view_rotx* (+ *view_rotx* xrel))
446 (setf *view_roty* (+ *view_roty* yrel )))))
447 (:idle
448 (move-objects)
449 (draw-screen))))
450
451 (unless (sdl:init-success)
452 (sdl:fformat "ERROR: sdl:with-init FAILED to initialize"))))
453
454 ;;; Run the example using...
455 ;;; (setf gears (mp:process-run-function "openGL-example-1" #'openGL-example-1))
456
457 ;;; Build the exe using...
458 ;;; (SAVE-APPLICATION "opengl-gears.exe" 'opengl-example-1 :static t)
459
460 ;;; Some parameters...
461 ;;; (setf *timescale* 1)
462 ;;; (setf *fps-display-interval* 1000)
463 ;;; (setf *draw-outline* t)

  ViewVC Help
Powered by ViewVC 1.1.5