------------------------------------------------------------------------------ -- MusicalTime.hs -- created: Fri Oct 1 23:20:55 JST 2010 ------------------------------------------------------------------------------ -- | This is a module for functions concerned with time and its use in music. module Sound.Conductive.MusicalTime where import Sound.Conductive.ConductiveBaseData import Data.List.Utils import Data.Map -- import System.Posix.Timer import Data.Time.Clock.POSIX -- | 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)