(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) (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))) (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))) (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))))))