;;; TEMPO STUFF
;
; Herein is a set of gadgets for converting time measured in tempo-driven
; beats to time measured in seconds. It's assumed that all tempi are
; expressed in beats/minute. The principal end-user function is WHAT-TIME.
;
;               - Pete Yadlowsky, 6/1/95

(load "/VCCM/lib/lisp/loop.cl")

;; miscellaneous functions
;
(defun beat (triple) (first triple))
(defun tempo (triple) (second triple))
(defun elapsed (triple) (third triple))

(defun interpolate (x x1 y1 x2 y2)
       (+ (* (/ (- y2 y1) (- x2 x1)) (- x x1)) y1))

(compile 'interpolate)

;; ETIME
;
; Given a tempo ramp ([beat1,tempo1]->[beat2,tempo2]), compute time
; elapsed (in seconds) by converting beats/min to secs/beat and
; integrate to compute area under curve.
;
(defun etime (x beat1 beat2 tempo1 tempo2)
       (* 60 (if (= tempo2 tempo1)
                 (/ (- x beat1) (float tempo1))
                 (let* ((slope (/ (- tempo2 tempo1) (- (float beat2) beat1)))
                       (intercept (- tempo1 (* slope beat1))))
                   (/ (- (log (+ (* slope x) intercept))
                         (log (+ (* slope beat1) intercept))) slope))
           ))
       )

(compile 'etime)

;; CTIME
;
; Given a graph of beat-tempo points, construct a list of triples, augmenting
; each point with its elapsed time (in seconds).
;
(defun ctime (points &aux prev sum)
       (setf prev nil)
       (loop for point in points
             collect (if (null prev)
                         (append point (list (setf sum 0.0)))
                         (let ((e (etime (beat point) (beat prev) (beat point)
                                         (tempo prev) (tempo point))))
                           (append point (list (setf sum (+ sum e))))
                           )
                         )
             do (setf prev point)
             )
       )

(compile 'ctime)

;; WHAT-TIME
;
; Given a beat and a graph of beat-tempo pairs (or beat-tempo-elapsed triples),
; return elapsed time and duration of one beat.
;
(defun what-time (beat graph &aux sum prev quit tempo triples)
       (setf triples (if (= (length (first graph)) 2) (ctime graph) graph))
       (let ((beat1 (beat (first triples)))
             (beat2 (beat (first (last triples)))))
         (when (or (< beat beat1) (> beat beat2))
               (error (format nil "Beat ~f is outside (~f, ~f)~%"
                              beat beat1 beat2))))
       (setf sum 0.0)
       (setf quit nil)
       (loop for triple in triples
             until quit
             do (cond
                 ((= beat (beat triple))
                  (setf sum (third triple))
                  (setf tempo (tempo triple))
                  (setf quit t))
                 ((> beat (beat triple))
                  (setf sum (+ sum (third triple))))
                 ((< beat (beat triple))
                  (setf sum (+ sum (etime beat
                                          (beat prev) (beat triple)
                                          (tempo prev) (tempo triple))))
                  (setf tempo (interpolate beat (beat prev) (tempo prev)
                                           (beat triple) (tempo triple)))
                  (setf quit t)))
             do (setf prev triple)
             finally (return (list sum (/ 60.0 tempo)))
             )
       )
(compile 'what-time)