module Network.Yogurt.Engine (connect, runMud) where
import Network.Yogurt.Mud
import System.IO
import Network
import Control.Concurrent
import Control.Monad.State
import System.Console.Readline
import Network.Yogurt.IO
import Data.Char (isSpace)
import System.Process
connect :: String -> Int -> Mud () -> IO ()
connect host port mud = mdo
putStrLn $ "Connecting to " ++ host ++ " port " ++ show port ++ "..."
h <- connectTo host (PortNumber (fromIntegral port))
let out ch msg = case ch of
Local -> writeToTTY msg
Remote -> do hPutStr h msg; hFlush h
let state0 = emptyMud (runMud vState) out
state1 <- execStateT mud state0
vState <- newMVar state1
forkIO (handleSource vState localInput Remote)
handleSource vState (remoteInput h) Local
runCommand "stty echo" >>= waitForProcess
return ()
handleSource :: MVar MudState ->
IO (Maybe String) ->
Destination ->
IO ()
handleSource env input dest = loop where
loop = do
mmessage <- input
case mmessage of
Nothing -> return ()
Just message -> do
runMud env (trigger dest message)
loop
localInput :: IO (Maybe String)
localInput = do
maybeLine <- readline ""
setLineBuffer ""
case maybeLine of
Nothing -> return Nothing
Just line -> do
when (not $ all isSpace line) (addHistory line)
return (Just $ line ++ "\n")
remoteInput :: Handle -> IO (Maybe String)
remoteInput h = do
input <- maybeInput (hGetImpatientLine h 10)
return input
runMud :: MVar MudState -> Mud a -> IO a
runMud vState prog = do
s <- takeMVar vState
(rv, s') <- runStateT prog s
putMVar vState s'
return rv