HRemote

From Soldat Community Wiki
Revision as of 13:36, 15 August 2012 by Freeman (talk | contribs) (Created page with "<source lang="haskell"> import Network import System.IO import Data.Char import Data.List import Control.Concurrent (threadDelay) -- config serverIP = "localhost" serverPort ...")
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to: navigation, search
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