TORCS (empty) → 0.1.0

raw patch · 12 files changed

+566/−0 lines, 12 filesdep +MonadRandomdep +TORCSdep +Yampasetup-changed

Dependencies added: MonadRandom, TORCS, Yampa, base, bytestring, containers, directory, lens, monad-loops, monad-parallel, network, process, random, random-shuffle, time

Files

• ChangeLog.md +5/−0
• Examples/Simple.hs +46/−0
• LICENSE +30/−0
• README +40/−0
• Setup.hs +2/−0
• TORCS.cabal +73/−0
• TORCS.hs +8/−0
• TORCS/Connect.hs +43/−0
• TORCS/Connect/Runner.hs +110/−0
• TORCS/Connect/Util.hs +25/−0
• TORCS/Parser.hs +80/−0
• TORCS/Types.hs +104/−0

@@ -0,0 +1,5 @@+# Revision history for Haskell-Racer++## 0.1.0.0  -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

@@ -0,0 +1,46 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE RecordWildCards #-}+module Main where++import FRP.Yampa++import TORCS++import Debug.Trace++main :: IO ()+main = (startDriver $ myDriver 100) >>= print ++myDriver :: Double -> Driver+myDriver targetSpeed = proc CarState{..} -> do+    g <- arr shifting -< (rpm,gear')+    s <- arr steering -< (angle,trackPos)+    a <- arr (gas targetSpeed) -< (speedX,s)+    m <- arr endRace -< (lapTimes,curLapTime)+    returnA -< defaultDriveState {accel = a, gear = g, steer = s, meta = m}++shifting :: (Double,Int) -> Int+shifting (rpm,g) = if +  | rpm > 7000 -> min 6 (g+1)+  | rpm < 3000 -> max 1 (g-1)+  | otherwise  -> g++steering :: (Double,Double) -> Double+steering (spd,trackPos) = let+  turns = spd*14 / pi+  centering = turns - (trackPos*0.1)+  clip x = max (-1) $ min x 1+ in+  clip centering+  +gas :: Double -> (Double,Double) -> Double+gas targetSpeed (speed,steer) = +  if speed < (targetSpeed-(steer*50)) then 0.5 else 0++-- | Run 3 laps then stop the simulation+endRace :: ([Double],Double) -> Int+endRace (lapTs,ct) = +    if (length lapTs >= 2) || ct > timeout then 1 else 0+  where+    timeout = 200

