diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -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 ------- diff --git a/ansi-terminal-game.cabal b/ansi-terminal-game.cabal --- a/ansi-terminal-game.cabal +++ b/ansi-terminal-game.cabal @@ -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, diff --git a/example/Alone.hs b/example/Alone.hs --- a/example/Alone.hs +++ b/example/Alone.hs @@ -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 - diff --git a/example/Balls.hs b/example/Balls.hs --- a/example/Balls.hs +++ b/example/Balls.hs @@ -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). diff --git a/example/Main.hs b/example/Main.hs --- a/example/Main.hs +++ b/example/Main.hs @@ -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 diff --git a/example/Playback.hs b/example/Playback.hs --- a/example/Playback.hs +++ b/example/Playback.hs @@ -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 diff --git a/src/Terminal/Game.hs b/src/Terminal/Game.hs --- a/src/Terminal/Game.hs +++ b/src/Terminal/Game.hs @@ -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 -- 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. --- 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" + + diff --git a/src/Terminal/Game/Character.hs b/src/Terminal/Game/Character.hs --- a/src/Terminal/Game/Character.hs +++ b/src/Terminal/Game/Character.hs @@ -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 diff --git a/src/Terminal/Game/Draw.hs b/src/Terminal/Game/Draw.hs --- a/src/Terminal/Game/Draw.hs +++ b/src/Terminal/Game/Draw.hs @@ -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) diff --git a/src/Terminal/Game/Layer/Imperative.hs b/src/Terminal/Game/Layer/Imperative.hs --- a/src/Terminal/Game/Layer/Imperative.hs +++ b/src/Terminal/Game/Layer/Imperative.hs @@ -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 diff --git a/src/Terminal/Game/Layer/Object/IO.hs b/src/Terminal/Game/Layer/Object/IO.hs --- a/src/Terminal/Game/Layer/Object/IO.hs +++ b/src/Terminal/Game/Layer/Object/IO.hs @@ -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) diff --git a/src/Terminal/Game/Layer/Object/Test.hs b/src/Terminal/Game/Layer/Object/Test.hs --- a/src/Terminal/Game/Layer/Object/Test.hs +++ b/src/Terminal/Game/Layer/Object/Test.hs @@ -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 ----------- diff --git a/src/Terminal/Game/Plane.hs b/src/Terminal/Game/Plane.hs --- a/src/Terminal/Game/Plane.hs +++ b/src/Terminal/Game/Plane.hs @@ -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 diff --git a/test/Terminal/Game/Layer/ImperativeSpec.hs b/test/Terminal/Game/Layer/ImperativeSpec.hs --- a/test/Terminal/Game/Layer/ImperativeSpec.hs +++ b/test/Terminal/Game/Layer/ImperativeSpec.hs @@ -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" $