diff --git a/ansi-terminal-game.cabal b/ansi-terminal-game.cabal --- a/ansi-terminal-game.cabal +++ b/ansi-terminal-game.cabal @@ -1,25 +1,26 @@ name: ansi-terminal-game -version: 1.0.0.0 +version: 1.1.0.0 synopsis: sdl-like functions for terminal applications, based on ansi-terminal description: Library which aims to replicate standard 2d game functions (blit, ticks, timers, etc.) in a terminal - setting. + setting; features double buffering to optimise + performance. Aims to be cross compatible (based on "ansi-terminal", no unix-only dependencies), practical. See @examples@ folder for some minimal programs. A full game: . -homepage: none-yet +homepage: http://www.ariis.it/static/articles/ansi-terminal-game/page.html license: GPL-3 license-file: LICENSE author: Francesco Ariis maintainer: fa-ml@ariis.it -copyright: © 2017-2019 Francesco Ariis +copyright: © 2017-2020 Francesco Ariis category: Game build-type: Simple extra-source-files: README, changes.txt, - test/alone-recors-test.gr + test/alone-record-test.gr cabal-version: >=1.10 flag examples @@ -41,25 +42,27 @@ 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, Terminal.Game.Timer build-depends: base == 4.*, - ansi-terminal >= 0.8 && < 0.11, + ansi-terminal == 0.11.*, array == 0.5.*, - bytestring == 0.10.*, + bytestring >= 0.10 && < 0.12, cereal == 0.5.*, clock >= 0.7 && < 0.9, exceptions == 0.10.*, linebreak == 1.0.*, mintty == 0.1.*, mtl == 2.2.*, - QuickCheck == 2.13.*, - random >= 1.1 && < 1.2, + QuickCheck >= 2.13 && < 2.15, + random >= 1.1 && < 1.3, split == 0.2.*, terminal-size == 0.3.*, + unidecode >= 0.1.0 && < 0.2, timers-tick > 0.4.2 && < 0.5 hs-source-dirs: src default-language: Haskell2010 @@ -77,6 +80,7 @@ other-modules: Alone, Terminal.Game, Terminal.Game.Animation, + Terminal.Game.Character, Terminal.Game.Draw, Terminal.Game.DrawSpec, Terminal.Game.Layer.Imperative, @@ -93,18 +97,19 @@ Terminal.Game.Random, Terminal.Game.PlaneSpec build-depends: base == 4.*, - ansi-terminal >= 0.8 && < 0.11, + ansi-terminal == 0.11.*, array == 0.5.*, - bytestring == 0.10.*, + bytestring >= 0.10 && < 0.12, cereal == 0.5.*, clock >= 0.7 && < 0.9, exceptions == 0.10.*, linebreak == 1.0.*, mtl == 2.2.*, - QuickCheck == 2.13.*, - random >= 1.1 && < 1.2, + QuickCheck >= 2.13 && < 2.15, + random >= 1.1 && < 1.3, split == 0.2.*, terminal-size == 0.3.*, + unidecode >= 0.1.0 && < 0.2, timers-tick > 0.4.2 && < 0.5 -- the above plus hspec , hspec diff --git a/changes.txt b/changes.txt --- a/changes.txt +++ b/changes.txt @@ -1,3 +1,13 @@ +1.1.0.0 +------- + +- Added Plane justapoxition functions (===, |||, vcat, hcat). +- Added `word` and and `textBoxLiquid` drawing functions. +- Added `subPlane`, `displaySize` Plane functions. +- Removed unused `trimPlane`. +- Sanitized non-ASCII chars on Win32 console. +- Wed 03 Feb 2021 18:41:20 CET + 1.0.0.0 ------- diff --git a/platform-dep/windows/Terminal/Game/Utils.hs b/platform-dep/windows/Terminal/Game/Utils.hs --- a/platform-dep/windows/Terminal/Game/Utils.hs +++ b/platform-dep/windows/Terminal/Game/Utils.hs @@ -4,10 +4,10 @@ -------------------------------------------------------------------------------- {-# LANGUAGE ForeignFunctionInterface #-} --- see .cabal conditionals for more info - -- horrible horrible horrible hack to make unbuffered input -- work on Windows (and win32console check) +-- todo [windows] https://gitlab.haskell.org/ghc/ghc/-/issues/2189#note_290480 +-- e anche i caratteri module Terminal.Game.Utils (inputCharTerminal, isWin32Console ) @@ -20,7 +20,7 @@ inputCharTerminal :: IO Char inputCharTerminal = getCharWindows --- no idea but unsafe breaks it +-- no idea why, but unsafe breaks it getCharWindows :: IO Char getCharWindows = fmap (C.chr . fromEnum) c_getch foreign import ccall safe "conio.h getch" diff --git a/src/Terminal/Game.hs b/src/Terminal/Game.hs --- a/src/Terminal/Game.hs +++ b/src/Terminal/Game.hs @@ -18,10 +18,15 @@ -- 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 schermo piccolo, si centra verticalmente? [test] --- xxx timer in contrib o altro modulo? --- xxx qptain e jimreed, implement normal movement --- todo add readme +-- todo timer in contrib o altro modulo? +-- todo qptain e jimreed, implement normal movement +-- todo [design] javascript backend +-- todo controlla caratteri strani su windows, prova con morganw e ibispi +-- todo boxratio, blitcenter e blitTL etc in ansi-terminal-game? +-- todo autoresize terminal (or get-term-size?) module Terminal.Game ( -- * Running FPS, @@ -33,7 +38,7 @@ -- | Some convenient function dealing with -- Timers ('Timed') and 'Animation's. -- - -- Usage of these is not mandatry: 'Game' is + -- Usage of these is not mandatory: 'Game' is -- parametrised over any state @s@, you are free -- to implement game logic as you prefer. @@ -63,6 +68,10 @@ -- * Drawing -- | To get to the gist of drawing, check the -- documentation for '%'. + -- + -- Blitting on screen is double-buffered and diff'd + -- (at each frame, only cells with changed character + -- will be redrawn). -- ** Plane Plane, @@ -79,9 +88,11 @@ -- ** Draw Draw, - (%), (#), (&), + (%), (&), (#), + subPlane, mergePlanes, - cell, box, textBox, + (|||), (===), hcat, vcat, + cell, word, box, textBox, textBoxLiquid, Color(..), ColorIntensity(..), color, bold, invert, @@ -91,6 +102,10 @@ recordGame, readRecord, narrateGame, + playGameS, + + -- * Utility + Terminal.Game.displaySize, errorPress -- * Cross platform @@ -102,7 +117,7 @@ import Terminal.Game.Animation import Terminal.Game.Draw import Terminal.Game.Layer.Imperative -import Terminal.Game.Layer.Object +import Terminal.Game.Layer.Object as O import Terminal.Game.Plane import Terminal.Game.Random @@ -126,3 +141,7 @@ -- between vivid/dull; do not base your game mechanics on that -- difference. +-- | /Usable/ terminal display size (on Win32 console the last line is +-- set aside for input). +displaySize :: IO (Width, Height) +displaySize = O.displaySize diff --git a/src/Terminal/Game/Character.hs b/src/Terminal/Game/Character.hs new file mode 100644 --- /dev/null +++ b/src/Terminal/Game/Character.hs @@ -0,0 +1,47 @@ +module Terminal.Game.Character where + +import Data.Char as C +import Text.Unidecode as D +import System.IO.Unsafe as U + + +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 +-- console, with another appropriate chatacter. + +win32SafeChar :: Char -> Char +win32SafeChar c | areWeWin32 = toASCII c + | otherwise = c + where + areWeWin32 :: Bool + areWeWin32 = unsafePerformIO isWin32Console + +-- ANCILLARIES -- + +toASCII :: Char -> Char +toASCII c | C.isAscii c = c + | Just cm <- lu = cm -- hand-made substitution + | [cu] <- unidecode c = cu -- unidecode + | otherwise = '?' -- all else failing + where + lu = lookup c subDictionary + +subDictionary :: [(Char, Char)] +subDictionary = [ -- various open/close quotes + ('«', '<'), + ('»', '>'), + ('“', '\''), + ('”', '\''), + ('‘', '\''), + ('’', '\''), + + -- typographical marks + ('—', '-') ] + 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 @@ -70,7 +70,33 @@ addPlane :: Plane -> (Coords, Plane) -> Plane addPlane bp (cs, tp) = bp F.& cs % tp +-- | Place two 'Plane's side-by-side, horizontally. +(|||) :: Plane -> Plane -> Plane +(|||) a b = let (wa, ha) = planeSize a + (wb, hb) = planeSize b + in mergePlanes (blankPlane (wa + wb) (max ha hb)) + [((1,1), a), + ((1,wa+1), b)] +-- | Place two 'Plane's side-by-side, vertically. +(===) :: Plane -> Plane -> Plane +(===) a b = let (wa, ha) = planeSize a + (wb, hb) = planeSize b + in mergePlanes (blankPlane (max wa wb) (ha + hb)) + [((1,1), a), + ((ha+1,1), b)] + +-- | Place a list of 'Plane's side-by-side, horizontally. +hcat :: [Plane] -> Plane +hcat ps = L.foldl' (|||) (blankPlane 0 0) ps + +-- | Place a list of 'Plane's side-by-side, vertically. +vcat :: [Plane] -> Plane +vcat ps = L.foldl' (===) (blankPlane 0 0) ps + +infixl 6 |||, === + + ------------ -- STYLES -- ------------ @@ -103,20 +129,32 @@ cell :: Char -> Plane cell ch = box ch 1 1 +-- | @1xn@ 'Plane' with a word in it. If you need to import multiline +-- ASCII art, check 'stringPlane' and 'stringPlaneTrans'. +word :: String -> Plane +word w = seqCellsDim (L.genericLength w) 1 cells + where + cells = zip (zip (repeat 1) [1..]) w + -- opaque :: Plane -> Plane -- opaque p = pastePlane p (box ' ' White w h) (1, 1) -- where -- (w, h) = pSize p --- xxx li vogliamo davvero transparent? --- | A text-box. Assumes ' ' are transparent. +-- | A text-box. Assumes @' '@s are transparent. textBox :: String -> Width -> Height -> Plane -textBox cs w h = transparent +textBox cs w h = let pt = textBoxLiquid cs w + in blankPlane w h F.& (1, 1) % pt + +-- | Like 'textBox', but tall enough to fit @String@. +textBoxLiquid :: String -> Width -> Plane +textBoxLiquid cs w = transparent where -- hypenathion hyp = Nothing -- Just english_GB bf = BreakFormat (fromIntegral w) 4 '-' hyp - hcs = breakStringLn bf (take (fromIntegral $ w*h) cs) + hcs = breakStringLn bf cs + h = L.genericLength hcs f :: [String] -> [(Coords, Char)] f css = concatMap (uncurry rf) (zip [1..] css) 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 @@ -22,12 +22,16 @@ -- | 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 --- new-run -f examples alone@) to see a simple game in action. +-- 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 size, width. - gScreenHeight :: Height, -- ^Gamescreen size, height. - gFPS :: FPS, -- ^Frames per second. + gScreenWidth :: Width, -- ^Gamescreen width, in columns. + gScreenHeight :: Height, -- ^Gamescreen height, in rows. + gFPS :: FPS, -- ^Frames per second. Since the + -- 2D «char canvas» is coarse, you + -- do not need a high value (e.g. + -- 13 FPS is enough for action + -- games). gInitState :: s, -- ^Initial state of the game. gLogicFunction :: s -> Event -> s, -- ^Logic function. gDrawFunction :: s -> Plane, -- ^Draw function. @@ -47,6 +51,10 @@ playGame :: Game s -> IO () playGame g = () <$ runGIO (runGameGeneral g) +-- | As 'playGame', but do not discard state. +playGameS :: Game s -> IO s +playGameS g = runGIO (runGameGeneral g) + -- | 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 @@ -62,7 +70,7 @@ -- 'testGame', the playthrough will be displayed on screen. Useful when a -- test fails and you want to see how. -- --- See this in action with @cabal new-run -f examples alone-playback@. +-- 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 @@ -112,8 +120,9 @@ -- | Wraps an @IO@ computation so that any 'error' gets displayed along -- with a @\@ prompt. --- Some terminals shut-down immediately upon program end: 'errorPress' --- makes it easier to beta-test games on those terminals. +-- 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 where 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 @@ -9,6 +9,8 @@ module Terminal.Game.Plane where +import Terminal.Game.Character + import qualified Data.Array as A import qualified Data.List as L import qualified Data.List.Split as LS @@ -50,7 +52,9 @@ ---------- creaCell :: Char -> Cell -creaCell ch = CellChar ch False False Nothing +creaCell ch = CellChar chm False False Nothing + where + chm = win32SafeChar ch colorCell :: CA.Color -> CA.ColorIntensity -> Cell -> Cell colorCell k i (CellChar c b r _) = CellChar c b r (Just (k, i)) @@ -113,14 +117,26 @@ solid (_, Transparent) = False solid _ = True --- | Trims 'Plane' @p@ dimensions to @w@ and @h@, if needed. -trimPlane :: Plane -> Width -> Height -> Plane -trimPlane p wt ht = pastePlane p (blankPlane w h) (1, 1) +-- | Cut out a plane by top-left and bottom-right coordinates. +subPlane :: Plane -> Coords -> Coords -> Plane +subPlane p (r1, c1) (r2, c2) + | r1 > r2 || c1 > c2 = err (r1, c1) (r2, c2) + | otherwise = + let cs = assocsPlane p + fs = filter f cs + (pw, ph) = planeSize p + (w, h) = (min pw (c2-c1+1), min ph (r2-r1+1)) + in listPlane (h, w) (map snd fs) where - (wp, hp) = planeSize p + f ((rw, cw), _) = rw >= r1 && rw <= r2 && + cw >= c1 && cw <= c2 - w = min wt wp - h = min ht hp + 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 -- diff --git a/test/Terminal/Game/DrawSpec.hs b/test/Terminal/Game/DrawSpec.hs --- a/test/Terminal/Game/DrawSpec.hs +++ b/test/Terminal/Game/DrawSpec.hs @@ -16,3 +16,13 @@ mergePlanes (stringPlane "aaa\naaa\naaa") [((2,2), cell 'b')] `shouldBe` stringPlane "aaa\naba\naaa" + + describe "textBox/textBoxLiquid" $ do + let s = "las rana in Spa" + w = 6 + ps = textBox s w 2 + pl = textBoxLiquid s w + it "textBox follows specific size" $ + planeSize ps `shouldBe` (6, 2) + it "textBoxLiquid fits the whole string" $ + planeSize pl `shouldBe` (6, 3) 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 @@ -29,7 +29,7 @@ testGame g es `shouldBe` (3, True, 2) describe "testGame" $ do - r <- runIO $ readRecord "test/alone-recors-test.gr" + r <- runIO $ readRecord "test/alone-record-test.gr" it "tests a game" $ testGame aloneInARoom r `shouldBe` MyState (20, 66) Stop True it "does not hang on empty/unclosed input" $ diff --git a/test/Terminal/Game/PlaneSpec.hs b/test/Terminal/Game/PlaneSpec.hs --- a/test/Terminal/Game/PlaneSpec.hs +++ b/test/Terminal/Game/PlaneSpec.hs @@ -4,7 +4,9 @@ import Terminal.Game.Plane import Terminal.Game.Draw +import qualified Control.Exception as E + spec :: Spec spec = do @@ -22,14 +24,6 @@ it "pastes a simple plane onto another" $ pastePlane (cell 'a') (cell 'b') (1,1) `shouldBe` cell 'a' - describe "trimPlane" $ do - it "trims a plane" $ - trimPlane (stringPlane "ab\nc") 1 2 `shouldBe` stringPlane "a\nc" - it "leaves it untouched on bigger dimensions" $ - trimPlane (stringPlane "ab\nc") 1 3 `shouldBe` stringPlane "a\nc" - it "other dimesion too" $ - trimPlane (stringPlane "ab\nc") 8 9 `shouldBe` stringPlane "ab\nc" - describe "stringPlane" $ do it "creates plane from spec" $ stringPlane ".\n.." `shouldBe` testPlane @@ -44,3 +38,22 @@ it "updates a Plane" $ updatePlane ma [((1,1), creaCell 'x')] `shouldBe` mb + describe "subPlane" $ do + let pa = word "prova" === word "fol" + it "cuts out a plane" $ + paperPlane (subPlane pa (1, 1) (2, 1)) `shouldBe` "p\nf\n" + it "does not crash on OOB" $ + planeSize (subPlane pa (1, 1) (10, 10)) `shouldBe` (5, 2) + it "errs on emptycell" $ + E.evaluate (subPlane pa (2, 3) (1, 1)) `shouldThrow` + errorCall "subPlane: top-left point (2,3) > bottom-right point (1,1)." + it "but not on a single cell" $ + subPlane pa (2, 3) (2, 3) `shouldBe` cell 'l' + + describe "hcat/vcat" $ do + let pa = blankPlane 2 1 + pb = blankPlane 3 4 + it "concats planes horizontally with hcat" $ + planeSize (hcat [pa, pb]) `shouldBe` (5, 4) + it "concats planes horizontally with vcat" $ + planeSize (vcat [pa, pb]) `shouldBe` (3, 5) diff --git a/test/alone-record-test.gr b/test/alone-record-test.gr new file mode 100644 Binary files /dev/null and b/test/alone-record-test.gr differ diff --git a/test/alone-recors-test.gr b/test/alone-recors-test.gr deleted file mode 100644 Binary files a/test/alone-recors-test.gr and /dev/null differ