module Game.Antisplice.Terminal.Repl where
import Text.Chatty.Printer
import Text.Chatty.Scanner
import Text.Chatty.Interactor
import Text.Chatty.Expansion
import Text.Chatty.Expansion.Vars
import Text.Chatty.Expansion.History
import Text.Chatty.Extended.Printer
import Text.Chatty.Channel.Broadcast
import System.Chatty.Misc
import Game.Antisplice.Monad.Dungeon
import Game.Antisplice.Monad.Vocab
import Game.Antisplice.Monad
import Game.Antisplice.Errors
import Game.Antisplice.Lang
import Game.Antisplice.Utils.Fail
import Game.Antisplice.Utils.Counter
import Game.Antisplice.Utils.AVL
import Game.Antisplice.Utils.BST
import Game.Antisplice.Utils.Atoms
import Control.Monad
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Monad.Error.Class
import Control.Monad.IO.Class
import Data.Time.Clock
import System.Console.Haskeline
import System.Console.Haskeline.History
repl :: (ExtendedPrinter m,MonadScanner m,MonadError SplErr m,MonadIO m,MonadExpand m,ExpanderEnv m,MonadDungeon m,MonadAtoms m,MonadRoom m,MonadClock m,MonadVocab m,HistoryEnv m,MonadRandom m,Broadcaster PlayerId m) => m ()
repl = do
mv <- liftIO (newEmptyMVar :: IO (MVar (Maybe String)))
cont <- liftIO (newEmptyMVar :: IO (MVar String))
thr <- liftIO $ forkOS $ runInputT defaultSettings{autoAddHistory=True} $ forever $ do
liftIO . putMVar mv =<< getInputLine =<< liftIO (takeMVar cont)
liftIO . putMVar cont =<< expand =<< expand "$prompt"
forever $ do
e <- runFailT $ forever $ do
ds <- getDungeonState
now <- mgetstamp
let ts = takeWhile ((<now).fst) $ avlInorder $ timeTriggersOf ds
putDungeonState ds{timeTriggersOf=foldr avlRemove (timeTriggersOf ds) $ map fst ts}
forM_ ts (runHandler . snd)
r <- liftIO $ tryTakeMVar mv
case r of
Just (Just l) -> do
l' <- expand l
mputh l'
e <- runFailT (act l')
case e of
Right _ -> return ()
Left VerbMustFirstError -> mprintLn "Please start with a verb."
Left UnintellegibleError -> mprintLn "I don't understand that."
Left CantWalkThereError -> mprintLn "I can't walk there."
Left WhichOneError -> mprintLn "Which one do you mean?"
Left CantSeeOneError -> mprintLn "I can't see one here."
Left DontCarryOneError -> mprintLn "You don't carry one."
Left CantEquipThatError -> mprintLn "I can't equip that."
Left CantEquipThatThereError -> mprintLn "I can't wear that there. You might want to try some other place?"
Left WhereToEquipError -> mprintLn "Where?"
Left CantCastThatNowError -> mprintLn "Sorry, I can't cast that now. Check your health, mana and cooldowns."
Left WontHitThatError -> mprintLn "I won't hit that."
Left CantAcquireThatError -> mprintLn "I can't take that."
Left e -> throwError e
throwError DoneError
Just Nothing -> liftIO (killThread thr) >> mprintLn "quit" >> throwError QuitError
Nothing -> liftIO $ threadDelay 100
case e of
Left DoneError -> do
pr <- expand =<< expand "$prompt"
liftIO $ putMVar cont pr
Left e -> throwError e