83 lines
2.3 KiB
Common Lisp
83 lines
2.3 KiB
Common Lisp
(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)))))) |