Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
233 lines (186 sloc) 7.79 KB
;;;; flight-sim.lisp
(in-package #:flight-sim)
;;; "flight-sim" goes here. Hacks and glory await!
;(defmethod time-step ((object powered-object) time)
; (loop for engine in (loop for engine-sym in (getf (engines object) :active) collecting (getf (engines engines) engine-sym)) do
; (time-step engine object time)))
; ; (motion-step (motion *self*) time))
(defparameter *world* nil)
(defparameter *self* nil)
(defparameter *velocity* 2) ; 1 unit / second
(defparameter *acceleration* 2) ; 1 unit /second
(defparameter *controls-active* '())
(defparameter *start-time* (wall-time))
(defparameter *last-time* nil)
(defparameter *num-frames* 0)
(defun draw-world (start-time)
;; clear the buffer
(gl:clear :color-buffer-bit :depth-buffer-bit)
;; move to eye position
;;draw (make-instance 'powered-object :motion (make-instance 'motion :coords (vector 0 0 -3)) :model *ship-model* :engine (engine *self*)))
(let ((orig-coords (coords (body *self*))))
(setf (coords (body *self*)) (vector 0 0 -3))
(draw *self* start-time)
(setf (coords (body *self*)) orig-coords))
(gl:translate (- (aref (coords (body *self*)) 0)) (- (aref (coords (body *self*)) 1)) (- (aref (coords (body *self*)) 2))) ;; eye
(loop for entity across *world* do
; only draw if its infront of me
(if (< (aref (coords (body entity)) 2) (+ 10 (aref (coords (body *self*)) 2)))
(draw entity start-time)))
(gl:matrix-mode :modelview)
(gl:load-identity)
(glu:look-at 0 6 10 ;; 0 6 10 pos
0 0 0 ;; center
0 1 0 ;; up in y pos
)
;; finish the frame
(gl:flush)
(sdl:update-display))
;(defun phys-step (time)
; (time-step *self* time))
(defun thruster-on (key)
(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-d) ; - y
(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))
; (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
(setf (aref (acceleration (motion *self*)) 1) 0))
(otherwise (format t "~a~%" key))))
(defun phys-step (time)
(let ((accel (vector 0 0 0)))
(loop for sym in (active-attachments *self*) do
(setf accel (vector+ accel (get-accel (getf (attachments *self*) sym) *self*))))
(apply-accel *self* accel time)))
(defun sim-step ()
"draw a frame"
(let* ((start-time (wall-time))
(time (- start-time *last-time*)))
(phys-step time)
(draw-world start-time)
(incf *num-frames*)
; (if (not (eql (floor *last-time*) (floor time)))
; (let* ((short-interval time)
; (long-interval (- start-time *start-time*) )
; (short-fps (floor (if (zerop short-interval) 0 (/ 1 short-interval))))
; (long-fps (floor (if (zerop long-interval) 0 (/ *num-frames* long-interval)))))
; (format t "FPS since last:~a since start:~a (~a frames in ~a seconds)~%" short-fps long-fps *num-frames* long-interval)))
(setf *last-time* start-time)))
(defun reshape ()
(gl:shade-model :smooth)
(gl:clear-color 0 0 0 0)
(gl:clear-depth 1)
(gl:enable :depth-test)
(gl:depth-func :lequal)
(gl:enable :cull-face)
(gl:hint :perspective-correction-hint :nicest)
(gl:matrix-mode :projection)
(gl:load-identity)
(glu:perspective 50; 45 ;; FOV
1.0 ;; aspect ratio(/ width (max height 1))
1/10 ;; z near
1000 ;; z far
)
(gl:matrix-mode :modelview)
)
(defun populate-world ()
(setf *world*
(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 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))))
e)))))
(defun init ()
(setf *start-time* (wall-time))
(setf *num-frames* 0)
(setf *last-time* *start-time*)
(setf *controls-active* '())
(setf *self*
(make-instance
'game-object
:body (make-instance 'body :coords (vector 0 0 11) :mass 1000)
:model *ship-model*
:attachments
(list :thruster
(make-instance 'engine-object
:activation-time 2
:model (make-instance 'engine-model
: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)))
; yaw (starboard (right) positive)
; :pos-yaw
; (make-instance 'engine-object
; :activation-time 2
; :model (make-instance 'engine-model
; :template-vertices *jet-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))))
; :body (make-instance 'body
; :coords (vector
)))
;:engines (list :engines (list :thrust
; (make-instance 'engine-object
; :motion (make-instance 'motion :coords (vector 0 0.5 3.0))
; :forces (list (make-instance 'force :newtons 10 :direction '(0 0 1))))))))
(populate-world))
(defun main-loop ()
(init)
(sdl:with-init ()
(sdl:window 640 480 :flags sdl:sdl-opengl)
;; cl-opengl needs platform specific support to be able to load GL
;; extensions, so we need to tell it how to do so in lispbuilder-sdl
(reshape)
(setf cl-opengl-bindings:*gl-get-proc-address* #'sdl-cffi::sdl-gl-get-proc-address)
(sdl:with-events ()
(:quit-event () t)
(:key-down-event (:key key) (thruster-on key)) ;(push key *controls-active*))
(:key-up-event (:key key) (thruster-off key)) ;(setf *controls-active* (remove key *controls-active*)))
(:idle ()
;; this lets slime keep working while the main loop is running
;; in sbcl using the :fd-handler swank:*communication-style*
;; (something similar might help in some other lisps, not sure which though)
#+(and sbcl (not sb-thread)) (restartable
(sb-sys:serve-all-events 0))
(restartable (sim-step))))))
;(draw)))))