{-# LANGUAGE DeriveGeneric #-}
module Data.Tempo where
import Data.Time
import GHC.Generics
-- | Musical tempo is represented as a data structure with three orthogonal components.
-- (Generic instances are derived in order to allow later generation of instances for
-- Aeson classes.)
data Tempo = Tempo {
freq :: Rational, -- frequency of cycles/beats, ie. cycles/beats per second
time :: UTCTime, -- a time at which a number of "elapsed" cycles/beats will be indicated
count :: Rational -- the number of "elapsed" cycles/beats at the time indicated
} deriving (Eq,Generic,Show)
-- | The 'origin' of a Tempo is the time at which the number of elapsed cycles/beats
-- would have been 0.
origin :: Tempo -> UTCTime
origin x = addUTCTime (realToFrac $ count x * (-1) / freq x) (time x)
-- | Given a Tempo and a clock time (UTCTime), timeToCount tells us how many cycles/beats
-- have elapsed at that time.
timeToCount :: Tempo -> UTCTime -> Rational
timeToCount x t = (realToFrac $ diffUTCTime t $ time x) * freq x + count x
-- | Given a Tempo and a count of elapsed cycles/beats, countToTime tells us when that "beat"
-- will (or would have) take(n) place.
countToTime :: Tempo -> Rational -> UTCTime
countToTime x c = addUTCTime (realToFrac $ c / freq x) (origin x)
-- | Provided a new frequency and a pivot time, changeTempo modifies a given Tempo as if
-- the frequency changed at the pivot time, with the count continuing to increase 'monotonically'
changeTempo :: Rational -> UTCTime -> Tempo -> Tempo
changeTempo f t x = Tempo {
freq = f,
time = t,
count = timeToCount x t
}
-- | For convenience, changeTempoNow is an IO action that changes the frequency of the tempo
-- 'now', ie. at the time returned by a call to getCurrentTime embedded in the action.
changeTempoNow :: Rational -> Tempo -> IO Tempo
changeTempoNow f x = do
t <- getCurrentTime
return $ changeTempo f t x
-- | Given a tempo, a window defined by two UTCTime-s, a metre (cycles of cycles), and an offset
-- within that metre, findBeats returns all occurrences of the defined metric position within the window.
-- The window is inclusive at the lower limit, and exclusive at the upper limit (so answers can
-- occur exactly at the lower limit but not at the upper limit).
findBeats :: Tempo -> UTCTime -> UTCTime -> Rational -> Rational -> [Rational]
findBeats tempo lowerLimitUtc upperLimitUtc metre offset =
let lowerLimitCycles = timeToCount tempo lowerLimitUtc
upperLimitCycles = timeToCount tempo upperLimitUtc
in findBeats' metre offset lowerLimitCycles upperLimitCycles
-- | Given a metre and offset (eg. 2 and 0.5 to represent half-way through the first cycle
-- of a metre lasting 2 cycles), and lower and upper limits in elapsed cycles, findBeats'
-- returns all positions that match the given offset and metre and are greater than or equal
-- to the lower limit, and lower than the upper limit.
findBeats' :: Rational -> Rational -> Rational -> Rational -> [Rational]
findBeats' metre offset lowerLimit upperLimit
| nextBeat metre offset lowerLimit >= upperLimit = []
| otherwise = nextBeat metre offset lowerLimit : findBeats' metre offset (lowerLimit+metre) upperLimit
-- | Given a metre, offset, and a lower limit in elapsed cycles, nextBeat returns the next
-- position in cycles that matches the given offset and metre, and is greater than
-- or equal to the lower limit.
nextBeat :: Rational -> Rational -> Rational -> Rational
nextBeat metre offset lowerLimit
| metre == 0 = error "you can't have a metre of 0!!!"
| otherwise =
let fract x = x - realToFrac (floor x :: Integer) -- for convenience
lowerLimitInMetre = lowerLimit/metre -- lower limit expressed in multiples of the metre (cycles of cycles)
offsetInMetre = fract $ offset/metre -- offset expressed in multiples of the metre
-- the answer occurs either in this instance of the metre, or the next...
nextBeatInMetre | offsetInMetre >= (fract lowerLimitInMetre) = (realToFrac (floor lowerLimitInMetre :: Integer)) + offsetInMetre
| otherwise = (realToFrac (ceiling lowerLimitInMetre :: Integer)) + offsetInMetre
in nextBeatInMetre*metre -- translate answer in terms of meter back to cycles