diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,49 @@ +1.6.0.0 +------- + +Summary and tl;dr migration guide: +- This version introduces a breaking changes in the main way to make + a `Game`. I will detail the changes below, but first a two-lines + migration guide: + the only thing you should have to do is to replace your `Game` + data constructor with `simpleGame` smart constructor. + And of course, if you are interested in displaying FPS and adapt to + screen size modifications at game-time (“liquid” layout), read along! + +Changes: +- This version introduces GEnv, a structure that exposes current frame + rate (in FPS) and current terminal size (in Width, Height). +- `GEnv` is added as a parameter to logic and draw functions, which + now have these signatures: + gLogicFunction :: GEnv -> s -> Event -> slightly + gDrawFunction :: GEnv -> s -> plane +- If you do not want to dabble with GEnv, you can still use `simpleGame` + smart constructor, which mimicks the old `Game`. `simpleGame` has some + nice defaults: + - if the terminal is too small it will ask the player to resize it + (even in the middle of the game), blocking any input; + - if the terminal is bigger, it will paste `Plane` in the middle + of the screen. +- For this reason, `DisplayTooSmall` exception exists no more. +- the new `Game` does not have those defaults, but allows you to get + creative with screen resizes, e.g. accomodating as much gameworld + as possible etc. Check `cabal run -f examples balls` and resize the + screen to see it in action. +- Minor change: I have introduced a `Dimensions` alias for + `(Width, Height)`. + +Future work: +- these changes lay the path for an even more general `Game` type, + adding effects like reading form a game configuration, writing to it + etc. + I would like to have these wrapped in a pure interface (maybe à la + Response/Request? Maybe callbacks?) and for sure want them to be + composable with current test scaffolding (testGame, + narrateGame, etc.). It will not be easy to design; if are reading + this and have any suggestion, please write to me. + +Released dom 14 nov 2021, 20:25:19 + 1.5.0.0 ------- @@ -10,10 +56,13 @@ - Removed `getFrames` from Animation interface. - Updated `Random` interface to fit the new `random`. This is a breaking change but it should be easy to fix by updating your `Random` constraints - to `UniformRange` + to `UniformRange`. + Be mindful that `recordGame` could play slightly differently, as the + update function for the StdGen in `random` has changed. - Removed `getRandomList` from Random interface. - Added `pickRandom` to Random interface. - Removed unuseful `creaStaticAnimation` from Animation interface. +- Released mar 9 nov 2021, 15:56:14. 1.4.0.0 ------- diff --git a/README b/README --- a/README +++ b/README @@ -27,6 +27,16 @@ http://www.ariis.it/static/articles/venzone/page.html +Other games made with a-t-g +--------------------------- + +- caverunner: + https://github.com/simonmichael/games/blob/main/caverunner/caverunner.hs +- pigafetta: http://www.ariis.it/link/repos/pigafetta/ +- avoidance: https://sabadev.xyz/avoidance_game + +If you want yours to be added to this list, write to me. + Contact ------- 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.5.0.0 +version: 1.6.0.0 synopsis: sdl-like functions for terminal applications, based on ansi-terminal description: Library which aims to replicate standard 2d game @@ -134,6 +134,7 @@ other-modules: Alone default-language: Haskell2010 ghc-options: -threaded + -Wall executable alone-playback if flag(examples) @@ -148,3 +149,17 @@ other-modules: Alone default-language: Haskell2010 ghc-options: -threaded + -Wall + +executable balls + if flag(examples) + build-depends: base == 4.*, + ansi-terminal-game + else + buildable: False + + hs-source-dirs: example + main-is: Balls.hs + default-language: Haskell2010 + ghc-options: -threaded + -Wall diff --git a/example/Alone.hs b/example/Alone.hs --- a/example/Alone.hs +++ b/example/Alone.hs @@ -5,21 +5,19 @@ import Terminal.Game +import qualified Data.Tuple as T --- this is the game specification -aloneInARoom :: Game MyState -aloneInARoom = - Game { gScreenWidth = gw, - gScreenHeight = gh, - gTPS = 13, - gInitState = MyState (10, 10) Stop False, - gLogicFunction = logicFun, - gDrawFunction = drawFun, - gQuitFunction = gsQuit } - where - (gh, gw) = snd boundaries - +-- 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 ----------- -- TYPES -- diff --git a/example/Balls.hs b/example/Balls.hs new file mode 100644 --- /dev/null +++ b/example/Balls.hs @@ -0,0 +1,185 @@ +module Main where + +import Terminal.Game + +import qualified Data.Bool as B +import qualified Data.Ix as I +import qualified Data.Maybe as M +import qualified Data.Tuple as T + +{- + 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 + 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` + and the information passed via GameEnv (in this case, terminal + dimensions). + + 3. ** That — while FPS can change — game speed does not. ** + Check the timer: even when screen is crowded and frames are + dropped, it is not slowed down. + + + This game runs at 60 FPS, you will almost surely never need such + a high TPS! 15-20 is more than enough in most cases. +-} + +main :: IO () +main = getStdGen >>= \g -> + playGame (fireworks g) + +------------------------------------------------------------------------------- +-- Ball + +data Ball = Ball { pChar :: Plane, + pSpeed :: Timed Bool, + pDir :: Coords, + pPos :: Coords } + +-- change direction is necessary, then and move +modPar :: Dimensions -> Ball -> Maybe Ball +modPar ds b@(Ball _ _ d _) = + -- tick the ball and check it is time to move + let b' = tickBall b in + if not (fetchFrame . pSpeed $ b') + then Just b' -- no time to move for you + else + + -- check all popssible directions + let pd = [d, togR d, togC d, togB d] + bs = map (\ld -> b' { pDir = ld }) pd + bs' = filter (isIn ds) $ map modPos bs in + + -- returns a moved ball nor nothing to mark it “to eliminate” + case bs' of + [] -> Nothing + (cp:_) -> Just cp + where + togR (wr, wc) = (-wr, wc) + togC (wr, wc) = ( wr, -wc) + togB (wr, wc) = (-wr, -wc) + +tickBall :: Ball -> Ball +tickBall b = b { pSpeed = tick (pSpeed b) } + +modPos :: Ball -> Ball +modPos (Ball p t d@(dr, dc) (r, c)) = Ball p t d (r+dr, c+dc) + +isIn :: Dimensions -> Ball -> Bool +isIn (w, h) (Ball p _ _ (pr, pc)) = + let (pw, ph) = planeSize p + in pr >= 1 && + pr+ph-1 <= h && + pc >= 1 && + pc+pw-1 <= w + +dpart :: Ball -> (Coords, Plane) +dpart (Ball p _ _ cs) = (cs, p) + +genBall :: StdGen -> Dimensions -> (Ball, StdGen) +genBall g ds = + let (c, g1) = pickRandom [minBound..] g + (s, g2) = getRandom (1, 3) g1 + (v, g3) = pickRandom dirs g2 + (p, g4) = ranIx ((1,1), T.swap ds) g3 + b = Ball (cell 'o' # color c Vivid) + (creaBoolTimerLoop s) v p + in (b, g4) + where + dirs = [(1, 1), (1, -1), (-1, 1), (-1, -1)] + + -- tuples instances are yet to be added to `random` + -- as nov 21; this will do meanwhile. + ranIx :: I.Ix a => (a, a) -> StdGen -> (a, StdGen) + ranIx r wg = pickRandom (I.range r) wg + +------------------------------------------------------------------------------- +-- Timer + +type Timer = (Timed Bool, Integer) + +ctimer :: TPS -> Timer +ctimer tps = (creaBoolTimerLoop tps, 0) + +ltimer :: Timer -> Timer +ltimer (t, i) = let t' = tick t + k = B.bool 0 1 (fetchFrame t') + in (t', i+k) + +dtimer :: Timer -> Plane +dtimer (_, i) = word . show $ i + +------------------------------------------------------------------------------- +-- Game + +data GState = GState { gen :: StdGen, + quit :: Bool, + timer :: Timer, + balls :: [Ball] } + +fireworks :: StdGen -> Game GState +fireworks g = Game tps istate lfun dfun qfun + where + tps = 60 + + istate :: GState + istate = GState g False (ctimer tps) [] + +------------------------------------------------------------------------------- +-- Logic + +lfun :: GEnv -> GState -> Event -> 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 +lfun r s Tick = + let ds = eTermDims r + + ps = balls s + ps' = M.mapMaybe (modPar ds) ps + in s { timer = ltimer (timer s), + balls = filter (isIn ds) ps' } + +qfun :: GState -> Bool +qfun s = quit s + +------------------------------------------------------------------------------- +-- Draw + +dfun :: GEnv -> GState -> Plane +dfun r s = mergePlanes + (uncurry blankPlane ds) + (map dpart $ balls s) & + (1, 2) %^> tui # trans & + (1, 2) %.< inst # trans # bold + where + ds = eTermDims r + tm = timer s + + tui :: Plane + tui = let fps = eFPS r + np = length $ balls s + + l1 = word "FPS: " ||| word (show fps) + l2 = word "Timer: " ||| dtimer tm + l3 = word ("Balls: " ++ show np) + l4 = word ("Term. dims.: " ++ show ds) + in vcat [l1, l2, l3, l4] + + inst :: Plane + inst = word "Press (s) to spawn" === + word "Press (q) to quit" + + trans :: Draw + trans = makeTransparent ' ' diff --git a/example/Playback.hs b/example/Playback.hs --- a/example/Playback.hs +++ b/example/Playback.hs @@ -21,7 +21,7 @@ recordGame aloneInARoom f prompt "Press to watch playback." es <- readRecord f - narrateGame aloneInARoom es + _ <- narrateGame aloneInARoom es prompt "Playback over! Press to quit." where prompt :: String -> IO () diff --git a/src/Terminal/Game.hs b/src/Terminal/Game.hs --- a/src/Terminal/Game.hs +++ b/src/Terminal/Game.hs @@ -10,25 +10,15 @@ -- -- Machinery and utilities for 2D terminal games. -- --- New? Start from 'Game'. +-- New? Start from 'simpleGame'. -- -------------------------------------------------------------------------------- -- Basic col-on-black ASCII terminal, operations. -- Only module to be imported. --- todo a-t-g senza timer -- todo test that handlers are closed in case of errr [test] -- todo invert # invert (doppio) si elimina? [test] [design] --- todo schermo piccolo, si centra verticalmente? [test] --- todo metti in a-t-g la formula «menu, poi fai questo, poi --- ritorni, astrai questo pattern [menu] - --- todo timer in contrib o altro modulo? --- todo controlla caratteri strani su windows, prova con morganw e ibispi --- todo boxratio, blit top left etc in ansi-terminal-game? [u:2] --- todo autoresize terminal (or get-term-size?) --- todo ranSelect :: [a] -> m a in a-t-g [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 ? @@ -38,14 +28,22 @@ -- play, to speed things up -- todo (da sm) hot reload for game (see IHP web app) [suggestion] -- todo (da sm) sound with sox --- todo (da sm) add tick counter -- 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 module Terminal.Game ( -- * Running TPS, + FPS, Event(..), + GEnv(..), Game(..), + simpleGame, playGame, -- * Game logic @@ -88,6 +86,7 @@ -- ** Plane Plane, + Dimensions, Coords, Row, Column, Width, Height, @@ -192,5 +191,5 @@ -- | /Usable/ terminal display size (on Win32 console the last line is -- set aside for input). Throws 'CannotGetDisplaySize' on error. -displaySize :: IO (Width, Height) +displaySize :: IO Dimensions displaySize = O.displaySizeErr 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 @@ -8,36 +8,92 @@ module Terminal.Game.Layer.Imperative where +import Terminal.Game.Draw import Terminal.Game.Layer.Object -import qualified Control.Concurrent as CC -import qualified Control.Exception as E -import qualified Control.Monad as CM -import qualified System.IO as SI +import qualified Control.Concurrent as CC +import qualified Control.Exception as E +import qualified Control.Monad as CM +import qualified Data.Bool as B +import qualified Data.List as D +import qualified System.IO as SI import Terminal.Game.Plane --- xxx also when it goes to crash screen, it says press any key to --- continue, yet only enter works +-- | Game environment with current terminal dimensions and current display +-- rate. +data GEnv = GEnv { eTermDims :: Dimensions, + eFPS :: FPS } --- | Game definition datatype, parametrised on your gamestate. The two --- most important elements 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 simple game in action. -data Game s = Game { - gScreenWidth :: Width, -- ^Gamescreen width, in columns. - gScreenHeight :: Height, -- ^Gamescreen height, in rows. - gTPS :: TPS, -- ^Ticks per second. Since the - -- 2D «char canvas» is coarse, you - -- do not need a high value (e.g. - -- 13 TPS is enough for action - -- games). - gInitState :: s, -- ^Initial state of the game. - gLogicFunction :: s -> Event -> s, -- ^Logic function. - gDrawFunction :: s -> Plane, -- ^Draw function. - gQuitFunction :: s -> Bool -- ^«Should I quit?» function. - } +-- | General way to create a 'Game'. This allows you more control by +-- exposing 'GEnv' (allows you to e.g. adapt to screen resizes, blit +-- FPS). If you fancy simple, sensible defaults, check 'simpleGame'. +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 + -- enough for action games). + gInitState :: s, -- ^ Initial state of the game. + gLogicFunction :: GEnv -> s -> Event -> s, + -- ^ Logic function. + gDrawFunction :: GEnv -> s -> Plane, + -- ^ Draw function. + gQuitFunction :: s -> Bool + -- ^ “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 :: forall s. + (Width, Height) -- ^ Gamescreen dimensions, in columns and + -- rows. Asks the player to resize their + -- terminal if it is too small. + -> 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!" + + -- | Entry point for the game execution, should be called in @main@. -- -- You __must__ compile your programs with @-threaded@; if you do not do @@ -93,23 +149,23 @@ runGameGeneral :: forall s m. MonadGameIO m => Game s -> m s -runGameGeneral (Game gw gh tps s lf df qf) = +runGameGeneral (Game tps s lf df qf) = -- init - sizeException gw gh >> - setupDisplay >> - startEvents tps >>= \(InputHandle ve ts) -> + setupDisplay >> + startEvents tps >>= \(InputHandle ve ts) -> + displaySizeErr >>= \ds -> -- do it! let c = Config ve tps in - cleanUpErr (game c) + cleanUpErr (game c ds) -- this under will be run regardless (stopEvents ts >> shutdownDisplay ) where - game :: MonadGameIO m => Config -> m s - game c = gameLoop gw gh c - s lf df qf - Nothing (0,0) + game :: MonadGameIO m => Config -> Dimensions -> m s + game c wds = gameLoop c s lf df qf + Nothing wds + (creaFPSCalc tps) -- | Wraps an @IO@ computation so that any 'ATGException' or 'error' gets @@ -128,8 +184,7 @@ putStrLn l atgDisplay :: ATGException -> IO a - atgDisplay e = report $ - putStrLn (show e) + atgDisplay e = report $ print e report :: IO () -> IO a report wm = @@ -147,17 +202,18 @@ -- from http://www.loomsoft.net/resources/alltut/alltut_lesson6.htm gameLoop :: MonadGameIO m => - Width -> -- gamewidth - Height -> -- gameheight Config -> -- event source s -> -- state - (s -> Event -> s) -> -- logic function - (s -> Plane) -> -- draw function + (GEnv -> + s -> Event -> s) -> -- logic function + (GEnv -> + s -> Plane) -> -- draw function (s -> Bool) -> -- quit? function Maybe Plane -> -- last blitted screen - (Width, Height) -> -- Term Dimensions + Dimensions -> -- Term dimensions + FPSCalc -> -- calculate fps m s -gameLoop gw gh c s lf df qf opln td = +gameLoop c s lf df qf opln td fps = -- quit? checkQuit qf s >>= \qb -> @@ -167,45 +223,78 @@ -- fetch events (if any) pollEvents (cMEvents c) >>= \es -> - -- xxx test poll events si rompe se lo sposto su -- no events? skip everything if null es then sleepABit (cTPS c) >> - gameLoop gw gh c s lf df qf opln td - -- xxx reader monad qui + gameLoop c s lf df qf opln td fps else + displaySizeErr >>= \td' -> + -- logic - let s' = stepsLogic s lf es in + let ge = GEnv td' (calcFPS fps) + (i, s') = stepsLogic s (lf ge) es in - -- clear screen if resolution change - displaySizeErr >>= \td'@(tw, th) -> + -- 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 + else + + -- FPS calc + let fps' = addFPS i fps in + + -- clear screen if resolution changed let resc = td /= td' in CM.when resc clearDisplay >> -- draw - -- xxx solo se è tick e non kpress? [loop] let opln' | resc = Nothing -- res changed? restart double buffering | otherwise = opln - gpl = blankPlane gw gh - npln = pastePlane (df s') gpl (1, 1) in - blitPlane tw th opln' npln >> + npln = df ge s' in - gameLoop gw gh c s' lf df qf (Just npln) td' + blitPlane opln' npln >> + gameLoop c s' lf df qf (Just npln) td' fps' -stepsLogic :: s -> (s -> Event -> s) -> [Event] -> s -stepsLogic s lf es = foldl lf s es +-- Int = number of `Tick` events +stepsLogic :: s -> (s -> Event -> s) -> [Event] -> (Integer, s) +stepsLogic s lf es = let ies = D.genericLength . filter isTick $ es + in (ies, foldl lf s es) + where + isTick Tick = True + isTick _ = False +------------------------------------------------------------------------------- +-- Frame per Seconds ------------------ --- ANCILLARIES -- ------------------ +-- | 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. +type FPS = Integer -sizeException :: (MonadDisplay m, MonadException m) => Width -> Height -> m () -sizeException gw gh = - displaySizeErr >>= \(sw, sh) -> - CM.when (gw > sw || gh > sh) - (throwExc $ DisplayTooSmall (gw, gh) (sw, sh)) +data FPSCalc = FPSCalc [Integer] TPS + -- list with number of `Ticks` processed at each blit and expected + -- FPS (i.e. TPS) +-- the size of moving average will be TPS (that simplifies calculations) +creaFPSCalc :: TPS -> FPSCalc +creaFPSCalc tps = FPSCalc (D.genericReplicate (tps*1) 1) tps + -- tps*1: size of thw window in **blit actions** (not tick actions!) + -- so keeping it small should be responsive and non flickery + -- at the same time! + +-- add ticks +addFPS :: Integer -> FPSCalc -> FPSCalc +addFPS nt (FPSCalc (_:fps) tps) = FPSCalc (fps ++ [nt]) tps +addFPS _ (FPSCalc [] _) = error "addFPS: empty list." + +calcFPS :: FPSCalc -> Integer +calcFPS (FPSCalc fps tps) = + let ts = sum fps + ds = D.genericLength fps + in roundQuot (tps * ds) ts + where + roundQuot :: Integer -> Integer -> Integer + roundQuot a b = let (q, r) = quotRem a b + in q + B.bool 0 1 (r > div b 2) diff --git a/src/Terminal/Game/Layer/Object.hs b/src/Terminal/Game/Layer/Object.hs --- a/src/Terminal/Game/Layer/Object.hs +++ b/src/Terminal/Game/Layer/Object.hs @@ -27,8 +27,3 @@ -- they'll just touch the classes from interface which behaviour they -- will modify; being more specific, they will be chosen instead of plain -- IO. - --- xxx cambia questa descrizione - --- xxx resize term to be smaller and see characters broken [ibispi] - 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 @@ -76,9 +76,9 @@ addTick mr ve tps el = -- precise timing. With `treadDelay`, on finer TPS, -- ticks take too much (check threadDelay doc). - getTimeTick tps >>= \t -> - CM.replicateM (fromIntegral $ t-el) - (addEvent mr ve Tick) >> + getTimeTick tps >>= \t -> + CM.replicateM_ (fromIntegral $ t-el) + (addEvent mr ve Tick) >> -- sleep some sleepABit tps >> @@ -139,10 +139,10 @@ setupDisplay = T.liftIO initPart clearDisplay = T.liftIO clearScreen displaySize = T.liftIO displaySizeIO - blitPlane w h mp p = T.liftIO (blitPlaneIO w h mp p) + blitPlane mp p = T.liftIO (blitPlaneIO mp p) shutdownDisplay = T.liftIO cleanAndExit -displaySizeIO :: IO (Maybe (Width, Height)) +displaySizeIO :: IO (Maybe Dimensions) displaySizeIO = TS.size >>= \ts -> -- cannot use ansi-terminal, on Windows you get @@ -151,18 +151,22 @@ return (fmap (f bw) ts) where - f :: Bool -> TS.Window Int -> (Width, Height) + f :: Bool -> TS.Window Int -> Dimensions f wbw (TS.Window h w) = let h' | wbw = h - 1 | otherwise = h in (w, h') --- th tw: terminal width and height -- pn: new plane, po: old plane -- wo, ho: dimensions of the terminal. If they change, reinit double buffering -blitPlaneIO :: Width -> Height -> Maybe Plane -> Plane -> IO () -blitPlaneIO tw th mpo pn = +blitPlaneIO :: Maybe Plane -> Plane -> IO () +blitPlaneIO mpo pn = + -- remember that Nothing will be passed: + -- - at the beginning of the game (first blit) + -- - when resolution changes (see gameLoop) + -- so do not duplicate hasResChanged checks here! + -- old plane let (pw, ph) = planeSize pn @@ -179,7 +183,7 @@ -- (error 87 on Win32 console). CA.setSGR [CA.Reset] >> - blitMap po pn' tw th + blitMap po pn' ----------------- @@ -223,21 +227,14 @@ CA.setCursorPosition 0 0 >> CA.showCursor --- plane + term w/h -blitMap :: Plane -> Plane -> Width -> Height -> IO () -blitMap po pn tw th = +-- plane +blitMap :: Plane -> Plane -> IO () +blitMap po pn = CM.when (planeSize po /= planeSize pn) (error "blitMap: different plane sizes") >> - CA.setCursorPosition (fi cr) (fi cc) >> + CA.setCursorPosition 0 0 >> -- setCursorPosition is *zero* based! - blitToTerminal (cr, cc) (orderedCells po) (orderedCells pn) - where - (pw, ph) = planeSize pn - - cr = div (th - ph) 2 - cc = div (tw - pw) 2 - - fi = fromIntegral + blitToTerminal (0, 0) (orderedCells po) (orderedCells pn) orderedCells :: Plane -> [[Cell]] orderedCells p = LS.chunksOf (fromIntegral w) cells diff --git a/src/Terminal/Game/Layer/Object/Interface.hs b/src/Terminal/Game/Layer/Object/Interface.hs --- a/src/Terminal/Game/Layer/Object/Interface.hs +++ b/src/Terminal/Game/Layer/Object/Interface.hs @@ -77,17 +77,9 @@ -- | @ATGException@s are thrown synchronously for easier catching. data ATGException = CannotGetDisplaySize - | DisplayTooSmall Coords Coords -- ^ Required size and actual size. instance Show ATGException where show CannotGetDisplaySize = "Cannot get display size!" - show (DisplayTooSmall (gw, gh) (sw, sh)) = - "This games requires a screen of " ++ show gw ++ - " columns and " ++ show gh ++ " rows.\n" ++ - "Yours only has " ++ show sw ++ " columns and " ++ - show sh ++ " rows!\n\n" ++ - "Please resize your terminal and relaunch " ++ - "the game!\n" instance MC.Exception ATGException @@ -108,15 +100,15 @@ class Monad m => MonadDisplay m where setupDisplay :: m () clearDisplay :: m () - displaySize :: m (Maybe (Width, Height)) - blitPlane :: Width -> Height -> Maybe Plane -> Plane -> m () + displaySize :: m (Maybe Dimensions) + blitPlane :: Maybe Plane -> Plane -> m () shutdownDisplay :: m () ----------- -- Utils -- ----------- -displaySizeErr :: (MonadDisplay m, MonadException m) => m (Width, Height) +displaySizeErr :: (MonadDisplay m, MonadException m) => m Dimensions displaySizeErr = displaySize >>= \case Nothing -> throwExc CannotGetDisplaySize Just d -> return d 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 @@ -80,6 +80,6 @@ clearDisplay = return () displaySize = return $ Just (8000, 2400) -- xxx no display size but check display size - blitPlane _ _ _ _ = return () + blitPlane _ _ = return () shutdownDisplay = () <$ S.tell [TShutdownDisplay] 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 @@ -27,6 +27,9 @@ type Row = Int type Column = Int +-- | Size of a surface. +type Dimensions = (Width, Height) + -- | Expressed in 'Column's. type Width = Int -- | Expressed in 'Row's. @@ -133,16 +136,12 @@ err p1 p2 = error ("subPlane: top-left point " ++ show p1 ++ " > bottom-right point " ++ show p2 ++ ".") --- xxx crea modulo primitive in cui fai pastrocci ed esponi solo poche --- funzioni di base da quello [refactor] - - ------------- -- INQUIRE -- ------------- -- | Dimensions or a plane. -planeSize :: Plane -> (Width, Height) +planeSize :: Plane -> Dimensions planeSize p = T.swap . snd $ A.bounds (fromPlane p) cellChar :: Cell -> Char 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 = Game 10 10 nd s lf nd qf + g = simpleGame (10, 10) nd s lf nd qf describe "runGame" $ do it "does not confuse input and logic" $