{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
module Terminal.Game.Layer.Object.Interface where
import Terminal.Game.Plane
import qualified Control.Concurrent as CC
import qualified Control.Monad.Catch as MC
import qualified Data.Serialize as S
import qualified GHC.Generics as G
import qualified Test.QuickCheck as Q
type MonadGameIO m = (MonadInput m, MonadTimer m,
MonadException m, MonadLogic m,
MonadDisplay m)
type FPS = Integer
data Event = Tick
| KeyPress Char
deriving (Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show, Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, (forall x. Event -> Rep Event x)
-> (forall x. Rep Event x -> Event) -> Generic Event
forall x. Rep Event x -> Event
forall x. Event -> Rep Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Event x -> Event
$cfrom :: forall x. Event -> Rep Event x
G.Generic)
instance S.Serialize Event where
instance Q.Arbitrary Event where
arbitrary :: Gen Event
arbitrary = [Gen Event] -> Gen Event
forall a. [Gen a] -> Gen a
Q.oneof [ Event -> Gen Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure Event
Tick,
Char -> Event
KeyPress (Char -> Event) -> Gen Char -> Gen Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char
forall a. Arbitrary a => Gen a
Q.arbitrary ]
data InputHandle = InputHandle
{ InputHandle -> MVar [Event]
ihKeyMVar :: CC.MVar [Event],
InputHandle -> [ThreadId]
ihOpenThreds :: [CC.ThreadId] }
class Monad m => MonadInput m where
startEvents :: FPS -> m InputHandle
pollEvents :: CC.MVar [Event] -> m [Event]
stopEvents :: [CC.ThreadId] -> m ()
class Monad m => MonadTimer m where
getTime :: m Integer
sleepABit :: FPS -> m ()
class Monad m => MonadException m where
cleanUpErr :: m a -> m b -> m a
throwExc :: ATGException -> m a
data ATGException =
CannotGetDisplaySize
| DisplayTooSmall Coords Coords
instance Show ATGException where
show :: ATGException -> String
show ATGException
CannotGetDisplaySize = String
"Cannot get display size!"
show (DisplayTooSmall (Int
gw, Int
gh) (Int
sw, Int
sh)) =
String
"This games requires a screen of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
gw 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
gh 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]
++ 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\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"Please resize your terminal and relaunch " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"the game!\n"
instance MC.Exception ATGException
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 (Width, Height))
blitPlane :: Width -> Height -> Maybe Plane -> Plane -> m ()
shutdownDisplay :: m ()
displaySizeErr :: (MonadDisplay m, MonadException m) => m (Width, Height)
displaySizeErr :: m (Int, Int)
displaySizeErr = m (Maybe (Int, Int))
forall (m :: * -> *). MonadDisplay m => m (Maybe (Int, Int))
displaySize m (Maybe (Int, Int))
-> (Maybe (Int, Int) -> m (Int, Int)) -> m (Int, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe (Int, Int)
Nothing -> ATGException -> m (Int, Int)
forall (m :: * -> *) a. MonadException m => ATGException -> m a
throwExc ATGException
CannotGetDisplaySize
Just (Int, Int)
d -> (Int, Int) -> m (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int, Int)
d