cl-opengl-tests/3bb-1.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)
    (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))))))