{-# 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

-------------------------------------------------------------------------------
-- 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
              -- ↑↓→← do not work on Windows (are handled by the app,
              -- not passed to the program) both on cmd.exe and
              -- PowerShell.
           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 ]

-- | 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
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)

-------------------------------------------------------------------------------
-- 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
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"
    -- 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 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

-- | Reads a file containing a recorded session. Throws
-- 'MalformedGRec' on failure.
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

-- | 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 = 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)

-------------------------------------------------------------------------------
-- Exceptions

-- | @ATGException@s are thrown synchronously for easier catching.
data ATGException = CannotGetDisplaySize
                  | DisplayTooSmall Dimensions Dimensions
                        -- ^ Required and actual 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