module Sound.Conductive.MusicalTime where
import Sound.Conductive.ConductiveBaseData
import Data.List.Utils
import Data.Map
import Data.Time.Clock.POSIX
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 (4length bVal) '0') ++ bVal
else bVal
bString = (head bVal2):'.':tail bVal2
in (show $ measure x) ++ ('.':bString)
currentTime :: IO Double
currentTime = do n <- getPOSIXTime
return $ realToFrac n
lastTempoChange :: TempoClock -> TempoChange
lastTempoChange t = head $ tempoChanges t
lastTimeSignatureChange :: TempoClock -> TimeSignature
lastTimeSignatureChange t = head $ timeSignatureChanges t
currentTempo :: TempoClock -> Double
currentTempo t = newTempo $ lastTempoChange t
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
currentTimeSignature :: TempoClock -> IO Int
currentTimeSignature t = do
tsc <- currentTimeSignatureChange t
return $ timeSignature tsc
elapsedTime :: TempoClock -> IO Double
elapsedTime t = let
s = startTime t
in do n <- currentTime
return $ n s
timeSinceTempoChange :: TempoClock -> IO Double
timeSinceTempoChange t = let
tc = timeOfTempoChange $ lastTempoChange t
in do n <- currentTime
return $ n tc
deltasToAbsolutes :: (Num a) => a -> [a] -> [a]
deltasToAbsolutes start input = scanl (+) start input
absolutesToDeltas :: (Num a) => [a] -> [a]
absolutesToDeltas [] = []
absolutesToDeltas (x:[]) = []
absolutesToDeltas (x:xs) = ((head xs) x):absolutesToDeltas xs
deltaToBeats :: (Fractional a) => a -> a -> a
deltaToBeats delta tmp = (tmp/60) * delta
beatsToDelta' :: (Fractional a) => a -> a -> a
beatsToDelta' t b = (b/t) * 60
beatsToDelta :: TempoClock -> Double -> Double
beatsToDelta tc b = beatsToDelta' (currentTempo tc) b
currentBeat :: TempoClock -> IO Double
currentBeat t = let
lastChange = beatOfTempoChange $ lastTempoChange t
in do elapsedT <- timeSinceTempoChange t
return $ lastChange + (deltaToBeats elapsedT $ currentTempo t)
elapsedBeats :: TempoClock -> IO Double
elapsedBeats = currentBeat
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))
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 }
elapsedMusicalTime :: TempoClock -> IO MusicalTime
elapsedMusicalTime = currentMusicalTime
currentMusicalTime2 :: TempoClock -> IO [Char]
currentMusicalTime2 t = do
mt <- currentMusicalTime t
return $ displayMusicalTime mt
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) }
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 }
timeStringToMusicalTime :: [Char] -> MusicalTime
timeStringToMusicalTime t = let
ts = break ((==) '.') t
m = read $ fst ts
b = read $ tail $ snd ts
in MusicalTime { measure = m, beat = b }
musicalTimeToBeats :: TempoClock -> MusicalTime -> Double
musicalTimeToBeats clock t = let
ts = timeSignature $ head $ timeSignatureChanges clock
in (beat t) + (fromIntegral $ (measure t) * ts)