{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}

module Terminal.Game.Layer.Object.Primitive where

import Terminal.Game.Plane

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

-------------------------------------------------------------------------------
-- Assorted API types

-- | The number of 'Tick's fed each second to the logic function;
-- constant on every machine. /Frames/ per second might be lower
-- (depending on drawing function onerousness, terminal refresh rate,
-- etc.).
type TPS = Integer

-- | The number of frames blit to terminal per second. Frames might be
-- dropped, but game speed will remain constant. Check @balls@
-- (@cabal run -f examples balls@) to see how to display FPS.
-- For obvious reasons (blits would be wasted) @max FPS = TPS@.
type FPS = Integer

-- | An @Event@ is a 'Tick' (time passes) or a 'KeyPress'.
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 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 (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 ]

-- | Game environment with current terminal dimensions and current display
-- rate.
data GEnv = GEnv { GEnv -> Dimensions
eTermDims :: Dimensions,
                        -- ^ Current terminal dimensions.
                   GEnv -> FPS
eFPS :: FPS
                        -- ^ Current blitting rate.
                       }
    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
showList :: [GEnv] -> ShowS
$cshowList :: [GEnv] -> ShowS
show :: GEnv -> String
$cshow :: GEnv -> String
showsPrec :: Int -> GEnv -> ShowS
$cshowsPrec :: Int -> GEnv -> ShowS
Show, GEnv -> GEnv -> Bool
(GEnv -> GEnv -> Bool) -> (GEnv -> GEnv -> Bool) -> Eq GEnv
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)

-------------------------------------------------------------------------------
-- GRec record/replay game typs

-- | Opaque data type with recorded game input, for testing purposes.
data GRec = GRec { GRec -> Seq [Event]
aPolled :: S.Seq [Event],
                                -- Seq. of polled events
                   GRec -> Seq (Maybe Dimensions)
aTermSize :: S.Seq (Maybe Dimensions) }
                                -- Seq. of polled termdims
        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
showList :: [GRec] -> ShowS
$cshowList :: [GRec] -> ShowS
show :: GRec -> String
$cshow :: GRec -> String
showsPrec :: Int -> GRec -> ShowS
$cshowsPrec :: Int -> GRec -> ShowS
Show, GRec -> GRec -> Bool
(GRec -> GRec -> Bool) -> (GRec -> GRec -> Bool) -> Eq GRec
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. 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
$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 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"
    -- Have to use _ or “non exhaustive patterns” warning

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
"getEvents: empty Seq"

isOver :: GRec -> Bool
isOver :: GRec -> Bool
isOver (GRec Seq [Event]
S.Empty Seq (Maybe Dimensions)
_) = Bool
True
isOver GRec
_ = Bool
False

-- | Reads a file containing a recorded session.
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  Left String
e  -> String -> IO GRec
forall a. HasCallStack => String -> a
error (String -> IO GRec) -> String -> IO GRec
forall a b. (a -> b) -> a -> b
$ String
"readRecord could not decode: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                     ShowS
forall a. Show a => a -> String
show String
e
                  Right GRec
r -> GRec -> IO GRec
forall (m :: * -> *) a. Monad m => a -> m a
return GRec
r

-- | Convenience function to create a 'GRec' from screen size (constant) plus a list of events. Useful with 'setupGame'.
createGRec :: Dimensions -> [Event] -> GRec
createGRec :: Dimensions -> [Event] -> GRec
createGRec Dimensions
ds [Event]
es = let l :: Int
l = [Event] -> 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)