;; Example 9-4  Three-Dimensional Texturing

(use gl)
(use gl.glut)
(use gauche.uvector)

;; Create checkerboard image
(define-constant *iwidth* 16)
(define-constant *iheight* 16)
(define-constant *idepth* 16)
(define *image* (make-u8vector (* *iwidth* *iheight* *idepth* 3)))
(define *texname* 0)

(define (make-image)
  ;; NB: this must be easier once uniform array is implemented.
  (dotimes (s 16)
    (dotimes (t 16)
      (dotimes (r 16)
        (let ((rts (* 3 (+ (* r *iwidth* *iheight*)
                           (* t *iwidth*)
                           s))))
          (set! (ref *image* rts)       (* s 17))
          (set! (ref *image* (+ rts 1)) (* t 17))
          (set! (ref *image* (+ rts 2)) (* r 17)))))))

(define (init)
  (gl-clear-color 0 0 0 0)
  (gl-shade-model GL_FLAT)
  (gl-enable GL_DEPTH_TEST)

  (make-image)
  (gl-pixel-store GL_UNPACK_ALIGNMENT 1)

  (let1 texnames (gl-gen-textures 1)
    (set! *texname* (ref texnames 0))
    (gl-bind-texture GL_TEXTURE_3D *texname*))
  (gl-tex-parameter GL_TEXTURE_3D GL_TEXTURE_WRAP_S GL_CLAMP)
  (gl-tex-parameter GL_TEXTURE_3D GL_TEXTURE_WRAP_T GL_CLAMP)
  (gl-tex-parameter GL_TEXTURE_3D GL_TEXTURE_WRAP_R GL_CLAMP)
  (gl-tex-parameter GL_TEXTURE_3D GL_TEXTURE_MAG_FILTER GL_NEAREST)
  (gl-tex-parameter GL_TEXTURE_3D GL_TEXTURE_MIN_FILTER GL_NEAREST)
  (gl-tex-image-3d GL_TEXTURE_3D 0 GL_RGB *iwidth* *iheight* *idepth*
                   0 GL_RGB GL_UNSIGNED_BYTE *image*)
  (gl-enable GL_TEXTURE_3D)
  )

(define (disp)
  (gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
  (gl-begin GL_QUADS)
  (gl-tex-coord 0.0 0.0 0.0) (gl-vertex -2.25 -1.0 0.0)
  (gl-tex-coord 0.0 1.0 0.0) (gl-vertex -2.25 1.0 0.0)
  (gl-tex-coord 1.0 1.0 1.0) (gl-vertex -0.25 1.0 0.0)
  (gl-tex-coord 1.0 0.0 1.0) (gl-vertex -0.25 -1.0 0.0)

  (gl-tex-coord 0.0 0.0 1.0) (gl-vertex 0.25 -1.0 0.0)
  (gl-tex-coord 0.0 1.0 1.0) (gl-vertex 0.25 1.0 0.0)
  (gl-tex-coord 1.0 1.0 0.0) (gl-vertex 2.25 1.0 0.0)
  (gl-tex-coord 1.0 0.0 0.0) (gl-vertex 2.25 -1.0 0.0)
  (gl-end)
  (gl-flush)
  )

(define (reshape w h)
  (gl-viewport 0 0 w h)
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (glu-perspective 60.0 (/ w h) 1.0 30.0)
  (gl-matrix-mode GL_MODELVIEW)
  (gl-load-identity)
  (gl-translate 0.0 0.0 -4.0))

(define (keyboard key x y)
  (cond
   ((= key 27) (exit 0))
   ))

(define (main args)
  (glut-init args)
  (glut-init-display-mode (logior GLUT_SINGLE GLUT_RGB GLUT_DEPTH))
  (glut-init-window-size 250 250)
  (glut-init-window-position 100 100)
  (glut-create-window (car args))
  (init)
  (glut-display-func disp)
  (glut-reshape-func reshape)
  (glut-keyboard-func keyboard)
  (glut-main-loop)
  0)