ansi-terminal-game 1.6.0.2 → 1.7.0.0

raw patch · 14 files changed

+190/−163 lines, 14 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES +27/−0
• ansi-terminal-game.cabal +2/−1
• example/Alone.hs +15/−21
• example/Balls.hs +3/−3
• example/Main.hs +3/−5
• example/Playback.hs +2/−2
• src/Terminal/Game.hs +44/−25
• src/Terminal/Game/Character.hs +0/−4
• src/Terminal/Game/Draw.hs +5/−3
• src/Terminal/Game/Layer/Imperative.hs +32/−63
• src/Terminal/Game/Layer/Object/IO.hs +3/−0
• src/Terminal/Game/Layer/Object/Test.hs +7/−5
• src/Terminal/Game/Plane.hs +46/−30
• test/Terminal/Game/Layer/ImperativeSpec.hs +1/−1

@@ -1,3 +1,30 @@+1.7.0.0+-------++- After some feedback from library users, I decided to eliminate+  `simpleGame` from the API.+  To reiterate hte migration guide, if your type was:++    Game 80 24 13 initState logicFun drawFun quitFun+    -- or+    -- simpleGame (80, 24) 13 initState logicFun drawFun quitFun++  You just need to modify it like this:++    Game 13 initState+                (const logicFun)+                (\e s -> centerFull e $ drawFun s)+                quitFun+        -- notice how we lost `80 24`. You can still have a screen size+        -- check with `assertTermDims`, as described below.+- Added `blankPlaneFull` and `centerFull` convenience functions (to work+  with GEnv terminal dimensions).+- Added assertTermDims, a quick way to check your user terminal is big+  enough at the start of the game.+- minimal blitting optimisation (you should be able to see a 1–2+  FPS improvement).+- improved documentation on various functions.+ 1.6.0.2 ------- 

@@ -1,5 +1,5 @@ name:                ansi-terminal-game-version:             1.6.0.2+version:             1.7.0.0 synopsis:            sdl-like functions for terminal applications, based on                      ansi-terminal description:         Library which aims to replicate standard 2d game@@ -105,6 +105,7 @@                        clock >= 0.7 && < 0.9,                        exceptions == 0.10.*,                        linebreak == 1.1.*,+                       mintty == 0.1.*,                        mtl == 2.2.*,                        QuickCheck >= 2.13 && < 2.15,                        random >= 1.2 && < 1.3,

@@ -7,22 +7,21 @@  import qualified Data.Tuple as T - -- game specification aloneInARoom :: Game MyState-aloneInARoom = let ds = T.swap . snd $ boundaries in-               simpleGame ds                   -- size-                          13                   -- ticks per second-                          (MyState (10, 10)-                                   Stop False) -- init state-                          logicFun             -- logic function-                          drawFun              -- draw function-                          gsQuit               -- quit function+aloneInARoom = Game 13                       -- ticks per second+                    (MyState (10, 10)+                             Stop False)     -- init state+                    (\_ s e -> logicFun s e) -- logic function+                    (\_ s -> drawFun s)      -- draw function+                    gsQuit                   -- quit function --------------- TYPES --------------+sizeCheck :: IO ()+sizeCheck = assertTermDims (T.swap . snd $ boundaries) +-------------------------------------------------------------------------------+-- Types+ data MyState = MyState { gsCoord :: Coords,                          gsMove  :: Move,                          gsQuit  :: Bool }@@ -34,10 +33,8 @@ boundaries :: (Coords, Coords) boundaries = ((1, 1), (24, 80)) ---------------- LOGIC --------------+-------------------------------------------------------------------------------+-- Logic  logicFun :: MyState -> Event -> MyState logicFun gs (KeyPress 'q') = gs { gsQuit = True }@@ -72,10 +69,8 @@           oob (r, c) = r <= lr || c <= lc ||                        r >= hr || c >= hc --------------- DRAW -------------+-------------------------------------------------------------------------------+-- Draw  drawFun :: MyState -> Plane drawFun (MyState (r, c) _ _) =@@ -91,4 +86,3 @@           mh :: Height           mw :: Width           (mh, mw) = snd boundaries-

@@ -11,13 +11,13 @@    There are three things I will showcase in this example:     1. ** How you can display current FPS. **-      This is done using `generalGame` to create your game rather than-      `simpleGame`. `generalGame` is a bit more complex but you gain+      This is done using `Game` to create your game rather than+      `simpleGame`. `Game` is a bit more complex but you gain       additional infos to manipulate/blit, like FPS.     2. ** How your game can gracefully handle screen resize. **       Notice how if you resize the terminal, balls will still-      fill the entire screen. This is again possible using `generalGame`+      fill the entire screen. This is again possible using `Game`       and the information passed via GameEnv (in this case, terminal       dimensions). 

