(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"))) (let ((time-units (/ 1.0 internal-time-units-per-second))) (defun wall-time (&key (offset 0)) (+ (* (get-internal-real-time) time-units) offset))) (defvar *start-time* (wall-time)) (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))) (defparameter *t1* '( (-0.5 -0.5 0) (0 0.5 0) (0.5 -0.5 0))) (defun rotate-vertex (v time) (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-vertex (first tri) time) (rotate-vertex (second tri) time) (rotate-vertex (third tri) time))) (defparameter *last-time* nil) (defparameter *num-frames* 0) (defun draw () "draw a frame" (let* ((time (- (wall-time) *start-time*)) (t1 (rotate-triangle *t1* time))) ;;;(setf *last-time* (wall-time)) ; (format t "~a ~a: ~a ~a ~a~%" *start-time* time red green blue) (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)) (multiple-value-bind (v1 v2 v3) (values-list (first t1)) (gl:vertex v1 v2 v3)) (multiple-value-bind (green blue red) (shift-color time) (gl:color red green blue)) (multiple-value-bind (v1 v2 v3) (values-list (second t1)) (gl:vertex v1 v2 v3)) (multiple-value-bind (blue green red) (shift-color time) (gl:color red green blue)) (multiple-value-bind (v1 v2 v3) (values-list (third t1)) (gl:vertex v1 v2 v3))) ;; finish the frame (gl:flush) (sdl:update-display) (incf *num-frames*) ;(if (not (eql (floor *last-time*) time)) (let* ((short-interval (- time (if *last-time* *last-time* time))) (long-interval (- time *start-time*)) (short-fps (if (zerop short-interval) 0 (/ 1 short-interval))) (long-fps (if (zerop long-interval) 0 (/ *num-frames* long-interval)))) (format t "FPS since last:~a->~a since start:~a/~a->~a ~%" short-interval short-fps *num-frames* long-interval long-fps)))) (setf *last-time* (wall-time))) (defun main-loop () (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))))))