ansi-terminal-game 1.3.0.0 → 1.4.0.0

raw patch · 11 files changed

+165/−45 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES +19/−2
• ansi-terminal-game.cabal +1/−1
• example/Alone.hs +1/−1
• src/Terminal/Game.hs +26/−3
• src/Terminal/Game/Draw.hs +41/−3
• src/Terminal/Game/Layer/Imperative.hs +7/−7
• src/Terminal/Game/Layer/Object/IO.hs +31/−15
• src/Terminal/Game/Layer/Object/Interface.hs +8/−4
• src/Terminal/Game/Layer/Object/Narrate.hs +7/−7
• src/Terminal/Game/Layer/Object/Record.hs +2/−2
• test/Terminal/Game/DrawSpec.hs +22/−0

@@ -1,3 +1,18 @@+1.4.0.0+-------++- Fixed an annoying bug that made a game run slower than expected on+  low TPS. Now if you select 5 ticks per second, you can rest assured+  that after 50 ticks, 5 seconds have elapsed.+- Renamed `FPS` to `TPS` (ticks per second); highlight logic speed is+  constant timewise on all machines, while FPS might be different on+  differently efficient terminals.+  This will allow in future releases to provide a function to easily+  calculate actual FPS of the game.+- Added alternative origin combinators `%^>`, `%.<`, `%.>`; they are+  useful when you want to — e.g. — «paste a plane one row from+  bottom-right corner».+ 1.3.0.0 ------- @@ -19,10 +34,11 @@  - Added textBoxHyphen and textBoxHyphenLiquid and a handful of `Hypenator`s.   This will allow you to have autohyphenation in textboxes. Compare:+    (normal textbox)                       (hyphenated textbox)     Rimasi un po’ a meditare nel buio      Rimasi un po’ a meditare nel buio     velato appena dal barlume azzurrino    velato appena dal barlume azzurrino-    del fornello a gas, su cui sobbol-     del fornello a gas, su cui-    liva quieta la pentola.                sobbolliva quieta la pentola.+    del fornello a gas, su cui             del fornello a gas, su cui sobbol-+    sobbollliva quieta la pentola.         liva quieta la pentola. - Switched `Width`, `Height`, `Row`, `Col` from `Integer` to `Int`.   This is unfortunate, but will make playing with `base` simpler. I will   switch it back once `Prelude` handles both integers appropriately@@ -32,6 +48,7 @@     textBoxLiquid :: String -> Width -> Plane  -- this was before     textBoxLiquid :: Width -> String -> Plane  -- this is now   This felt more ergonomic while writing games.+- `paperPlane` is now `planePaper` (to respect SVO order)  1.1.1.0 -------

@@ -1,5 +1,5 @@ name:                ansi-terminal-game-version:             1.3.0.0+version:             1.4.0.0 synopsis:            sdl-like functions for terminal applications, based on                      ansi-terminal description:         Library which aims to replicate standard 2d game

@@ -11,7 +11,7 @@ aloneInARoom =     Game { gScreenWidth  = gw,            gScreenHeight = gh,-           gFPS          = 13,+           gTPS          = 13,             gInitState     = MyState (10, 10) Stop False,            gLogicFunction = logicFun,

@@ -42,7 +42,7 @@   module Terminal.Game ( -- * Running-                       FPS,+                       TPS,                        Event(..),                        Game(..),                        playGame,@@ -108,6 +108,10 @@                        Color(..), ColorIntensity(..),                        color, bold, invert, +                       -- *** Alternative origins+                       -- $origins+                       (%^>), (%.<), (%.>),+                        -- *** Text boxes                        textBox, textBoxLiquid,                        textBoxHyphen, textBoxHyphenLiquid,@@ -134,7 +138,7 @@                        ATGException(..)                         -- * Cross platform-                       -- $threaded+                       -- $xcompat                      )     where @@ -147,7 +151,26 @@ import Terminal.Game.Random import Text.LineBreak --- $threaded+-- $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 '%'+-- — allow you to do so. Example:+--+-- @+-- prova :: Plane+-- prova = let rect = box 6 3  \'.\'+--             letters = word "ab"+--         in            rect &+--            (1, 1) %.> letters         -- start from bottom-right+--+--     -- λ> putStr (planePaper prova)+--     -- ......+--     -- ......+--     -- ....ab+-- @++-- $xcompat -- Good practices for cross-compatibility: -- -- * choose game dimensions of no more than __24 rows__ and __80 columns__.

@@ -163,13 +163,14 @@ -- | As 'textBox', but hypenated. Example: -- -- @+-- (normal textbox)                        (hyphenated textbox) -- Rimasi un po’ a meditare nel buio       Rimasi un po’ a meditare nel buio -- velato appena dal barlume azzurrino     velato appena dal barlume azzurrino--- del fornello a gas, su cui sobbol-      del fornello a gas, su cui--- liva quieta la pentola.                 sobbolliva quieta la pentola.+-- del fornello a gas, su cui              del fornello a gas, su cui sobbol-+-- sobbolliva quieta la pentola.           liva quieta la pentola. -- @ ----- Notice how in the left 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)@@ -193,6 +194,43 @@            out         = seqCellsDim w h (f hcs)           transparent = makeTransparent ' ' out+++----------------------------+-- ADDITIONAL COMBINATORS --+----------------------------++-- Coords as if origin were @ bottom-right+recipCoords :: Coords -> Plane -> Plane -> Coords+recipCoords (r, c) p p1 =+            let (pw, ph) = planeSize p+                (p1w, p1h) = planeSize p1+                r' = ph-p1h-r+2+                c' = pw-p1w-c+2+            in (r', c')++-- | Pastes a plane onto another (origin: top-right).+(%^>) :: Coords -> Plane -> Draw+(r, c) %^> p1 = \p ->+            let (_, c') = recipCoords (r, c) p p1+            in p F.& (r, c') % p1++-- | Pastes a plane onto another (origin: bottom-left).+(%.<) :: Coords -> Plane -> Draw+(r, c) %.< p1 = \p ->+            let (r', _) = recipCoords (r, c) p p1+            in p F.& (r', c) % p1++-- | Pastes a plane onto another (origin: bottom-right).+(%.>) :: Coords -> Plane -> Draw+cs %.> p1 = \p ->+            let (r', c') = recipCoords cs p p1+            in p F.& (r', c') % p1++infixl 4 %^>+infixl 4 %.<+infixl 4 %.>+  ----------------- -- ANCILLARIES --

