Update of /project/corman-sdl/cvsroot/corman-sdl/examples In directory common-lisp.net:/tmp/cvs-serv1208/examples Modified Files: rotating-cube_3.lisp Log Message: Date: Wed Apr 14 18:08:54 2004 Author: lcrook Index: corman-sdl/examples/rotating-cube_3.lisp diff -u corman-sdl/examples/rotating-cube_3.lisp:1.1 corman-sdl/examples/rotating-cube_3.lisp:1.2 --- corman-sdl/examples/rotating-cube_3.lisp:1.1 Tue Apr 13 13:09:40 2004 +++ corman-sdl/examples/rotating-cube_3.lisp Wed Apr 14 18:08:54 2004 @@ -14,6 +14,7 @@ ;; 26 Feb, 2004 ;; Version 0.2 +(require :mp) (require 'sdl) (require 'sdl-util) (require 'opengl) @@ -57,103 +58,88 @@ (defun create-object () - (let ((cube (list - (ct:malloc (ct:sizeof 'vertex-arrayf)) - (ct:malloc (ct:sizeof 'vertex-arrayf)) - (ct:malloc (ct:sizeof 'vertex-arrayf)) - (ct:malloc (ct:sizeof 'vertex-arrayf)) - (ct:malloc (ct:sizeof 'vertex-arrayf)) - (ct:malloc (ct:sizeof 'vertex-arrayf)) - (ct:malloc (ct:sizeof 'vertex-arrayf)) - (ct:malloc (ct:sizeof 'vertex-arrayf))))) + (let ((cube '( + (-1.0 -1.0 1.0) + (1.0 -1.0 1.0) + (1.0 1.0 1.0) + (-1.0 1.0 1.0) + (-1.0 -1.0 -1.0) + (1.0 -1.0 -1.0) + (1.0 1.0 -1.0) + (-1.0 1.0 -1.0))) + (vertices nil) + (colors nil) + (polys nil)) ;v0[0] = -1.0f; ;v0[1] = -1.0f; ;v0[2] = 1.0f; - (setf (ct:cref vertex-arrayf (nth 0 cube) 0) -1.0) - (setf (ct:cref vertex-arrayf (nth 0 cube) 1) -1.0) - (setf (ct:cref vertex-arrayf (nth 0 cube) 2) 1.0) - - (setf (ct:cref vertex-arrayf (nth 1 cube) 0) 1.0) - (setf (ct:cref vertex-arrayf (nth 1 cube) 1) -1.0) - (setf (ct:cref vertex-arrayf (nth 1 cube) 2) 1.0) - - (setf (ct:cref vertex-arrayf (nth 2 cube) 0) 1.0) - (setf (ct:cref vertex-arrayf (nth 2 cube) 1) 1.0) - (setf (ct:cref vertex-arrayf (nth 2 cube) 2) 1.0) - - (setf (ct:cref vertex-arrayf (nth 3 cube) 0) -1.0) - (setf (ct:cref vertex-arrayf (nth 3 cube) 1) 1.0) - (setf (ct:cref vertex-arrayf (nth 3 cube) 2) 1.0) - - (setf (ct:cref vertex-arrayf (nth 4 cube) 0) -1.0) - (setf (ct:cref vertex-arrayf (nth 4 cube) 1) -1.0) - (setf (ct:cref vertex-arrayf (nth 4 cube) 2) -1.0) - - (setf (ct:cref vertex-arrayf (nth 5 cube) 0) 1.0) - (setf (ct:cref vertex-arrayf (nth 5 cube) 1) -1.0) - (setf (ct:cref vertex-arrayf (nth 5 cube) 2) -1.0) - - (setf (ct:cref vertex-arrayf (nth 6 cube) 0) 1.0) - (setf (ct:cref vertex-arrayf (nth 6 cube) 1) 1.0) - (setf (ct:cref vertex-arrayf (nth 6 cube) 2) -1.0) - - (setf (ct:cref vertex-arrayf (nth 7 cube) 0) -1.0) - (setf (ct:cref vertex-arrayf (nth 7 cube) 1) 1.0) - (setf (ct:cref vertex-arrayf (nth 7 cube) 2) -1.0) - cube)) + + ;;Create the vertices + (setf vertices + (mapcar #'(lambda (vertex) + (let ((v-array (ct:malloc (ct:sizeof 'vertex-arrayf)))) + (sdl:for i 0 2 + (setf (ct:cref vertex-arrayf v-array i) (nth i vertex))) + v-array)) + cube)) + + + ;;Assign a color to each vertex + (setf colors (list + (get-color 'red) + (get-color 'green) + (get-color 'blue) + (get-color 'white) + (get-color 'yellow) + (get-color 'black) + (get-color 'orange) + (get-color 'purple))) + + ;;Create the polygons + (setf polys '( + (0 1 2) + (0 2 3) + (1 5 6) + (1 6 2) + (5 4 7) + (5 7 6) + (4 0 3) + (4 3 7) + (3 2 6) + (3 6 7) + (1 0 4) + (1 4 5))) + + `( + (vertices ,vertices) + (colors ,colors) + (polys ,polys)))) (defun create-palette () - (add-color 'red (ct:malloc (ct:sizeof 'colour-arrayu))) - (add-color 'white (ct:malloc (ct:sizeof 'colour-arrayu))) - (add-color 'green (ct:malloc (ct:sizeof 'colour-arrayu))) - (add-color 'blue (ct:malloc (ct:sizeof 'colour-arrayu))) - (add-color 'yellow (ct:malloc (ct:sizeof 'colour-arrayu))) - (add-color 'black (ct:malloc (ct:sizeof 'colour-arrayu))) - (add-color 'orange (ct:malloc (ct:sizeof 'colour-arrayu))) - (add-color 'purple (ct:malloc (ct:sizeof 'colour-arrayu))) - + (let ((palette '( + (red 255 0 0 255) + (green 0 255 0 255) + (blue 0 0 255 255) + (white 255 255 255 255) + (yellow 0 255 255 255) + (black 0 0 0 255) + (orange 255 255 0 255) + (purple 255 0 255 0)))) + + (mapcar #'(lambda (color) + (let ( + (color-array (ct:malloc (ct:sizeof 'colour-arrayu))) + (col (first color)) + (rgb (rest color))) + + (add-color col color-array) + (sdl:for i 0 3 + (setf (ct:cref colour-arrayu color-array i) (nth i rgb))))) + palette))) - - (setf (ct:cref colour-arrayu (get-color 'red) 0) 255) - (setf (ct:cref colour-arrayu (get-color 'red) 1) 0) - (setf (ct:cref colour-arrayu (get-color 'red) 2) 0) - (setf (ct:cref colour-arrayu (get-color 'red) 3) 255) - - (setf (ct:cref colour-arrayu (get-color 'green) 0) 0) - (setf (ct:cref colour-arrayu (get-color 'green) 1) 255) - (setf (ct:cref colour-arrayu (get-color 'green) 2) 0) - (setf (ct:cref colour-arrayu (get-color 'green) 3) 255) - - (setf (ct:cref colour-arrayu (get-color 'blue) 0) 0) - (setf (ct:cref colour-arrayu (get-color 'blue) 1) 0) - (setf (ct:cref colour-arrayu (get-color 'blue) 2) 255) - (setf (ct:cref colour-arrayu (get-color 'blue) 3) 255) - - (setf (ct:cref colour-arrayu (get-color 'white) 0) 255) - (setf (ct:cref colour-arrayu (get-color 'white) 1) 255) - (setf (ct:cref colour-arrayu (get-color 'white) 2) 255) - (setf (ct:cref colour-arrayu (get-color 'white) 3) 255) - - (setf (ct:cref colour-arrayu (get-color 'yellow) 0) 0) - (setf (ct:cref colour-arrayu (get-color 'yellow) 1) 255) - (setf (ct:cref colour-arrayu (get-color 'yellow) 2) 255) - (setf (ct:cref colour-arrayu (get-color 'yellow) 3) 255) - - (setf (ct:cref colour-arrayu (get-color 'black) 0) 0) - (setf (ct:cref colour-arrayu (get-color 'black) 1) 0) - (setf (ct:cref colour-arrayu (get-color 'black) 2) 0) - (setf (ct:cref colour-arrayu (get-color 'black) 3) 255) - - (setf (ct:cref colour-arrayu (get-color 'orange) 0) 255) - (setf (ct:cref colour-arrayu (get-color 'orange) 1) 255) - (setf (ct:cref colour-arrayu (get-color 'orange) 2) 0) - (setf (ct:cref colour-arrayu (get-color 'orange) 3) 255) - - (setf (ct:cref colour-arrayu (get-color 'purple) 0) 255) - (setf (ct:cref colour-arrayu (get-color 'purple) 1) 0) - (setf (ct:cref colour-arrayu (get-color 'purple) 2) 255) - (setf (ct:cref colour-arrayu (get-color 'purple) 3) 0)) +(defun assoc-data (key assoc-list) + (first (rest (assoc key assoc-list)))) (defun draw-screen (object) (if (not (null *rotate*)) @@ -170,90 +156,17 @@ (setf *angle* 0.0)) (with-glBegin GL_TRIANGLES - (glColor4ubv (get-color 'red)) - (glVertex3fv (nth 0 object)) - (glColor4ubv (get-color 'green)) - (glVertex3fv (nth 1 object)) - (glColor4ubv (get-color 'blue)) - (glVertex3fv (nth 2 object)) - - (glColor4ubv (get-color 'red)) - (glVertex3fv (nth 0 object)) - (glColor4ubv (get-color 'blue)) - (glVertex3fv (nth 2 object)) - (glColor4ubv (get-color 'white)) - (glVertex3fv (nth 3 object)) - - (glColor4ubv (get-color 'green)) - (glVertex3fv (nth 1 object)) - (glColor4ubv (get-color 'black)) - (glVertex3fv (nth 5 object)) - (glColor4ubv (get-color 'orange)) - (glVertex3fv (nth 6 object)) - - (glColor4ubv (get-color 'green)) - (glVertex3fv (nth 1 object)) - (glColor4ubv (get-color 'orange)) - (glVertex3fv (nth 6 object)) - (glColor4ubv (get-color 'blue)) - (glVertex3fv (nth 2 object)) - - (glColor4ubv (get-color 'black)) - (glVertex3fv (nth 5 object)) - (glColor4ubv (get-color 'yellow)) - (glVertex3fv (nth 4 object)) - (glColor4ubv (get-color 'purple)) - (glVertex3fv (nth 7 object)) - - (glColor4ubv (get-color 'black)) - (glVertex3fv (nth 5 object)) - (glColor4ubv (get-color 'purple)) - (glVertex3fv (nth 7 object)) - (glColor4ubv (get-color 'orange)) - (glVertex3fv (nth 6 object)) - - (glColor4ubv (get-color 'yellow)) - (glVertex3fv (nth 4 object)) - (glColor4ubv (get-color 'red)) - (glVertex3fv (nth 0 object)) - (glColor4ubv (get-color 'white)) - (glVertex3fv (nth 3 object)) - - (glColor4ubv (get-color 'yellow)) - (glVertex3fv (nth 4 object)) - (glColor4ubv (get-color 'white)) - (glVertex3fv (nth 3 object)) - (glColor4ubv (get-color 'purple)) - (glVertex3fv (nth 7 object)) - - (glColor4ubv (get-color 'white)) - (glVertex3fv (nth 3 object)) - (glColor4ubv (get-color 'blue)) - (glVertex3fv (nth 2 object)) - (glColor4ubv (get-color 'orange)) - (glVertex3fv (nth 6 object)) - - (glColor4ubv (get-color 'white)) - (glVertex3fv (nth 3 object)) - (glColor4ubv (get-color 'orange)) - (glVertex3fv (nth 6 object)) - (glColor4ubv (get-color 'purple)) - (glVertex3fv (nth 7 object)) - - (glColor4ubv (get-color 'green)) - (glVertex3fv (nth 1 object)) - (glColor4ubv (get-color 'red)) - (glVertex3fv (nth 0 object)) - (glColor4ubv (get-color 'yellow)) - (glVertex3fv (nth 4 object)) - - (glColor4ubv (get-color 'green)) - (glVertex3fv (nth 1 object)) - (glColor4ubv (get-color 'yellow)) - (glVertex3fv (nth 4 object)) - (glColor4ubv (get-color 'black)) - (glVertex3fv (nth 5 object))) + (let ( + (vertices (assoc-data 'vertices object)) + (colors (assoc-data 'colors object)) + (polys (assoc-data 'polys object))) + (mapcar #'(lambda (poly) + (sdl:for i 0 2 + (glColor4ubv (nth (nth i poly) colors)) + (glVertex3fv (nth (nth i poly) vertices)))) + polys))) + (sdl:SDL_GL_SwapBuffers)) (defun setup-opengl (width height) @@ -279,9 +192,9 @@ (defun rotating-cube () (let ( (width 640) (height 480) (video-flags (list sdl:SDL_SWSURFACE sdl:SDL_OPENGL)) - (cube (create-object))) + (cube nil)) - (sdl:with-sdl-init (sdl:SDL_INIT_VIDEO) + (sdl:with-init (sdl:SDL_INIT_VIDEO) (unless (sdl:set-videomode width height :flags video-flags) (fformat "FAILED: set-videomode, cannot set the video mode") @@ -289,19 +202,24 @@ (setup-opengl width height) (create-palette) + (setf cube (create-object)) - (sdl:with-sdl-events + (sdl:with-events (:quit t) (:keydown (state keysym) - (when (eql (sdl:get-key keysym) sdl:SDLK_ESCAPE) + (when (sdl:is-key keysym sdl:SDLK_ESCAPE) (sdl:push-quitevent)) - (when (eql (sdl:get-key keysym) sdl:SDLK_SPACE) + (when (sdl:is-key keysym sdl:SDLK_SPACE) (setf *rotate* (not *rotate*)))) (:idle (draw-screen cube)))) - (unless (sdl:sdl-init-success) - (fformat "ERROR: sdl-init FAILED to initialize")))) + (unless (sdl:init-success) + (sdl:fformat "ERROR: sdl-init FAILED to initialize")))) -;;; (th:create-thread #'rotating-cube) +;;; Run the example using... +;;; (setf cube (mp:process-run-function "rotating-cube" #'rotating-cube)) +;;; (mp:proc) + +;;; Build the exe using... ;;; (SAVE-APPLICATION "rotating-cube.exe" 'rotating-cube :static t)