tweeked points to be more uniform

LICENSE

@@ -1,20 +0,0 @@
-The MIT License (MIT)
-
-Copyright (c) 2011 Dan Ballard
-
-Permission is hereby granted, free of charge, to any person obtaining a copy of
-this software and associated documentation files (the "Software"), to deal in
-the Software without restriction, including without limitation the rights to
-use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
-the Software, and to permit persons to whom the Software is furnished to do so,
-subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in all
-copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
-FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
-COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
-IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
-CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

README.md

@@ -1,30 +0,0 @@
-flight-sim is a simple space flight simulator written in Lisp (tested only in SBCL) with cl-opengl and sdl.
-Right now it's mostly still in tech demo stage
-
-So far the controls are simple. 
-
-A - Forward acceleration
-
-Requires: 
-ASDF
-cl-opengl
-cl-glu
-lispbuilder-sdl
-
-To try:
-$ sh run.sh
-
-# Media
-
-Youtube video:
-
-<https://www.youtube.com/watch?v=8Y6zutbYWvg>
-
-The ship sitting in space with a field of diamonds:
-
-![The ship sitting in space with a field of diamonds](https://raw.github.com/dballard/flight-sim/master/img/screenshot01.png "The ship sitting in space with a field of diamonds")
-
-The ship firing its main thruster:
-
-![The ship firing its main thruster](https://raw.github.com/dballard/flight-sim/master/img/screenshot02.png "The ship firing its main thruster")
-

engine.lisp

@@ -1,5 +1,6 @@
 (in-package #:flight-sim)
 
+
 (defclass engine-object (game-object)
  ((start-time :initarg :start-time :accessor start-time :initform 0)
   ;; time till fully active
@@ -10,6 +11,17 @@
 (defmethod activate ((object engine-object) start-time)
   (setf (start-time object) start-time))
 
+;; Engine Vertices &
+;; Engine colors
+;; array of color transforms for engine vertices
+;;   Each cell if an RGB array of transforms for the vertex
+;;     Each subcell is (Start-color Final-color Transform-time)
+;; 4 vertices
+;; each of 3 coords/colors
+;; each either:
+;;   Value
+;;   (start end time)
+
 (defclass engine-model (model)
   ((template-vertices :initarg :template-vertices :accessor template-vertices :initform nil)
    (template-colors :initarg :template-colors :accessor template-colors :initform nil)))
@@ -31,25 +43,33 @@
   (setf (vertices model) (generate-step-2d-array (template-vertices model) time))
   (setf (colors model) (generate-step-2d-array (template-colors model) time)))
 
+(defun make-thruster-vertices (start-model final-model duration)
+  (loop for i from 0 to (1- (length start-model)) collect
+       (let ((start (elt start-model i))
+	     (final (elt final-model i)))
+	 (loop for x from 0 to 2 collect
+	      (if (eql (elt start x) (elt final x))
+		  (elt start x)
+		  (list (elt start x) (elt final x) duration))))))
 
-(defparameter *thruster-vertices* 
-  '((0.0 0.5 0.0) (-2.0 -0.5 0.0) (2.0 -0.5 0.0) 
-    ; z goes from 0 to 1 in 2 seconds
-    (0.0 0.0 (0 1.5 2))))
 
-(defparameter *thruster-colors*
-  '(((32 64 2) (32 132 2) (32 164 2))
-    ((32 64 2) (32 132 2) (32 164 2))
-    ((32 64 2) (32 132 2) (32 164 2))
-    ((0 255 2) (0 255 2) (64 255 2))))
+(defun make-thruster-colors (base-color-start base-color-final tip-color-start tip-color-final duration)
+  (append (loop for i from 1 to 3 collect 
+	     (loop for x from 0 to 2 collect
+		  (list (elt base-color-start x) (elt base-color-final x) duration)))
+	(list (loop for x from 0 to 2 collect
+		   (if (eql (elt tip-color-start x) (elt tip-color-final x)) 
+		       (elt tip-color-start x)
+		       (list (elt tip-color-start x) (elt tip-color-final x) duration))))))
+		    
 
-;; jet shooting up
-(defparameter *jet-vertices* 
-  '((0 0 -0.2) (-0.2 0 0.2) (0.2 0 0.2) (0 (0 0.4 1) 0)))
 
 (defmethod draw ((object engine-object) time) 
   (if (< (- time (start-time object)) (activation-time object)) ;; hack since times are in templates!!!
-      (regen-model (model object) (- time (start-time object))))
+      ;(progn ;debug model transform 
+	(regen-model (model object) (- time (start-time object))) 
+	;(format t "~a~%" (vertices (model object))) )  
+      ) 
   (call-next-method))
 	    
       
@@ -59,6 +79,31 @@
 	 (accel-vec (scale-vector (scale-vector-1 (direction (force src))) (- accel))))
     accel-vec))
     
