MusicalTime.hs

------------------------------------------------------------------------------

-- /home/renick/haskell/conductive-0.3c/MusicalTime.hs
-- created: Sun Sep 16 22:23:57 JST 2012

------------------------------------------------------------------------------

-- | This is a module for functions concerned with time and its use in music.

module Sound.Conductive.MusicalTime where

import Data.Map
import Data.Time.Clock.POSIX
import Sound.Conductive.ConductiveBaseData

-- | a function which displays a musical time with beats to three decimal places, as it's more readable that way...

displayMusicalTime :: MusicalTime -> [Char]
displayMusicalTime x = let 
    b = beat x 
    bVal = if ( b < 0.001)
              then "0000"
              else take 4 $ show $ truncate $ b * 1000
    bVal2 = if ((length $ bVal) < 4)
                then (replicate (4-length bVal) '0') ++ bVal
                else bVal
    bString = (head bVal2):'.':tail bVal2
    in (show $ measure x) ++ ('.':bString)

-- | a cast from POSIX time to a Double

currentTime :: IO Double
currentTime = do n <- getPOSIXTime
                 return $ realToFrac n

-- | returns the latest (current) tempo change (not tempo) of a clock

lastTempoChange :: TempoClock -> TempoChange
lastTempoChange t = head $ tempoChanges t

-- | returns the latest (may not be current) time signature change (not timesignature) of a clock

lastTimeSignatureChange :: TempoClock -> TimeSignature
lastTimeSignatureChange t = head $ timeSignatureChanges t

-- | returns the latest (current) tempo of a clock

currentTempo :: TempoClock -> Double
currentTempo t = newTempo $ lastTempoChange t

-- | returns the current (may not be latest) time signature change of a clock

currentTimeSignatureChange :: TempoClock -> IO TimeSignature
currentTimeSignatureChange t = 
    let ts = timeSignatureChanges t
        currentTS tsc cb 
            | (startingBeat $ head tsc) <= cb = head tsc
            | otherwise = currentTS (tail tsc) cb
    in do cb <- currentBeat t
          return $ currentTS ts cb

-- | returns the current time signature of a clock

currentTimeSignature :: TempoClock -> IO Int
currentTimeSignature t = do
    tsc <- currentTimeSignatureChange t
    return $ timeSignature tsc

-- | returns the time elapsed since the start time of a given clock

elapsedTime :: TempoClock -> IO Double
elapsedTime t = let
    s = startTime t
    in do n <- currentTime 
          return $ n - s

-- | returns the time elapsed since the last tempo change

timeSinceTempoChange :: TempoClock -> IO Double
timeSinceTempoChange t = let
    tc = timeOfTempoChange $ lastTempoChange t
    in do n <- currentTime 
          return $ n - tc

-- | converts a list of relative time deltas to a list of absolute times starting from the given time (first argument)

deltasToAbsolutes :: (Num a) => a -> [a] -> [a]
deltasToAbsolutes start input = scanl (+) start input

-- | converts a list of relative time deltas to a list of absolute times

absolutesToDeltas :: (Num a) => [a] -> [a]
absolutesToDeltas [] = []
absolutesToDeltas (x:[]) = []
absolutesToDeltas (x:xs) = ((head xs) - x):absolutesToDeltas xs

-- | converts a time delta (first argument) to a length specified in beats based on the given tempo (second argument)

deltaToBeats :: (Fractional a) => a -> a -> a
deltaToBeats delta tmp = (tmp/60) * delta

beatsToDelta' :: (Fractional a) => a -> a -> a
beatsToDelta' t b = (b/t) * 60

-- | converts a time delta specified in beats (second argument) to one in seconds based on the given clock (first argument)

beatsToDelta :: TempoClock -> Double -> Double
beatsToDelta tc b = beatsToDelta' (currentTempo tc) b

-- | when given a clock, returns the current beat

currentBeat :: TempoClock -> IO Double
currentBeat t = let
    lastChange = beatOfTempoChange $ lastTempoChange t
    in do elapsedT <- timeSinceTempoChange t
          return $ lastChange + (deltaToBeats elapsedT $ currentTempo t)

-- | an alias for currentBeat

elapsedBeats :: TempoClock -> IO Double
elapsedBeats = currentBeat

-- | when given a clock, returns the current measure

currentMeasure :: TempoClock -> IO Int
currentMeasure t = let
    in do b <- currentBeat t
          tsc <- currentTimeSignatureChange t
          let sm = startingMeasure tsc
          let sb = startingBeat tsc
          let ts = timeSignature tsc
          return $ sm + (truncate $ (b - sb)/(fromIntegral ts))

-- | when given a clock, returns the current MusicalTime

currentMusicalTime :: TempoClock -> IO MusicalTime
currentMusicalTime t = let
    in do m <- currentMeasure t
          tsc <- currentTimeSignatureChange t
          let ts = timeSignature tsc
          let sm = startingMeasure tsc
          let sb = startingBeat tsc
          b <- currentBeat t
          let b2 = (b - sb) - (fromIntegral ((m - sm)*ts))
          return MusicalTime { measure = m, beat = b2 }

-- | shows the elapsed time in terms of a MusicalTime

elapsedMusicalTime :: TempoClock -> IO MusicalTime
elapsedMusicalTime = currentMusicalTime

-- | returns the time as a more human-readable string version of MusicalTime

currentMusicalTime2 :: TempoClock -> IO [Char]
currentMusicalTime2 t = do
    mt <- currentMusicalTime t
    return $ displayMusicalTime mt

-- | given a TempoClock and a new tempo, adds a TempoChange to it and returns a new clock

changeTempo :: TempoClock -> Double -> IO TempoClock
changeTempo t new = do
    b <- currentBeat t
    n <- currentTime
    let ch = TempoChange { newTempo = new
                         , beatOfTempoChange = b
                         , timeOfTempoChange = n
                         }
    return $ t { tempoChanges = ch:(tempoChanges t) }

-- | given a TempoClock and a new time signature, adds a TimeSignatureChange and returns a new TempoClock. Changing the time signature takes effect in the next measure after the current one.

changeTimeSignature :: TempoClock -> Int -> IO TempoClock
changeTimeSignature t new = let
    tscs = timeSignatureChanges t
    in do tsc <- currentTimeSignatureChange t
          let sm = startingMeasure tsc
          let sb = startingBeat tsc
          cm <- currentMeasure t
          let nextMeasure = cm + 1
          let beatsSinceChange = (timeSignature tsc) * (nextMeasure - sm)
          let nsb = sb + (fromIntegral beatsSinceChange)
          let newTsc = TimeSignature { startingMeasure = nextMeasure
                                     , startingBeat = nsb
                                     , timeSignature = new
                                     }
          return $ t { timeSignatureChanges = newTsc:tscs }

-- | converts a string with the time, written as "measure.beat.decimalFractionOfABeat", to a MusicalTime. 
--
-- For example, "2.2.5" converts to MusicalTime { measure = 2, beat = 2.5 }.

timeStringToMusicalTime :: [Char] -> MusicalTime
timeStringToMusicalTime t = let
    ts = break ((==) '.') t
    m = read $ fst ts
    b = read $ tail $ snd ts
    in MusicalTime { measure = m, beat = b }

-- | a cast from MusicalTime to beats

musicalTimeToBeats :: TempoClock -> MusicalTime -> Double
musicalTimeToBeats clock t = let
    ts = timeSignature $ head $ timeSignatureChanges clock
    in (beat t) + (fromIntegral $ (measure t) * ts)