spherical-plot-lighting.sps

;; spherical plot with lighting

(import (rnrs)
        (gl)
        (glut)
        (agave glu)
        (agave glamour window)
        (agave glamour misc)
        (agave glamour mouse))

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

(define-record-type vec
  (fields x y z))

(define (v- a b)
  (make-vec (- (vec-x a) (vec-x b))
            (- (vec-y a) (vec-y b))
            (- (vec-z a) (vec-z b))))

(define (vxv a b)

  (let ((a1 (vec-x a))
        (a2 (vec-y a))
        (a3 (vec-z a))
        (b1 (vec-x b))
        (b2 (vec-y b))
        (b3 (vec-z b)))

    (make-vec (- (* a2 b3) (* a3 b2))
              (- (* a3 b1) (* a1 b3))
              (- (* a1 b2) (* a2 b1)))))

(define (vneg v)
  (make-vec (- (vec-x v))
            (- (vec-y v))
            (- (vec-z v))))

(define (gl-vertex-vec v)
  (glVertex3d (vec-x v) (vec-y v) (vec-z v)))

(define (gl-normal-vec v)
  (glNormal3d (vec-x v) (vec-y v) (vec-z v)))

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

(initialize-glut)

(window (size 500 500)
        (title "R[ sin( theta + i * phi ) ]")
        (reshape (width height)
          (lambda (w h)
            (glLoadIdentity)
            (glFrustum -1.0 1.0 -1.0 1.0 1.5 20.0))))

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

(define f32vector
  (lambda lst
    (define-syntax f32set!
      (syntax-rules ()
        ((_ bv n value)
         (bytevector-ieee-single-native-set! bv (* n 4) value))))
    (let ((bv (make-bytevector (* (length lst) 4))))
      (let loop ((i 0) (lst lst))
        (cond ((null? lst) bv)
              (else
               (f32set! bv i (car lst))
               (loop (+ i 1) (cdr lst))))))))

(glShadeModel GL_FLAT)

(glEnable GL_LIGHTING)
(glEnable GL_LIGHT0)

(glEnable GL_NORMALIZE)
(glEnable GL_DEPTH_TEST)

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

(define mouse-x 0.0)
(define mouse-y 0.0)

(glutPassiveMotionFunc
 (lambda (x y)
   (set! mouse-x x)

   ;; (set! mouse-y y)

   (set! mouse-y (- height y))
   
   (glutPostRedisplay)))

(define pi 3.14159265358979323846)

(define two-pi (* 2 pi))

(define (deg x)
  (* x (/ 180.0 pi)))

(define (rad x)
  (* x (/ pi 180.0)))

(buffered-display-procedure

 (lambda ()

   (glClear GL_DEPTH_BUFFER_BIT)
   
   (background 0.0)
   
   ;; viewing transformation

   (gluLookAt (* 5 (sin (* (/ mouse-x width) two-pi)))
              (+ -5.0 (* (/ mouse-y height) 10.0))
              (* 5 (cos (* (/ mouse-x width) two-pi)))
              0.0 0.0 0.0
              0.0 1.0 0.0)

   ;; modeling transformation

   (glLightfv GL_LIGHT0 GL_POSITION (f32vector -10.0 0.0 0.0 0.0))

   (glColor3d 1.0 1.0 1.0)

   (let ((data '()))

     (define-syntax push
       (syntax-rules ()
         ((push elt)
          (set! data (cons elt data)))))

     (do ((phi (* -1/4 two-pi) (+ phi (* 1/20 two-pi))))
         ((> phi (* 1/4 two-pi)))

       (do ((theta 0.0 (+ theta (* 1/100 two-pi))))
           ((>= theta two-pi))

         (let ((radius (real-part (sin (+ theta (* 1i phi))))))

           (push (make-vec (* radius (sin theta) (cos phi))
                           (* radius (sin theta) (sin phi))
                           (* radius (cos theta))))

           (let ((phi (+ phi (* 1/20 two-pi))))

             (let ((radius (real-part (sin (+ theta (* 1i phi))))))

               (push (make-vec (* radius (sin theta) (cos phi))
                               (* radius (sin theta) (sin phi))
                               (* radius (cos theta)))))))))

     (set! data (reverse data))

     (gl-begin GL_QUAD_STRIP
     
       (let loop ((data data))

         (when (and (pair? data)
                    (pair? (cdr data))
                    (pair? (cdr (cdr data))))

           (let ((a (list-ref data 0))
                 (b (list-ref data 1))
                 (c (list-ref data 2))
                 (d (list-ref data 3)))

             (gl-normal-vec (vxv (v- a b) (v- b c)))

             (gl-vertex-vec a)
             (gl-vertex-vec b)
             (gl-vertex-vec c)
             (gl-vertex-vec d)

             (loop (cdr (cdr (cdr (cdr data)))))))))

     )))

(glutMainLoop)