;; Example 8-3  Use of glDrawPixels

(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* 3)))
(define *zoom-factor* 1.0)
(define *height* 0)

(define (make-check-image)
  ;; 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) 3))
            (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))))
  )

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

(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-raster-pos 0 0)
  (gl-draw-pixels *check-image-width* *check-image-height* GL_RGB
                  GL_UNSIGNED_BYTE *check-image*)
  (gl-flush)
  )

(define (reshape w h)
  (gl-viewport 0 0 w h)
  (set! *height* h)
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (glu-ortho-2d 0.0 w 0.0 h)
  (gl-matrix-mode GL_MODELVIEW)
  (gl-load-identity)
  )

(define (motion x y)
  (let1 screen-y (- *height* y)
    (gl-raster-pos x screen-y)
    (gl-pixel-zoom *zoom-factor* *zoom-factor*)
    (gl-copy-pixels 0 0 *check-image-width* *check-image-height* GL_COLOR)
    (gl-pixel-zoom 1.0 1.0)
    (gl-flush)))

(define (keyboard key x y)
  (cond
   ((or (= key (char->integer #\r))
        (= key (char->integer #\R)))
    (set! *zoom-factor* 1.0)
    (glut-post-redisplay)
    (format #t "zoomFactor reset to 1.0\n")
    )
   ((= key (char->integer #\z))
    (inc! *zoom-factor* 0.5)
    (when (>= *zoom-factor* 3.0) (set! *zoom-factor* 3.0))
    (format #t "zoomFactor is now ~a\n" *zoom-factor*)
    )
   ((= key (char->integer #\Z))
    (dec! *zoom-factor* 0.5)
    (when (<= *zoom-factor* 0.5) (set! *zoom-factor* 0.5))
    (format #t "zoomFactor is now ~a\n" *zoom-factor*)
    )
   ((= key 27)                          ;ESC
    (exit 0)))
  )

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