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

;;

;; OpenGL Constellation Video

;;

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

(gfx:start-live-video)

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

(gl:open-opengl *gl* '(200 200 640 480))

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

(define *gl:texture-rectangle-arb* 34037)

(define init

   (lambda ()

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

      (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* 40.0 (/ 640 480) 1.0 500.0)

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

(define load-texture

   (lambda (time)      

      (let* ((frame (gfx:get-live-frame))

             (*image2* (gfx:convert-image frame "RGBA")))

      (define *image-size* (gfx:get-image-size *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-rectangle-arb* *gl:texture-mag-filter* *gl:nearest*)

         (gl:tex-parameter *gl* *gl:texture-rectangle-arb* *gl:texture-min-filter* *gl:nearest*)

         (gl:bind-texture *gl* *gl:texture-rectangle-arb* *texture*)

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

                          (car *image-size*) 

                          (cdr *image-size*) 

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

                          *image2*)

         (objc:release (+ time 1000) *image2* frame)

         (callback (+ time 1000) 'load-texture (+ time 2000)))))

(define draw-rect

   (lambda (x y d)

      (gl:tex-coord-2d *gl* 0 0)

      (gl:vertex *gl* x y d)  

      (gl:tex-coord-2d *gl* 0 480)                

      (gl:vertex *gl* x (+ y 2.0) d)

      (gl:tex-coord-2d *gl* 640 480)      

      (gl:vertex *gl* (+ x 3.0) (+ y 2.0) d)

      (gl:tex-coord-2d *gl* 640 0)      

      (gl:vertex *gl* (+ x 3.0) y d)

      (gl:tex-coord-2d *gl* 0 0)))      

(define xv (make-vector 200 0))

(define yv (make-vector 200 0))

(define dv (make-vector 200 0))

(define rand (make-vector 200 0))

(math:vector-rand xv)

(math:vector-rand yv)

(math:vector-rand dv)

(math:vector* xv 30)

(math:vector* yv 30)

(math:vector* dv 50)

(define draw

   (lambda (time angle)

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

      (gl:push-matrix *gl*)

      (glu:look-at *gl* (cos angle) (cos angle) (+ 0 (* 80 (cos angle))) 15 15 0 0 1 0)            

      (gl:enable *gl* *gl:texture-rectangle-arb*)                        

      (dotimes (i 200)

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

         (gl:begin *gl* *gl:quads*)         

         (draw-rect (vector-ref xv i) (vector-ref yv i) (vector-ref dv i))

         (gl:end *gl*))

      (gl:disable *gl* *gl:texture-rectangle-arb*)

      (gl:pop-matrix *gl*)      

      (gl:flush *gl*)

      (callback (+ time 500) 'draw (+ time 2000) (fmod (+ angle .01) 360))))

(define start

   (lambda ()

      (init)

      (view)

      (load-texture (now))

      (draw (now) 0)))

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