[corman-sdl-cvs] CVS update: corman-sdl/examples/rotating-cube_3.lisp - corman-sdl-cvs@common-lisp.net - mailman3.common-lisp.net

17 Apr 2004

Update of /project/corman-sdl/cvsroot/corman-sdl/examples
In directory common-lisp.net:/tmp/cvs-serv21416/examples
Modified Files:
    rotating-cube_3.lisp 
Log Message:
Date: Fri Apr 16 20:02:09 2004
Author: lcrook
Index: corman-sdl/examples/rotating-cube_3.lisp
diff -u corman-sdl/examples/rotating-cube_3.lisp:1.2 corman-sdl/examples/rotating-cube_3.lisp:1.3

--- corman-sdl/examples/rotating-cube_3.lisp:1.2	Wed Apr 14 18:08:54 2004
+++ corman-sdl/examples/rotating-cube_3.lisp	Fri Apr 16 20:02:09 2004
@@ -1,18 +1,17 @@
 ;;; A rotating cube example.
-;;; Taken from the SDL example http://sdldoc.csn.ul.ie/guidevideoopengl.php
+;;; Taken from the SDL example at http://sdldoc.csn.ul.ie/guidevideoopengl.php
 ;;; Author: Luke J Crook, luke@balooga.com
 ;;;
 ;;; Operation:
-;;; - Click any mouse button to pause/restart rotation. 
+;;; - Press any key (except Escape) to pause/restart rotation.
+;;; - Press Escape to exit.
+;;; - Left-click and use the mouse to rotate the cube around the x/y axises.
 ;;; 
 ;;; Issues:
 ;;; - Rotation is not scaled to time but is based on frame-rate. Therefore the rotation is crazy-fast on decent
 ;;;   hardware.
-;;; - Tends to crash the CCL IDE after being run a few times, so SAVE YOUR WORK. Author is not responsible for
-;;    any damage to hardware, loss of data, weight gain, hair loss etc. Use at your own risk.
 ;;
-;; 26 Feb, 2004
-;; Version 0.2
+;; 16 Feb, 2004
(require :mp)
 (require 'sdl)
@@ -26,6 +25,9 @@
(defparameter *angle* 0)
 (defparameter *rotate* t)
+(defparameter *rotatex* 0.0)
+(defparameter *rotatey* 0.0)
+(defparameter *rotatez* 0.0)
; Many thanks, Chris Double
 (defmacro with-glBegin (type &body body)
@@ -57,6 +59,28 @@
     (gethash id (get-palette-table)))
+(defun create-palette ()
+    (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)))
+
 (defun create-object ()
     (let ((cube '(
                     (-1.0 -1.0 1.0)
@@ -71,10 +95,6 @@
             (colors nil)
             (polys nil))
-        ;v0[0] = -1.0f;
-        ;v0[1] = -1.0f;
-        ;v0[2] = 1.0f;
-        
         ;;Create the vertices
         (setf vertices 
             (mapcar #'(lambda (vertex)
@@ -83,9 +103,9 @@
                         (setf (ct:cref vertex-arrayf v-array i) (nth i vertex)))
                     v-array))
             cube))
-        
-        
-        ;;Assign a color to each vertex
+                
+        ;;Assign a color to each vertex. Assignment is based on position in the list, 
+        ;;so the first color in the colors list is assigned to the first vertex in the vertices list.
         (setf colors (list 
                 (get-color 'red)
                 (get-color 'green)
@@ -111,33 +131,12 @@
                 (1 0 4)
                 (1 4 5)))
+        ;Return an 'object' with the vertices, color assignment and list of polygons
         `(
             (vertices ,vertices)
             (colors ,colors)
             (polys ,polys))))
-(defun create-palette ()
-    (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)))
-
 (defun assoc-data (key assoc-list)
     (first (rest (assoc key assoc-list))))
@@ -150,8 +149,10 @@
     (glLoadIdentity)
(glTranslatef 0.0 0.0 -5.0)
-    (glRotatef (coerce *angle* 'single-float) 0.0 1.0 0.0)
-        
+    (glRotatef (+ (coerce *angle* 'single-float) (coerce *rotatex* 'single-float)) 0.0 1.0 0.0)
+    (glRotatef (coerce *rotatey* 'single-float) 1.0 0.0 0.0)    
+    (glRotatef (coerce *rotatez* 'single-float) 0.0 0.0 1.0)
+           
     (if (> *angle* 360.0)
         (setf *angle* 0.0))
@@ -211,6 +212,11 @@
                         (sdl:push-quitevent))
                     (when (sdl:is-key keysym sdl:SDLK_SPACE)
                         (setf *rotate* (not *rotate*))))
+                (:mousemotion (state x y xrel yrel)
+                    (cond
+                        ((eql state 1)
+                            (setf *rotatex* (+ *rotatex* xrel))
+                            (setf *rotatey* (+ *rotatey* yrel )))))
                 (:idle
                     (draw-screen cube))))

    