From 74e4e3e925ccaee42fa07afec6f3c8cb1046281a Mon Sep 17 00:00:00 2001 From: Dan Ballard Date: Wed, 13 Jul 2011 00:50:34 -0700 Subject: [PATCH] quicklisp quickproject and import of test code --- README.txt | 1 + flight-sim.asd | 10 +++ flight-sim.lisp | 219 ++++++++++++++++++++++++++++++++++++++++++++++++ package.lisp | 6 ++ 4 files changed, 236 insertions(+) create mode 100644 README.txt create mode 100644 flight-sim.asd create mode 100644 flight-sim.lisp create mode 100644 package.lisp diff --git a/README.txt b/README.txt new file mode 100644 index 0000000..f536112 --- /dev/null +++ b/README.txt @@ -0,0 +1 @@ +This is the stub README.txt for the "flight-sim" project. diff --git a/flight-sim.asd b/flight-sim.asd new file mode 100644 index 0000000..b508fd4 --- /dev/null +++ b/flight-sim.asd @@ -0,0 +1,10 @@ +;;;; flight-sim.asd + +(asdf:defsystem #:flight-sim + :serial t + :depends-on (#:cl-opengl + #:cl-glu + #:lispbuilder-sdl) + :components ((:file "package") + (:file "flight-sim"))) + diff --git a/flight-sim.lisp b/flight-sim.lisp new file mode 100644 index 0000000..51abc6d --- /dev/null +++ b/flight-sim.lisp @@ -0,0 +1,219 @@ +;;;; flight-sim.lisp + +(in-package #:flight-sim) + +;;; "flight-sim" goes here. Hacks and glory await! + +(defmacro restartable (&body body) + "Helper macro since we use continue restarts a lot + (remember to hit C in slime or pick the restart so errors don't kill the app" + `(restart-case + (progn ,@body) + (continue () :report "Continue"))) + +(defun make-2d-array (h w contents) + (let ((arr (make-array h))) + (do ((i 0 (incf i)) + (rest-list contents (rest rest-list))) + ((eql i h)) + (setf (aref arr i) (make-array w :initial-contents (car rest-list)))) + arr)) + +(defparameter *n* (make-array 3 :initial-contents '(0 0 1))) +(defparameter *v* (make-2d-array 24 3 '( + (0.0 1 0) (-0.5 0 0.5) (0.5 0 0.5) + (0.0 1 0) (0.5 0 -0.5) (-0.5 0 -0.5) + (0.0 1 0) (0.5 0 0.5) (0.5 0 -0.5) + (0.0 1 0) (-0.5 0 -0.5) (-0.5 0 0.5) + + (0.0 -1 0) (-0.5 0 0.5) (0.5 0 0.5) + (0.0 -1 0) (0.5 0 -0.5) (-0.5 0 -0.5) + (0.0 -1 0) (0.5 0 0.5) (0.5 0 -0.5) + (0.0 -1 0) (-0.5 0 -0.5) (-0.5 0 0.5) + + ))) +(defparameter *faces* (make-2d-array 8 3 '((0 1 2) (3 4 5) (6 7 8) (9 10 11) + (13 12 14) (16 15 17) (19 18 20) (22 21 23)))) + +(defparameter *position* (make-array 3 :initial-contents + '(0 0 -3))) + +(let ((time-units (/ 1.0 internal-time-units-per-second))) + (defun wall-time (&key (offset 0)) + (+ (* (get-internal-real-time) time-units) + offset))) + + +(defparameter *start-time* (wall-time)) + +(defparameter *last-time* nil) +(defparameter *num-frames* 0) + +;;(defparameter *t1* '( (-0.5 -0.5 0) (0 0.5 0) (0.5 -0.5 0))) + +(defun get-vertecies (faces) + (make-array (length faces) :initial-contents + (loop for i across faces collecting (aref *v* i)))) + + + +(defun shift-color (time) + (values + ;;; red + (/ (+ (* (sin (+ (* 0.3 time) 0)) 127) 128) 255) + ;;; green + (/ (+ (* (sin (+ (* 0.3 time) (* 2/3 PI))) 127 ) 128) 255) + ;;; blue + (/ (+ (* (sin (+ (* 0.3 time) (* 4/3 PI))) 127) 128) 255))) + + +(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)))))) + +(defun rotate* (m v) + (let ((result (make-array 3 :initial-element 0))) + (dotimes (x 3) + (dotimes (y 3) + (incf (aref result x) (* (aref v y) (aref m x y))))) + result)) + +(defun translate-point (v1 v2 &optional (fn #'+)) + (let ((result (make-array 3))) + (dotimes (i 3) + (setf (aref result i) (funcall fn (aref v1 i) (aref v2 i)))) + result)) + + +(defun translate-triangle (tri position) + (make-array (length tri) :initial-contents + (loop for v across tri collecting (translate-point position v)))) + +;(defun rotate-vertex-2d (v rM) +; v) + ;; (let ((result (lm:* rM (lm:vector (first v) (second v))))) + ;; (list (lm:elt result 0) (lm:elt result 1)))) + +;; (let* ((x (first v)) +;; (y (second v)) +;; (theta (atan (if (eql 0 x) 1000000 (/ y x)))) +;; (hyp (sqrt (+ (* x x) (* y y))))) + ;; (list (/ (cos (+ theta time)) hyp) (/ (sin (+ theta time)) hyp) (third v)))) +; (list (+ (first v) (/ (sin time) 2)) (+ (second v) (/ (cos time) 2)) (third v))) + +(defun rotate-triangle (tri m) + (make-array (length tri) :initial-contents + (loop for v across tri collecting (rotate* m v)))) + +; (let* ((angle (/ time 1000)) +; (cos-a (cos angle)) +; (sin-a (sin angle)) +; (rM nil)) ;lm:make-matrix 2 2 :initial-elements +; ; '(cos-a sin-a +; ; (- sin-a) cos-a)))) + ; (list (append (rotate-vertex-2d (first tri) rM) '((third (firt tri)))) +; (append (rotate-vertex-2d (second tri) rM) '((third (second tri)))) +; (append (rotate-vertex-2d (third tri) rM) (third (third tri)))))) +; + +(defun draw-triangle (tri time) + (gl:with-primitive :triangles + (multiple-value-bind (red green blue) (shift-color time) + (gl:color red green blue)) + (let ((v (aref tri 0))) + (gl:vertex (aref v 0) (aref v 1) (aref v 2))) + + (multiple-value-bind (green blue red) (shift-color time) + (gl:color red green blue)) + (let ((v (aref tri 1))) + (gl:vertex (aref v 0) (aref v 1) (aref v 2))) + + (multiple-value-bind (blue green red) (shift-color time) + (gl:color red green blue)) + (let ((v (aref tri 2))) + (gl:vertex (aref v 0) (aref v 1) (aref v 2))))) + + + + +(defun draw () + "draw a frame" + (let* ((time (- (wall-time) *start-time*))) + + (gl:clear :color-buffer-bit) + ;;; draw a triangle + (loop for face-list across *faces* do + (let ((rt (translate-triangle (rotate-triangle (get-vertecies face-list) (make-rotation-matrix 0 (* 2 time) 0)) (rotate* (make-rotation-matrix 0 time 0) *position*)))) + (draw-triangle rt time))) + ;; finish the frame + (gl:flush) + (sdl:update-display) + + (incf *num-frames*) + (if (not (eql (floor *last-time*) (floor time))) + (let* ((short-interval (- time *last-time* )) + (long-interval 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~%" short-fps long-fps))) + + (setf *last-time* 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 + 100 ;; z far + ) + + (gl:matrix-mode :modelview) + (gl:load-identity) + (glu:look-at 0 2 7 ;; eye + 0 0 0 ;; center + 0 1 0 ;; up in y pos + ) + +) + +(defun init () + (setf *start-time* (wall-time)) + (setf *num-frames* 0) + (setf *last-time* 0) +; (reshape) +) + +(defun main-loop () + (init) + (sdl:with-init () + (sdl:window 320 240 :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) + (: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 (draw)))))) \ No newline at end of file diff --git a/package.lisp b/package.lisp new file mode 100644 index 0000000..1994e5c --- /dev/null +++ b/package.lisp @@ -0,0 +1,6 @@ +;;;; package.lisp + +(defpackage #:flight-sim + (:use #:cl) + (:export #:main-loop)) +