module Network.Yogurt.Engine (connect, Environment, Output, 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)
type Environment = (Output, MVar MudState)
type Output = Destination -> String -> IO ()
connect :: String -> Int -> Mud () -> IO ()
connect host port mud = do
putStrLn $ "Connecting to " ++ host ++ " port " ++ show port ++ "..."
h <- connectTo host (PortNumber (fromIntegral port))
vState <- newMVar (execState mud emptyMud)
let out ch msg = case ch of
Local -> writeToTTY msg
Remote -> do hPutStr h msg; hFlush h
let env = (out, vState)
forkIO (handleSource env localInput Remote)
handleSource env (remoteInput h) Local
handleSource :: Environment ->
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 50)
return input
runMud :: Environment -> Mud a -> IO a
runMud env@(_, vState) prog = do
s1 <- takeMVar vState
let (rv, s2) = runState prog s1
let (rs, s3) = runState flushResults s2
putMVar vState s3
executeResults env rs
return rv
executeResults :: Environment -> [Result] -> IO ()
executeResults env = sequence_ . map (executeResult env)
executeResult :: Environment -> Result -> IO ()
executeResult env@(out, _) res = case res of
Send ch msg -> do
out ch msg
RunIO io actf -> do
x <- io
runMud env (actf x)
NewTimer timer -> do
forkIO (runTimer env timer)
return ()
runTimer :: Environment -> Timer -> IO ()
runTimer env timer = loop where
loop = do
threadDelay (1000 * tInterval timer)
ok <- runMud env (existsTimer timer)
when ok (runMud env $ tAction timer)
again <- runMud env (existsTimer timer)
when again loop
debug :: String -> IO ()
debug = appendFile "debug.log" . (++ "\n")