96 lines
3.4 KiB
Common Lisp
96 lines
3.4 KiB
Common Lisp
(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)))))) |