{-# 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'. -- -- Note that all @Keypress@es are recorded and fed to your game-logic -- function. This means you will not lose a single character, no matter -- how fast your player is at typing or how low you set 'FPS' to be. -- -- Example: in a game where you are controlling a hot-air baloon and have -- @direction@ and @position@ variables, you most likely want @direction@ -- to change at every @KeyPress@, while having @position@ only change at -- @Tick@s. 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 (Show, Eq, G.Generic) instance Z.Serialize Event where instance Q.Arbitrary Event where arbitrary = Q.oneof [ pure Tick, KeyPress <$> Q.arbitrary ] -- | Game environment with current terminal dimensions and current display -- rate. data GEnv = GEnv { eTermDims :: Dimensions, -- ^ Current terminal dimensions. eFPS :: FPS -- ^ Current blitting rate. } deriving (Show, Eq) ------------------------------------------------------------------------------- -- GRec record/replay game typs -- | Opaque data type with recorded game input, for testing purposes. data GRec = GRec { aPolled :: S.Seq [Event], -- Seq. of polled events aTermSize :: S.Seq (Maybe Dimensions) } -- Seq. of polled termdims deriving (Show, Eq, G.Generic) instance Z.Serialize GRec where igrec :: GRec igrec = GRec S.Empty S.Empty addDims :: Maybe Dimensions -> GRec -> GRec addDims mds (GRec p s) = GRec p (mds S.<| s) getDims :: GRec -> (Maybe Dimensions, GRec) getDims (GRec p (ds S.:|> d)) = (d, GRec p ds) getDims _ = error "getDims: empty Seq" -- Have to use _ or “non exhaustive patterns” warning addPolled :: [Event] -> GRec -> GRec addPolled es (GRec p s) = GRec (es S.<| p) s getPolled :: GRec -> ([Event], GRec) getPolled (GRec (ps S.:|> p) d) = (p, GRec ps d) getPolled _ = error "getPolled: empty Seq" isOver :: GRec -> Bool isOver (GRec S.Empty _) = True isOver _ = False -- | Reads a file containing a recorded session. Throws -- 'MalformedGRec' on failure. readRecord :: FilePath -> IO GRec readRecord fp = Z.decode <$> BS.readFile fp >>= \case Left e -> MC.throwM (MalformedGRec e) Right r -> return r -- | Convenience function to create a 'GRec' from screen size (constant) plus a list of events. Useful with 'setupGame'. createGRec :: Dimensions -> [Event] -> GRec createGRec ds es = let l = length es * 2 in GRec (S.fromList [es]) (S.fromList . replicate l $ Just ds) ------------------------------------------------------------------------------- -- Exceptions -- | @ATGException@s are thrown synchronously for easier catching. data ATGException = CannotGetDisplaySize | DisplayTooSmall Dimensions Dimensions -- ^ Required and actual dimensions. | MalformedGRec String deriving (Eq) instance Show ATGException where show CannotGetDisplaySize = "CannotGetDisplaySize" show (DisplayTooSmall (sw, sh) tds) = let colS ww = ww < sw rowS wh = wh < sh smallMsg :: Dimensions -> String smallMsg (ww, wh) = let cm = show ww ++ " columns" rm = show wh ++ " rows" em | colS ww && rowS wh = cm ++ " and " ++ rm | colS ww = cm | rowS wh = rm | otherwise = "smallMsg: passed correct term size!" in "This games requires a display of " ++ show sw ++ " columns and " ++ show sh ++ " rows.\n" ++ "Yours only has " ++ em ++ "!\n\n" ++ "Please resize your terminal and restart the game.\n" in "DisplayTooSmall.\n" ++ smallMsg tds show (MalformedGRec e) = "MalformedGRec: " ++ e instance MC.Exception ATGException where