; pattern cascade kit 1.0.0
; o.+o.--o.+o.o.+o.--o.+o..
; (c) 2006   dave griffiths 
; GPL licence (see COPYING)
; ~~~~~~~~~~~~~~~~~~~~~~~~~

; example pattern visuals script
; pretty simple 3D piano roll kinda thing

(ortho)

(define shapes '())
(define animlist '())
(define rot 0)

(define (build id string)
    (define (parse l shape)
        (cond 
            ((char=? #\o (car l))
                (let ((obj (build-cube)))
                (set! shape (append shape (list obj)))))
            ((char=? #\O (car l))
				(push)
                (scale (vector 1.5 1.5 1.5))
                (let ((obj (build-cube)))
                (set! shape (append shape (list obj)))
                (pop)))
            ((char=? #\. (car l))
                (translate (vector 1 0 0)))
            ((char=? #\+ (car l))
                (translate (vector 0 1 0)))
            ((char=? #\- (car l))
                (translate (vector 0 -1 0))))

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

    (push)
    (colour (vector (* (flxrnd) 0.4) (flxrnd) (flxrnd)))
    (wire-colour (vector (flxrnd) (* (flxrnd) 0.4) (* (flxrnd) 0.4)))
    (hint-none)
    (hint-wire)
    (line-width 2)
    (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)
    (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)))
                (hint-none)(hint-wire)
                (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)))))))))

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