;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 'in place' looping based on rmap
;;
(define-macro (rmap-loop-runner name tagtime run beatsexpr offsetexpr expr . lsts)
(let* ((loopcnt 0)
(f `(lambda ,(cons 'beat (cons 'dur (cons 'loop (map (lambda (x)
(string->symbol (string-append "@" (number->string x))))
(range 1 (+ 1 (length lsts)))))))
,expr))
(beats (eval beatsexpr))
(offset (eval offsetexpr))
(running? (closure? name)))
(if (equal? run 'modify)
(begin
(print-with-colors 'blue 'default #t (print "pattern "))
(print-with-colors 'yellow 'default #f (print "changing "))
(println name)))
(begin (eval `(define ,name
(lambda (beat totaldur loopcnt dur)
(define beats ,beatsexpr)
(define offset ,offsetexpr)
(define LC loopcnt)
(define LP totaldur)
(define LL beats)
(set! ,tagtime (now))
(rmap beats offset ,f loopcnt totaldur ,@lsts)
(if ,(if (equal? run 'stop) #t #f)
(begin
(print-with-colors 'blue 'default #t (print "pattern "))
(print-with-colors 'red 'default #f (print "stopping "))
(println ',name)
(eval '(define ,name #f) (interaction-environment))
#f)
(callback (*metro* (+ beat (* .5 dur))) ',name (+ beat dur)
(if (= (+ totaldur dur) beats) 0 (+ totaldur dur))
(if (= (+ totaldur dur) beats) (+ loopcnt 1) loopcnt)
,(if (> beats 1) 1/2 (/ beats 2))))))
(interaction-environment))
(if (equal? run 'start)
(eval `(begin
(print-with-colors 'blue 'default #t (print "pattern "))
(print-with-colors 'green 'default #f (print "starting "))
(println ',name)
(,name (*metro* 'get-beat 4) 0 0 (if (> ,beats 1) 1/2 (/ ,beats 2))))
(interaction-environment))))))