module Network.Netclock.Client where

import Sound.OSC.FD
import Sound.OSC.Core
import Sound.OSC.Type
import Control.Concurrent (threadDelay, forkIO)
import Control.Concurrent.MVar
import Data.List
import Data.Maybe
import qualified Network.Socket as N
import Data.Function
import Control.Monad
import qualified Data.ByteString.Char8 as C

data BpsChange = BpsChange {changeBps :: Double, 
                            changeTime :: Double, 
                            changeBeat :: Double
                            }

instance Show BpsChange where
     show change = "bps " ++ show (changeBps change)
                  ++ " time " ++ show (changeTime change) 
                  ++ " beat " ++ show (changeBeat change)

-- Bps changes are ordered by beat value, and considered the same if
-- they happen at the same time.

instance Eq BpsChange where
    (==) = (==) `on` changeBeat
instance Ord BpsChange where
    compare = compare `on` changeBeat

-- Wait until the the given beat value.

scport = 57120

logicalTime :: BpsChange -> Double -> Double
logicalTime change beat = 
  changeTime change + ((beat - changeBeat change) / changeBps change)

waitBeat :: BpsChange -> Double -> IO ()
waitBeat change beat = 
    do let logicalNow = logicalTime change beat
       realNow <- time
       let diff = logicalNow - realNow
       let delay = floor $ diff * 1000000.0
       when (diff > 0) $ threadDelay delay
       return ()

sched :: String -> String -> String -> Int -> IO () -> IO ()
sched username clientIp serverIp t f = 
  do mBps <- newEmptyMVar
     forkIO $ bpsListen username clientIp serverIp mBps
     change <- updateBps mBps 0
     realNow <- time
     let diff = realNow - changeTime change
         bps = changeBps change
         beat = changeBeat change + (diff * bps)
         nextbeat = fromIntegral $ ((floor beat) + t*2) - ((floor beat) `mod` t)
     current <- updateBps mBps nextbeat
     forkIO $ do waitBeat current (nextbeat - 1/32) 
                 f
     return()

clocked :: String -> String -> String -> Int -> (BpsChange -> Int -> IO ()) -> IO ()
clocked username clientIp serverIp tpb f = 
    do mBps <- newEmptyMVar
       forkIO $ bpsListen username clientIp serverIp mBps
       change <- updateBps mBps 0
       realNow <- time
       let diff = realNow - changeTime change
           bps = changeBps change
           beat = changeBeat change + (diff * bps)
           tick = floor beat * tpb
       loop mBps tick
    where 
      loop :: MVar (BpsChange, [BpsChange]) -> Int -> IO ()
      loop mBps tick = 
          do let beat = fromIntegral tick / fromIntegral tpb
             current <- updateBps mBps beat
             let bps = changeBps current
             waitBeat current beat
             f current tick
             loop mBps (tick + 1)

updateBps :: MVar (BpsChange, [BpsChange]) -> Double -> IO (BpsChange)
updateBps mBps beat = do modifyMVar_ mBps (\x -> return (nextChange x beat))
                         (current, others) <- readMVar mBps
                         return current

nextChange :: (BpsChange, [BpsChange]) -> Double -> (BpsChange, [BpsChange])
nextChange changeset@(_, []) _ = changeset
nextChange changeset@(change, change':changes) beat
    = if and [beat > 0, beat < changeBeat change']
      then changeset
      else nextChange (change', changes) beat

bpsListen :: String -> String -> String -> MVar (BpsChange, [BpsChange]) -> IO ()
bpsListen username clientIp serverIp mBps = 
    do localServer <- udpServer clientIp 0
       localPort <- udpPort localServer
       -- hack to get the integer port number out
       let localPortI = fromIntegral $ read $ show localPort
       register username clientIp serverIp localPortI
       start <- readChange localServer
       putMVar mBps (start, [])
       bpsListenLoop mBps localServer

bpsListenLoop mBps localServer = 
    do change <- readChange localServer
       addChange mBps change
       bpsListenLoop mBps localServer

addChange :: MVar (BpsChange, [BpsChange]) -> BpsChange -> IO ()
addChange mBps newBps | changeBps newBps <= 0 = return ()
                      | otherwise = modifyMVar_ mBps ( \(x, xs) -> return (x, insert newBps xs) )

register :: String -> String -> String -> Int -> IO (UDP)
register username clientIp serverIp localPort = 
    do sc <- openUDP serverIp scport
       let m = message "/clock/register" [string username,
                                          string clientIp,
                                          int32 localPort,
                                          int32 1
                                         ]
       sendOSC sc m
       return sc

toFloat (Float f) = f
toFloat (Int32 f) = fromIntegral f

readChange :: UDP -> IO (BpsChange)
readChange localServer =
    do bundle <- recvBundle localServer
       let (Bundle t message) = bundle
       let (Message _ (absBeat:bps:_)) = Data.List.head message
           absBeatF = fromJust $ d_get absBeat
           bpsF = fromJust $ d_get bps
       return BpsChange {changeBps = bpsF,
                         changeTime = t, 
                         changeBeat = absBeatF
                        }