{-# 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
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
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. 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 Z.Serialize Event where
instance Q.Arbitrary Event where
arbitrary :: Gen Event
arbitrary = forall a. [Gen a] -> Gen a
Q.oneof [ forall (f :: * -> *) a. Applicative f => a -> f a
pure Event
Tick,
Char -> Event
KeyPress forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GEnv] -> ShowS
$cshowList :: [GEnv] -> ShowS
show :: GEnv -> String
$cshow :: GEnv -> String
showsPrec :: Int -> GEnv -> ShowS
$cshowsPrec :: Int -> GEnv -> ShowS
Show, GEnv -> GEnv -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GEnv -> GEnv -> Bool
$c/= :: GEnv -> GEnv -> Bool
== :: GEnv -> GEnv -> Bool
$c== :: 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GRec] -> ShowS
$cshowList :: [GRec] -> ShowS
show :: GRec -> String
$cshow :: GRec -> String
showsPrec :: Int -> GRec -> ShowS
$cshowsPrec :: Int -> GRec -> ShowS
Show, GRec -> GRec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GRec -> GRec -> Bool
$c/= :: GRec -> GRec -> Bool
== :: GRec -> GRec -> Bool
$c== :: GRec -> GRec -> Bool
Eq, 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
$cto :: forall x. Rep GRec x -> GRec
$cfrom :: forall x. GRec -> Rep GRec x
G.Generic)
instance Z.Serialize GRec where
igrec :: GRec
igrec :: GRec
igrec = Seq [Event] -> Seq (Maybe Dimensions) -> GRec
GRec forall a. Seq a
S.Empty 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 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
_ = 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 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
_ = forall a. HasCallStack => String -> a
error String
"getEvents: 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 = forall a. Serialize a => ByteString -> Either String a
Z.decode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
fp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left String
e -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
MC.throwM (String -> ATGException
MalformedGRec String
e)
Right GRec
r -> 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Event]
es forall a. Num a => a -> a -> a
* Int
2 in
Seq [Event] -> Seq (Maybe Dimensions) -> GRec
GRec (forall a. [a] -> Seq a
S.fromList [[Event]
es])
(forall a. [a] -> Seq a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> [a]
replicate Int
l forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Dimensions
ds)
data ATGException = CannotGetDisplaySize
| DisplayTooSmall Dimensions Dimensions
| MalformedGRec String
deriving (ATGException -> ATGException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ATGException -> ATGException -> Bool
$c/= :: ATGException -> ATGException -> Bool
== :: ATGException -> ATGException -> Bool
$c== :: 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 forall a. Ord a => a -> a -> Bool
< Int
sw
rowS :: Int -> Bool
rowS Int
wh = Int
wh forall a. Ord a => a -> a -> Bool
< Int
sh
smallMsg :: Dimensions -> String
smallMsg :: Dimensions -> String
smallMsg (Int
ww, Int
wh) =
let cm :: String
cm = forall a. Show a => a -> String
show Int
ww forall a. [a] -> [a] -> [a]
++ String
" columns"
rm :: String
rm = forall a. Show a => a -> String
show Int
wh 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 forall a. [a] -> [a] -> [a]
++ String
" and " 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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
sw forall a. [a] -> [a] -> [a]
++
String
" columns and " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
sh forall a. [a] -> [a] -> [a]
++ String
" rows.\n" forall a. [a] -> [a] -> [a]
++
String
"Yours only has " forall a. [a] -> [a] -> [a]
++ String
em forall a. [a] -> [a] -> [a]
++ String
"!\n\n" forall a. [a] -> [a] -> [a]
++
String
"Please resize your terminal and restart the game.\n"
in String
"DisplayTooSmall.\n" forall a. [a] -> [a] -> [a]
++ Dimensions -> String
smallMsg Dimensions
tds
show (MalformedGRec String
e) = String
"MalformedGRec: " forall a. [a] -> [a] -> [a]
++ String
e
instance MC.Exception ATGException where