You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

83 lines
2.3 KiB

  1. (defmacro restartable (&body body)
  2. `(restart-case
  3. (progn ,@body)
  4. (continue () :report "Continue")))
  5. (defparameter *light-diffuse* (vector 1.0 0.0 0.0 1.0)) ;; red diffuse light
  6. (defparameter *light-position* (vector 1.0 1.0 1.0 0.0)) ;; infinite light position
  7. ;;; Normals for the 6 faces of the cube
  8. (defparameter *n* '((-1.0 0.0 0.0) (0.0 1.0 0.0) (1.0 0.0 0.0)
  9. (0.0 -1.0 0.0) (0.0 0.0 1.0) (0.0 0.0 -1.0)))
  10. ;;; Vertex indices for the 6 faces of the cube
  11. (defparameter *faces* '((0 1 2 3) (2 3 6 7) (7 6 5 4)
  12. (4 5 1 0) (5 6 2 1) (7 4 0 3)))
  13. ;;; will be filled with the vertexes
  14. (defparameter *v* '((-1 -1 1) (-1 -1 -1) (-1 1 -1) (-1 1 1)
  15. (1 -1 1) (1 -1 -1) (1 1 -1) (1 1 1)))
  16. (defmacro 2elt (e x y)
  17. `(elt (elt ,e ,x) ,y))
  18. (defmacro 3delt (e1 x1 e2 x3)
  19. `(elt (elt ,e2 (elt ,e1 ,x1)) ,x3))
  20. (defun draw-box ()
  21. (dotimes (i 6)
  22. (gl:with-primitives :quads
  23. (gl:normal (2elt *n* i 0) (2elt *n* i 1) (2elt *n* i 2))
  24. (let ((face (elt *faces* i)))
  25. (dotimes (x 4)
  26. (gl:vertex (3delt face x *v* 0) (3delt face x *v* 1) (3delt face x *v* 1)))))))
  27. ;(cffi:defcallback display :void ()
  28. (defun display ()
  29. (gl:clear :color-buffer-bit :depth-buffer-bit)
  30. (draw-box)
  31. ;;glut:swap-buffers
  32. (gl:flush)
  33. (sdl:update-display)
  34. )
  35. (defun init ()
  36. (gl:light :light0 :diffuse *light-diffuse*)
  37. (gl:light :light0 :position *light-position*)
  38. (gl:enable :light0 :lighting :depth-test)
  39. (gl:matrix-mode :projection)
  40. (glu:perspective 40.0 ;; FOV
  41. 1.0 ;; aspect ratio
  42. 1.0 ;; z near
  43. 10.0 ;; z far
  44. )
  45. (gl:matrix-mode :modelview)
  46. (glu:look-at 0 0 5 ;; eye is at 0,0,5
  47. 0 0 0 ;; center is at 0,0,0
  48. 0 1 0 ;;up is in pos Y
  49. )
  50. ;; adjust cube position to be asthetic angle
  51. (gl:translate 0.0 0.0 -1.0)
  52. (gl:rotate 60 1.0 0.0 0.0)
  53. (gl:rotate -20 0.0 0.0 1.0))
  54. (defun cube-main-glut ()
  55. (glut:init "Cube")
  56. (glut:init-display-mode :double :rgb :depth)
  57. (glut:create-window "red 3D lighted cube")
  58. (glut:display-func (cffi:callback display))
  59. (init)
  60. (glut:main-loop)
  61. )
  62. (defun cube-main-sdl ()
  63. (sdl:with-init ()
  64. (sdl:window 320 240 :flags sdl:sdl-opengl)
  65. (setf cl-opengl-bindings:*gl-get-proc-address* #'sdl-cffi::sdl-gl-get-proc-address)
  66. (sdl:with-events ()
  67. (:quit-event () t)
  68. (:idle ()
  69. (restartable (display))))))