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))))