(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 3 3 '((0 0.5 0) (0.5 -0.5 0.0) (-0.5 -0.5 0.0)))) (defparameter *faces* (make-2d-array 1 3 '((0 1 2)))) (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) (loop for i from 0 to (1- (length faces)) collecting (aref *v* (aref faces i)))) (let ((time-units (/ 1.0 internal-time-units-per-second))) (defun wall-time (&key (offset 0)) (+ (* (get-internal-real-time) time-units) offset))) (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 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 time) (list (rotate* (make-rotation-matrix 0 0 time) (first tri)) (rotate* (make-rotation-matrix 0 0 time) (second tri)) (rotate* (make-rotation-matrix 0 0 time) (third tri)))) ; (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 () "draw a frame" (let* ((time (- (wall-time) *start-time*)) (t1 (rotate-triangle (get-vertecies (aref *faces* 0)) time))) (gl:clear :color-buffer-bit) ;;; draw a triangle (gl:with-primitive :triangles (multiple-value-bind (red green blue) (shift-color time) (gl:color red green blue)) (let ((v (first t1))) (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 (second t1))) (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 (third t1))) (gl:vertex (aref v 0) (aref v 1) (aref v 2)))) ;; 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 init () (setf *start-time* (wall-time)) (setf *num-frames* 0) (setf *last-time* 0) ) (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 (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))))))