(ortho)

(define shapes '())
(define animlist '())

; light zero is the default camera light - set to a low level
(light-diffuse 0 (vector 0 0 0))
(light-specular 0 (vector 0 0 0))

; make a big fat key light
(define key (make-light "spot" "free"))
(light-position key (vector 50 50 0))
(light-diffuse key (vector 1 0.95 0.8))
(light-specular key (vector 0.6 0.3 0.1))
(light-spot-angle key 22)
(light-spot-exponent key 100)
(light-direction key (vector -1 -1 0))

; make a fill light
(define fill (make-light "spot" "free"))
(light-position fill (vector -70 70 12))
(light-diffuse fill (vector 0.5 0.3 0.1))
(light-specular fill (vector 0.5 0.3 0.05))
(light-spot-angle fill 12)
(light-spot-exponent fill 100)
(light-direction fill (vector 0.6 -0.6 -1))

; make a rim light
(define rim (make-light "spot" "free"))
(light-position rim (vector 5 70 -120))
(light-diffuse rim (vector 0.9 0.3 0.1))
(light-specular rim (vector 0.7 0.1 0.1))
(light-spot-angle rim 12)
(light-spot-exponent rim 100)
(light-direction rim (vector 0 -0.6 1))

(specular (vector 1 1 1))
(shinyness 500)
(texture (force-load-texture "fingers.png"))

(define (settx n)
	(pdata-set "t" n (vadd (vmul (pdata-get "t" n) 0.1) (vector 0 (flxrnd) 0)))
	(if (zero? n)
		0
		(mvtx (- n 1))))

(define (mvtx n)
	(pdata-set "t" n (vadd (pdata-get "t" n) (vector 0.02 0.01 0)))
	(if (zero? n)
		0
		(mvtx (- n 1))))

(define (build id string)
    (define (parse l shape)
        (cond 
            ((char=? #\o (car l))
                (let ((obj (build-sphere 8 8)))
				(grab obj)
				(settx (pdata-size))
				(ungrab)
                (set! shape (append shape (list obj)))
                (pop)(push)
                (parent obj)))
            ((char=? #\O (car l))
                (let ((obj (build-sphere 8 8)))
                (set! shape (append shape (list obj)))
                (pop)(push)
                (parent obj)))
            ((char=? #\. (car l))
                (translate (vector 1 0 0)))
            ((char=? #\+ (car l))
                (rotate (vector 1 5 1)))
            ((char=? #\- (car l))
                (rotate (vector 1 -5 1))))

        (if (null? (cdr l))
            shape
            (parse (cdr l) shape)))

    (push)
	;(hint-unlit)
    (colour (vector 1 1 1))
    (push)
    (translate (vector 0 0 id))
    (let ((shape (parse (string->list string) '())))
    (pop)(pop)
    (set! animlist (append animlist (list (car shape))))
    (set! shapes (append shapes (list (list id shape))))))


(define (anim notes)
    (define (_anim l)
        (cond 
            ((not (null? l))
                (grab (car l))
				(rotate (vector 0 0 1))
				(mvtx (pdata-size))
                (ungrab)
                (if (null? (cdr l))
                    0
                    (_anim (cdr l))))))

    (cond ((not (null? notes))
        (let ((id (car (car notes))))
        (let ((note (cdr (car notes))))
        (let ((shape (assq id shapes)))
        (cond 
            ((and (not (eq? shape #f)) (< note (length (car (cdr shape)))))
                (grab (list-ref animlist (- id 1)))
                (ungrab)
                (list-set! animlist (- id 1) (list-ref (car (cdr shape)) note))
                (grab (list-ref animlist (- id 1)))
                (hint-solid)
                (ungrab)))
        (if (null? (cdr notes))
            0
            (anim (cdr notes))))))))
    (_anim animlist))

(pattern-build-func build)
(pattern-animate-func anim)