-    
-    
+
+(defparameter *rear-thruster-vertices* 
+  (make-thruster-vertices                                                                                                      (transform-points *3pyramid-points* (vector 4 1 0.1))
+   ;'( (0.0 0.5 0.0) (-2.0 -0.5 0.0) (2.0 -0.5 0.0) (o0.0 0.0 0.0))
+   (transform-points *3pyramid-points* (vector 4 1 1.5))
+  ; '( (0.0 0.5 0.0) (-2.0 -0.5 0.0) (2.0 -0.5 0.0) (0.0 0.0 1.5))
+   2))
+;  '((0.0 0.5 0.0) (-2.0 -0.5 0.0) (2.0 -0.5 0.0) 
+;    ; z goes from 0 to 1 in 2 seconds
+;    (0.0 0.0 (0 1.5 2))))
+
+(defparameter *rear-thruster-colors*
+  (make-thruster-colors '(32 32 32) '(64 132 164) '(0 0 64) '(255 255 255) 2))
+;  '(((32 64 2) (32 132 2) (32 164 2))  ;; vertex1 : Red (32 -> 62 in 2 sec) Green (32 -> 132 in 2 sec) Blue (32 -> 164 in 2 sec
+;    ((32 64 2) (32 132 2) (32 164 2))
+;    ((32 64 2) (32 132 2) (32 164 2))
+;    ((0 255 2) (0 255 2) (64 255 2))))
+
+(defparameter *left-jet-vertices*
+  (make-thruster-vertices
+   (rotate-points (transform-points *3pyramid-points* (vector 0.25 0.25 0.2)) (vector (- (+ (/ pi 2) .5)) 0 .5))
+   (rotate-points (transform-points *3pyramid-points* (vector 0.25 0.25 0.4)) (vector (- (+ (/ pi 2) .5)) 0 .5))
+   2))
+
+(defparameter *left-jet-colors*
+  (make-thruster-colors '(40 40 40) '(255 255 0) '(80 80 80) '(255 255 255) 2))
+;  (make-thruster-colors '(196 196 196) '(255 255 196) '(196 196 196) '(255 255 255) 2))
 

flight-sim.lisp

@@ -65,41 +65,33 @@
   (case key 
     ((:sdl-key-w) ; + z
      (activate-attachment *self* :thruster (wall-time)))
-   ;  (progn
-       ;(setf (aref (acceleration (motion *self*)) 2) (- *acceleration*))
-       ;(engine-start (engine *self*) (wall-time))))
- ;      (activate-engine *self* :thrust))) 
      
