From Soldat Community Wiki
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
import Network
import System.IO
import Data.Char
import Data.List
import Control.Concurrent (threadDelay)
-- config
serverIP = "localhost"
serverPort = 23073
adminPassword = "boob"
onConnect = "/say In-game commands now running"
unpauseInterval = 1000000
-- function definitions
sleep = threadDelay
-- trim gets rid of prefixing and suffixing whitespaces
trim = reverse . dropSpaces . reverse . dropSpaces
dropSpaces = dropWhile isSpace
-- splits a string by a string
split :: String -> String -> [String]
split _ "" = []
split delim string = let (h,t) = chomp delim string in h : split delim t
-- chomp chomp
chomp :: String -> String -> (String,String)
chomp _ [] = ([],[])
chomp delim str@(x:xs) | delim `isPrefixOf` str = ("", drop (length delim) str)
| otherwise = let (h,t) = (chomp delim xs) in (x:h, t)
-- sends a line
send h str = do
hPutStrLn h str
-- logs to stdout whatever we send
putStrLn $ "> " ++ str
-- reads a line
recv = hGetLine
-- forever
forever action = action >> forever action
-- gets the said text (cleans nickname)
getCommand str = safe $ tail' $ split "] !" str
where safe [] = ""; safe [x] = x;
tail' [] = []; tail' l@(x:xs) = tail l
-- main listening function
listen h = forever $ do
buff <- (recv h >>= (\x -> (return . trim) x))
-- give to parse
-- print (getCommand buff)
parse (getCommand buff) h
putStrLn buff
-- parser
parse cmd h | cmd == "pause" = pause h
| cmd == "unpause" = unpause h
| "map" `isPrefixOf` cmd = mapChange h (trim $ snd $ break (==' ') cmd)
| cmd == "restart" = restart h
| otherwise = return ()
-- various commands
pause h = send h "/pause"
unpause h = do
send h "/say 3"
sleep unpauseInterval
send h "/say 2"
sleep unpauseInterval
send h "/say 1"
sleep unpauseInterval
send h "/unpause"
mapChange h mapName = do
send h ("/map "++mapName)
restart h = do
send h "/restart"
-- main entry
main = do
putStrLn "Starting -"
h <- connectTo serverIP (PortNumber (fromIntegral serverPort))
hSetBuffering h NoBuffering
send h adminPassword
send h onConnect
listen h
putStrLn "Exit"
hClose h