@@ -0,0 +1,30 @@+Copyright (c) 2017, Mark Santolucito++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Mark Santolucito nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,40 @@+# Haskell Binding to TORCS++requires ++- torcs 1.3.4 (http://prdownloads.sourceforge.net/torcs/torcs-1.3.4.tar.bz2?download)+- scr-server 2.1 (https://sourceforge.net/projects/cig/files/SCR%20Championship/Server%20Linux/)++scr-server will only work with 1.3.4, until that is updated you must use exactly torcs 1.3.4++Complete install instructions here https://arxiv.org/abs/1304.1672++on Ubunutu 16.04, you may need to comment out line 70 in src/modules/simu/simuv2/simu.cpp ++## Usage++To install, go to the top level directory, and run 'cabal install'.+You only need to do 'cabal install' the first time, or whenever you change the cabal file.+Later on, just 'cabal repl' is fine.++See the examples folder for how to program a controller.++You can load up the examples and run them with 'cabal repl' on the top directory. +This will load TORCS.hs, which loads a few examples that can be connected to TORCS.+As an example, first open TORCS to a quick race and set the player to src_server1. +Then on the command line run:++    $> cabal repl+    ghci> :l Examples/Simple.hs+    ghci> main+++### Using machine learning with TORCS++Race Mode : Practice+Configure Race -> Last page of options, switch 'display' from 'normal' to 'results only'++### TODO++- write controller for basic platoon+- build and ship to hackage

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,73 @@+-- Initial Haskell-Racer.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                TORCS+version:             0.1.0+synopsis:            Bindings to the TORCS vehicle simulator.+description:         +  A library for building autonomous vehicles that run in the TORCS simulator. This requires the following external dependencies:+  .+    1. torcs 1.3.4 (<http://prdownloads.sourceforge.net/torcs/torcs-1.3.4.tar.bz2?download>)+    2. scr-server 2.1 (<https://sourceforge.net/projects/cig/files/SCR%20Championship/Server%20Linux/>)+  .+  Not that scr-server will only work with 1.3.4, until that is updated you must use exactly torcs 1.3.4.+  Complete install instructions here <https://arxiv.org/abs/1304.1672>+  .+  On Ubunutu 16.04, you may need to comment out line 70 in @src\/modules\/simu\/simuv2\/simu.cpp@ in order for TORCS to compile.+  .+  A guide script for install is available at <https://github.com/santolucito/Haskell-TORCS/blob/master/installTORCS.sh>++license:             GPL+license-file:        LICENSE+author:              Mark Santolucito+maintainer:          mark.santolucito@yale.edu+-- copyright:           +category:            Simulation, FRP, Bindings+build-type:          Simple+extra-source-files:  ChangeLog.md, README+cabal-version:       >=1.10++source-repository head+  type:     git+  location: git://github.com/santolucito/Haskell-TORCS.git++library+  exposed-modules:     +     TORCS+   , TORCS.Types+   , TORCS.Connect+   , TORCS.Connect.Runner+  other-modules:  +     TORCS.Connect.Util     +   , TORCS.Parser+  other-extensions:    Arrows, OverloadedStrings+  build-depends:       base >=4.9 && <4.11, +                       time >=1.6 && <1.7,+                       bytestring >=0.10 && <0.11, +                       network >=2.6 && <2.7, +                       Yampa >=0.10 && <0.11,+                       containers >= 0.5.7.1,+                       monad-parallel >= 0.7.2.2,+                       process >=1.4,+                       lens,+                       random,+                       random-shuffle,+                       monad-loops,+                       MonadRandom,+                       directory+  default-language:    Haskell2010+  ghc-options: +      -fno-warn-partial-type-signatures+   --   -Wall +   -- -O2 +   -- "-with-rtsopts= -s -h -i0.1"++executable Simple+  main-is:             Simple.hs+  build-depends:       base+                     , TORCS+                     , Yampa >=0.10 && <0.11+                     , bytestring >=0.10 && <0.11+  hs-source-dirs:      Examples+  default-language:    Haskell2010+

@@ -0,0 +1,8 @@+module TORCS (+  module TORCS.Types,+  module TORCS.Connect) where+++import TORCS.Types+import TORCS.Connect+

@@ -0,0 +1,43 @@+module TORCS.Connect (startDriver_,startDriver,startGUIDriver,startDrivers) where++import qualified Data.Map as M+import Data.Tuple+import qualified Control.Monad.Parallel as P+import Control.Concurrent.MVar++import TORCS.Types+import TORCS.Parser+import TORCS.Connect.Runner (startDriverWithPort)++-- | This is the will boot TORCS and run the simulation saved in the practice config.+--   this is probably saved in @~\/.torcs\/config\/raceman\/practice.xml@, but should be changed via the TORCS GUI.+--   If the config file is elsewhere, you will need to change this library and recompile Haskell-TORCS from source+startDriver :: Driver -> IO(CarState, DriveState)+-- if starting a single driver, we dont need any communication channels (mvar)+startDriver d    = startDriverWithPort False M.empty d 0 "3001" ++-- | start a single driver as in startDriver, but dont get the final state of the car at the end.+startDriver_ :: Driver -> IO()+startDriver_ d   = startDriver d >> return ()++-- | Use this if you want to watch the car drive in TORCS.+--   Requires booting up TORCS manually and starting a track to the screen where TORCS says:+--   @...Initializing Driver scr_server1...@+startGUIDriver d = startDriverWithPort True M.empty d 0 "3001" ++-- | This allows you to run simulate multiple vehicles on the same track.+--   This will automatically connect the broadcast in DriveState to the communications in CarState for all other cars.+--   Platooning simulation will implement controllers that utilize this comm channel between all vehicles.+--   Each car's channel is addressable with their cooresponding TORCS port (starting at 3001)+startDrivers  :: [Driver] -> IO()+startDrivers ds = do+-- TODO must seperate startTORCS IO from startDriverWtihPort to have everyone race in same torcs instance+  mvars' <- mapM (\x->newEmptyMVar) ds :: IO [MVar String]+  let +    mvars = M.fromList $ map swap $ zip mvars' [3001..] :: M.Map Int (MVar String)+    ps = map show [3001..]+    ts = map (*1000000) [0,1..]+    cs = zip (zip ds ts) ps+  P.mapM_ ((uncurry. uncurry) (startDriverWithPort False mvars)) cs +  return ()+

@@ -0,0 +1,110 @@+{-# 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++-- | The low level interface for connecting to TORCS. Usually, you should prefer to use "TORCS.Connect".+startDriverWithPort :: +     Bool -- ^ Should we start the GUI for you+  -> M.Map Int (MVar String) -- ^ Shared gloabl communications channel+  -> Driver -- ^ the controller to start+  -> Int  -- ^ the delay to allow TORCS to load before sending connection messages +  -> ServiceName -- ^ the port, should be in [3001..]+  -> IO (CarState,DriveState)+startDriverWithPort gui mvars myDriver delay port = withSocketsDo $ bracket connectMe close (yampaRunner myDriver mvars port)+  where+    connectMe = do+      homeDir <- getHomeDirectory+      -- NB TORCS requires full path to config file+      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+++--the id (port number) is used to choose this car's writing mvar+yampaRunner :: Driver -> M.Map Int (MVar String) -> ServiceName -> Socket -> IO (CarState, DriveState)+yampaRunner myDriver allChannels id conn = do+  --let trySend = timeout 10000 $ try (attemptSend) :: IO (Maybe (Either (SomeException) Int))+  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+  --TODO clean this syntax+  d <- readIORef driveRef+  c <- readIORef carRef+  return (c,d)++-- | action will do two things separately+--   first, send the drive instructions+--   second, broadcast the message to the other threads+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+  --since our monitor needs updated DriveState in sense, we update the ref everytime now+  writeIORef outRef msg+  --if we just sent a restart signal, end the reactimation (return True)+  --otherwise, continue (return False)+  if (meta msg == 1)+  then return True +  else return False+  +-- | sensing will try to read from all the mvars, and add this info to CarState+--   this only writes to the lapTimes part of CarState (not native to TORCS)+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 "")) --if nothing to sense from, get default value+  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)}+  --TODO this should not need to write everytime - find a way to detect when we are restarting and only save the carState then +  writeIORef carRef carState+  return (dt, Just $ carState) --TODO do i need the Event wrapper?

@@ -0,0 +1,25 @@+{-# LANGUAGE MultiWayIf #-}+module TORCS.Connect.Util where++import Data.IORef+import FRP.Yampa (DTime)+import Data.Time.Clock+import Control.Concurrent++-- | A small wrapper to keep track of how long each lap took+countLaps :: ([Double],Double) -> [Double]+countLaps (lapTs,lastT) = if +  | lastT == 0 -> []+  | lastT>0 && (length lapTs == 0 || lastT /= head lapTs) -> lastT : lapTs+  | otherwise -> lapTs++timediff ::  IORef UTCTime -> UTCTime -> IO DTime+timediff ref cur = do+  old <- readIORef ref+  writeIORef ref cur+  return $ realToFrac $ diffUTCTime cur old++mySwapMVar :: MVar a -> a -> IO Bool+mySwapMVar m v = do+  tryTakeMVar m+  tryPutMVar m v

@@ -0,0 +1,80 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+module TORCS.Parser where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B+import qualified Data.Map as M+import Data.Maybe ++import TORCS.Types++import Debug.Trace+-- | the parser reads a s-expressions to a CarState+--   and writes a DriveState to a s-expression+--   TORCS sends all data as doubles, or lists of doubles, none nested++-- when packing DriveState to send to TORCS, do not include broadcast+-- broadcast is for internal MVars only+toByteString :: DriveState -> ByteString+toByteString DriveState{..} = B.pack $+  "(gear " ++(show gear)++")"+++  "(clutch "++(show clutch)++")"+++  "(focus "++(show focus)++")"+++  "(accel "++(show accel)++")"+++  "(meta " ++(show meta)++")"+++  "(brake "++(show brakes)++")"+++  "(steer "++(show steer)++")"++-- Again, do not include communications when decoding from server+-- communications is internal mvars only+fromByteString :: ByteString -> CarState +fromByteString s = let+  fs' = B.splitWith (\c -> c==')' || c=='(') s+  fs = filter (/="") fs' :: [ByteString]+  ps = map (B.span (/=' ')) fs :: [(ByteString,ByteString)]+  fieldMap = M.fromList ps+  getField' s =  B.filter (/=' ') $ M.findWithDefault "" s fieldMap+  getField s = readAsDouble $ getField' s+  getList s = map readAsDouble $ tail $ B.split ' ' $ M.findWithDefault "" s fieldMap+ in+  --NB, restarting is handled by user+  if (s=="***restart***\NUL" || s=="" || s=="***shutdown***\NUL")+  then defaultCarState --TODO, make this Nothing?+  else defaultCarState +     {+      z = getField "z", +      angle = getField "angle", +      speedX = getField "speedX", +      speedY = getField "speedY", +      speedZ = getField "speedZ", +      rpm = getField "rpm", +      distRaced = getField "distRaced", +      lastLapTime = getField "lastLapTime", +      curLapTime = getField "curLapTime", +      gear' = floor $ getField "gear",+      fuel = getField "fuel", +      trackPos = getField "trackPos",+      track = getList "track",+      damage = getField "damage",+      wheelSpinVel = getList "wheelSpinVel",+      focus' = map floor $ getList "focus",+      racePos = floor $ getField "racePos",+      distFromStart = getField "distFromStart",+      opponents = getList "opponents"+     }++-- TODO someone has to have a better way of doing this+readAsDouble :: ByteString -> Double+readAsDouble s = let+  neg = B.head s == '-'+  s' = if neg then B.tail s else s+  (decPart, fracPart) = B.span (/='.') s'+  f = fromIntegral. fromMaybe 0. fmap fst. B.readInt+  frac = if B.length fracPart > 0 +    then (f $ B.tail fracPart) / (fromIntegral $ 10^(B.length $ B.tail fracPart))+    else 0+ in+  (if neg then -1 else 1) * ((f decPart) + frac)+  +

@@ -0,0 +1,104 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DuplicateRecordFields #-}+module TORCS.Types where++import qualified Data.Map as M++import FRP.Yampa++-- | A driver observes the environment and changes the drive state+type Driver = SF CarState DriveState++-- | The DriveState dictates how the controller actuators behave and, by extension, how the car moves around the world.+--   See the TORCS manual for full description (<https://arxiv.org/pdf/1304.1672>)+data DriveState = DriveState {+   gear      :: Int+  ,clutch    :: Double+  ,focus     :: [Int]+  ,accel     :: Double+  -- | (0=continue) or (1=end simulation)+  ,meta      :: Int +  ,brakes    :: Double+  ,steer     :: Double+  -- | non-native to torcs+  ,broadcast :: Message +} deriving (Show)++-- | Broadcast messages are strings, but might be Text in the future+type Message = String+++defaultDriveState = DriveState {+  gear   = 1+ ,clutch = 0+ ,focus  = [-90, -45, 0, 45, 90]+ ,accel  = 1+ ,meta   = 0+ ,brakes = 0+ ,steer  = 0+ ,broadcast = ""}+++-- | CarState is everything the controller can observe in the world.+--   See the TORCS manual for full description (<https://arxiv.org/pdf/1304.1672>)+data CarState = CarState {+   z              :: Double+  ,angle          :: Double+  -- | /NB/: CarState uses prime version of identical DriveState field+  ,gear'          :: Int+  ,trackPos       :: Double+  ,speedY         :: Double+  ,distRaced      :: Double+  ,speedZ         :: Double+  ,damage         :: Double+  -- | length 4+  ,wheelSpinVel   :: [Double] +  -- | /NB/: CarState uses prime version of identical DriveState field+  ,focus'         :: [Int]+  ,track          :: [Double]+  ,curLapTime     :: Double+  ,speedX         :: Double+  ,racePos        :: Int+  ,fuel           :: Double+  ,distFromStart  :: Double+  ,opponents      :: [Double] +  ,rpm            :: Double+  ,lastLapTime    :: Double+  --nonnative to torrcs+  -- | non-native to TORCS+  ,lapTimes       :: [Double]+  -- | non-native to TORCS+  ,communications :: Communications +  -- | non-native to TORCS+  ,monitor        :: String +} deriving (Show)++-- | The global communications channel to read broadcasts from other vehicles.+--   The port for each vehicle is the index into the map (ports start at 3001 in TORCS)+type Communications = M.Map Int (Maybe Message)++defaultCarState = CarState {+   z         = 0+  ,angle     = 0+  ,speedX    = 0+  ,speedY    = 0+  ,speedZ    = 0+  ,rpm       = 0+  ,distRaced = 0+  ,lastLapTime = 0+  ,curLapTime = 0+  ,gear'     = 1+  ,fuel      = 100+  ,trackPos  = 0+  ,track     = replicate 19 0+  ,damage    = 0+  ,wheelSpinVel = [0,0,0,0] -- length 4+  ,focus'    = [0]+  ,racePos   = 1+  ,distFromStart = 0+  ,opponents = [0]+  ,lapTimes  = []+  ,communications = M.empty+  ,monitor = ""+}