ansi-terminal-game 1.2.1.0 → 1.3.0.0

raw patch · 9 files changed

+96/−57 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES +9/−0
• ansi-terminal-game.cabal +4/−4
• example/Main.hs +1/−1
• src/Terminal/Game.hs +4/−3
• src/Terminal/Game/Layer/Imperative.hs +26/−34
• src/Terminal/Game/Layer/Object/IO.hs +13/−9
• src/Terminal/Game/Layer/Object/Interface.hs +31/−1
• src/Terminal/Game/Layer/Object/Narrate.hs +2/−2
• src/Terminal/Game/Layer/Object/Test.hs +6/−3

@@ -1,3 +1,12 @@+1.3.0.0+-------++- `displaySize` and `playGame`/`playGameS` now throw an exception+  (of type `ATGException`) instead of `error`ing. These exeptions are+  `CannotGetDisplaySize` and `DisplayTooSmall`; they are synchronous,+  for easier catching. (requested by sm)+- Released sab 16 ott 2021, 21:09:22+ 1.2.1.0 ------- 

@@ -1,5 +1,5 @@ name:                ansi-terminal-game-version:             1.2.1.0+version:             1.3.0.0 synopsis:            sdl-like functions for terminal applications, based on                      ansi-terminal description:         Library which aims to replicate standard 2d game@@ -34,6 +34,8 @@ library   exposed-modules:     Terminal.Game   other-modules:       Terminal.Game.Animation,+                       Terminal.Game.Character,+                       Terminal.Game.Draw,                        Terminal.Game.Layer.Imperative,                        Terminal.Game.Layer.Object,                        Terminal.Game.Layer.Object.GameIO,@@ -42,8 +44,6 @@                        Terminal.Game.Layer.Object.Narrate,                        Terminal.Game.Layer.Object.Record,                        Terminal.Game.Layer.Object.Test,-                       Terminal.Game.Character,-                       Terminal.Game.Draw,                        Terminal.Game.Utils,                        Terminal.Game.Plane,                        Terminal.Game.Random,@@ -94,8 +94,8 @@                        Terminal.Game.Layer.Object.Test,                        Terminal.Game.Utils,                        Terminal.Game.Plane,-                       Terminal.Game.Random,                        Terminal.Game.PlaneSpec+                       Terminal.Game.Random   build-depends:       base == 4.*,                        ansi-terminal == 0.11.*,                        array == 0.5.*,

@@ -9,6 +9,6 @@ -- run with: cabal new-run -f examples alone  main :: IO ()-main = playGame aloneInARoom+main = errorPress $ playGame aloneInARoom  

@@ -130,7 +130,8 @@                         -- * Utility                        Terminal.Game.displaySize,-                       errorPress+                       errorPress,+                       ATGException(..)                         -- * Cross platform                        -- $threaded@@ -167,6 +168,6 @@ --   difference.  -- | /Usable/ terminal display size (on Win32 console the last line is--- set aside for input).+-- set aside for input). Throws 'CannotGetDisplaySize' on error. displaySize :: IO (Width, Height)-displaySize = O.displaySize+displaySize = O.displaySizeErr

@@ -47,7 +47,10 @@ -- ghc-options:      -threaded -- @ -----   in your @.cabal@ file and you will be fine!+-- in your @.cabal@ file and you will be fine!+--+-- Throws 'DisplayTooSmall' if game widht/height cannot be accomodated+-- by terminal. playGame :: Game s -> IO () playGame g = () <$ runGIO (runGameGeneral g) @@ -75,17 +78,8 @@ 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'.--- recordGame :: Game s -> FilePath -> IO s--- recordGame g fp =---         CC.newMVar []                   >>= \ve ->---         runRecord (runGameGeneral g) ve >>= \s ->---         writeMoves fp ve                >>---         return s- -- | Play as in 'playGame' and write the session to @file@. Useful to--- produce input for 'testGame' and 'replayGame'. Session will be+-- produce input for 'testGame' and 'narrateGame'. Session will be -- recorded even if an exception happens while playing. recordGame :: Game s -> FilePath -> IO () recordGame g fp =@@ -101,7 +95,7 @@                   Game s -> m s runGameGeneral (Game gw gh fps s lf df qf) =             -- init-            sizeAssert gw gh >>+            sizeException gw gh >>             setupDisplay     >>             startEvents fps  >>= \(InputHandle ve ts) -> @@ -118,22 +112,30 @@                             Nothing (0,0)  --- | Wraps an @IO@ computation so that any 'error' gets displayed along--- with a @\<press any key to quit\>@ prompt.+-- | Wraps an @IO@ computation so that any 'ATGException' or 'error' gets+-- displayed along with a @\<press any key to quit\>@ prompt. -- Some terminals shut-down immediately upon program end; adding -- @errorPress@ to 'playGame' makes it easier to beta-test games on those -- terminals. errorPress :: IO a -> IO a-errorPress m = E.catch m errorDisplay+errorPress m = E.catches m [E.Handler errorDisplay,+                            E.Handler atgDisplay]     where           errorDisplay :: E.ErrorCall -> IO a-          errorDisplay (E.ErrorCallWithLocation cs l) =-              putStrLn "ERROR REPORT\n"      >>+          errorDisplay (E.ErrorCallWithLocation cs l) = report $               putStrLn (cs ++ "\n\n")        >>               putStrLn "Stack trace info:\n" >>-              putStrLn (l ++ "\n")           >>+              putStrLn l -              putStrLn "\n <Press any key to quit>"    >>+          atgDisplay :: ATGException -> IO a+          atgDisplay e = report $+              putStrLn (show e)++          report :: IO () -> IO a+          report wm =+              putStrLn "ERROR REPORT\n"                >>+              wm                                       >>+              putStrLn "\n\n <Press any key to quit>"  >>               SI.hSetBuffering SI.stdin SI.NoBuffering >>               getChar                                  >>               errorWithoutStackTrace "errorPress"@@ -178,7 +180,7 @@         let s' = stepsLogic s lf es in          -- clear screen if resolution change-        displaySize               >>= \td'@(tw, th) ->+        displaySizeErr            >>= \td'@(tw, th) ->         let resc = td /= td' in         CM.when resc clearDisplay >> @@ -201,19 +203,9 @@ -- ANCILLARIES -- ----------------- -sizeAssert :: MonadDisplay m => Width -> Height -> m ()-sizeAssert gw gh =-        displaySize >>= \(sw, sh) ->--        let errMess =-               "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"-        in-+sizeException :: (MonadDisplay m, MonadException m) => Width -> Height -> m ()+sizeException gw gh =+        displaySizeErr >>= \(sw, sh) ->         CM.when (gw > sw || gh > sh)-                (error errMess)+                (throwExc $ DisplayTooSmall (gw, gh) (sw, sh)) 

