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

-- ClockDisplay.hs
-- created: Sat Oct  2 01:12:08 JST 2010

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

module Sound.Conductive.ClockDisplay where

import Control.Concurrent
import Data.List
import Sound.Conductive.ConductiveBaseData
import Sound.Conductive.MusicalEnvironment
import Sound.OpenSoundControl
-- import Sound.OpenSoundControl.OSC
-- import Sound.OpenSoundControl.Transport
-- import Sound.OpenSoundControl.Transport.UDP

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