(ortho)

(define shapes '())
(define animlist '())
(define stroke-curve '())
(define stroke-angle 20)
(define stroke-dist 1)
(define stroke-width 1)
(define stroke-dir (vector 1 0 0))
(define stroke-pos (vector 0 0 0))
(define camera (build-cube))
(grab camera)
(hide 1)
(ungrab)
(lock-camera camera)
(camera-lag 0.01)

(define stroke-textures (list 
    (load-texture "stroke/01.png") 
    (load-texture "stroke/02.png")
    (load-texture "stroke2/04.png")
    (load-texture "stroke/04.png")
    (load-texture "stroke/05.png")
    (load-texture "stroke/06.png")
    ))
        
(define stroke-append-curve
    (lambda ()
        (set! stroke-pos (vadd stroke-pos stroke-dir))
        (set! stroke-curve (append stroke-curve (list stroke-pos)))
        (set! stroke-curve (append stroke-curve (list stroke-width)))))

(define stroke-make-curve
    (lambda (n l)
        (pdata-set "p" n (car l))
        (pdata-set "w" n (car (cdr l)))
        (if (eq? (cdr (cdr l)) '())
            0
            (stroke-make-curve (+ n 1) (cdr (cdr l))))))

(define stroke-build-curve
    (lambda ()
        (push)
            (hint-unlit)
            (let ((o (build-line (/ (length stroke-curve) 2))))
        (pop)
        (grab o)
            (stroke-make-curve 0 stroke-curve)
        (ungrab)
        (set! stroke-curve '())
        o)))


(define (build id string)
    (define (parse l shape)
        (cond 
            ((char=? (car l) #\+)
                (set! stroke-dir (vtransform stroke-dir (mrotate (vector 0 stroke-angle 0))))(stroke-append-curve))
            ((char=? (car l) #\-)
                (set! stroke-dir (vtransform stroke-dir (mrotate (vector 0 (- stroke-angle) 0))))(stroke-append-curve))
            ((char=? (car l) #\[)
                (set! stroke-width (+ stroke-width 0.4))(stroke-append-curve))
            ((char=? (car l) #\])
                (set! stroke-width (- stroke-width 0.4))(stroke-append-curve))
            ((char=? (car l) #\/)
                (set! stroke-dir (vtransform stroke-dir (mrotate (vector 0 0 stroke-angle))))(stroke-append-curve))
            ((char=? (car l) #\\)
                (set! stroke-dir (vtransform stroke-dir (mrotate (vector 0 0 (- stroke-angle)))))(stroke-append-curve))
            ((char=? (car l) #\.)
                (stroke-append-curve))
               ((or (char=? (car l) #\o) (char=? (car l) #\O))
                
                ; add some more points in case we haven't got any yet
                (stroke-append-curve)
                (stroke-append-curve)
                
                ; make the stroke
                (let ((ob (stroke-build-curve)))    
                    ; add the stroke to the right list
                    (set! shape (append shape (list ob)))
                    (grab ob)
                    (hide 1)
                    (pdata-copy "p" "pref")
                    (ungrab))
                    
                (set! stroke-curve '())))

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

	(set! stroke-pos (vector 0 0 0))
	(set! stroke-curve '())
    (push)
    (texture (list-ref stroke-textures (modulo id (length stroke-textures))))
    (translate (vector 0 0 id))
    (let ((shape (parse (string->list string) '())))
    (pop)
    (set! animlist (append animlist (list (car shape))))
    (set! shapes (append shapes (list (list id shape))))))


(define (anim notes)
    (define (jitter n)
        (pdata-set "p" n (vadd (pdata-get "pref" n)
            (vsub (vector (flxrnd)(flxrnd)(flxrnd)) (vector 0.5 0.5 0.5))))
        (if (zero? n)
            0
            (jitter (- n 1))))

    (define (_anim l)
        (cond 
            ((not (null? l))
                (grab (car l))
                (jitter (pdata-size))
                (ungrab)
                (if (null? (cdr l))
                    0
                    (_anim (cdr l))))))
 
    (define (_hideall l)
        (cond 
            ((not (null? l))
                (grab (car l))
                (hide 1)
                (ungrab)
                (if (null? (cdr l))
                    0
                    (_hideall (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)))))
                (if (eq? note 1)
                    (_hideall (car (cdr shape))))
                (list-set! animlist (- id 1) (list-ref (car (cdr shape)) note))
                (grab (list-ref animlist (- id 1)))
                (let ((pos (pdata-get "p" 0)))
                (hide 0)
                (ungrab)
                (grab camera)
                (identity)
                (translate pos)
                (rotate (vmul (vector (flxrnd)(flxrnd)(flxrnd)) 90))
                (ungrab))))
        (if (null? (cdr notes))
            0
            (anim (cdr notes))))))))
    (_anim animlist))

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