@@ -1,14 +1,12 @@ module Main where  -import Alone ( aloneInARoom )+import Alone ( aloneInARoom, sizeCheck )  import Terminal.Game --- plays the game normally -- run with: cabal new-run -f examples alone  main :: IO ()-main = errorPress $ playGame aloneInARoom--+main = do sizeCheck+          errorPress $ playGame aloneInARoom

@@ -1,7 +1,6 @@ module Main where --import Alone ( aloneInARoom )+import Alone ( aloneInARoom, sizeCheck )  import Terminal.Game @@ -12,6 +11,7 @@  main :: IO () main = do+        sizeCheck         tf <- emptySystemTempFile "alone-record.gr"         playback tf 

@@ -1,8 +1,8 @@ -------------------------------------------------------------------------------- -- | -- Module      :  Terminal.Game--- Copyright   :  © 2017-2019 Francesco Ariis--- License     :  GPLv3 (see LICENSE file)+-- Copyright   :  © 2017-2021 Francesco Ariis+-- License     :  GPLv3 (see COPYING file) -- -- Maintainer  :  Francesco Ariis <fa-ml@ariis.it> -- Stability   :  provisional@@ -10,32 +10,15 @@ -- -- Machinery and utilities for 2D terminal games. ----- New? Start from 'simpleGame'.+-- New? Start from 'Game'. -- --------------------------------------------------------------------------------  -- Basic col-on-black ASCII terminal, operations. -- Only module to be imported. --- todo test that handlers are closed in case of errr [test]--- todo invert # invert (doppio) si elimina? [test] [design]--- todo random shuffle in atg?--- todo (da sm) sm any plans to expose more of these bits in a future---      release, making ansi-terminal-game more of a full game engine ?---      [suggestion]--- todo (da sm) music [suggestion]--- todo (da sm) I'm also wondering if I can adjust the frame rate during---      play, to speed things up--- todo (da sm) hot reload for game (see IHP web app) [suggestion]--- todo (da sm) sound with sox -- todo eccezioni con maybe o lanciando l’eccezione?--- todo (da sm) not having access to IO forces me to restart a-t-g at---      each level (if I want to write to disk).---      If they C-c that will not be saved too.---      <icrbow> an engine can provide a separate post-frame callback that---      has read-only access to world and stuff, but can do `IO ()`.--- todo space (stack/heap) analysis-+-- todo [u:3] testing facilities should record/read fps/screen-resize  module Terminal.Game ( -- * Running                        TPS,@@ -43,9 +26,14 @@                        Event(..),                        GEnv(..),                        Game(..),-                       simpleGame,                        playGame, +                       -- ** Helpers+                       playGameS,+                       assertTermDims,+                       blankPlaneFull,+                       centerFull,+                        -- * Game logic                        -- | Some convenient function dealing with                        -- Timers ('Timed') and 'Animation's.@@ -129,7 +117,6 @@                        recordGame,                        readRecord,                        narrateGame,-                       playGameS,                         -- * Utility                        Terminal.Game.displaySize,@@ -150,10 +137,12 @@ import Terminal.Game.Random import Text.LineBreak +import qualified Control.Monad as CM+ -- $origins -- Placing a plane is sometimes more convenient if the coordinates origin--- is a corner other than top-left (e.g. “Paste this plane one row from--- bottom-left corner”). These combinators — meant to be used instead of '%'+-- is a corner other than top-left (e.g. «Paste this plane one row from+-- bottom-left corner»). These combinators — meant to be used instead of '%' -- — allow you to do so. Example: -- -- @@@ -193,3 +182,33 @@ -- set aside for input). Throws 'CannotGetDisplaySize' on error. displaySize :: IO Dimensions displaySize = O.displaySizeErr++-- | Check if terminal can accomodate 'Dimensions', otherwise @error@ with+-- a «please resize your term» message.+assertTermDims :: Dimensions -> IO ()+assertTermDims (sw, sh) =+                clearScreen >>+                setCursorPosition 0 0 >>+                displaySizeErr >>= \tds ->+                CM.when (isSmaller tds) (error $ smallMsg tds)+    where+          colS ww = ww < sw+          rowS wh = wh < sh+          isSmaller :: Dimensions -> Bool+          isSmaller (ww, wh) = colS ww || rowS wh++          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 grid of " ++ show sw +++                  " columns and " ++ show sh ++ " rows.\n" +++                  "Yours only has " ++ em ++ "!\n\n" +++                  "Please resize your terminal now!\n"++

