;; Example 9-8  Automatic Texture-Coordinate Generation

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

;; Create checkerboard image
(define-constant *stripe-image-width* 32)
(define *stripe-image*
  (make-u8vector (* *stripe-image-width* 4)))
(define *texname* #f)

(define (make-stripe-image)
  (dotimes (j *stripe-image-width*)
    (set! (ref *stripe-image* (* 4 j)) (if (<= j 4) 255 0))
    (set! (ref *stripe-image* (+ (* 4 j) 1)) (if (> j 4) 255 0))
    (set! (ref *stripe-image* (+ (* 4 j) 2)) 0)
    (set! (ref *stripe-image* (+ (* 4 j) 3)) 255)))

;; planes for texture coordinate generation
(define x=0plane '#f32(1.0 0.0 0.0 0.0))
(define slanted  '#f32(1.0 1.0 1.0 0.0))
(define *current-coeff* x=0plane)
(define *current-plane* 0)
(define *current-gen-mode* 0)

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

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

  (set! *texname* (ref (gl-gen-textures 1) 0))
  (gl-bind-texture GL_TEXTURE_1D *texname*)
  (gl-tex-parameter GL_TEXTURE_1D GL_TEXTURE_WRAP_S GL_REPEAT)
  (gl-tex-parameter GL_TEXTURE_1D GL_TEXTURE_MAG_FILTER GL_LINEAR)
  (gl-tex-parameter GL_TEXTURE_1D GL_TEXTURE_MIN_FILTER GL_LINEAR)
  (gl-tex-image-1d GL_TEXTURE_1D 0 GL_RGBA
                   *stripe-image-width*
                   0 GL_RGBA GL_UNSIGNED_BYTE *stripe-image*)

  (gl-tex-env GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE GL_MODULATE)
  (set! *current-coeff* x=0plane)
  (set! *current-gen-mode* GL_OBJECT_LINEAR)
  (set! *current-plane* GL_OBJECT_PLANE)
  (gl-tex-gen GL_S GL_TEXTURE_GEN_MODE *current-gen-mode*)
  (gl-tex-gen GL_S *current-plane* *current-coeff*)

  (gl-enable GL_TEXTURE_GEN_S)
  (gl-enable GL_TEXTURE_1D)
  (gl-enable GL_CULL_FACE)
  (gl-enable GL_LIGHTING)
  (gl-enable GL_LIGHT0)
  (gl-enable GL_AUTO_NORMAL)
  (gl-enable GL_NORMALIZE)
  (gl-front-face GL_CW)
  (gl-cull-face GL_BACK)
  (gl-material GL_FRONT GL_SHININESS 64.0)
  )

(define (disp)
  (gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))

  (gl-push-matrix)
  (gl-rotate 45.0 0.0 0.0 1.0)
  (gl-bind-texture GL_TEXTURE_1D *texname*)
  (glut-solid-teapot 2.0)
  (gl-pop-matrix)
  (gl-flush))

(define (reshape w h)
  (gl-viewport 0 0 w h)
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (if (<= w h)
      (gl-ortho -3.5 3.5 (* -3.5 (/ h w)) (* 3.5 (/ h w)) -3.5 3.5)
      (gl-ortho (* -3.5 (/ w h)) (* 3.5 (/ w h)) -3.5 3.5 -3.5 3.5))
  (gl-matrix-mode GL_MODELVIEW)
  (gl-load-identity)
  )

(define (keyboard key x y)
  (cond
   ((or (= key (char->integer #\e))
        (= key (char->integer #\E)))
    (set! *current-gen-mode* GL_EYE_LINEAR)
    (set! *current-plane* GL_EYE_PLANE)
    (gl-tex-gen GL_S GL_TEXTURE_GEN_MODE *current-gen-mode*)
    (gl-tex-gen GL_S *current-plane* *current-coeff*)
    (glut-post-redisplay))
   ((or (= key (char->integer #\o))
        (= key (char->integer #\O)))
    (set! *current-gen-mode* GL_OBJECT_LINEAR)
    (set! *current-plane* GL_OBJECT_PLANE)
    (gl-tex-gen GL_S GL_TEXTURE_GEN_MODE *current-gen-mode*)
    (gl-tex-gen GL_S *current-plane* *current-coeff*)
    (glut-post-redisplay))
   ((or (= key (char->integer #\s))
        (= key (char->integer #\S)))
    (set! *current-coeff* slanted)
    (gl-tex-gen GL_S *current-plane* *current-coeff*)
    (glut-post-redisplay))
   ((or (= key (char->integer #\x))
        (= key (char->integer #\X)))
    (set! *current-coeff* x=0plane)
    (gl-tex-gen GL_S *current-plane* *current-coeff*)
    (glut-post-redisplay))
   ((= 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 256 256)
  (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)