{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiWayIf #-}
module TORCS.Connect.Runner (startDriverWithPort) where
import Network.Socket hiding (sendTo,recvFrom)
import Network.Socket.ByteString (sendTo,recvFrom)
import Control.Exception
import Control.Concurrent
import Control.Monad
import Prelude hiding (concat)
import Data.IORef
import qualified Data.Map as M
import Data.Time.Clock
import Data.ByteString (concat)
import Data.ByteString.Char8 (pack)
import System.Process
import System.Directory
import FRP.Yampa
import TORCS.Types
import TORCS.Parser
import TORCS.Connect.Util
import qualified TORCS.Monitor as M
startDriverWithPort ::
Bool
-> M.Map Int (MVar String)
-> Driver
-> Int
-> ServiceName
-> IO (CarState,DriveState)
startDriverWithPort gui mvars myDriver delay port = withSocketsDo $ bracket connectMe close (yampaRunner myDriver mvars port)
where
connectMe = do
homeDir <- getHomeDirectory
unless gui $ createProcess (proc "torcs" ["-r "++homeDir++"/.torcs/config/raceman/practice.xml"]) {std_out = CreatePipe} >> return ()
(serveraddr:_) <- getAddrInfo
(Just (defaultHints {addrFlags = [AI_PASSIVE]}))
Nothing (Just port)
sock <- socket (addrFamily serveraddr) Datagram defaultProtocol
connect sock (addrAddress serveraddr)
threadDelay delay
threadDelay 100000
let mysteryString = concat["SCR",(pack $ show port),"(init -90 -75 -60 -45 -30 -20 -15 -10 -5 0 5 10 15 20 30 45 60 75 90)"]
sendTo sock mysteryString (addrAddress serveraddr)
return sock
yampaRunner :: Driver -> M.Map Int (MVar String) -> ServiceName -> Socket -> IO (CarState, DriveState)
yampaRunner myDriver allChannels id conn = do
t <- getCurrentTime
timeRef <- newIORef t
driveRef <- newIORef defaultDriveState
carRef <- newIORef defaultCarState
let myChannel = read id :: Int
(msg,addr) <- recvFrom conn 1024
print "Starting new driver"
reactimate
(return defaultCarState)
(sense timeRef conn allChannels carRef driveRef M.monitorWrapper)
(action conn addr (M.lookup myChannel allChannels) driveRef)
myDriver
d <- readIORef driveRef
c <- readIORef carRef
return (c,d)
action :: Socket -> SockAddr -> Maybe (MVar String) -> IORef DriveState ->
Bool -> DriveState -> IO Bool
action conn d myBroadcastChan outRef _ msg = do
bytesSent <- sendTo conn (toByteString msg) d
oldVal <- maybe (return Nothing) tryReadMVar myBroadcastChan
_ <- maybe (return False) (\x -> if oldVal == (Just $ broadcast msg) then return False else mySwapMVar x (broadcast msg)) myBroadcastChan
writeIORef outRef msg
if (meta msg == 1)
then return True
else return False
sense :: IORef UTCTime -> Socket -> M.Map Int (MVar String) -> IORef CarState -> IORef DriveState -> ((CarState,DriveState) -> IO String) -> Bool -> IO (DTime, Maybe CarState)
sense timeRef conn chans carRef driveRef monitorAction _ = do
cur <- getCurrentTime
(msg,d) <- catch (recvFrom conn 1024) (\(e :: SomeException) -> return ("",SockAddrUnix ""))
ms <- mapM tryReadMVar chans :: IO (M.Map Int (Maybe String))
dt <- timediff timeRef cur
oldCarState <- readIORef carRef
oldDriveState <- readIORef driveRef
monitorInfo <- monitorAction (oldCarState,oldDriveState)
let rawCarState = (fromByteString msg){communications = ms,monitor=monitorInfo}
let carState = rawCarState{lapTimes = countLaps (lapTimes oldCarState, lastLapTime rawCarState)}
writeIORef carRef carState
return (dt, Just $ carState)