@@ -7,10 +7,6 @@  import Terminal.Game.Utils --- TODO [test] this need to be tested on Win, both newer ones and older---      versions (newer should display non-changed chars, old should not---      crash).- -- Non ASCII character still cause crashes on Win32 console (see this -- report: https://gitlab.haskell.org/ghc/ghc/issues/7593 ). -- We provide a function to substitute them when playing on Win32

@@ -99,11 +99,13 @@  -- | Place a list of 'Plane's side-by-side, horizontally. hcat :: [Plane] -> Plane-hcat ps = L.foldl' (|||) (blankPlane 0 0) ps+hcat [] = error "hcat: empty list"+hcat ps = L.foldl1' (|||) ps  -- | Place a list of 'Plane's side-by-side, vertically. vcat :: [Plane] -> Plane-vcat ps = L.foldl' (===) (blankPlane 0 0) ps+vcat [] = error "vcat: empty list"+vcat ps = L.foldl1' (===) ps  infixl 6 |||, ===, *** @@ -170,7 +172,7 @@ -- sobbolliva quieta la pentola.           liva quieta la pentola. -- @ ----- Notice how in the right box “sobbolliva” is broken in two. This+-- Notice how in the right box «sobbolliva» is broken in two. This -- can be useful and aesthetically pleasing when textboxes are narrow. textBoxHyphen :: Hyphenator -> Width -> Height -> String -> Plane textBoxHyphen hp w h cs = frameTrans w h (textBoxHyphenLiquid hp w cs)

@@ -23,77 +23,44 @@ -- | Game environment with current terminal dimensions and current display -- rate. data GEnv = GEnv { eTermDims :: Dimensions,-                   eFPS :: FPS }+                        -- ^ Current terminal dimensions.+                   eFPS :: FPS+                        -- ^ Current blitting rate.+                       } --- | General way to create a game. This gives you more control by--- exposing 'GEnv' (allowing e.g. to adapt to screen resizes, blit--- FPS, etc.. If you fancy simple, sensible defaults, check 'simpleGame'.+-- | 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, -- ^ Ticks per second. Since the 2D-                                      -- “char canvas” is coarse, you do not-                                      -- need high values (e.g. 13 TPS is+        Game { gTPS           :: TPS, -- ^ 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.+                         -- ^ Logic function.                gDrawFunction  :: GEnv -> s -> Plane,-                                      -- ^ Draw function. Check '***' for-                                       --  centre-blitting.+                         -- ^ Draw function. Just want to blit your game+                         -- in the middle? Check 'centerFull'.                gQuitFunction  :: s -> Bool-                                      -- ^ “Should I quit?” function.+                         -- ^ «Should I quit?» function.                                       } --- | Simplest way to create a game. The two most important parameters--- are the function dealing with logic and the drawing one. Check @alone@--- (you can compile it with @cabal run -f examples alone@) to see a basic--- game in action. If you want more control, look at 'Game'.-simpleGame :: Dimensions           -- ^ Gamescreen dimensions, in columns and-                                   --   rows. Asks the player to resize their-                                   --   terminal if it is too small.-                                   --   Centre-blits on bigger terminals.-              -> TPS               -- ^ Ticks per second. Since the 2D “char-                                   --   canvas” is coarse, you do not need-                                   --   high values (e.g. 13 TPS is enough-                                   --   for action games).-              -> s                 -- ^ Initial state of the game.-              -> (s -> Event -> s) -- ^ Simple logic function.-              -> (s -> Plane)      -- ^ Simple draw function.-              -> (s -> Bool)       -- ^ “Should I quit?” function.-              -> Game s-simpleGame (sw, sh) tps s lf df qf = Game tps s lf' df' qf-    where-          -- lf' :: GEnv -> s -> Event -> s-          lf' wen ws we-                | isSmaller (eTermDims wen) = ws-                | otherwise = lf ws we--          -- df' :: GEnv -> s -> Plane-          df' wen ws =-                let ds = eTermDims wen in-                if isSmaller ds-                  then smallMsg ds-                  else uncurry blankPlane ds *** df ws--          colS ww = ww < sw-          rowS wh = wh < sh-          isSmaller :: Dimensions -> Bool-          isSmaller (ww, wh) = colS ww || rowS wh--          smallMsg :: Dimensions -> Plane-          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-                textBoxLiquid ww $-                  "This games requires a screen of " ++ show sw ++-                  " columns and " ++ show sh ++ " rows.\n" ++-                  "Yours only has " ++ em ++ "!\n\n" ++-                  "Please resize your terminal now!"+-- | A blank plane as big as the terminal.+blankPlaneFull :: GEnv -> Plane+blankPlaneFull e = uncurry blankPlane (eTermDims e) +-- | Blits plane in the middle of terminal.+--+-- @+--   draw :: GEnv -> MyState -> Plane+--   draw ev s =+--       centerFull ev $+--         ⁝+-- @+centerFull :: GEnv -> Plane -> Plane+centerFull e p = blankPlaneFull e *** p  -- | Entry point for the game execution, should be called in @main@. --@@ -105,6 +72,8 @@ -- @ -- -- 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) @@ -115,7 +84,7 @@ -- | Tests a game in a /pure/ environment. You can -- supply the 'Event's yourself or use 'recordGame' to obtain them. testGame :: Game s -> [Event] -> s-testGame g es = fst $ runTest (runGameGeneral g) (Env False es)+testGame g es = fst $ runTest (runGameGeneral g) es  -- | As 'testGame', but returns 'Game' instead of a bare state. -- Useful to fast-forward (e.g.: skip menus) before invoking 'playGame'.@@ -130,7 +99,6 @@ -- See this in action with  @cabal run -f examples alone-playback@. narrateGame :: Game s -> [Event] -> IO s narrateGame g e = runReplay (runGameGeneral g) e-    -- xxx replaygame is very difficult to test  -- | Play as in 'playGame' and write the session to @file@. Useful to -- produce input for 'testGame' and 'narrateGame'. Session will be@@ -269,6 +237,7 @@ -- | 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  data FPSCalc = FPSCalc [Integer] TPS

@@ -147,6 +147,9 @@         TS.size        >>= \ts ->             -- cannot use ansi-terminal, on Windows you get             -- "ConsoleException 87" (too much scrolling)+            -- and it does not work for mintty and it is+            -- inefficient as it gets (attempts to scroll past+            -- bottom right)         isWin32Console >>= \bw ->          return (fmap (f bw) ts)

@@ -20,8 +20,10 @@ -- TYPES -- ----------- -data Env = Env { eLogging :: Bool,-                 eEvents  :: [Event] }+-- | Type with events happened during play+data GTest = GTest+    -- magari devo cambiare draw e toglier loro entrambe le cose,+    -- ma poi come faccio con simple game?…  data TestEvent = TCleanUpError                | TQuitGame@@ -32,12 +34,12 @@                | TStopEvents         deriving (Eq, Show) -newtype Test a = Test (S.RWS Env [TestEvent] [Event] a)+newtype Test a = Test (S.RWS () [TestEvent] [Event] a)                deriving (Functor, Applicative, Monad,                          S.MonadWriter [TestEvent]) -runTest :: Test a -> Env -> (a, [TestEvent])-runTest (Test m) e = S.evalRWS m e (eEvents e)+runTest :: Test a -> [Event] -> (a, [TestEvent])+runTest (Test m) es = S.evalRWS m () es   -----------

@@ -48,7 +48,31 @@ newtype Plane = Plane { fromPlane :: A.Array Coords Cell }
               deriving (Show, Eq, G.Generic)
 
+-------------------------------------------------------------------------------
+-- Plane interface (abstracting Array)
 
+listPlane :: Coords -> [Cell] -> Plane
+listPlane (r, c) cs = Plane $ A.listArray ((1,1), (r, c)) cs
+
+-- | Dimensions or a plane.
+planeSize :: Plane -> Dimensions
+planeSize p = T.swap . snd $ A.bounds (fromPlane p)
+
+assocsPlane :: Plane -> [(Coords, Cell)]
+assocsPlane p = A.assocs (fromPlane p)
+
+elemsPlane :: Plane -> [Cell]
+elemsPlane p = A.elems (fromPlane p)
+
+-- Array.//
+updatePlane :: Plane -> [(Coords, Cell)] -> Plane
+updatePlane (Plane a) kcs = Plane $ a A.// kcs
+
+-- faux map
+mapPlane :: (Cell -> Cell) -> Plane -> Plane
+mapPlane f (Plane a) = Plane $ fmap f a
+
+
 ----------
 -- CREA --
 ----------
@@ -71,11 +95,12 @@ reverseCell Transparent        = Transparent
 
 -- | Creates 'Plane' from 'String', good way to import ASCII
--- art/diagrams.
+-- art/diagrams. @error@s on empty string.
 stringPlane :: String -> Plane
 stringPlane t = stringPlaneGeneric Nothing t
 
 -- | Same as 'stringPlane', but with transparent 'Char'.
+-- @error@s on empty string.
 stringPlaneTrans :: Char -> String -> Plane
 stringPlaneTrans c t = stringPlaneGeneric (Just c) t
 
@@ -104,21 +129,29 @@ 
 -- | Paste one plane over the other at a certain position (p1 gets over p2).
 pastePlane :: Plane -> Plane -> Coords -> Plane
-pastePlane p1 p2 (r, c) = updatePlane p2 filtered
+pastePlane p1 p2 (r, c)
+            | r > h2 || c > w2 = p2
+            | otherwise =
+                let ks = assocsPlane p1
+                    fs = filter (\x -> solid x && inside x) ks
+                    ts = fmap (\(lcs, k) -> (trasl lcs, k)) fs
+                in updatePlane p2 ts
     where
-          cs        = assocsPlane p1
-          (w2, h2)  = planeSize p2
-          traslated = fmap (\((r1, c1), cl) -> ((r1 + r - 1, c1 + c -1), cl))
-                           cs
-          filtered  = filter (\x -> inside x && solid x) traslated
+          trasl :: Coords -> Coords
+          trasl (wr, wc) = (wr + r - 1, wc + c - 1)
 
-          inside ((r1, c1), _) | r1 >= 1 && r1 <= h2 &&
-                                 c1 >= 1 && c1 <= w2    = True
-                               | otherwise              = False
+          -- inside new position, cheaper than first mapping and then
+          -- filtering.
+          inside (wcs, _) =
+                let (r1', c1') = trasl wcs
+                in r1' >= 1 && r1' <= h2 &&
+                   c1' >= 1 && c1' <= w2
 
           solid (_, Transparent) = False
           solid _                = True
 
+          (w2, h2)  = planeSize p2
+
 -- | Cut out a plane by top-left and bottom-right coordinates.
 subPlane :: Plane -> Coords -> Coords -> Plane
 subPlane p (r1, c1) (r2, c2)
@@ -140,10 +173,6 @@ -- INQUIRE --
 -------------
 
--- | Dimensions or a plane.
-planeSize :: Plane -> Dimensions
-planeSize p = T.swap . snd $ A.bounds (fromPlane p)
-
 cellChar :: Cell -> Char
 cellChar (CellChar c _ _ _) = c
 cellChar Transparent        = ' '
@@ -160,14 +189,10 @@ isReversed (CellChar _ _ r _) = r
 isReversed _                  = False
 
-assocsPlane :: Plane -> [(Coords, Cell)]
-assocsPlane p = A.assocs (fromPlane p)
-
 -- | A String (@\n@ divided and ended) representing the 'Plane'. Useful
 -- for debugging/testing purposes.
 planePaper :: Plane -> String
-planePaper p = unlines . LS.chunksOf w .
-               map cellChar . A.elems $ fromPlane p
+planePaper p = unlines . LS.chunksOf w . map cellChar $ elemsPlane p
     where
           w :: Int
           w = fromIntegral . fst . planeSize $ p
@@ -176,18 +201,9 @@ -- ANCILLARIES --
 -----------------
 
--- faux map
-mapPlane :: (Cell -> Cell) -> Plane -> Plane
-mapPlane f (Plane a) = Plane $ fmap f a
-
--- Array.//
-updatePlane :: Plane -> [(Coords, Cell)] -> Plane
-updatePlane (Plane a) kcs = Plane $ a A.// kcs
-
-listPlane :: Coords -> [Cell] -> Plane
-listPlane (r, c) cs = Plane $ A.listArray ((1,1), (r, c)) cs
-
 stringPlaneGeneric :: Maybe Char -> String -> Plane
+stringPlaneGeneric _ "" = error "stringPlane/stringPlanetran: cannot make \
+                                \a Plane out of an empty string!"
 stringPlaneGeneric mc t = vitrous
     where
           lined = lines t

@@ -22,7 +22,7 @@       qf (3, _,    _) = True       qf _            = False       es = [Tick, KeyPress 'c', KeyPress 'c', Tick, Tick]-      g = simpleGame (10, 10) nd s lf nd qf+      g = Game nd s (const lf) nd qf    describe "runGame" $ do     it "does not confuse input and logic" $