@@ -99,9 +99,11 @@ -- Error handling -- -------------------- -instance {-# OVERLAPS #-} (Monad m, T.MonadIO m, MC.MonadMask m) =>+instance {-# OVERLAPS #-}+        (Monad m, T.MonadIO m, MC.MonadMask m, MC.MonadThrow m) =>           MonadException m where     cleanUpErr m c = MC.finally m c+    throwExc t = MC.throwM t   -----------@@ -124,19 +126,21 @@     blitPlane w h mp p = T.liftIO (blitPlaneIO w h mp p)     shutdownDisplay = T.liftIO cleanAndExit -displaySizeIO :: IO (Width, Height)+displaySizeIO :: IO (Maybe (Width, Height)) displaySizeIO =         TS.size        >>= \ts ->             -- cannot use ansi-terminal, on Windows you get             -- "ConsoleException 87" (too much scrolling)         isWin32Console >>= \bw ->-        let (TS.Window h w) = maybe (error "cannot get TERM size") id ts-            h' | bw        = h - 1-               | otherwise = h-               -- win32 console has 1 less row available than displayes-               -- (it will scroll and make a mess otherwise)-        in return (w, h') +        return (fmap (f bw) ts)+    where+          f :: Bool -> TS.Window Int -> (Width, Height)+          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@@ -194,7 +198,7 @@ clearScreen :: IO () clearScreen = CA.setCursorPosition 0 0 >>               CA.setSGR [CA.Reset]     >>-              displaySizeIO            >>= \(w, h) ->+              displaySizeErr           >>= \(w, h) ->               CM.replicateM_ (fromIntegral $ w*h) (putChar ' ')  cleanAndExit :: IO ()

@@ -6,12 +6,14 @@  {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}  module Terminal.Game.Layer.Object.Interface where  import Terminal.Game.Plane  import qualified Control.Concurrent as CC+import qualified Control.Monad.Catch as MC import qualified Data.Serialize     as S import qualified GHC.Generics       as G import qualified Test.QuickCheck    as Q@@ -66,7 +68,26 @@ -- if a fails, do b (useful for cleaning up) class Monad m => MonadException m where     cleanUpErr :: m a -> m b -> m a+    throwExc :: ATGException -> m a +-- | @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++ ----------- -- Logic -- -----------@@ -83,7 +104,16 @@ class Monad m => MonadDisplay m where     setupDisplay :: m ()     clearDisplay :: m ()-    displaySize :: m (Width, Height) -- w, h+    displaySize :: m (Maybe (Width, Height))     blitPlane :: Width -> Height -> Maybe Plane -> Plane -> m ()     shutdownDisplay :: m ()++-----------+-- Utils --+-----------++displaySizeErr :: (MonadDisplay m, MonadException m) => m (Width, Height)+displaySizeErr = displaySize >>= \case+                   Nothing -> throwExc CannotGetDisplaySize+                   Just d -> return d 

@@ -31,7 +31,7 @@ readRecord :: FilePath -> IO [Event] readRecord fp = S.decode <$> BS.readFile fp >>= \case                   Left e  -> error $ "readRecord could not decode: " ++-                                    show e+                                     show e                   Right r -> return r  instance MonadInput Narrate where@@ -68,7 +68,7 @@  addEnv :: CC.MVar [Event] -> [Event] -> FPS -> IO () addEnv _  []     _   = error "fine"-                        -- xxx occhio qui+                        -- xxx occhio qui, error or throwIO? Which message? addEnv ve (e:es) fps = addEvent Nothing ve e >>                        CM.when (e == Tick)                             (CC.threadDelay delayAmount) >>

@@ -55,8 +55,7 @@     startEvents _ = S.tell [TStartEvents] >>                     return mockHandle     pollEvents _ = Test $ S.state (\s -> (s, []))-    stopEvents _ = S.tell [TStopEvents] >>-                   return ()+    stopEvents _ = S.tell [TStopEvents]  instance MonadTimer Test where     getTime = return 1@@ -64,6 +63,10 @@  instance MonadException Test where     cleanUpErr a _ = S.tell [TCleanUpError] >> a+    throwExc e = error . show $ e+            -- we shouldn’t need strict sequencing in testing+            -- xxx make it a list of TestEvent + the error+            -- (not Either Err a!)  instance MonadLogic Test where     -- if eof, quit@@ -75,7 +78,7 @@ instance MonadDisplay Test where     setupDisplay = () <$ S.tell [TSetupDisplay]     clearDisplay = return ()-    displaySize = return (110, 11110)+    displaySize = return $ Just (8000, 2400)         -- xxx no display size but check display size     blitPlane _ _ _ _ = return ()     shutdownDisplay = () <$ S.tell [TShutdownDisplay]