-    ((:sdl-key-s) ; - z
-     (setf (aref (acceleration (motion *self*)) 2) *acceleration*))
-    ((:sdl-key-q) ; + x
-     (setf (aref (acceleration (motion *self*)) 0) *acceleration*))
-    ((:sdl-key-a) ; - x
-     (setf (aref (acceleration (motion *self*)) 0) (- *acceleration*)))
-    ((:sdl-key-e) ; + y
-     (setf (aref (acceleration (motion *self*)) 1) *acceleration*))
+   ; ((:sdl-key-s) ; - z
+   ;  (setf (aref (acceleration (motion *self*)) 2) *acceleration*))
+   ; ((:sdl-key-q) ; + x
+   ;  (setf (aref (acceleration (motion *self*)) 0) *acceleration*))
+   ; ((:sdl-key-a) ; - x
+   ;  (setf (aref (acceleration (motion *self*)) 0) (- *acceleration*)))
+   ; ((:sdl-key-e) ; + y
+   ;  (setf (aref (acceleration (motion *self*)) 1) *acceleration*))
     ((:sdl-key-d) ; - y
-     (setf (aref (acceleration (motion *self*)) 1) (- *acceleration*)))
+     (activate-attachment *self* :left-jet (wall-time)))
     (otherwise (format t "~a~%" key))))
 
 (defun thruster-off (key)
   (case key 
     ((:sdl-key-w) ; + z
      (deactivate-attachment *self* :thruster))
-    ; (progn
-    ;   (setf (aref (acceleration (motion *self*)) 2) 0)
-    ;   (engine-stop (engine *self*))))
-     
-    ((:sdl-key-s) ; - z
-     (setf (aref (acceleration (motion *self*)) 2) 0))
-    ((:sdl-key-q) ; + q
-     (setf (aref (acceleration (motion *self*)) 0) 0))
-    ((:sdl-key-a) ; - a
-     (setf (aref (acceleration (motion *self*)) 0) 0))
-    ((:sdl-key-e) ; + e
-     (setf (aref (acceleration (motion *self*)) 1) 0))
+      ;((:sdl-key-s) ; - z
+    ; (setf (aref (acceleration (motion *self*)) 2) 0))
+    ;((:sdl-key-q) ; + q
+    ; (setf (aref (acceleration (motion *self*)) 0) 0))
+    ;((:sdl-key-a) ; - a
+    ; (setf (aref (acceleration (motion *self*)) 0) 0))
+    ;((:sdl-key-e) ; + e
+    ; (setf (aref (acceleration (motion *self*)) 1) 0))
     ((:sdl-key-d) ; - d
-     (setf (aref (acceleration (motion *self*)) 1) 0))
+     (deactivate-attachment *self* :left-jet))
     (otherwise (format t "~a~%" key))))
 
 (defun phys-step (time)
@@ -153,15 +145,15 @@
 
 (defun populate-world ()
   (setf *world* 
-	(make-array 201 :initial-contents
-		    (loop for i from 0 to 200 collecting
+	(make-array 101 :initial-contents
+		    (loop for i from 0 to 100 collecting
 			 (let ((e (make-instance 'game-object 
 					:model (make-instance 'model
 							      :vertices (vertices *diamond-model*)
 							      :faces (faces *diamond-model*))
 					
 					:body (make-instance 'body
-							     :coords (vector (- (random 75) 37) (- (random 75) 37) (- (random 400) ))
+							     :coords (vector (- (random 75) 37) (- (random 75) 37) (- (random 200) ))
 							     :angles (vector (random 360) (random 360) (random 360))))))
 			   (setf (colors (model e)) (make-2d-array 3 3 `((,(random 255) ,(random 255) ,(random 255)) (,(random 255) ,(random 255) ,(random 255)) (,(random 255) ,(random 255) ,(random 255)))))
 			   (setf (face-colors (model e)) (make-2d-array 8 3 '((0 1 1) (0 1 1) (0 1 1) (0 1 1) (1 2 1) (1 2 1) (1 2 1) (1 2 1))))
@@ -182,14 +174,25 @@
 	       (make-instance 'engine-object
 			      :activation-time 2
 			      :model (make-instance 'engine-model 
-						    :template-vertices *thruster-vertices*
-						    :template-colors *thruster-colors*
+						    :template-vertices *rear-thruster-vertices*
+						    :template-colors *rear-thruster-colors*
 						    :faces (make-2d-array 4 3 '((0 1 3) (0 2 1) (0 3 2) (1 2 3)))
 						    :face-colors (make-2d-array 4 3 '((0 1 3) (0 2 1) (0 3 2) (1 2 3))))
 			      :force (make-instance 'force :newtons 10000 :direction (vector 0 0 1))
 			      
 			      :body (make-instance 'body
 						   :coords (vector 0 0 1.5)))
+	       :left-jet
+	       (make-instance 'engine-object
+			      :activation-time 2
+			      :model (make-instance 'engine-model
+						    :template-vertices *left-jet-vertices*
+						    :template-colors *left-jet-colors*
+						    :faces (make-2d-array 4 3 '((0 1 3) (0 2 1) (0 3 2) (1 2 3)))
+						    :face-colors (make-2d-array 4 3 '((0 1 3) (0 2 1) (0 3 2) (1 2 3))))
+			      :force (make-instance 'force :newtons 2000 :direction (vector 1 0 0))
+			      :body (make-instance 'body
+						   :coords (vector -.5 .2 0)))
 	       ; yaw (starboard (right) positive)
 ;	       :pos-yaw 
 ;	       (make-instance 'engine-object
@@ -229,4 +232,4 @@
 	     #+(and sbcl (not sb-thread)) (restartable
                                            (sb-sys:serve-all-events 0))
              (restartable (sim-step))))))
-	     ;(draw)))))
+	     ;(draw)))))

math.lisp

@@ -22,14 +22,14 @@
       (float (+ start (* (- end start) (if (eql now 0.0) 0.0 (/ (min now duration) duration)))))))
 
 
-;; returns a real lisp 2d array
-(defun make-rotation-matrix (xa ya za) 
-  (let ((sxa (sin xa))
-	(cxa (cos xa))
-	(sya (sin ya))
-	(cya (cos ya))
-	(sza (sin za))
-	(cza (cos za)))
+;; returns a real lisp 2d array: args in radians
+(defun make-rotation-matrix (xyz) 
+  (let ((sxa (sin (aref xyz 0))) ;x
+	(cxa (cos (aref xyz 0))) ;x
+	(sya (sin (aref xyz 1))) ;y 
+	(cya (cos (aref xyz 1))) ;y
+	(sza (sin (aref xyz 2))) ;z
+	(cza (cos (aref xyz 2)))) ;z
     (make-array '(3 3) :initial-contents (list (list (* cya cza) (+ (- (* cxa sza)) (* sxa sya cza)) (+ (* sxa sza) (* cxa sya cza)))
 					   (list (* cya sza) (+ (* cxa cza) (* sxa sya sza)) (+ (- (* sxa cza)) (* cxa sya sza)))
 					   (list (- sya) (* sxa cya) (* cxa cya))))))
@@ -48,17 +48,36 @@
     result))
   
 
-(defun translate-triangle (tri position)
+(defun translate-points (tri position)
   (make-array (length tri) :initial-contents
 	      (loop for v across tri collecting (translate-point position v))))
 
-(defun rotate-triangle (tri m)
-  (make-array (length tri) :initial-contents
-	      (loop for v across tri collecting (rotate* m v))))
+(defun rotate-triangle (points m)
+  (if (not (eql (second (type-of m)) t))
+      (rotate-triangle points (make-rotation-matrix m))
+      (make-array (length points) :initial-contents
+		  (loop for v across points collecting (rotate* m v)))))
+
+(defun rotate-points (points m)
+  (if (not (eql (second (type-of m)) t))
+      (rotate-points points (make-rotation-matrix m))
+      (make-array (length points) :initial-contents (loop for tri across points collecting (rotate* m tri)))))
+
 
 (defun scale-vector (v a)
   (make-array (length v) :initial-contents (loop for i across v collecting (* i a))))
 
+; scale points by a
+(defun scale-points (points a)
+  (make-array (length points) :initial-contents (loop for v across points collecting (scale-vector v a))))
+
+; scale poitns by v (x y z)
+(defun transform-points (points xyz)
+  (make-array (length points) :initial-contents 
+	      (loop for v across points collecting 
+		   (make-array 3 :initial-contents
+			       (list (* (aref v 0) (aref xyz 0)) (* (aref v 1) (aref xyz 1)) (* (aref v 2) (aref xyz 2)))))))
+
 ; returns a vector with all elemts scaled to biggest 1 which is scaled to 1
 ; e.x. (scale-vector (8 4 2)) -> (1 .5 .25)
 (defun scale-vector-1 (v)
@@ -81,4 +100,5 @@
   (make-array (length v1) :initial-contents (loop for i from 0 to (1- (length v1)) collecting (- (aref v1 i) (aref v2 i)))))
 
 (defun vector+ (v1 v2)
-  (make-array (length v1) :initial-contents (loop for i from 0 to (1- (length v1)) collecting (+ (aref v1 i) (aref v2 i)))))
+  (make-array (length v1) :initial-contents (loop for i from 0 to (1- (length v1)) collecting (+ (aref v1 i) (aref v2 i)))))
+

model.lisp

@@ -53,18 +53,72 @@
 						(-0.5 0.0 0.5) (-0.5 0.0 -0.5) (0.0 -1.0 0.0)))
 		 :faces (make-2d-array 8 3 '((0 3 1) (0 2 4) (0 1 2) (0 4 3)
 					     (3 5 1) (2 5 4) (1 5 2) (4 5 3)))))
+; point up along +z
+(defparameter *3pyramid-points*
+  (make-2d-array 4 3 '((0.0 0.5 0) (-0.5 -0.5 0) (0.5 -0.5 0) (0.0 0.0 1))))
 
-;; returns a model of a 3 pyramid
+; point up along +z, flat facing +y (into)
+(defparameter *3pyramid-flat-points*
+  (make-2d-array 4 3 '((0.0 0.5 0) (-0.5 -0.5 0) (0.5 -0.5 0) (0.0 -0.5 1))))
+;                        back top                                    tip
+;  (make-2d-array 4 3 '((0.0 -0.5 -1) (0.0 0.5 0) (-0.5 -0.5 0) (0.5 -0.5 0))))
+ ;                           tip                                     backtop
+
+(defparameter *colors* (make-hash-table :test 'equal))
+(setf (gethash "red" *colors*) '(255 0 0))
+(setf (gethash "darkred" *colors*) '(139 0 0))
+;(setf (gethash "lightred" *colors*) '(255 0 0))
+
+(setf (gethash "cyan" *colors*) '(0 255 255))
+
+(setf (gethash "blue" *colors*) '(0 0 255))
+(setf (gethash "darkblue" *colors*) '(0 0 139))
+(setf (gethash "lightblue" *colors*) '(173 216 230))
+
+(setf (gethash "pink" *colors*) '(255 20 147))
+
+(setf (gethash "green" *colors*) '(0 128 0))
+(setf (gethash "darkgreen" *colors*) '(0 100 0))
+(setf (gethash "lightgreen" *colors*) '(144 238 144))
+(setf (gethash "forestgreen" *colors*) '(34 140 34))
+
+(setf (gethash "lime" *colors*) '(0 255 0))
+
+(setf (gethash "orange" *colors*) '(255 165 0))
+(setf (gethash "yellow" *colors*) '(255 255 0))
+(setf (gethash "purple" *colors*) '(128 0 128))
+
+(setf (gethash "black" *colors*) '(0 0 0))
+(setf (gethash "white" *colors*) '(255 255 255))
+(setf (gethash "grey" *colors*) '(128 128 128))
+
+
+;; returns a model of a 3 pyramid from points and colors
 (defun make-model-3pyramid (points &key (face-colors nil) (point-colors nil))
   (make-instance 'model
-		 :vertices points
-		 :faces (make-2d-array 4 3 '((0 1 3) (0 2 1) (0 3 2) (1 2 3)))
-		 :colors (if face-colors face-colors point-colors)
+		 :vertices (if (listp points) (make-2d-array 4 3 points) points)
+		 :faces (make-2d-array 4 3 '((0 1 3) (1 2 3) (0 3 2) (0 2 1)))
+		 ;'((0 1 3) (0 2 1) (0 3 2) (1 2 3)))
+		 :colors (if face-colors 
+			     (if (listp face-colors) (make-2d-array 4 3 face-colors) face-colors)
+			     (if (listp point-colors) (make-2d-array 4 3 point-colors) point-colors))
 		 :face-colors (if face-colors 
 				  (make-2d-array 4 3 '((0 0 0) (1 1 1) (2 2 2) (3 3 3)))
 				  (make-2d-array 4 3 '((0 1 3) (0 2 1) (0 3 2) (1 2 3))))))
-	 
-(defparameter *ship-model*
-  (make-model-3pyramid (make-2d-array 4 3 '((0.0 -0.5 -1.5) (0.0 0.5 1.5) (-2.0 -0.5 1.5) (2.0 -0.5 1.5)))
-		       :face-colors (make-2d-array 4 3 '((196 196 196) (196 196 196) (196 196 196) (32 32 32)))))
 
+
+
+
+
+(defparameter *ship-model*
+  (make-model-3pyramid ;*3pyramid-flat-points*
+   (transform-points
+    ;(rotate-points  *3pyramid-flat-points* (make-rotation-matrix (vector 0 0 0)))
+    (translate-points (rotate-points  *3pyramid-flat-points* (vector 0 pi 0)) (vector 0 0 0.5))
+    (vector 4 1 3))
+   :face-colors '((196 196 196) (196 196 196) (196 196 196) (32 32 32))))
+
+;(defparameter *ship-model*
+;  (make-model-3pyramid '((0.0 -0.5 -1.5) (0.0 0.5 1.5) (-2.0 -0.5 1.5) (2.0 -0.5 1.5))
+;		       :face-colors '((196 196 196) (196 196 196) (196 196 196) (32 32 32))))
+