(defmacro restartable (&body body) `(restart-case (progn ,@body) (continue () :report "Continue"))) (defparameter *light-diffuse* (vector 1.0 0.0 0.0 1.0)) ;; red diffuse light (defparameter *light-position* (vector 1.0 1.0 1.0 0.0)) ;; infinite light position ;;; Normals for the 6 faces of the cube (defparameter *n* '((-1.0 0.0 0.0) (0.0 1.0 0.0) (1.0 0.0 0.0) (0.0 -1.0 0.0) (0.0 0.0 1.0) (0.0 0.0 -1.0))) ;;; Vertex indices for the 6 faces of the cube (defparameter *faces* '((0 1 2 3) (2 3 6 7) (7 6 5 4) (4 5 1 0) (5 6 2 1) (7 4 0 3))) ;;; will be filled with the vertexes (defparameter *v* '((-1 -1 1) (-1 -1 -1) (-1 1 -1) (-1 1 1) (1 -1 1) (1 -1 -1) (1 1 -1) (1 1 1))) (defmacro 2elt (e x y) `(elt (elt ,e ,x) ,y)) (defmacro 3delt (e1 x1 e2 x3) `(elt (elt ,e2 (elt ,e1 ,x1)) ,x3)) (defun draw-box () (dotimes (i 6) (gl:with-primitives :quads (gl:normal (2elt *n* i 0) (2elt *n* i 1) (2elt *n* i 2)) (let ((face (elt *faces* i))) (dotimes (x 4) (gl:vertex (3delt face x *v* 0) (3delt face x *v* 1) (3delt face x *v* 1))))))) ;(cffi:defcallback display :void () (defun display () (gl:clear :color-buffer-bit :depth-buffer-bit) (draw-box) ;;glut:swap-buffers (gl:flush) (sdl:update-display) ) (defun init () (gl:light :light0 :diffuse *light-diffuse*) (gl:light :light0 :position *light-position*) (gl:enable :light0 :lighting :depth-test) (gl:matrix-mode :projection) (glu:perspective 40.0 ;; FOV 1.0 ;; aspect ratio 1.0 ;; z near 10.0 ;; z far ) (gl:matrix-mode :modelview) (glu:look-at 0 0 5 ;; eye is at 0,0,5 0 0 0 ;; center is at 0,0,0 0 1 0 ;;up is in pos Y ) ;; adjust cube position to be asthetic angle (gl:translate 0.0 0.0 -1.0) (gl:rotate 60 1.0 0.0 0.0) (gl:rotate -20 0.0 0.0 1.0)) (defun cube-main-glut () (glut:init "Cube") (glut:init-display-mode :double :rgb :depth) (glut:create-window "red 3D lighted cube") (glut:display-func (cffi:callback display)) (init) (glut:main-loop) ) (defun cube-main-sdl () (sdl:with-init () (sdl:window 320 240 :flags sdl:sdl-opengl) (setf cl-opengl-bindings:*gl-get-proc-address* #'sdl-cffi::sdl-gl-get-proc-address) (sdl:with-events () (:quit-event () t) (:idle () (restartable (display))))))