module Sound.Conductive.ClockDisplay where
import Control.Concurrent
import Data.List
import Sound.Conductive.ConductiveBaseData
import Sound.Conductive.MusicalEnvironment
import Sound.OpenSoundControl
elapsed :: (RealFrac a1, Show a) => a1 -> a -> [Char]
elapsed minutes secs = let
secsString = show secs
s = if ((head $ tail secsString) == '.')
then "0"++secsString
else secsString
in (show $ floor minutes) ++ ":" ++ (take 5 $ s)
clockTimeString :: MVar MusicalEnvironment -> String -> IO [Char]
clockTimeString e clock = do
tempo <- eCurrentTempo e clock
ts <- eCurrentTimeSignature e clock
mt <- showCurrentTime e clock
secs' <- eElapsedTime e clock
let minutes = fromIntegral $ floor $ secs'/60
let secs = secs' (minutes*60)
let e = elapsed minutes secs
let timeString = concat [" "
,clock
," "
,(show tempo)
,"bpm"
," "
,(show ts)
," "
,mt
," "
,e
]
return timeString
clockTimeOSC :: MVar MusicalEnvironment -> String -> Int -> IO ()
clockTimeOSC e clock port = clockTimeString e clock
>>= (\y -> withTransport (openUDP "127.0.0.1" port)
(\x -> send x $ Message clock [String y])
)
showClockTimeString :: MVar MusicalEnvironment -> String -> IO b
showClockTimeString e clock = clockTimeString e clock
>>= (\x -> putStrLn x) >> threadDelay 200000
>> showClockTimeString e clock