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 +63/−0
- ansi-terminal-game.cabal +5/−4
- example/Alone.hs +9/−11
- example/Balls.hs +15/−15
- example/MainBalls.hs +12/−2
- example/MainHotReload.hs +1/−1
- src/Terminal/Game.hs +1/−1
- src/Terminal/Game/Layer/Imperative.hs +101/−64
- src/Terminal/Game/Layer/Object/IO.hs +4/−8
- src/Terminal/Game/Layer/Object/Interface.hs +9/−6
- src/Terminal/Game/Layer/Object/Narrate.hs +1/−3
- src/Terminal/Game/Layer/Object/Primitive.hs +10/−1
- src/Terminal/Game/Layer/Object/Record.hs +1/−0
- src/Terminal/Game/Layer/Object/Test.hs +1/−3
- test/Terminal/Game/Layer/ImperativeSpec.hs +21/−12
- test/records/alone-record-left.gr binary
- test/records/alone-record-test.gr binary
- test/records/balls-dims.gr binary
- test/records/balls-slow.gr binary
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)