;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;

;; OpenGL Texture examples

;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define *gl* (gl:make-opengl 640 480))

(gfx:start-live-video)

(define *texture* (gl:gen-textures *gl*))

(define init

   (lambda ()

      (gl:clear-color *gl* 0.0 0.0 0.0 0.0)

      (gl:shade-model *gl* *gl:flat*)

      (gl:enable *gl* *gl:lighting*)

      (gl:enable *gl* *gl:light0*)

      (gl:enable *gl* *gl:depth-test*)))

(define view

   (lambda ()

      (gl:viewport *gl* 0 0 640 480)

      (gl:matrix-mode *gl* *gl:projection*)

      (gl:load-identity *gl*)

      (glu:perspective *gl* 60.0 (/ 640.0 480.0) 0.1 30.0)

      (gl:matrix-mode *gl* *gl:modelview*)

      (gl:load-identity *gl*)))

(define load-texture

   (lambda ()      

      (define *image* (gfx:convert-image (gfx:get-live-frame)))

      (define *image2* (gfx:make-image 128 128))

      (gfx:image2image *image* *image2* 1.0 '(0 0 128 128))

      (define *image-size* (gfx:get-image-size *image2*))

      (define *data* (gl:get-image-texture-data *image2*))

      (gl:pixel-store *gl* *gl:unpack-row-length* (car *image-size*))

      (gl:pixel-store *gl* *gl:unpack-alignment* 1)

      (gl:tex-parameter *gl* *gl:texture-2d* *gl:texture-wrap-s* *gl:repeat*)

      (gl:tex-parameter *gl* *gl:texture-2d* *gl:texture-wrap-t* *gl:repeat*)

      (gl:tex-parameter *gl* *gl:texture-2d* *gl:texture-mag-filter* *gl:nearest*)

      (gl:tex-parameter *gl* *gl:texture-2d* *gl:texture-min-filter* *gl:nearest*)

      (gl:bind-texture *gl* *gl:texture-2d* *texture*)

      (gl:tex-image-2d *gl* *gl:texture-2d* 0 *gl:rgba8* 

                       (car *image-size*) 

                       (cdr *image-size*) 

                       0 *gl:rgba* *gl:unsigned-byte*

                       *data*)

      (callback (+ (now) 5000) 'load-texture)))

(define draw

   (lambda (angle)

      (gl:clear *gl* (io:binary-or *gl:color-buffer-bit* *gl:depth-buffer-bit*))

      (gl:push-matrix *gl*)

      (glu:look-at *gl* -2.0 -1.0 2.0 0.0 0.0 0.0 0.0 1.0 0.0)

      (gl:rotate *gl* angle 1 1 1)      

      (gl:enable *gl* *gl:texture-2d*)                  

      (glut:solid-teapot *gl* 1.0)      

      (gl:disable *gl* *gl:texture-2d*)                        

      (gl:pop-matrix *gl*)      

      (gl:flush *gl*)

      (callback (+ (now) 1000) 'draw (fmod (+ angle 3) 360))))

(define start

   (lambda ()

      (init)

      (view)

      (load-texture)

      (draw 0)))

(callback (+ (now) (* *second* 5)) 'start)