;; Example 9-3  Replacing a Texture Subimage

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

;; Create checkerboard image
(define-constant *check-image-width* 64)
(define-constant *check-image-height* 64)
(define *check-image*
  (make-u8vector (* *check-image-height* *check-image-width* 4)))
(define-constant *sub-image-width* 16)
(define-constant *sub-image-height* 16)
(define *sub-image*
  (make-u8vector (* *sub-image-height* *sub-image-width* 4)))

(define *texname* 0)

(define (make-check-images)
  ;; NB: this must be easier once uniform array is implemented.
  (dotimes (i *check-image-height*)
    (dotimes (j *check-image-width*)
      (let ((ij (* (+ (* i *check-image-width*) j) 4))
            (c  (if (or (and (zero? (logand i #x08))
                             (zero? (logand j #x08)))
                        (and (not (zero? (logand i #x08)))
                             (not (zero? (logand j #x08)))))
                    0
                    255)))
        (set! (ref *check-image* ij) c)
        (set! (ref *check-image* (+ ij 1)) c)
        (set! (ref *check-image* (+ ij 2)) c)
        (set! (ref *check-image* (+ ij 3)) 255))))
  (dotimes (i *sub-image-height*)
    (dotimes (j *sub-image-width*)
      (let ((ij (* (+ (* i *sub-image-width*) j) 4))
            (c  (if (or (and (zero? (logand i #x04))
                             (zero? (logand j #x04)))
                        (and (not (zero? (logand i #x04)))
                             (not (zero? (logand j #x04)))))
                    0
                    255)))
        (set! (ref *sub-image* ij) c)
        (set! (ref *sub-image* (+ ij 1)) 0)
        (set! (ref *sub-image* (+ ij 2)) 0)
        (set! (ref *sub-image* (+ ij 3)) 255))))
  )

(define (init)
  (gl-clear-color 0 0 0 0)
  (gl-shade-model GL_FLAT)
  (gl-enable GL_DEPTH_TEST)
  (make-check-images)
  (gl-pixel-store GL_UNPACK_ALIGNMENT 1)

  (let1 texnames (gl-gen-textures 1)
    (set! *texname* (ref texnames 0))
    (gl-bind-texture GL_TEXTURE_2D *texname*))
  (gl-tex-parameter GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT)
  (gl-tex-parameter GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT)
  (gl-tex-parameter GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST)
  (gl-tex-parameter GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_NEAREST)
  (gl-tex-image-2d GL_TEXTURE_2D 0 GL_RGBA
                   *check-image-width* *check-image-height*
                   0 GL_RGBA GL_UNSIGNED_BYTE *check-image*)
  )

(define (disp)
  (gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
  (gl-enable GL_TEXTURE_2D)
  (gl-tex-env GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE GL_DECAL)
  (gl-bind-texture GL_TEXTURE_2D *texname*)

  (gl-begin GL_QUADS)
  (gl-tex-coord 0.0 0.0) (gl-vertex -2.0 -1.0 0.0)
  (gl-tex-coord 0.0 1.0) (gl-vertex -2.0 1.0 0.0)
  (gl-tex-coord 1.0 1.0) (gl-vertex 0.0 1.0 0.0)
  (gl-tex-coord 1.0 0.0) (gl-vertex 0.0 -1.0 0.0)

  (gl-tex-coord 0.0 0.0) (gl-vertex 1.0 -1.0 0.0)
  (gl-tex-coord 0.0 1.0) (gl-vertex 1.0 1.0 0.0)
  (gl-tex-coord 1.0 1.0) (gl-vertex 2.41421 1.0 -1.41421)
  (gl-tex-coord 1.0 0.0) (gl-vertex 2.41421 -1.0 -1.41421)
  (gl-end)
  (gl-flush)
  (gl-disable GL_TEXTURE_2D)
  )

(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 -3.6))

(define (keyboard key x y)
  (cond
   ((or (= key (char->integer #\s))
        (= key (char->integer #\S)))
    (gl-bind-texture GL_TEXTURE_2D *texname*)
    (gl-tex-sub-image-2d GL_TEXTURE_2D 0 12 44
                         *sub-image-width* *sub-image-height*
                         GL_RGBA GL_UNSIGNED_BYTE *sub-image*)
    (glut-post-redisplay))
   ((or (= key (char->integer #\r))
        (= key (char->integer #\R)))
    (gl-bind-texture GL_TEXTURE_2D *texname*)
    (gl-tex-image-2d GL_TEXTURE_2D 0 GL_RGBA
                     *check-image-width* *check-image-height*
                     0 GL_RGBA GL_UNSIGNED_BYTE *check-image*)
    (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 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)