packages feed

ansi-terminal-game 1.8.1.0 → 1.9.0.0

raw patch · 19 files changed

+254/−131 lines, 19 filesbinary-addedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Terminal.Game: [gQuitFunction] :: Game s -> s -> Bool
- Terminal.Game: playGameS :: Game s -> IO s
+ Terminal.Game: playGame_ :: Game s r -> IO ()
- Terminal.Game: Game :: TPS -> s -> (GEnv -> s -> Event -> s) -> (GEnv -> s -> Plane) -> (s -> Bool) -> Game s
+ Terminal.Game: Game :: TPS -> s -> (GEnv -> s -> Event -> Either r s) -> (GEnv -> s -> Plane) -> Game s r
- Terminal.Game: [gDrawFunction] :: Game s -> GEnv -> s -> Plane
+ Terminal.Game: [gDrawFunction] :: Game s r -> GEnv -> s -> Plane
- Terminal.Game: [gInitState] :: Game s -> s
+ Terminal.Game: [gInitState] :: Game s r -> s
- Terminal.Game: [gLogicFunction] :: Game s -> GEnv -> s -> Event -> s
+ Terminal.Game: [gLogicFunction] :: Game s r -> GEnv -> s -> Event -> Either r s
- Terminal.Game: [gTPS] :: Game s -> TPS
+ Terminal.Game: [gTPS] :: Game s r -> TPS
- Terminal.Game: data Game s
+ Terminal.Game: data Game s r
- Terminal.Game: narrateGame :: Game s -> GRec -> IO s
+ Terminal.Game: narrateGame :: Game s r -> GRec -> IO ()
- Terminal.Game: playGame :: Game s -> IO ()
+ Terminal.Game: playGame :: Game s r -> IO r
- Terminal.Game: recordGame :: Game s -> FilePath -> IO ()
+ Terminal.Game: recordGame :: Game s r -> FilePath -> IO ()
- Terminal.Game: setupGame :: Game s -> GRec -> Game s
+ Terminal.Game: setupGame :: Game s r -> GRec -> Game s r
- Terminal.Game: testGame :: Game s -> GRec -> s
+ Terminal.Game: testGame :: Game s r -> GRec -> Either r s

Files