@@ -27,10 +27,10 @@ data Game s = Game {         gScreenWidth   :: Width,           -- ^Gamescreen width, in columns.         gScreenHeight  :: Height,          -- ^Gamescreen height, in rows.-        gFPS           :: FPS,             -- ^Frames per second. Since the+        gTPS           :: TPS,             -- ^Ticks per second. Since the                                            -- 2D «char canvas» is coarse, you                                            -- do not need a high value (e.g.-                                           -- 13 FPS is enough for action+                                           -- 13 TPS is enough for action                                            -- games).         gInitState     :: s,               -- ^Initial state of the game.         gLogicFunction :: s -> Event -> s, -- ^Logic function.@@ -89,18 +89,18 @@           (\ve -> () <$ runRecord (runGameGeneral g) ve)  data Config = Config { cMEvents :: CC.MVar [Event],-                       cFPS     :: FPS              }+                       cTPS     :: TPS              }  runGameGeneral :: forall s m. MonadGameIO m =>                   Game s -> m s-runGameGeneral (Game gw gh fps s lf df qf) =+runGameGeneral (Game gw gh tps s lf df qf) =             -- init             sizeException gw gh >>             setupDisplay     >>-            startEvents fps  >>= \(InputHandle ve ts) ->+            startEvents tps  >>= \(InputHandle ve ts) ->              -- do it!-            let c = Config ve fps in+            let c = Config ve tps in             cleanUpErr (game c)                             -- this under will be run regardless                        (stopEvents ts >>@@ -171,7 +171,7 @@          -- no events? skip everything         if null es-          then sleepABit (cFPS c)               >>+          then sleepABit (cTPS c)               >>                gameLoop gw gh c s lf df qf opln td                -- xxx reader monad qui         else

@@ -34,14 +34,14 @@ ----------------  instance {-# OVERLAPS #-} (Monad m, T.MonadIO m) => MonadInput m where-    startEvents fps = T.liftIO $ startIOInput Nothing fps+    startEvents tps = T.liftIO $ startIOInput Nothing tps     pollEvents ve = T.liftIO $ CC.swapMVar ve []     stopEvents ts = T.liftIO $ stopEventsIO ts  -- xxx astrai da qui? -- filepath = logging-startIOInput :: Maybe (CC.MVar [Event]) -> FPS -> IO InputHandle-startIOInput mr fps =+startIOInput :: Maybe (CC.MVar [Event]) -> TPS -> IO InputHandle+startIOInput mr tps =             -- non buffered input             SI.hSetBuffering SI.stdin SI.NoBuffering  >>             SI.hSetBuffering SI.stdout SI.NoBuffering >>@@ -54,20 +54,36 @@             -- event and log variables             CC.newMVar [] >>= \ve -> -            CC.forkIO (addTick mr ve fps) >>= \te ->-            CC.forkIO (addKeypress mr ve) >>= \tk ->+            getTimeTick tps                  >>= \it ->+            CC.forkIO (addTick mr ve tps it) >>= \te ->+            CC.forkIO (addKeypress mr ve)    >>= \tk ->             return (InputHandle ve [te, tk]) --- modifica il timer+-- a precise timer, not based on `threadDelay`+type Elapsed = Integer -- in `Ticks`++-- elapsed from Epoch in ticks+getTimeTick :: TPS -> IO Elapsed+getTimeTick tps =+        getTime >>= \tm ->+        let ns = 10 ^ (9 :: Integer)+            t1 = quot ns tps in+        return (quot tm t1)+ -- mr: maybe recording-addTick :: Maybe (CC.MVar [Event]) -> CC.MVar [Event] -> FPS -> IO ()-addTick mr ve fps = addEvent mr ve Tick        >>-                    CC.threadDelay delayAmount >>-                    addTick mr ve fps-    where-          delayAmount :: Int-          delayAmount = fromIntegral $ quot oneTickSec fps+addTick :: Maybe (CC.MVar [Event]) -> CC.MVar [Event] ->+           TPS -> Elapsed -> IO ()+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) >> +                -- sleep some+                sleepABit tps >>+                addTick mr ve tps t+ -- get action char -- mr: maybe recording addKeypress :: Maybe (CC.MVar [Event]) -> CC.MVar [Event] -> IO ()@@ -92,8 +108,8 @@  instance {-# OVERLAPS #-} (Monad m, T.MonadIO m) => MonadTimer m where     getTime = T.liftIO $ SC.toNanoSecs <$> SC.getTime SC.Monotonic-    sleepABit fps = T.liftIO $-        CC.threadDelay (fromIntegral $ quot oneTickSec (fps*10))+    sleepABit tps = T.liftIO $+        CC.threadDelay (fromIntegral $ quot oneTickSec (tps*10))  -------------------- -- Error handling --

@@ -30,8 +30,11 @@ -- Game input -- ---------------- --- | Frames per second.-type FPS = Integer+-- | The number of 'Tick's fed each second to the logic function;+-- constant on every machine. /Frames/ per second might be lower+-- (depending on drawing function onerousness, terminal refresh rate,+-- etc.).+type TPS = Integer  -- | An @Event@ is a 'Tick' (time passes) or a 'KeyPress'. data Event = Tick@@ -49,7 +52,7 @@               ihOpenThreds :: [CC.ThreadId] }  class Monad m => MonadInput m where-    startEvents :: FPS -> m InputHandle+    startEvents :: TPS -> m InputHandle     pollEvents  :: CC.MVar [Event] -> m [Event]     stopEvents :: [CC.ThreadId] -> m () @@ -59,7 +62,8 @@  class Monad m => MonadTimer m where     getTime :: m Integer     -- to nanoseconds-    sleepABit :: FPS -> m () -- useful not to hammer cpu while polling+    sleepABit :: TPS -> m () -- Given TPS, sleep a fracion of a single+                             -- Tick.  -------------------- -- Error handling --

@@ -53,8 +53,8 @@  -- xxx astrai da qui? -- filepath = logging-startNarrate :: [Event] -> FPS -> IO InputHandle-startNarrate env fps =+startNarrate :: [Event] -> TPS -> IO InputHandle+startNarrate env tps =                     -- non buffered input                    SI.hSetBuffering SI.stdin SI.NoBuffering  >>@@ -63,18 +63,18 @@                    -- xxx astrai this                     CC.newMVar []                 >>= \ve ->-                   CC.forkIO (addEnv ve env fps) >>= \te ->+                   CC.forkIO (addEnv ve env tps) >>= \te ->                    return (InputHandle ve [te]) -addEnv :: CC.MVar [Event] -> [Event] -> FPS -> IO ()+addEnv :: CC.MVar [Event] -> [Event] -> TPS -> IO () addEnv _  []     _   = error "fine"                         -- xxx occhio qui, error or throwIO? Which message?-addEnv ve (e:es) fps = addEvent Nothing ve e >>+addEnv ve (e:es) tps = addEvent Nothing ve e >>                        CM.when (e == Tick)                             (CC.threadDelay delayAmount) >>-                       addEnv ve es fps+                       addEnv ve es tps     where           delayAmount :: Int-          delayAmount = fromIntegral $ quot oneTickSec fps+          delayAmount = fromIntegral $ quot oneTickSec tps  

@@ -26,9 +26,9 @@ runRecord (Record r) me = R.runReaderT r me  instance MonadInput Record where-    startEvents fps = Record $+    startEvents tps = Record $                         R.ask >>= \ve ->-                        T.liftIO $ startIOInput (Just ve) fps+                        T.liftIO $ startIOInput (Just ve) tps     pollEvents ve = T.liftIO $ CC.swapMVar ve []     stopEvents ts = T.liftIO $ stopEventsIO ts         -- xxx questi puoi fare dispatch tramite TC?

@@ -44,3 +44,25 @@         c  = stringPlane ".\n*\n.\n"     it "blits b in the centre of a" $       a *** b `shouldBe` c++  -- combinators++  let sp = stringPlane "ab"+      bp = blankPlane 4 3++  describe "%^>" $ do+    it "blits in the top right corner" $+      planePaper (bp & (1,1) %^> sp) `shouldBe` "  ab\n    \n    \n"++  describe "%_<" $ do+    it "blits in the bottom left corner" $+      planePaper (bp & (2,1) %.< sp) `shouldBe` "    \nab  \n    \n"++  describe "%_<" $ do+    it "blits in the bottom left corner" $+      planePaper (bp & (2,3) %.> sp) `shouldBe` "    \nab  \n    \n"++  describe "%" $ do+    it "mixes with alternative combinators" $+      planePaper (bp & (1,2) % sp & (2,3) %.> sp) `shouldBe`+        " ab \nab  \n    \n"