Update LICENSE

LICENSE

@@ -0,0 +1,20 @@
+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

@@ -0,0 +1,30 @@
+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,6 +1,5 @@
 (in-package #:flight-sim)
 
-
 (defclass engine-object (game-object)
  ((start-time :initarg :start-time :accessor start-time :initform 0)
   ;; time till fully active
@@ -11,17 +10,6 @@
 (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)))
@@ -43,33 +31,25 @@
   (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))))
 
-(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))))))
-		    
+(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))))
 
+;; 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!!!
-      ;(progn ;debug model transform 
-	(regen-model (model object) (- time (start-time object))) 
-	;(format t "~a~%" (vertices (model object))) )  
-      ) 
+      (regen-model (model object) (- time (start-time object))))
   (call-next-method))
 	    
       
@@ -79,31 +59,6 @@
 	 (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,33 +65,41 @@
   (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
-     (activate-attachment *self* :left-jet (wall-time)))
+     (setf (aref (acceleration (motion *self*)) 1) (- *acceleration*)))
     (otherwise (format t "~a~%" key))))
 
 (defun thruster-off (key)
   (case key 
     ((:sdl-key-w) ; + z
      (deactivate-attachment *self* :thruster))
-      ;((: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))
+    ; (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-d) ; - d
-     (deactivate-attachment *self* :left-jet))
+     (setf (aref (acceleration (motion *self*)) 1) 0))
     (otherwise (format t "~a~%" key))))
 
 (defun phys-step (time)
@@ -145,15 +153,15 @@
 
 (defun populate-world ()
   (setf *world* 
-	(make-array 101 :initial-contents
-		    (loop for i from 0 to 100 collecting
+	(make-array 201 :initial-contents
+		    (loop for i from 0 to 200 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 200) ))
+							     :coords (vector (- (random 75) 37) (- (random 75) 37) (- (random 400) ))
 							     :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))))
@@ -174,25 +182,14 @@
 	       (make-instance 'engine-object
 			      :activation-time 2
 			      :model (make-instance 'engine-model 
-						    :template-vertices *rear-thruster-vertices*
-						    :template-colors *rear-thruster-colors*
+						    :template-vertices *thruster-vertices*
+						    :template-colors *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
@@ -232,4 +229,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: 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
+;; 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)))
     (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,36 +48,17 @@
     result))
   
 
-(defun translate-points (tri position)
+(defun translate-triangle (tri position)
   (make-array (length tri) :initial-contents
 	      (loop for v across tri collecting (translate-point position 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 rotate-triangle (tri m)
+  (make-array (length tri) :initial-contents
+	      (loop for v across tri collecting (rotate* m v))))
 
 (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)
@@ -100,5 +81,4 @@
   (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,72 +53,18 @@
 						(-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))))
 
-; 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
+;; returns a model of a 3 pyramid
 (defun make-model-3pyramid (points &key (face-colors nil) (point-colors nil))
   (make-instance 'model
-		 :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))
+		 :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)
 		 :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 ;*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))))
+  (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 '((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))))
-