{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
module Terminal.Game.Layer.Object.Primitive where
import Terminal.Game.Plane
import qualified Control.Monad.Catch as MC
import qualified GHC.Generics as G
import qualified Data.ByteString as BS
import qualified Data.Serialize as Z
import qualified Data.Sequence as S
import qualified Test.QuickCheck as Q
type TPS = Integer
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
$cshowsPrec :: Int -> Event -> ShowS
showsPrec :: Int -> Event -> ShowS
$cshow :: Event -> String
show :: Event -> String
$cshowList :: [Event] -> ShowS
showList :: [Event] -> ShowS
Show, Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
/= :: 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
$cfrom :: forall x. Event -> Rep Event x
from :: forall x. Event -> Rep Event x
$cto :: forall x. Rep Event x -> Event
to :: forall x. Rep Event x -> Event
G.Generic)
instance Z.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 a. a -> Gen a
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 GEnv = GEnv { GEnv -> Dimensions
eTermDims :: Dimensions,
GEnv -> FPS
eFPS :: FPS
}
deriving (Int -> GEnv -> ShowS
[GEnv] -> ShowS
GEnv -> String
(Int -> GEnv -> ShowS)
-> (GEnv -> String) -> ([GEnv] -> ShowS) -> Show GEnv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GEnv -> ShowS
showsPrec :: Int -> GEnv -> ShowS
$cshow :: GEnv -> String
show :: GEnv -> String
$cshowList :: [GEnv] -> ShowS
showList :: [GEnv] -> ShowS
Show, GEnv -> GEnv -> Bool
(GEnv -> GEnv -> Bool) -> (GEnv -> GEnv -> Bool) -> Eq GEnv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GEnv -> GEnv -> Bool
== :: GEnv -> GEnv -> Bool
$c/= :: GEnv -> GEnv -> Bool
/= :: GEnv -> GEnv -> Bool
Eq)
data GRec = GRec { GRec -> Seq [Event]
aPolled :: S.Seq [Event],
GRec -> Seq (Maybe Dimensions)
aTermSize :: S.Seq (Maybe Dimensions) }
deriving (Int -> GRec -> ShowS
[GRec] -> ShowS
GRec -> String
(Int -> GRec -> ShowS)
-> (GRec -> String) -> ([GRec] -> ShowS) -> Show GRec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GRec -> ShowS
showsPrec :: Int -> GRec -> ShowS
$cshow :: GRec -> String
show :: GRec -> String
$cshowList :: [GRec] -> ShowS
showList :: [GRec] -> ShowS
Show, GRec -> GRec -> Bool
(GRec -> GRec -> Bool) -> (GRec -> GRec -> Bool) -> Eq GRec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GRec -> GRec -> Bool
== :: GRec -> GRec -> Bool
$c/= :: GRec -> GRec -> Bool
/= :: GRec -> GRec -> Bool
Eq, (forall x. GRec -> Rep GRec x)
-> (forall x. Rep GRec x -> GRec) -> Generic GRec
forall x. Rep GRec x -> GRec
forall x. GRec -> Rep GRec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GRec -> Rep GRec x
from :: forall x. GRec -> Rep GRec x
$cto :: forall x. Rep GRec x -> GRec
to :: forall x. Rep GRec x -> GRec
G.Generic)
instance Z.Serialize GRec where
igrec :: GRec
igrec :: GRec
igrec = Seq [Event] -> Seq (Maybe Dimensions) -> GRec
GRec Seq [Event]
forall a. Seq a
S.Empty Seq (Maybe Dimensions)
forall a. Seq a
S.Empty
addDims :: Maybe Dimensions -> GRec -> GRec
addDims :: Maybe Dimensions -> GRec -> GRec
addDims Maybe Dimensions
mds (GRec Seq [Event]
p Seq (Maybe Dimensions)
s) = Seq [Event] -> Seq (Maybe Dimensions) -> GRec
GRec Seq [Event]
p (Maybe Dimensions
mds Maybe Dimensions
-> Seq (Maybe Dimensions) -> Seq (Maybe Dimensions)
forall a. a -> Seq a -> Seq a
S.<| Seq (Maybe Dimensions)
s)
getDims :: GRec -> (Maybe Dimensions, GRec)
getDims :: GRec -> (Maybe Dimensions, GRec)
getDims (GRec Seq [Event]
p (Seq (Maybe Dimensions)
ds S.:|> Maybe Dimensions
d)) = (Maybe Dimensions
d, Seq [Event] -> Seq (Maybe Dimensions) -> GRec
GRec Seq [Event]
p Seq (Maybe Dimensions)
ds)
getDims GRec
_ = String -> (Maybe Dimensions, GRec)
forall a. HasCallStack => String -> a
error String
"getDims: empty Seq"
addPolled :: [Event] -> GRec -> GRec
addPolled :: [Event] -> GRec -> GRec
addPolled [Event]
es (GRec Seq [Event]
p Seq (Maybe Dimensions)
s) = Seq [Event] -> Seq (Maybe Dimensions) -> GRec
GRec ([Event]
es [Event] -> Seq [Event] -> Seq [Event]
forall a. a -> Seq a -> Seq a
S.<| Seq [Event]
p) Seq (Maybe Dimensions)
s
getPolled :: GRec -> ([Event], GRec)
getPolled :: GRec -> ([Event], GRec)
getPolled (GRec (Seq [Event]
ps S.:|> [Event]
p) Seq (Maybe Dimensions)
d) = ([Event]
p, Seq [Event] -> Seq (Maybe Dimensions) -> GRec
GRec Seq [Event]
ps Seq (Maybe Dimensions)
d)
getPolled GRec
_ = String -> ([Event], GRec)
forall a. HasCallStack => String -> a
error String
"getPolled: empty Seq"
isOver :: GRec -> Bool
isOver :: GRec -> Bool
isOver (GRec Seq [Event]
S.Empty Seq (Maybe Dimensions)
_) = Bool
True
isOver GRec
_ = Bool
False
readRecord :: FilePath -> IO GRec
readRecord :: String -> IO GRec
readRecord String
fp = ByteString -> Either String GRec
forall a. Serialize a => ByteString -> Either String a
Z.decode (ByteString -> Either String GRec)
-> IO ByteString -> IO (Either String GRec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
fp IO (Either String GRec)
-> (Either String GRec -> IO GRec) -> IO GRec
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left String
e -> ATGException -> IO GRec
forall e a. (HasCallStack, Exception e) => e -> IO a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
MC.throwM (String -> ATGException
MalformedGRec String
e)
Right GRec
r -> GRec -> IO GRec
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GRec
r
createGRec :: Dimensions -> [Event] -> GRec
createGRec :: Dimensions -> [Event] -> GRec
createGRec Dimensions
ds [Event]
es = let l :: Int
l = [Event] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Event]
es Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 in
Seq [Event] -> Seq (Maybe Dimensions) -> GRec
GRec ([[Event]] -> Seq [Event]
forall a. [a] -> Seq a
S.fromList [[Event]
es])
([Maybe Dimensions] -> Seq (Maybe Dimensions)
forall a. [a] -> Seq a
S.fromList ([Maybe Dimensions] -> Seq (Maybe Dimensions))
-> (Maybe Dimensions -> [Maybe Dimensions])
-> Maybe Dimensions
-> Seq (Maybe Dimensions)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Dimensions -> [Maybe Dimensions]
forall a. Int -> a -> [a]
replicate Int
l (Maybe Dimensions -> Seq (Maybe Dimensions))
-> Maybe Dimensions -> Seq (Maybe Dimensions)
forall a b. (a -> b) -> a -> b
$ Dimensions -> Maybe Dimensions
forall a. a -> Maybe a
Just Dimensions
ds)
data ATGException = CannotGetDisplaySize
| DisplayTooSmall Dimensions Dimensions
| MalformedGRec String
deriving (ATGException -> ATGException -> Bool
(ATGException -> ATGException -> Bool)
-> (ATGException -> ATGException -> Bool) -> Eq ATGException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ATGException -> ATGException -> Bool
== :: ATGException -> ATGException -> Bool
$c/= :: ATGException -> ATGException -> Bool
/= :: ATGException -> ATGException -> Bool
Eq)
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
show (MalformedGRec String
e) = String
"MalformedGRec: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e
instance MC.Exception ATGException where