(require rsc3-interface/plt/rsc3-interface
	 sgl/gl)

(define two-pi (* 2 pi))

(define (torus C T)
  (do ((i 0 (+ i 1))) ((= i C))
    (glBegin GL_LINE_STRIP)
    (do ((j 0 (+ j 1))) ((> j T))
      (do ((k 1 (- k 1))) ((< k 0))
	(let* ((s (+ (modulo (+ i k) C) 0.5))
	       (t (modulo j T))
	       (x (* (+ 1 (* 0.1 (cos (* s (/ two-pi C))))) 
		     (cos (* t (/ two-pi T)))))
	       (y (* (+ 1 (* 0.1 (cos (* s (/ two-pi C))))) 
		     (sin (* t (/ two-pi T)))))
	       (z (* 0.1 (sin (* s (/ two-pi C))))))
	  (glVertex3f x y z))))
    (glEnd)))

(define (draw t r)
  (glClear GL_COLOR_BUFFER_BIT)
  (glColor3f 1.0 1.0 1.0)
  (glRotatef (/ r 270.0) (/ r 180.0) (/ r 135.0) 1.0)
  (glCallList t)
  (glFlush))

(define (init gl)
  (in-gl gl
	 (glViewport 0 0 400 400)
	 (glMatrixMode GL_PROJECTION)
	 (glLoadIdentity)
	 (gluPerspective 30 1.0 1.0 100.0)
	 (glMatrixMode GL_MODELVIEW)
	 (glLoadIdentity)
	 (gluLookAt 0 0 10 0 0 0 0 1 0)
	 (let ((t (glGenLists 1)))
	   (glNewList t GL_COMPILE)
	   (torus 8 25)
	   (glEndList)
	   (glShadeModel GL_FLAT)
	   (glClearColor 0.0 0.0 0.0 0.0)
	   t)))

(let* ((w  (make-window "gl.test"))
       (gl (make-gl w 400 400))
       (t  (init gl)))
  (window-show w)
  (thread
   (lambda ()
     (let loop ((r 0))
       (in-gl gl (draw t r))
       (gl-blit gl)
       (sleep 1/25)
       (loop (+ r 1))))))