{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE LambdaCase #-}
module Terminal.Game.Layer.Object.Interface where
import Terminal.Game.Plane
import Terminal.Game.Layer.Object.Primitive
import qualified Control.Concurrent as CC
import qualified Control.Monad.Catch as MC
type MonadGameIO m = (MonadInput m, MonadTimer m,
MonadException m, MonadLogic m,
MonadDisplay m)
data InputHandle = InputHandle
{ InputHandle -> MVar [Event]
ihKeyMVar :: CC.MVar [Event],
InputHandle -> [ThreadId]
ihOpenThreads :: [CC.ThreadId] }
class Monad m => MonadInput m where
startEvents :: TPS -> m InputHandle
pollEvents :: CC.MVar [Event] -> m [Event]
stopEvents :: [CC.ThreadId] -> m ()
class Monad m => MonadTimer m where
getTime :: m Integer
sleepABit :: TPS -> m ()
class Monad m => MonadException m where
cleanUpErr :: m a -> m b -> m a
throwExc :: ATGException -> m a
class Monad m => MonadLogic m where
checkQuit :: (s -> Bool) -> s -> m Bool
class Monad m => MonadDisplay m where
setupDisplay :: m ()
clearDisplay :: m ()
displaySize :: m (Maybe Dimensions)
blitPlane :: Maybe Plane -> Plane -> m ()
shutdownDisplay :: m ()
displaySizeErr :: (MonadDisplay m, MonadException m) => m Dimensions
displaySizeErr :: m Dimensions
displaySizeErr = m (Maybe Dimensions)
forall (m :: * -> *). MonadDisplay m => m (Maybe Dimensions)
displaySize m (Maybe Dimensions)
-> (Maybe Dimensions -> m Dimensions) -> m Dimensions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Dimensions
Nothing -> ATGException -> m Dimensions
forall (m :: * -> *) a. MonadException m => ATGException -> m a
throwExc ATGException
CannotGetDisplaySize
Just Dimensions
d -> Dimensions -> m Dimensions
forall (m :: * -> *) a. Monad m => a -> m a
return Dimensions
d
data ATGException = CannotGetDisplaySize
| DisplayTooSmall Dimensions Dimensions
instance Show ATGException where
show :: ATGException -> String
show ATGException
CannotGetDisplaySize = String
"CannotGetDisplaySize"
show (DisplayTooSmall (Int
sw, Int
sh) Dimensions
tds) =
let colS :: Int -> Bool
colS Int
ww = Int
ww Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sw
rowS :: Int -> Bool
rowS Int
wh = Int
wh Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sh
smallMsg :: Dimensions -> String
smallMsg :: Dimensions -> String
smallMsg (Int
ww, Int
wh) =
let cm :: String
cm = Int -> String
forall a. Show a => a -> String
show Int
ww String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" columns"
rm :: String
rm = Int -> String
forall a. Show a => a -> String
show Int
wh String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" rows"
em :: String
em | Int -> Bool
colS Int
ww Bool -> Bool -> Bool
&& Int -> Bool
rowS Int
wh = String
cm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rm
| Int -> Bool
colS Int
ww = String
cm
| Int -> Bool
rowS Int
wh = String
rm
| Bool
otherwise = String
"smallMsg: passed correct term size!"
in
String
"This games requires a display of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sw String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" columns and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sh String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" rows.\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"Yours only has " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
em String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"!\n\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"Please resize your terminal and restart the game.\n"
in String
"DisplayTooSmall.\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dimensions -> String
smallMsg Dimensions
tds
instance MC.Exception ATGException where