#lang scheme

(require mred sgl sgl/gl sgl/gl-vectors)

;;;
;;; OPENGL RED BOOK example 9-1
;;;


(define *tex-name* #f)
(define (get-tex-name) (gl-vector-ref *tex-name* 0))
(define *check-image-width* 64)
(define *check-image-height* 64)
(define *check-image*
  (let ((v (make-gl-ubyte-vector (* 4 *check-image-width* *check-image-height*))))
    (do ((i 0 (+ i 1))) ((= i *check-image-width*) v)
      (do ((j 0 (+ j 1))) ((= j *check-image-height*) v)
        (let ((c
;               (* 255 (bitwise-xor (if (bitwise-bit-set? i 3) 0 1)
;                                   (if (bitwise-bit-set? j 3) 0 1)))
               
;               (let ((ib (bitwise-bit-set? i 3))
;                     (jb (bitwise-bit-set? j 3)))
;                 (if (or (and ib (not jb)) (and (not ib) jb)) 255 0))
               (if (bitwise-bit-set? (bitwise-xor i j) 3) 255 0)
                 ))
          (gl-vector-set! v (+ 0 (* j 4) (* i 4 *check-image-width*)) c)
          (gl-vector-set! v (+ 1 (* j 4) (* i 4 *check-image-width*)) c)
          (gl-vector-set! v (+ 2 (* j 4) (* i 4 *check-image-width*)) c)
          (gl-vector-set! v (+ 3 (* j 4) (* i 4 *check-image-width*)) 255)) ))))


(define my-canvas%
  (class* canvas% ()

    (inherit with-gl-context swap-gl-buffers)

    (define/override on-paint 
      (lambda ()
        (with-gl-context
         (lambda () 
           (draw-image) 
           (swap-gl-buffers))) ))
    
    (define/override on-size 
      (lambda (w h)
        (with-gl-context
         (lambda () 
           (draw-sizing w h)))))

    (super-instantiate () (style '(gl no-autoclear)))))


(define (draw-image)
  (gl-clear 'color-buffer-bit 'depth-buffer-bit)
  (gl-enable 'texture-2d)
  (glTexEnvf GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE GL_DECAL)
  (glBindTexture GL_TEXTURE_2D (get-tex-name))
  (gl-begin 'quads)
  (gl-tex-coord 0 0)
  (gl-vertex -2 -1 0)
  (gl-tex-coord 0 1)
  (gl-vertex -2 1 0)
  (gl-tex-coord 1 1)
  (gl-vertex 0 1 0)
  (gl-tex-coord 1 0)
  (gl-vertex 0 -1 0)
  (gl-tex-coord 0 0)
  (gl-vertex 1 -1 0)
  (gl-tex-coord 0 1)
  (gl-vertex 1 1 0)
  (gl-tex-coord 1 1)
  (gl-vertex 2.41421 1.0 -1.41421)
  (gl-tex-coord 1 0)
  (gl-vertex 2.41421 -1.0 -1.41421)
  (gl-end)
  (gl-disable 'texture-2d)
  )

(define (draw-sizing w h)
  (gl-viewport 0 0 w h)
  (gl-matrix-mode 'projection)
  (gl-load-identity)
  (gl-perspective 60 (/ w h) 1 30)
  (gl-matrix-mode 'modelview)
  (gl-load-identity)
  (gl-translate 0 0 -3.6)
  )

(define (draw-init)
  (gl-clear-color 0 0 0 0)
  (gl-shade-model 'flat)
  (gl-enable 'depth-test)
  (gl-pixel-store 'unpack-alignment 1)
  (set! *tex-name* (glGenTextures 1))
  (glBindTexture GL_TEXTURE_2D (get-tex-name))
  (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT)
  (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT)
  (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST)
  (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_NEAREST)
  (glTexImage2D GL_TEXTURE_2D 0 GL_RGBA
                *check-image-width* *check-image-height* 0 GL_RGBA GL_UNSIGNED_BYTE *check-image*)  
  )


(define f (instantiate frame% ("Example 9-1")))
(define a-canvas (instantiate my-canvas% (f) (min-width 250) (min-height 250) ))
(send f show #t)
(send a-canvas with-gl-context draw-init)