NEWS view
@@ -1,3 +1,66 @@+1.9.0.0+-------++tl;dr and migration guide:+- This version of ansi-terminal-games has a new signature for logic+  function:+      gLogicFunction :: GEnv -> s -> Event -> Either r s+- Notice the `Either r s`: `Left` means “game is over”; `Right`means+  “game continues.+- To migrate a project to 1.9.0.0 you should:+    - Adjust logic function to incorporate those changes.+    - Get rid of your `quitFunction` in your `Game`.+    - Modify every `Game s` to `Game s ()`.++Breaking changes:+- This version changes the logic function from+      gLogicFunction :: GEnv -> s -> Event -> s+  to+      gLogicFunction :: GEnv -> s -> Event -> Either r s+  `Either r s` is a way to explicitly state whether the game is over+  not not. If you return `Left $ …` then the game will stop, if you+  return `Right $ …` your game will continue.+- the `r` stands for `result` and is present in the type constructor+  too:+      Game s r  -- A game with state `s` which will,+                -- upon exit, return a result `r`.+- Usually r is () (as simple games do not care about end results,+  they just quit to terminal). But there are cases (games embedded+  in a larger program, a set of minigames, high scores) where you+  want to return something and this is the way to do it.+- Many other functions have had a slight change of signature to+  accomodate this change+      playGame :: Game s r -> IO r+      narrateGame :: Game s r -> GRec -> IO ()+      testGame :: Game s -> GRec -> Either s r+  I will spend some second on the test function. A game tested in+  a pure environment will end in two ways: a) by reaching Left+  (proper end game) b) by exhausting the input stream.+  In case b) we cannot return a result `r`, but just a half-baked+  ingame state. This is very useful for testing purposes.+  A trick that I do is this: record events with `recordGame` and+  then press Ctrl-C midgame. This way the stream is cut and I will+  get a `Right` state when running `testGame`. I can then analyse+  the resulting state.+- Functions have been deleted too+      playGame :: Game s -> IO s+  is no more+- And new functions were introduced:+    playGame_ :: Game s r -> IO ()      -- discard result+- The change was suggested by Gergő Érdi, whom I thank.+  The rationale was to improve ergonomics for the game-makes, I+  welcome feedback from you.+- Released mar 28 feb 2023, 20:23:02++Other changes:+- Clarified KeyPress and Tick behaviour. tl;dr: *all* keypresses are+  recorded and fed to your game-logic function. If your played manages+  to type the Divine Comedy in the space of a Tick, all those characters+  are recorded, not just one.+  If your game is running faster when keys are pressed, that probably+  means you are updating some world variables on `KeyPress` events too,+  while you should do that only on `Tick` events.+ 1.8.1.0 ------- 
ansi-terminal-game.cabal view
@@ -1,5 +1,5 @@ name:                ansi-terminal-game-version:             1.8.1.0+version:             1.9.0.0 synopsis:            sdl-like functions for terminal applications, based on                      ansi-terminal description:         Library which aims to replicate standard 2d game@@ -15,14 +15,15 @@ license-file:        COPYING author:              Francesco Ariis et al. (see AUTHORS) maintainer:          fa-ml@ariis.it-copyright:           © 2017-2021 Francesco Ariis+copyright:           © 2017-2023 Francesco Ariis et al. category:            Game build-type:          Simple extra-source-files:  README,                      NEWS,                      AUTHORS,-                     test/records/alone-record-test.gr-                     test/records/balls-dims.gr+                     test/records/alone-record-test.gr,+                     test/records/alone-record-left.gr,+                     test/records/balls-dims.gr,                      test/records/balls-slow.gr cabal-version:       >=1.10 
example/Alone.hs view
@@ -8,14 +8,12 @@ import qualified Data.Tuple as T  -- game specification-aloneInARoom :: Game MyState+aloneInARoom :: Game MyState () aloneInARoom = Game 13                       -- ticks per second-                    (MyState (10, 10)-                             Stop False)     -- init state+                    (MyState (10, 10) Stop)  -- init state                     (\_ s e -> logicFun s e) -- logic function                     (\r s -> centerFull r $                                drawFun s)    -- draw function-                    gsQuit                   -- quit function  sizeCheck :: IO () sizeCheck = let (w, h) = T.swap . snd $ boundaries@@ -25,8 +23,7 @@ -- Types  data MyState = MyState { gsCoord :: Coords,-                         gsMove  :: Move,-                         gsQuit  :: Bool }+                         gsMove  :: Move }              deriving (Show, Eq)  data Move = N | S | E | W | Stop@@ -38,10 +35,11 @@ ------------------------------------------------------------------------------- -- Logic -logicFun :: MyState -> Event -> MyState-logicFun gs (KeyPress 'q') = gs { gsQuit = True }-logicFun gs Tick           = gs { gsCoord = pos (gsMove gs) (gsCoord gs) }-logicFun gs (KeyPress c)   = gs { gsMove = move (gsMove gs) c }+logicFun :: MyState -> Event -> Either () MyState+logicFun _ (KeyPress 'q') = Left ()+logicFun gs Tick          = Right $ gs { gsCoord = pos (gsMove gs)+                                                       (gsCoord gs) }+logicFun gs (KeyPress c)  = Right $ gs { gsMove = move (gsMove gs) c }  -- SCI movement move :: Move -> Char -> Move@@ -75,7 +73,7 @@ -- Draw  drawFun :: MyState -> Plane-drawFun (MyState (r, c) _ _) =+drawFun (MyState (r, c) _) =                            blankPlane mw     mh            &                 (1, 1)   % box mw mh '.'                   &                 (2, 2)   % box (mw-2) (mh-2) ' '           &
example/Balls.hs view
@@ -117,33 +117,35 @@ -- Game  data GState = GState { gen :: StdGen,-                       quit :: Bool,                        timer :: Timer,                        balls :: [Ball],                        bslow :: Bool }             -- pSlow is not used in game, it is there just             -- for the test suite -fireworks :: StdGen -> Game GState-fireworks g = Game tps istate lfun dfun qfun+fireworks :: StdGen -> Game GState Int+fireworks g = Game tps istate lfun dfun     where           tps = 60            istate :: GState-          istate = GState g False (ctimer tps) [] False+          istate = GState g (ctimer tps) [] False  ------------------------------------------------------------------------------- -- Logic -lfun :: GEnv -> GState -> Event -> GState+-- The `Int` in `Either Int Gstate` is: number of balls+-- on screen at the end of the game.+lfun :: GEnv -> GState -> Event -> Either Int GState lfun e s (KeyPress 's') =             let g = gen s                 ds = eTermDims e                 (b, g1) = genBall g ds-            in s { gen = g1,-                   balls = b : balls s }-lfun _ s (KeyPress 'q') = s { quit = True }-lfun _ s (KeyPress _)   = s+                s' = s { gen = g1,+                         balls = b : balls s }+            in Right s'+lfun _ s (KeyPress 'q') = Left $ length (balls s)+lfun _ s (KeyPress _)   = Right s lfun r s Tick           =             let ds = eTermDims r @@ -151,12 +153,10 @@                 ps' = M.mapMaybe (modPar ds) ps                  bs = eFPS r < 30-            in s { timer = ltimer (timer s),-                   balls = filter (isIn ds)  ps',-                   bslow = bs }--qfun :: GState -> Bool-qfun s = quit s+                s' = s { timer = ltimer (timer s),+                         balls = filter (isIn ds)  ps',+                         bslow = bs }+            in Right s'  ------------------------------------------------------------------------------- -- Draw
example/MainBalls.hs view
@@ -7,6 +7,16 @@ -- Balls Main module. The meat of the game is in `examples/Balls.hs`  main :: IO ()-main = getStdGen >>= \g ->-       playGame (fireworks g)+main = do+        g <- getStdGen+        r <- playGame (fireworks g)+            -- We use game result `r` (how many balls were on+            -- screen) and feed it to another function.+            -- This could be useful to upload high scores to+            -- a site, or for a game embedded in a larger pro-+            -- gram, etc.+        putStrLn (bye i)+    where+          bye wi = "See you later!\nYou left the game with " +++                   show wi ++ " balls on screen." 
example/MainHotReload.hs view
@@ -65,7 +65,7 @@     cannot handle interactive programs. But if you are just displaying a     replay, this can come handy -        find example/*.hs | entr -cr cabal run -f examples hot reload+        find example/*.hs | entr -cr cabal run -f examples hot-reload      This is very useful to incrementally build NPCs’ behaviour,     iron out mechanics bugs etc.
src/Terminal/Game.hs view
@@ -33,7 +33,7 @@                        ATGException(..),                         -- ** Helpers-                       playGameS,+                       playGame_,                        Terminal.Game.displaySize,                        assertTermDims,                        errorPress,
src/Terminal/Game/Layer/Imperative.hs view
@@ -15,29 +15,43 @@ import qualified Control.Exception as E import qualified Control.Monad as CM import qualified Data.Bool as B+import qualified Data.Either as ET import qualified Data.List as D import qualified System.IO as SI  import Terminal.Game.Plane --- | Game definition datatype, parametrised on your gamestate. The two most--- important elements are the function dealing with logic and the drawing--- one. Check @alone@ demo (@cabal run -f examples alone@) to see a simple--- game in action.-data Game s =-        Game { gTPS           :: TPS,-                    -- ^ Game speed in ticks per second. You do not-                    -- need high values, since the 2D canvas is coarse-                    -- (e.g. 13 TPS is enough for action games).-               gInitState     :: s,   -- ^ Initial state of the game.-               gLogicFunction :: GEnv -> s -> Event -> s,-                         -- ^ Logic function.-               gDrawFunction  :: GEnv -> s -> Plane,-                         -- ^ Draw function. Just want to blit your game-                         -- in the middle? Check 'centerFull'.-               gQuitFunction  :: s -> Bool-                         -- ^ /Should I quit?/ function.-                                      }+-- | Game definition datatype, parametrised on:+--+-- * your gamestate @s@; and+-- * a result when the game is finished @r@. Simple games do not need this,+--   just fill @r@ with @()@.+--+-- The two most important elements are the function dealing with logic and+-- the drawing one. Check @alone@ demo (@cabal run -f examples alone@) to+-- see a basic game in action.+data Game s r = Game {+        gTPS           :: TPS,+            -- ^ Game speed in ticks per second. You do not+            -- need high values, since the 2D canvas is coarse+            -- (e.g. 13 TPS is enough for action games).+        gInitState     :: s,   -- ^ Initial state of the game.+        gLogicFunction :: GEnv -> s -> Event -> Either r s,+            -- ^ Logic function. @s@ is the game state while @r@+            -- is some sort of result you want to return when the+            -- game is finished.+            --+            -- If `gLogicFunction` returns 'Right' the game will+            -- continue; if it returns 'Left' the game is over+            -- (quit condition).+            --+            -- Curious to see how @r@ can be useful? Check+            -- @cabal run -f examples balls@ and+            -- @example/MainBalls.hs@.+        gDrawFunction  :: GEnv -> s -> Plane+            -- ^ Draw function. Just want to blit your game+            -- in the middle? Check 'centerFull'.+    }  -- | A blank plane as big as the terminal. blankPlaneFull :: GEnv -> Plane@@ -64,18 +78,22 @@ -- @ -- -- in your @.cabal@ file and you will be fine!------ Need to inspect state on exit? Check 'playGameS'.-playGame :: Game s -> IO ()-playGame g = () <$ runGIO (runGameGeneral g)+playGame :: Game s r -> IO r+playGame g = either id (error "`Right` in playGame") <$>+               runGIO (runGameGeneral g) --- | As 'playGame', but do not discard state.-playGameS :: Game s -> IO s-playGameS g = runGIO (runGameGeneral g)+-- | As 'playGame', but ignore the result @r@.+playGame_ :: Game s r -> IO ()+playGame_ g = () <$ playGame g  -- | Tests a game in a /pure/ environment. Aims to accurately emulate 'GEnv'--- changes (screen size, FPS) too.-testGame :: Game s -> GRec -> s+-- changes (screen size, FPS) too. Returns a result @r@ or a state @s@ in+-- case the Event stream is exhausted before the game exits.+--+-- A useful trick is to call 'recordGame' and press /Ctrl-C/ while playing+-- (instead of quitting properly). This way @testGame@ will return+-- @Left s@, a state that you can then inspect.+testGame :: Game s r -> GRec -> Either r s testGame g ts =         case runTest (runGameGeneral g) ts of             (Nothing, l) -> error $ "testGame, exception called: " ++@@ -85,12 +103,15 @@                 -- more infos on a failed test             (Just s, _) -> s --- | As 'testGame', but returns 'Game' instead of a bare state.+-- | As 'testGame', but returns 'Game' instead of result/state. -- Useful to fast-forward (e.g.: skip menus) before invoking 'playGame'.-setupGame :: Game s -> GRec -> Game s+setupGame :: Game s r -> GRec -> Game s r setupGame g ts = let s' = testGame g ts-                 in g { gInitState = s' }-                 -- xx qua messi solo [Event]?+                 in case s' of+                      -- If the game is already over, return a mock logic+                      -- function which simply ends the game.+                      Left r -> g { gLogicFunction = \_ _ _ -> Left r }+                      Right s -> g { gInitState = s }  -- | Similar to 'testGame', runs the game given a 'GRec'. Unlike -- 'testGame', the playthrough will be displayed on screen. Useful when a@@ -102,13 +123,13 @@ -- record-time; this can make emulation slightly inaccurate if — e.g. — -- you replay the game on a smaller terminal than the one you recorded -- the session on.-narrateGame :: Game s -> GRec -> IO s-narrateGame g e = runReplay (runGameGeneral g) e+narrateGame :: Game s r -> GRec -> IO ()+narrateGame g e = () <$ runReplay (runGameGeneral g) e --- | Play as in 'playGame' and write the session to @file@. Useful to--- produce input for 'testGame' and 'narrateGame'. Session will be--- recorded even if an exception happens while playing.-recordGame :: Game s -> FilePath -> IO ()+-- | Play as in 'playGame' and write the session (input stream, etc.) to+-- @file@. Then you can use this with 'testGame' and 'narrateGame'. Session+-- will be recorded even if an exception happens while playing.+recordGame :: Game s r -> FilePath -> IO () recordGame g fp =         E.bracket           (CC.newMVar igrec)@@ -118,9 +139,9 @@ data Config = Config { cMEvents :: CC.MVar [Event],                        cTPS     :: TPS } -runGameGeneral :: forall s m. MonadGameIO m =>-                  Game s -> m s-runGameGeneral (Game tps s lf df qf) =+runGameGeneral :: forall s r m. MonadGameIO m =>+                  Game s r -> m (Either r s)+runGameGeneral (Game tps s lf df) =             -- init             setupDisplay    >>             startEvents tps >>= \(InputHandle ve ts) ->@@ -133,8 +154,8 @@                        (stopEvents ts >>                         shutdownDisplay  )     where-          game :: MonadGameIO m => Config -> Dimensions -> m s-          game c wds = gameLoop c s lf df qf+          game :: MonadGameIO m => Config -> Dimensions -> m (Either r s)+          game c wds = gameLoop c (Right s) lf df                                 Nothing wds                                 (creaFPSCalc tps) @@ -172,35 +193,38 @@  -- from http://www.loomsoft.net/resources/alltut/alltut_lesson6.htm gameLoop :: MonadGameIO m     =>-            Config            -> -- event source-            s                 -> -- state+            Config            ->  -- event source+            Either r s        ->  -- state             (GEnv ->-             s -> Event -> s) -> -- logic function+              s -> Event ->+              Either r s)     ->  -- logic function             (GEnv ->-             s -> Plane)      -> -- draw function-            (s -> Bool)       -> -- quit? function-            Maybe Plane       -> -- last blitted screen-            Dimensions        -> -- Term dimensions-            FPSCalc           -> -- calculate fps-            m s-gameLoop c s lf df qf opln td fps =+             s -> Plane)      ->  -- draw function+            Maybe Plane       ->  -- last blitted screen+            Dimensions        ->  -- Term dimensions+            FPSCalc           ->  -- calculate fps+            m (Either r s)+gameLoop c s lf df opln td fps = -        -- quit?-        checkQuit qf s >>= \qb ->-        if qb+        -- Quit?+        areEventsOver >>= \qb ->+            -- We will quit in case input stream (events) is exhausted.+            -- This might happen during test/narrate.+        if ET.isLeft s || qb           then return s         else -        -- fetch events (if any)+        -- Fetch events (if any).+        -- This is safe as we checked for `areEventsOver` above.         pollEvents (cMEvents c) >>= \es ->          -- no events? skip everything         if null es           then sleepABit (cTPS c)               >>-               gameLoop c s lf df qf opln td fps+               gameLoop c s lf df opln td fps         else -        displaySizeErr            >>= \td' ->+        displaySizeErr          >>= \td' ->          -- logic         let ge = GEnv td' (calcFPS fps)@@ -208,7 +232,7 @@          -- no `Tick` events? You do not need to blit, just update state         if i == 0-          then gameLoop c s' lf df qf opln td fps+          then gameLoop c s' lf df opln td fps         else          -- FPS calc@@ -219,21 +243,34 @@         CM.when resc clearDisplay >>          -- draw-        let opln' | resc = Nothing -- res changed? restart double buffering+        let+            opln' | resc = Nothing -- res changed? restart double buffering                   | otherwise = opln-            npln = df ge s' in+            npln = case s' of+                    (Right rs) -> df ge rs+                    (Left _) -> uncurry blankPlane td'+                    -- In case the logic function came to an end+                    -- (Left), just print a blank plane.+        in          blitPlane opln' npln >> -        gameLoop c s' lf df qf (Just npln) td' fps'+        gameLoop c s' lf df (Just npln) td' fps'  -- Int = number of `Tick` events-stepsLogic :: s -> (s -> Event -> s) -> [Event] -> (Integer, s)+stepsLogic :: Either r s -> (s -> Event -> Either r s) -> [Event] ->+              (Integer, Either r s) stepsLogic s lf es = let ies = D.genericLength . filter isTick $ es-                     in (ies, foldl lf s es)+                     in (ies, logicFold lf s es)     where           isTick Tick = True           isTick _    = False++          logicFold :: (s -> Event -> Either r s) ->+                       Either r s -> [Event] -> Either r s+          logicFold _ (Left r) _ = Left r+          logicFold wlf (Right ws) wes = CM.foldM wlf ws wes+  ------------------------------------------------------------------------------- -- Frame per Seconds
src/Terminal/Game/Layer/Object/IO.hs view
@@ -37,7 +37,11 @@     startEvents tps = T.liftIO $ startIOInput tps     pollEvents ve = T.liftIO $ CC.swapMVar ve []     stopEvents ts = T.liftIO $ stopEventsIO ts+    areEventsOver = return False+      -- IO monad is the actual game, we never quit bar if+      -- the logic function returns `Right`. + -- filepath = logging startIOInput :: TPS -> IO InputHandle startIOInput tps =@@ -116,14 +120,6 @@           MonadException m where     cleanUpErr m c = MC.finally m c     throwExc t = MC.throwM t---------------- Logic ----------------instance {-# OVERLAPS #-} (Monad m, T.MonadIO m) =>-          MonadLogic m where-    checkQuit fb s = return (fb s)  ------------- -- Display --
src/Terminal/Game/Layer/Object/Interface.hs view
@@ -18,8 +18,7 @@ -- mtl interface for game  type MonadGameIO m = (MonadInput m, MonadTimer m,-                      MonadException m, MonadLogic m,-                      MonadDisplay m)+                      MonadException m, MonadDisplay m)  data InputHandle = InputHandle             { ihKeyMVar     :: CC.MVar [Event],@@ -29,6 +28,13 @@     startEvents :: TPS -> m InputHandle     pollEvents  :: CC.MVar [Event] -> m [Event]     stopEvents :: [CC.ThreadId] -> m ()+    areEventsOver :: m Bool+      -- Why do we need this? For test/narrate purposes. When+      -- we play a game events are never over, but when we+      -- test/narrate, it might be than the stream of [Event]+      -- is exhausted before the state function returns Right.+      -- We do not want to be stuck in an endless loop in that+      -- case.  class Monad m => MonadTimer m where     getTime :: m Integer     -- to nanoseconds@@ -40,10 +46,6 @@     cleanUpErr :: m a -> m b -> m a     throwExc :: ATGException -> m a -class Monad m => MonadLogic m where-    -- decide whether it's time to quit-    checkQuit :: (s -> Bool) -> s -> m Bool- class Monad m => MonadDisplay m where     setupDisplay :: m ()     clearDisplay :: m ()@@ -55,3 +57,4 @@ displaySizeErr = displaySize >>= \case                    Nothing -> throwExc CannotGetDisplaySize                    Just d -> return d+
src/Terminal/Game/Layer/Object/Narrate.hs view
@@ -22,9 +22,7 @@     startEvents fps = T.liftIO $ startEvents fps     pollEvents _ = S.state getPolled     stopEvents ts = T.liftIO $ stopEvents ts--instance MonadLogic Narrate where-    checkQuit _ _ = S.gets isOver+    areEventsOver = S.gets isOver  runReplay :: Narrate a -> GRec -> IO a runReplay (Narrate s) k = S.evalStateT s k
src/Terminal/Game/Layer/Object/Primitive.hs view
@@ -28,6 +28,15 @@ 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,@@ -76,7 +85,7 @@  getPolled :: GRec -> ([Event], GRec) getPolled (GRec (ps S.:|> p) d) = (p, GRec ps d)-getPolled _ = error "getEvents: empty Seq"+getPolled _ = error "getPolled: empty Seq"  isOver :: GRec -> Bool isOver (GRec S.Empty _) = True
src/Terminal/Game/Layer/Object/Record.hs view
@@ -29,6 +29,7 @@     pollEvents ve = T.liftIO (pollEvents ve) >>= \es ->                     modMRec addPolled es     stopEvents ts = T.liftIO (stopEvents ts)+    areEventsOver = T.liftIO areEventsOver  instance MonadDisplay Record where     setupDisplay = T.liftIO setupDisplay
src/Terminal/Game/Layer/Object/Test.hs view
@@ -58,6 +58,7 @@                     return mockHandle     pollEvents _ = S.state getPolled     stopEvents _ = S.tell [TStopEvents]+    areEventsOver = S.gets isOver  instance MonadTimer Test where     getTime = return 1@@ -67,9 +68,6 @@     cleanUpErr a _ = S.tell [TCleanUpError] >> a     throwExc e = S.tell [TException e] >>                  E.throwError ()--instance MonadLogic Test where-    checkQuit _ _ = S.gets isOver  instance MonadDisplay Test where     setupDisplay = () <$ S.tell [TSetupDisplay]
test/Terminal/Game/Layer/ImperativeSpec.hs view
@@ -13,6 +13,12 @@ import qualified Test.QuickCheck as Q import qualified GHC.Exts as X +-- Test for state.+stateTest :: Show r => Game s r -> GRec -> s+stateTest g r = either em id (testGame g r)+    where+          em wr = error $ "stateTest: " ++ show wr+ spec :: Spec spec = do @@ -20,33 +26,35 @@     let nd = error "<not-defined>"         s :: (Integer, Bool, Integer)         s = (0, False, 0)-        lf (t, True, i) Tick         = (t+1, True, i+1)-        lf (t, b,    i) Tick         = (t+1, b,    i  )-        lf (t, _,    i) (KeyPress _) = (t,   True, i  )-        qf (3, _,    _) = True-        qf _            = False+        lf (t, True, i) Tick         = Right (t+1, True, i+1)+        lf (t, b,    i) Tick         = Right (t+1, b,    i  )+        lf (t, _,    i) (KeyPress _) = Right (t,   True, i  )         es = [Tick, KeyPress 'c', KeyPress 'c', Tick, Tick]-        g = Game nd s (const lf) nd qf+        g :: Game (Integer, Bool, Integer) ()+        g = Game nd s (const lf) nd     it "does not confuse input and logic" $-      testGame g (createGRec (80, 24) es) `shouldBe` (3, True, 2)+      stateTest g (createGRec (80, 24) es) `shouldBe` (3, True, 2)    describe "testGame" $ do     it "tests a game" $ do         r <- readRecord "test/records/alone-record-test.gr"-        testGame aloneInARoom r `shouldBe` MyState (20, 66) Stop True+        stateTest aloneInARoom r `shouldBe` MyState (20, 66) Stop+    it "tests a game exiting correctly" $ do+        r <- readRecord "test/records/alone-record-left.gr"+        testGame aloneInARoom r `shouldBe` Left ()     it "picks up screen resize events" $ do         r <- readRecord "test/records/balls-dims.gr"         let g = fireworks (mkStdGen 1)-            t = testGame g r+            t = stateTest g r         length (balls t) `shouldBe` 1-    it "picks up screen resize events" $ do+    it "picks FPS too" $ do         r <- readRecord "test/records/balls-slow.gr"         let g = fireworks (mkStdGen 1)-            t = testGame g r+            t = stateTest g r         bslow t `shouldBe` True     it "does not hang on empty/unclosed input" $         let w = createGRec (80, 24) [Tick] in-        testGame aloneInARoom w `shouldBe` MyState (10, 10) Stop False+        stateTest aloneInARoom w `shouldBe` MyState (10, 10) Stop     modifyMaxSize (const 1000) $       it "does not crash/hang on random input" $ Q.property $         let genEvs = Q.listOf1 Q.arbitrary@@ -61,3 +69,4 @@             e = "testGame, exception called: [TSetupDisplay,TStartEvents,\                 \TException CannotGetDisplaySize]"         E.evaluate t `shouldThrow` errorCall e+
+ test/records/alone-record-left.gr view

binary file changed (absent → 2960 bytes)

test/records/alone-record-test.gr view

binary file changed (17880 → 9317 bytes)

test/records/balls-dims.gr view

binary file changed (2141 → 6460 bytes)

test/records/balls-slow.gr view

binary file changed (10878 → 2418 bytes)