ansi-terminal-game 0.2.1.0 → 0.3.0.0
raw patch · 15 files changed
+783/−488 lines, 15 filesdep +mtldep ~arraydep ~linebreakPVP ok
version bump matches the API change (PVP)
Dependencies added: mtl
Dependency ranges changed: array, linebreak
API changes (from Hackage documentation)
- Terminal.Game: copyPlane :: Plane -> Coords -> Coords -> Plane
- Terminal.Game: decodeAni :: FilePath -> IO (Either String Animation)
- Terminal.Game: encodeAni :: FilePath -> Animation -> IO ()
- Terminal.Game: gameLoop :: String -> s -> (s -> Maybe Char -> IO s) -> (s -> Plane) -> (s -> Bool) -> Integer -> IO ()
- Terminal.Game: screenSize :: IO (Width, Height)
+ Terminal.Game: (#) :: Plane -> Draw -> Plane
+ Terminal.Game: KeyPress :: Char -> Event
+ Terminal.Game: Tick :: Event
+ Terminal.Game: bold :: Plane -> Plane
+ Terminal.Game: data Event
+ Terminal.Game: infixl 4 %
+ Terminal.Game: infixl 8 #
+ Terminal.Game: invert :: Plane -> Plane
+ Terminal.Game: mergePlanes :: Plane -> [(Coords, Plane)] -> Plane
+ Terminal.Game: runGame :: forall s m. MonadGameIO m => s -> (s -> Event -> s) -> (s -> Plane) -> (s -> Bool) -> FPS -> m s
+ Terminal.Game: stringPlaneTrans :: Char -> String -> Plane
+ Terminal.Game: type Column = Integer
+ Terminal.Game: type Draw = Plane -> Plane
+ Terminal.Game: type FPS = Integer
+ Terminal.Game: type MonadGameIO m = (MonadInput m, MonadTimer m, MonadDisplay m)
+ Terminal.Game: type Row = Integer
- Terminal.Game: data ExpBehaviour :: *
+ Terminal.Game: data ExpBehaviour
- Terminal.Game: data Loop :: *
+ Terminal.Game: data Loop
- Terminal.Game: data Timed a :: * -> *
+ Terminal.Game: data Timed a
- Terminal.Game: stringPlane :: Maybe Char -> Integer -> String -> Plane
+ Terminal.Game: stringPlane :: String -> Plane
Files
- ansi-terminal-game.cabal +58/−20
- example/Alone.hs +54/−34
- src/Terminal/Game.hs +39/−45
- src/Terminal/Game/ANSI.hs +0/−96
- src/Terminal/Game/Animation.hs +22/−22
- src/Terminal/Game/Draw.hs +62/−10
- src/Terminal/Game/GameLoop.hs +0/−193
- src/Terminal/Game/Layer/Imperative.hs +125/−0
- src/Terminal/Game/Layer/Object.hs +262/−0
- src/Terminal/Game/Layer/Object/Display.hs +19/−0
- src/Terminal/Game/Plane.hs +67/−57
- src/Terminal/Game/Utils.hs +0/−11
- test/Terminal/Game/DrawSpec.hs +15/−0
- test/Terminal/Game/Layer/ImperativeSpec.hs +22/−0
- test/Terminal/Game/PlaneSpec.hs +38/−0
ansi-terminal-game.cabal view
@@ -1,5 +1,5 @@ name: ansi-terminal-game-version: 0.2.1.0+version: 0.3.0.0 synopsis: sdl-like functions for terminal applications, based on ansi-terminal description: Library which aims to replicate standard 2d game@@ -7,15 +7,13 @@ setting. Aims to be cross compatible (based on "ansi-terminal", no unix-only dependencies), practical.- This is a proof of concept release, used to implement- @http://www.ariis.it/static/articles/animascii/page.html@- . See example folder for some minimal programs.+ See example folder for some minimal programs. homepage: none-yet license: GPL-3 license-file: LICENSE author: Francesco Ariis maintainer: fa-ml@ariis.it-copyright: © 2017-2018 Francesco Ariis+copyright: © 2017-2019 Francesco Ariis category: Game build-type: Simple extra-source-files: changes.txt@@ -27,14 +25,14 @@ library exposed-modules: Terminal.Game- other-modules: Terminal.Game.ANSI,- Terminal.Game.Plane,+ other-modules: Terminal.Game.Animation,+ Terminal.Game.Layer.Imperative,+ Terminal.Game.Layer.Object,+ Terminal.Game.Layer.Object.Display, Terminal.Game.Draw,- Terminal.Game.Animation, Terminal.Game.Input,- Terminal.Game.Timer,- Terminal.Game.GameLoop- Terminal.Game.Utils+ Terminal.Game.Plane,+ Terminal.Game.Timer build-depends: base == 4.*, ansi-terminal == 0.8.*, array == 0.5.*,@@ -42,11 +40,13 @@ cereal == 0.5.*, clock == 0.7.*, linebreak == 1.0.*,+ mtl == 2.2.*, split == 0.2.*, terminal-size == 0.3.*, timers-tick == 0.4.* hs-source-dirs: src default-language: Haskell2010+ ghc-options: -Wall -- horrible horrible horrible hack to make unbuffered input -- work on Windows@@ -57,16 +57,42 @@ test-suite test default-language: Haskell2010- ghc-options: -Wall- HS-Source-Dirs: test, src+ hs-Source-Dirs: test, src main-is: Test.hs- build-depends: base==4.*,- array,- linebreak+ other-modules: Terminal.Game,+ Terminal.Game.Animation,+ Terminal.Game.Draw,+ Terminal.Game.DrawSpec,+ Terminal.Game.Layer.Imperative,+ Terminal.Game.Layer.ImperativeSpec,+ Terminal.Game.Layer.Object,+ Terminal.Game.Layer.Object.Display,+ Terminal.Game.Input,+ Terminal.Game.Plane,+ Terminal.Game.PlaneSpec+ build-depends: base == 4.*,+ ansi-terminal == 0.8.*,+ array == 0.5.*,+ bytestring == 0.10.*,+ cereal == 0.5.*,+ clock == 0.7.*,+ linebreak == 1.0.*,+ mtl == 2.2.*,+ split == 0.2.*,+ terminal-size == 0.3.*,+ timers-tick == 0.4.* -- the above plus hspec , hspec type: exitcode-stdio-1.0+ ghc-options: -Wall + -- horrible horrible horrible hack to make unbuffered input+ -- work on Windows, part II+ if os(windows)+ hs-source-dirs: platform-dep/windows+ if !os(windows)+ hs-source-dirs: platform-dep/non-win+ executable alone-in-a-room if flag(example) build-depends: base == 4.*,@@ -77,9 +103,21 @@ hs-source-dirs: example main-is: Alone.hs default-language: Haskell2010- -- With the -threaded option, only foreign calls with the unsafe- -- attribute will block all other threads.- -- TODO [breaking] [severe] [u:3] senza threaded non compila sin windows- -- required on win before ghc 8.4?+ -- With the -threaded option, only foreign calls with the unsafe+ -- attribute will block all other threads. ghc-options: -threaded+ -- -O2 non rende le cose più veloci+ -- Senza threaded non compila su windows+ -- required on win before ghc 8.4?+ --+ -- geekosaur dice+ -- geekosaur f-a, a. heh. so the thoguht I had turned out to+ -- be correct:+ -- Control.Concurent.rtsSupportsBoundThreads (because+ -- green threads can't be usefully bound)+ -- geekosaur so if that produces True, it's using the+ -- threaded runtime; if False, you can say+ -- something useful instead of hanging +-- per time profiling+-- cabal new-run -f example alone-in-a-room --enable-profiling -- +RTS -p
example/Alone.hs view
@@ -1,40 +1,43 @@ module Main where --- alone in a room: a scary game--- vai a dormire--- scary room--- escape--- blink exit, blink enemies--- pit--- randomly generated import Terminal.Game main :: IO ()-main = gameLoop "Alone in a room"- (GameState (10, 10) Stop False)- logicFun- drawFun- (\gs -> gsQuit gs)- 5+main = do+ runGame (GameState (10, 10) Stop False)+ logicFun+ drawFun+ (\gs -> gsQuit gs)+ 10+ return ()+ -- xxx no () in iok0 --- STATE -- -data GameState = GameState { gsCoord :: (Integer, Integer),+-----------+-- TYPES --+-----------++data GameState = GameState { gsCoord :: Coords, gsMove :: Move, gsQuit :: Bool } data Move = N | S | E | W | Stop deriving (Show, Eq) -logicFun :: GameState -> Maybe Char -> IO GameState-logicFun gs (Just 'q') = return $ gs { gsQuit = True }-logicFun (GameState cs m b) Nothing =- return $ GameState (pos m cs) m b -- xxx duplicated code-logicFun (GameState cs m b) (Just c) =- let m' = move m c- in return $ GameState (pos m' cs) m' b+boundaries :: (Coords, Coords)+boundaries = ((1, 1), (25, 80)) ++-----------+-- LOGIC --+-----------++logicFun :: GameState -> Event -> GameState+logicFun gs (KeyPress 'q') = gs { gsQuit = True }+logicFun gs Tick = gs { gsCoord = pos (gsMove gs) (gsCoord gs) }+logicFun gs (KeyPress c) = gs { gsMove = move (gsMove gs) c }+ -- SCI movement move :: Move -> Char -> Move move N 'w' = Stop@@ -47,22 +50,39 @@ move _ 'd' = E move m _ = m --- todo add boundaries pos :: Move -> (Integer, Integer) -> (Integer, Integer)-pos Stop cs = cs-pos N (r, c) = (r-1, c )-pos S (r, c) = (r+1, c )-pos E (r, c) = (r , c+1)-pos W (r, c) = (r , c-1)+pos m oldcs | oob newcs = oldcs+ | otherwise = newcs+ where+ newcs = new m oldcs + new Stop cs = cs+ new N (r, c) = (r-1, c )+ new S (r, c) = (r+1, c )+ new E (r, c) = (r , c+1)+ new W (r, c) = (r , c-1) + ((lr, lc), (hr, hc)) = boundaries+ oob (r, c) = r <= lr || c <= lc ||+ r >= hr || c >= hc+++---------- -- DRAW --+---------- drawFun :: GameState -> Plane drawFun (GameState (r, c) _ _) =- blankPlane 80 25 &- (1, 1) % box '_' 80 25 &- (2, 2) % box ' ' 78 23 &- (15, 20) % textBox "tap WASD to move, tap again to stop"- 10 4 &- (r, c) % cell '@'+ blankPlane mw mh &+ (1, 1) % box '_' mw mh &+ (2, 2) % box ' ' (mw-2) (mh-2) &+ (15, 20) % textBox "Tap WASD to move, tap again to stop."+ 10 4 &+ (20, 60) % textBox "Press Q to quit."+ 8 10 &+ (r, c) % cell '@' # invert+ where+ mh :: Height+ mw :: Width+ (mh, mw) = snd boundaries+
src/Terminal/Game.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Terminal.Game--- Copyright : © 2017-2018 Francesco Ariis+-- Copyright : © 2017-2019 Francesco Ariis -- License : GPLv3 (see LICENSE file) -- -- Maintainer : Francesco Ariis <fa-ml@ariis.it>@@ -10,70 +10,64 @@ -- -- Machinery and utilities for 2D terminal games. --+-- Before continuing, __please read this__: to use @ansi-terminal-game@,+-- you need to compile your programs with @-threaded@; if you do not do+-- this the program will crash at start-up. Just add:+--+-- @+-- ghc-options: -threaded+-- @+--+-- in your @.cabal@ file and you will be fine!+-- -------------------------------------------------------------------------------- -- Basic col-on-black ASCII terminal, operations. -- Only module to be imported. --- todo color [release]--- todo resize screen corruption [grave]--- add docs [release]+-- todo add docs [release] module Terminal.Game ( -- * Game Loop- gameLoop,+ MonadGameIO,+ FPS,+ runGame,+ Event(..), -- * Plane- Plane, -- types- Coords, Width, Height,- stringPlane, -- crea+ Plane,+ Coords,+ Row, Column,+ Width, Height,+ stringPlane,+ stringPlaneTrans, blankPlane, addVitrum,- copyPlane, pastePlane, -- slice- planeSize, paperPlane, -- info+ pastePlane,+ planeSize, paperPlane, -- * Draw- (%), (&), cell, -- draw- box, textBox,+ Draw,+ (%), (#), (&),+ mergePlanes,+ cell, box, textBox,+ bold, invert, -- * Animations- Animation, Loop(..), -- types+ Animation, Loop(..), creaAni,- tick, reset, -- operate- -- xxx metti fetchframe in- -- documentation- -- e anche isexpired+ tick, reset, getFrames,- encodeAni, -- serialise- decodeAni, -- * Timers- Timed, -- types+ Timed, ExpBehaviour(..),- creaTimer, -- crea+ creaTimer, creaBoolTimer,- fetchFrame, isExpired, -- operate+ fetchFrame, isExpired,+ -- * Utils- screenSize+ -- screenSize ) where -import Terminal.Game.GameLoop+import Terminal.Game.Layer.Imperative+import Terminal.Game.Layer.Object+import Terminal.Game.Layer.Object.Display () import Terminal.Game.Plane import Terminal.Game.Draw--- xxx rivedi gli export di animation, encapsula tutto il possibile import Terminal.Game.Animation-import Terminal.Game.Timer-import Terminal.Game.Utils---- todo text deve essere gestito da una cosa smart, pensa a pp leijin---- todo [post-first-release] setTitle hSupportsANSI bold? italics? intensity---- todo geekosaur threaded shit bug---- geekosaur f-a, a. heh. so the thoguht I had turned out to--- be correct:--- Control.Concurent.rtsSupportsBoundThreads (because--- green threads can't be usefully bound)--- x hiratara--- [~hiratara@240f:7:4708:1:47a:b8c4:d18a:d063]--- has left Ping timeout: 276 seconds [#haskell]--- geekosaur so if that produces True, it's using the--- threaded runtime; if False, you can say--- something useful instead of hanging-
− src/Terminal/Game/ANSI.hs
@@ -1,96 +0,0 @@----------------------------------------------------------------------------------- ANSI terminal display--- (C) 2017 Francesco Ariis (GPL v3)------------------------------------------------------------------------------------ Plane to ANSI terminal display--module Terminal.Game.ANSI where--import Terminal.Game.Draw-import Terminal.Game.Plane--import qualified System.Console.ANSI as CA-import qualified Data.List.Split as LS-import qualified Control.Monad as CM-import qualified Data.Array as A---- xxx elmina 80 cols---- th tw: terminal width and height--- pn: new plane, po: old plane--- fps sono gli fps attuali, puoi stamparli come preferisci (o non stamparli)--- wo, ho: dimensions of the terminal. If they change, reinit double buffering-blitPlane :: Width -> Height -> Maybe Plane -> Plane -> Integer -> IO ()-blitPlane tw th mpo pn cFps =-- -- old plane- let- (pw, ph) = planeSize pn- bp = blankPlane pw ph- po = pastePlane (maybe bp id mpo) bp (1, 1)- in-- -- new plane- let pn' = pastePlane pn bp (1, 1)- pn'' = pastePlane (textBox (show cFps) 100 100) pn' (1, 2)- in-- -- reset formatting and print everything- -- CA.setSGR [CA.Reset, CA.SetColor CA.Background CA.Dull CA.Black] >>- CA.setSGR [CA.Reset] >>- blitMap po pn' tw th----------------------- ANCILLARIES ------------------------ plane + term w/h-blitMap :: Plane -> Plane -> Width -> Height -> IO ()-blitMap po pn tw th = CM.when (planeSize po /= planeSize pn)- (error "blitMap: different plane sizes") >>- CA.setCursorPosition (fi cr) (fi cc) >>- blitToTerminal cc (orderedCells po) (orderedCells pn)- where- (pw, ph) = planeSize pn-- cr = div (th - ph) 2- cc = div (tw - pw) 2-- fi = fromIntegral--orderedCells :: Plane -> [[Cell]]-orderedCells p = LS.chunksOf (fromIntegral w) cells- where- -- todo altra funzione invece che un map 2nd?- cells = map snd $ assocsPlane p- (w, _) = planeSize p----- ordered sequence of cells, both old and new, like they were a String to--- print to screen-blitToTerminal :: Column -> [[Cell]] -> [[Cell]] -> IO ()-blitToTerminal rc ocs ncs = mapM_ blitLine oldNew- where- oldNew :: [[(Cell, Cell)]]- oldNew = zipWith zip ocs ncs-- blitLine :: [(Cell, Cell)] -> IO ()- blitLine ccs = CM.foldM blitChar 0 ccs >>- CA.cursorDown 1 >>- CA.setCursorColumn (fromIntegral rc)-- -- k is "spaces to skip"- blitChar :: Int -> (Cell, Cell) -> IO Int- blitChar k (clo, cln)- | cln == clo = return (k+1)- | otherwise = moveIf k >>= \k' ->- putChar (cellChar cln) >>- return k'-- moveIf :: Int -> IO Int- moveIf k | k == 0 = return k- | otherwise = CA.cursorForward k >>- return 0-
src/Terminal/Game/Animation.hs view
@@ -1,12 +1,13 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE FlexibleInstances #-} ------------------------------------------------------------------------------- -- Animation -- 2018 Francesco Ariis GPLv3 ------------------------------------------------------------------------------- +-- {-# LANGUAGE DeriveGeneric #-}+-- {-# LANGUAGE DefaultSignatures #-}+-- {-# LANGUAGE StandaloneDeriving #-}+-- {-# LANGUAGE FlexibleInstances #-}+ module Terminal.Game.Animation (module Terminal.Game.Animation, module T ) where@@ -15,13 +16,10 @@ import Control.Timer.Tick as T -import Data.Serialize-import GHC.Generics--import qualified Data.ByteString as BS-import qualified Data.Bifunctor as BF+-- import Data.Serialize --- todo missing: creaani, creaframe, fetchcurrframe, etc.+-- import qualified Data.ByteString as BS+-- import qualified Data.Bifunctor as BF type Animation = T.Timed Plane @@ -35,19 +33,21 @@ -- deriving instance Generic loc => Generic (Frame loc) -- instance (Generic loc, Serialize loc) => Serialize (Frame loc Integer) -instance Serialize ExpBehaviour-instance Serialize Loop-instance Serialize Cell-instance Serialize Plane-instance Serialize Animation+-- -- xxx vanno messe in timers+-- instance Serialize ExpBehaviour+-- instance Serialize Loop -encodeAni :: FilePath -> Animation -> IO ()-encodeAni fp fs = BS.writeFile fp (encode fs)+-- instance Serialize Cell+-- instance Serialize Plane+-- instance Serialize Animation -decodeAni :: FilePath -> IO (Either String Animation)-decodeAni fp = fmap decode (BS.readFile fp) >>=- return . BF.bimap err id- where- err se = fp ++ ": " ++ se+-- encodeAni :: FilePath -> Animation -> IO ()+-- encodeAni fp fs = BS.writeFile fp (encode fs)++-- decodeAni :: FilePath -> IO (Either String Animation)+-- decodeAni fp = fmap decode (BS.readFile fp) >>=+-- return . BF.bimap err id+-- where+-- err se = fp ++ ": " ++ se
src/Terminal/Game/Draw.hs view
@@ -7,13 +7,15 @@ -- assumed to be opaque module Terminal.Game.Draw (module Terminal.Game.Draw,- module DF) where+ (F.&)+ ) where import Terminal.Game.Plane import Text.LineBreak -import Data.Function as DF ( (&) )+import qualified Data.Function as F ( (&) )+import qualified Data.List as L ----------- -- TYPES --@@ -21,26 +23,77 @@ type Draw = Plane -> Plane ++-----------------+-- COMBINATORS --+-----------------++-- | Pastes one 'Plane' onto another. To be used along with 'F.&'+-- like this:+--+-- @+-- d :: Plane+-- d = blankPlane (100, 100) &+-- (3, 4) % box '_' (3, 5) &+-- (a, b) % cell \'A\' '#' bold+-- @ (%) :: Coords -> Plane -> Draw cds % p1 = \p2 -> pastePlane p1 p2 cds+infixl 4 % - -- most of the drawing is done with % and &, e.g.- --- -- let d :: Plane- -- d = blankPlane (100, 100) &- -- (3, 4) % box '_' Yellow (3, 5) &- -- (a, b) % butCell '@' Red- --+-- | Apply style to plane, e.g.+--+-- > cell 'w' # bold+(#) :: Plane -> Draw -> Plane+p # sf = sf p+infixl 8 # +-- | Shorthand for sequencing 'Plane's, e.g.+--+-- @+-- firstPlane &+-- (3, 4) '%' secondPlane &+-- (1, 9) '%' thirdPlane+-- @+--+-- is equal to+--+-- @+-- mergePlanes firstPlane [((3,4), secondPlane),+-- ((1,9), thirdPlane)]+-- @+mergePlanes :: Plane -> [(Coords, Plane)] -> Plane+mergePlanes p cps = L.foldl' addPlane p cps+ where+ addPlane :: Plane -> (Coords, Plane) -> Plane+ addPlane bp (cs, tp) = bp F.& cs % tp+++------------+-- STYLES --+------------++-- | Apply bold style to 'Plane'.+bold :: Plane -> Plane+bold p = mapPlane boldCell p++-- | Swap foreground and background colours of 'Plane'.+invert :: Plane -> Plane+invert p = mapPlane reverseCell p+++ ------------- -- DRAWING -- ------------- +-- | A box of dimensions @w h@. box :: Char -> Width -> Height -> Plane box chr w h = seqCellsDim w h cells where cells = [((r, c), chr) | r <- [1..h], c <- [1..w]] +-- | A @1x1@ cell. cell :: Char -> Plane cell ch = box ch 1 1 @@ -57,7 +110,6 @@ hyp = Nothing -- Just english_GB bf = BreakFormat (fromIntegral w) 4 '-' hyp hcs = breakStringLn bf (take (fromIntegral $ w*h) cs)- hl = fromIntegral $ length hcs f :: [String] -> [(Coords, Char)] f css = concatMap (uncurry rf) (zip [1..] css)
− src/Terminal/Game/GameLoop.hs
@@ -1,193 +0,0 @@----------------------------------------------------------------------------------- Input/compute/output loop--- 2017 Francesco Ariis GPLv3----------------------------------------------------------------------------------{-# OPTIONS_GHC -fno-warn-type-defaults #-}--module Terminal.Game.GameLoop where--import Terminal.Game.Plane-import Terminal.Game.Input-import Terminal.Game.ANSI-import Terminal.Game.Utils-import Control.Concurrent--import qualified System.IO as SI-import qualified Control.Monad as CM-import qualified System.Console.ANSI as CA-import qualified System.Console.Terminal.Size as TS-import qualified System.Clock as SC-import qualified Control.Exception as E---- todo [release] [study] no full IO for s, but a--- jailed IO (provided by a datatype), both for I--- and for O---- todo elimina fps ora che li puoi fare on IO---- | Entry point for the game, should be called in @main@. The two--- most important functions are the one dealing with logic and the--- blitting one. Check @alone-in-a-room@ (you can compiler it with--- @cabal new-build -f examples@) to see a simple game in action.-gameLoop :: String -- ^Terminal title.- -> s -- ^Initial state of the game.- -> (s -> Maybe Char -> IO s) -- ^Logic function.- -> (s -> Plane) -- ^Draw function.- -> (s -> Bool) -- ^\"Should I quit?" function.- -> Integer -- ^Framerate (in fps).- -> IO ()-gameLoop t s lf df qf fps =-- E.finally (initPart >> game)- cleanAndExit -- this will be run regardless- -- of exception- where- initPart :: IO ()- initPart = -- init- SI.hSetBuffering SI.stdout SI.NoBuffering >>- SI.hSetBuffering SI.stdin SI.NoBuffering >>- SI.hSetEcho SI.stdin False >>-- -- title and initial setup/checks- CA.setTitle t >>- CA.hideCursor >>- blackScreen-- game :: IO ()- game = -- mvars & fork- newMVar 1 >>= \frameCounter ->- newMVar Nothing >>= \inputChar ->- forkIO (inputAction inputChar) >>- forkIO (incTimer frameCounter fps) >>-- logicDraw inputChar frameCounter- s lf df qf Nothing- (initFPSCounter 20) (0,0)---------------------- CONCURRENT ----------------------- get action char-inputAction :: MVar (Maybe Char) -> IO ()-inputAction mc = -- vedi platform-dep/- inputCharTerminal >>= \c ->- swapMVar mc (Just c) >>- inputAction mc---- modifica il timer-incTimer :: MVar Integer -> Integer -> IO ()-incTimer mi fps = modifyMVar_ mi (return . succ) >>- threadDelay delayAmount >>- incTimer mi fps- where- delayAmount :: Int- delayAmount = fromIntegral $ div (10^6) fps----- from http://www.loomsoft.net/resources/alltut/alltut_lesson5.htm-logicDraw :: MVar (Maybe Char) -> MVar Integer -> s -> -- input, ticks, state- (s -> Maybe Char -> IO s) -> -- logic function- (s -> Plane) -> -- draw function- (s -> Bool) -> -- quit? function- Maybe Plane -> -- last blitted screen- FPSCounter -> -- FPS counter- (Width, Height) -> -- Term Dimensions- IO ()-logicDraw mc mi s lf df qf opln fc td =-- -- not to hog CPU cycles- -- todo come mai 300 così alto? come influenza i timer?- threadDelay 300 >>-- -- quit?- if qf s- then return ()- else-- -- no tick from timer yet?- readMVar mi >>= \k ->- if k <= 0- then logicDraw mc mi s lf df qf opln fc td- else-- -- do logic- readMVarNothing mc >>= \c ->- modifyMVar mi (\a -> return (a-1, a-1)) >>= \k' ->- lf s c >>= \s' ->-- -- not enough logic done? Skip blitting- if k' > 0- then logicDraw mc mi s' lf df qf opln fc td- else-- -- clear screen if resolution change- screenSize >>= \td'@(tw, th) ->- let resc = td /= td' in- CM.when resc blackScreen >>-- let opln' | resc = Nothing -- res changed? restart double buffering- | otherwise = opln- npln = df s'- cFps = getCurrFPS fc in- blitPlane tw th opln' npln cFps >>- tickCounter fc >>= \fc' ->- logicDraw mc mi s' lf df qf (Just npln) fc' td'----------------------- FPS COUNTER ------------------------ poll fps every x frames, current fps, stored time, current fps-data FPSCounter = FPSCounter Integer Integer SC.TimeSpec Integer---- poll utctime every x ticks-initFPSCounter :: Integer -> FPSCounter-initFPSCounter x = FPSCounter x 0 0 0--tickCounter :: FPSCounter -> IO FPSCounter-tickCounter (FPSCounter g e t1 cf)- | g > e = return (FPSCounter g (e+1) t1 cf)- | g == e = SC.getTime SC.Monotonic >>= \t2 ->- let dtn = SC.toNanoSecs $ SC.diffTimeSpec t2 t1- fr = fi dtn / fi (g+1)- fps = round $ fi (10^9) / fr in- --- xxx no div- return (FPSCounter g 0 t2 fps)- | otherwise = error "tickCounter: g < e"- where- fi = fromIntegral--getCurrFPS :: FPSCounter -> Integer-getCurrFPS (FPSCounter _ _ _ cFps) = cFps---------------------- ANCILLARIES ------------------------ todo [release] catch any exception in IO and execute this-cleanAndExit :: IO ()-cleanAndExit = CA.setSGR [CA.Reset] >>- CA.clearScreen >>- CA.setCursorPosition 0 0 >>- CA.showCursor--readMVarNothing :: MVar (Maybe a) -> IO (Maybe a)-readMVarNothing mvar = readMVar mvar >>= \ma ->- CM.unless (null ma)- (() <$ swapMVar mvar Nothing) >>- return ma---- turn screen into black-blackScreen :: IO ()-blackScreen = CA.setCursorPosition 0 0 >>- -- CA.setSGR [CA.Reset,- -- CA.SetColor CA.Foreground CA.Dull CA.White,- -- CA.SetColor CA.Background CA.Dull CA.Black] >>- -- è dull black che voglio?- screenSize >>= \(w, h) ->- CM.replicateM_ (fromIntegral $ w*h) (putChar ' ')-
+ src/Terminal/Game/Layer/Imperative.hs view
@@ -0,0 +1,125 @@+-------------------------------------------------------------------------------+-- Layer 1 (imperative), as per+-- https://www.parsonsmatt.org/2018/03/22/three_layer_haskell_cake.html+-- 2019 Francesco Ariis GPLv3+-------------------------------------------------------------------------------++{-# Language ScopedTypeVariables #-}++module Terminal.Game.Layer.Imperative where++import Terminal.Game.Layer.Object++import qualified Control.Monad.Reader as R+import qualified Control.Concurrent as CC+import qualified Control.Monad as CM++import Terminal.Game.Plane+++type Game m a = R.ReaderT Config m a++data Config = Config { cMEvents :: CC.MVar [Event],+ cFPS :: FPS }++-- | Entry point for the game, should be called in @main@. The two+-- most important functions are the one dealing with logic and the+-- blitting one. Check @alone-in-a-room@ (you can compiler it with+-- @cabal new-build -f examples@) to see a simple game in action.+runGame :: forall s m. MonadGameIO m =>+ s -- ^Initial state of the game.+ -> (s -> Event -> s) -- ^Logic function.+ -> (s -> Plane) -- ^Draw function.+ -> (s -> Bool) -- ^\"Should I quit?\" function.+ -> FPS -- ^Frames per second.+ -> m s+runGame s lf df qf fps =+ startEvents fps >>= \ve ->+ R.runReaderT game (Config ve fps)+ where+ game :: MonadGameIO m => Game m s+ game = R.ask >>= \c ->+ R.lift (setupDisplay+ (gameLoop c s lf df qf Nothing (0,0)+ (initFPSCounter 10)))+++-- from http://www.loomsoft.net/resources/alltut/alltut_lesson6.htm+gameLoop :: MonadGameIO m =>+ Config -> -- event source+ s -> -- state+ (s -> Event -> s) -> -- logic function+ (s -> Plane) -> -- draw function+ (s -> Bool) -> -- quit? function+ Maybe Plane -> -- last blitted screen+ -- FPSCounter -> -- FPS counter+ (Width, Height) -> -- Term Dimensions+ FPSCounter -> -- FPS counter+ m s+gameLoop c s lf df qf opln td fc =++ -- fetch events (if any)+ pollEvents (cMEvents c) >>= \es ->++ -- quit?+ if qf s+ then return s+ else++ -- no events? skip everything+ if null es+ then sleepABit (cFPS c) >>+ gameLoop c s lf df qf opln td fc+ else++ -- logic+ let s' = stepsLogic s lf es in++ -- clear screen if resolution change+ displaySize >>= \td'@(tw, th) ->+ let resc = td /= td' in+ CM.when resc clearDisplay >>++ -- draw+ -- xxx solo se è tick e non kpress?+ let opln' | resc = Nothing -- res changed? restart double buffering+ | otherwise = opln+ npln = df s'+ cFps = getCurrFPS fc in+ blitPlane tw th opln' npln cFps >>+ tickCounter fc >>= \fc' ->++ gameLoop c s' lf df qf (Just npln) td' fc'+++stepsLogic :: s -> (s -> Event -> s) -> [Event] -> s+stepsLogic s lf es = foldl lf s es+++-----------------+-- FPS COUNTER --+-----------------++-- poll fps every x frames, current fps, stored time, current fps+data FPSCounter = FPSCounter Integer Integer Integer Integer++-- poll utctime every x ticks+initFPSCounter :: Integer -> FPSCounter+initFPSCounter x = FPSCounter x 0 0 0++tickCounter :: MonadGameIO m => FPSCounter -> m FPSCounter+tickCounter (FPSCounter g e t1 cf)+ | g > e = return (FPSCounter g (e+1) t1 cf)+ | g == e = getTime >>= \t2 ->+ let dtn = t2 - t1+ fr = fi dtn / fi (g+1)+ fps = round $ fi (10^(9::Integer)) / fr in+ --- xxx no div+ return (FPSCounter g 0 t2 fps)+ | otherwise = error "tickCounter: g < e"+ where+ fi :: Integer -> Double+ fi = fromIntegral++getCurrFPS :: FPSCounter -> Integer+getCurrFPS (FPSCounter _ _ _ cFps) = cFps
+ src/Terminal/Game/Layer/Object.hs view
@@ -0,0 +1,262 @@+-------------------------------------------------------------------------------+-- Layer 2 (mockable IO), as per+-- https://www.parsonsmatt.org/2018/03/22/three_layer_haskell_cake.html+-- 2019 Francesco Ariis GPLv3+-------------------------------------------------------------------------------++{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-}++module Terminal.Game.Layer.Object where++import Terminal.Game.Input+import Terminal.Game.Plane++import qualified Control.Concurrent as CC+import qualified System.Clock as SC++-- xxx elimina, sono ansi shit+import Terminal.Game.Draw+import qualified System.IO as SI+import qualified System.Console.ANSI as CA+import qualified Control.Exception as E+import qualified Control.Monad as CM+import qualified System.Console.Terminal.Size as TS+import qualified Data.List.Split as LS++type MonadGameIO m = (MonadInput m, MonadTimer m, MonadDisplay m)++----------------+-- Game input --+----------------++-- | Frames per second.+type FPS = Integer++-- | An @Event@ is a 'Tick' (time passes) or a 'KeyPress'.+data Event = Tick+ | KeyPress Char++class Monad m => MonadInput m where+ startEvents :: FPS -> m (CC.MVar [Event])+ pollEvents :: CC.MVar [Event] ->+ m [Event]++instance MonadInput IO where+ startEvents fps = startIOInput fps+ pollEvents ve = CC.swapMVar ve []++startIOInput :: FPS -> IO (CC.MVar [Event])+startIOInput fps = CC.newMVar [] >>= \ve ->+ CC.forkIO (addTick ve fps) >>+ CC.forkIO (addKeypress ve) >>+ return ve++-- modifica il timer+addTick :: CC.MVar [Event] -> FPS -> IO ()+addTick ve fps = addEvent ve Tick >>+ CC.threadDelay delayAmount >>+ addTick ve fps+ where+ delayAmount :: Int+ delayAmount = fromIntegral $ quot oneTickSec fps++-- get action char+addKeypress :: CC.MVar [Event] -> IO ()+addKeypress ve = -- vedi platform-dep/+ inputCharTerminal >>= \c ->+ addEvent ve (KeyPress c) >>+ addKeypress ve++addEvent :: CC.MVar [Event] -> Event -> IO ()+addEvent ve e = CC.modifyMVar_ ve (return . (++[e]))++instance MonadInput ((->) [Event]) where+ startEvents _ = error "startEvent in (->) instance"+ pollEvents _ = id+++-----------------+-- Game timing --+-----------------++class Monad m => MonadTimer m where+ getTime :: m Integer -- to nanoseconds+ sleepABit :: FPS -> m () -- useful not to hammer cpu while polling++instance MonadTimer IO where+ getTime = SC.toNanoSecs <$> SC.getTime SC.Monotonic+ sleepABit fps =+ CC.threadDelay (fromIntegral $ quot oneTickSec (fps*10))++instance MonadTimer ((->) [Event]) where+ getTime = const 1+ sleepABit _ = const ()+++-------------------------------------------+-- MONADDISPLAY+-------------------------------------------++-- xxx move out monaddisplay m dipende da event! circular!++class Monad m => MonadDisplay m where+ setupDisplay :: m s -> m s+ clearDisplay :: m ()+ displaySize :: m (Integer, Integer)+ blitPlane :: Width -> Height -> Maybe Plane -> Plane -> Integer -> m ()+++---------------+-- Instances --+---------------++instance MonadDisplay ((->) [Event]) where+ setupDisplay s = s+ clearDisplay = const ()+ displaySize = const (0, 0)+ blitPlane _ _ _ _ _ = const ()+++instance MonadDisplay IO where+ setupDisplay = setupDisplayIO+ clearDisplay = clearScreen+ displaySize = displaySizeIO+ blitPlane = blitPlaneIO+++setupDisplayIO :: IO s -> IO s+setupDisplayIO m = E.finally (initPart >> m)+ cleanAndExit -- this will be run regardless+ -- of exception++displaySizeIO :: IO (Integer, Integer)+displaySizeIO =+ TS.size >>= \ts ->+ let (TS.Window h w) = maybe (error "cannot get TERM size") id ts+ in return (w, h)++-- th tw: terminal width and height+-- pn: new plane, po: old plane+-- fps sono gli fps attuali, puoi stamparli come preferisci (o non stamparli)+-- wo, ho: dimensions of the terminal. If they change, reinit double buffering+blitPlaneIO :: Width -> Height -> Maybe Plane -> Plane -> Integer -> IO ()+blitPlaneIO tw th mpo pn cFps =++ -- old plane+ let+ (pw, ph) = planeSize pn+ bp = blankPlane pw ph+ po = pastePlane (maybe bp id mpo) bp (1, 1)+ in++ -- new plane+ let pn' = pastePlane pn bp (1, 1)+ pn'' = pastePlane (textBox (show cFps) 100 100) pn' (1, 2)+ in++ -- reset formatting and print everything+ -- CA.setSGR [CA.Reset, CA.SetColor CA.Background CA.Dull CA.Black] >>+ CA.setSGR [CA.Reset] >>+ blitMap po pn'' tw th+++-----------------+-- ANCILLARIES --+-----------------++initPart :: IO ()+initPart = -- check thread support+ CM.unless CC.rtsSupportsBoundThreads+ (error errMes) >>+ -- init+ SI.hSetBuffering SI.stdout SI.NoBuffering >>+ SI.hSetBuffering SI.stdin SI.NoBuffering >>+ SI.hSetEcho SI.stdin False >>++ -- initial setup/checks+ CA.hideCursor >>+ clearScreen+ where+ errMes = unlines+ ["\nError: you *must* compile this program with -threaded!",+ "Just add",+ "",+ " ghc-options: -threaded",+ "",+ "in your .cabal file (executale section) and you will be fine!"]++-- clears screen+clearScreen :: IO ()+clearScreen = CA.setCursorPosition 0 0 >>+ CA.setSGR [CA.Reset] >>+ displaySize >>= \(w, h) ->+ CM.replicateM_ (fromIntegral $ w*h) (putChar ' ')++cleanAndExit :: IO ()+cleanAndExit = CA.setSGR [CA.Reset] >>+ CA.clearScreen >>+ CA.setCursorPosition 0 0 >>+ CA.showCursor++-- plane + term w/h+blitMap :: Plane -> Plane -> Width -> Height -> IO ()+blitMap po pn tw th = CM.when (planeSize po /= planeSize pn)+ (error "blitMap: different plane sizes") >>+ CA.setCursorPosition (fi cr) (fi cc) >>+ blitToTerminal cc (orderedCells po) (orderedCells pn)+ where+ (pw, ph) = planeSize pn++ cr = div (th - ph) 2+ cc = div (tw - pw) 2++ fi = fromIntegral++orderedCells :: Plane -> [[Cell]]+orderedCells p = LS.chunksOf (fromIntegral w) cells+ where+ cells = map snd $ assocsPlane p+ (w, _) = planeSize p+++-- ordered sequence of cells, both old and new, like they were a String to+-- print to screen+blitToTerminal :: Column -> [[Cell]] -> [[Cell]] -> IO ()+blitToTerminal rc ocs ncs = mapM_ blitLine oldNew+ where+ oldNew :: [[(Cell, Cell)]]+ oldNew = zipWith zip ocs ncs++ blitLine :: [(Cell, Cell)] -> IO ()+ blitLine ccs = CM.foldM blitCell 0 ccs >>+ CA.cursorDown 1 >>+ CA.setCursorColumn (fromIntegral rc)++ -- k is "spaces to skip"+ blitCell :: Int -> (Cell, Cell) -> IO Int+ blitCell k (clo, cln)+ | cln == clo = return (k+1)+ | otherwise = moveIf k >>= \k' ->+ putCellStyle cln >>+ return k'++ moveIf :: Int -> IO Int+ moveIf k | k == 0 = return k+ | otherwise = CA.cursorForward k >>+ return 0++putCellStyle :: Cell -> IO ()+putCellStyle c = CA.setSGR ([CA.Reset] ++ sgrb ++ sgrr) >>+ putChar (cellChar c)+ where+ sgrb | isBold c = [CA.SetConsoleIntensity CA.BoldIntensity]+ | otherwise = []++ sgrr | isReversed c = [CA.SetSwapForegroundBackground True]+ | otherwise = []++-- ANCILLARIES --++oneTickSec :: Integer+oneTickSec = 10 ^ (6 :: Integer)
+ src/Terminal/Game/Layer/Object/Display.hs view
@@ -0,0 +1,19 @@+-------------------------------------------------------------------------------+-- Layer 2 (mockable IO), as per+-- https://www.parsonsmatt.org/2018/03/22/three_layer_haskell_cake.html+-- 2019 Francesco Ariis GPLv3+-------------------------------------------------------------------------------++module Terminal.Game.Layer.Object.Display where++-- import Terminal.Game.Plane+-- import Terminal.Game.Draw++-- import qualified System.IO as SI+-- import qualified System.Console.ANSI as CA+-- import qualified Control.Exception as E+-- import qualified Control.Monad as CM+-- import qualified System.Console.Terminal.Size as TS+-- import qualified Data.List.Split as LS+-- import qualified Control.Concurrent as CC+
src/Terminal/Game/Plane.hs view
@@ -11,7 +11,6 @@ import qualified GHC.Generics as G import qualified Data.Array as A -import qualified Data.Char as C import qualified Data.List as L import qualified Data.List.Split as LS import qualified Data.Tuple as T @@ -27,54 +26,46 @@ type Column = Integer type Coords = (Row, Column) -- row, column, from TL (TL = 1, 1) +type Bold = Bool +type Reversed = Bool + -- can be an ASCIIChar or a special, transparent character -data Cell = CellChar Char +data Cell = CellChar Char Bold Reversed | Transparent deriving (Show, Eq, Ord, G.Generic) --- A place where to blit stuff. Coordinates starts from top left --- corner (1, 1) -newtype Plane = Plane { fromPlane :: (A.Array Coords Cell) } +-- | A two-dimensional surface (Row, Column) where to blit stuff. +newtype Plane = Plane { fromPlane :: A.Array Coords Cell } deriving (Show, Eq, G.Generic) + ---------- -- CREA -- ---------- creaCell :: Char -> Cell -creaCell ch = CellChar ch - --- creates plane from a string, good to import ascii art/diagrams/etc. --- Char indicates transparency, integer = pic width -stringPlane :: Maybe Char -> Integer -> String -> Plane -stringPlane mc w t = vitrous - where - lined = lines t - - h :: Integer - h = L.genericLength lined - - pad :: Integer -> String -> String - pad mw t = take (fromIntegral mw) (t ++ repeat ' ') - - padded :: [String] - padded = map (pad w) lined +creaCell ch = CellChar ch False False - celled :: [Cell] - celled = map creaCell . concat $ padded +boldCell :: Cell -> Cell +boldCell (CellChar c _ r) = CellChar c True r +boldCell Transparent = Transparent - plane :: Plane - plane = Plane $ A.listArray ((1,1), (h, w)) celled +reverseCell :: Cell -> Cell +reverseCell (CellChar c b _) = CellChar c b True +reverseCell Transparent = Transparent - vitrous :: Plane - vitrous = case mc of - Just c -> addVitrum c plane - Nothing -> plane +-- | Creates 'Plane' from 'String', good way to import ASCII +-- art/diagrams. +stringPlane :: String -> Plane +stringPlane t = stringPlaneGeneric Nothing t +-- | Same as 'stringPlane', but with transparent 'Char'. +stringPlaneTrans :: Char -> String -> Plane +stringPlaneTrans c t = stringPlaneGeneric (Just c) t --- creates an empty, opaque Plane (limits: TL, BR) +-- | Creates an empty, opaque 'Plane'. blankPlane :: Width -> Height -> Plane -blankPlane w h = Plane $ A.listArray ((1,1), (h, w)) (repeat $ creaCell ' ') +blankPlane w h = listPlane (h, w) (repeat $ creaCell ' ') -- add transparency to a plane, matching a given character addVitrum :: Char -> Plane -> Plane @@ -88,22 +79,6 @@ -- SLICE -- ----------- --- copies a slice of the plane (bl, tr) -copyPlane :: Plane -> Coords -> Coords -> Plane -copyPlane p (r1, c1) (r2, c2) = - Plane $ A.listArray ((1, 1), (w', h')) (map snd section) - where - inside ((r, c), _) | r >= r1 && r <= r2 && - c >= c1 && c <= c2 = True - | otherwise = False - - (w, h) = planeSize p - - w' = min w c2 - max c1 1 + 1 - h' = min h r2 - max r1 1 + 1 - - section = filter inside (assocsPlane p) - -- paste one plane over the other at a certain position (p1 gets over p2). -- Remember that coordinates start from bottom left! -- Maybe char = possible transparency @@ -121,7 +96,7 @@ | otherwise = False solid (_, Transparent) = False - solid (_, otherwise) = True + solid _ = True ------------- @@ -132,25 +107,28 @@ planeSize p = T.swap . snd $ A.bounds (fromPlane p) cellChar :: Cell -> Char -cellChar (CellChar ch) = ch -cellChar Transparent = ' ' +cellChar (CellChar ch _ _) = ch +cellChar Transparent = ' ' +isBold :: Cell -> Bool +isBold (CellChar _ b _) = b +isBold _ = False + +isReversed :: Cell -> Bool +isReversed (CellChar _ _ r) = r +isReversed _ = False + assocsPlane :: Plane -> [(Coords, Cell)] assocsPlane p = A.assocs (fromPlane p) -- an '\n' divided (and ended) String ready to be written on file paperPlane :: Plane -> String paperPlane p = unlines . LS.chunksOf w . - map c2c . A.elems $ fromPlane p + map cellChar . A.elems $ fromPlane p where w :: Int w = fromIntegral . fst . planeSize $ p - c2c :: Cell -> Char - c2c Transparent = ' ' - c2c (CellChar c) = c - - ----------------- -- ANCILLARIES -- ----------------- @@ -162,3 +140,35 @@ -- 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 mc t = vitrous + where + lined = lines t + + h :: Integer + h = L.genericLength lined + + w :: Integer + w = maximum (map L.genericLength lined) + + pad :: Integer -> String -> String + pad mw tl = take (fromIntegral mw) (tl ++ repeat ' ') + + padded :: [String] + padded = map (pad w) lined + + celled :: [Cell] + celled = map creaCell . concat $ padded + + plane :: Plane + plane = listPlane (h, w) celled + + vitrous :: Plane + vitrous = case mc of + Just c -> addVitrum c plane + Nothing -> plane +
− src/Terminal/Game/Utils.hs
@@ -1,11 +0,0 @@-module Terminal.Game.Utils where--import Terminal.Game.Plane--import qualified System.Console.Terminal.Size as TS--screenSize :: IO (Width, Height)-screenSize =- TS.size >>= \ts ->- let (TS.Window h w) = maybe (error "cannot get TERM size") id ts- in return (w, h)
+ test/Terminal/Game/DrawSpec.hs view
@@ -0,0 +1,15 @@+module Terminal.Game.DrawSpec where++import Test.Hspec+import Terminal.Game.Plane+import Terminal.Game.Draw+++spec :: Spec+spec = do++ describe "mergePlanes" $ do+ it "piles multiple planes together" $+ mergePlanes (stringPlane "aa")+ [((1,2), cell 'b')] `shouldBe` stringPlane "ab"+
+ test/Terminal/Game/Layer/ImperativeSpec.hs view
@@ -0,0 +1,22 @@+module Terminal.Game.Layer.ImperativeSpec where++import Test.Hspec+import Terminal.Game+++spec :: Spec+spec = do++ let nd = error "<not-defined>"+ s = (0, False, 0)+ lf (t, True, i) Tick = (t+1, True, i+1)+ lf (t, b, i) Tick = (t+1, b, i )+ lf (t, _, i) (KeyPress _) = (t, True, i )+ qf (3, _, _) = True+ qf _ = False+ es = [Tick, KeyPress 'c', KeyPress 'c', Tick, Tick]++ describe "runGame" $ do+ it "does not confuse input and logic" $+ runGame s lf nd qf nd es `shouldBe` (3, True, 2)+
+ test/Terminal/Game/PlaneSpec.hs view
@@ -0,0 +1,38 @@+module Terminal.Game.PlaneSpec where++import Test.Hspec+import Terminal.Game.Plane+import Terminal.Game.Draw+++spec :: Spec+spec = do++ let testPlane = blankPlane 2 2 &+ (1,1) % box '.' 2 2 &+ (1,2) % cell ' '++ describe "listPlane" $ do+ it "creates a plane from string" $+ listPlane (2,2) (map creaCell ". ..") `shouldBe` testPlane+ it "ignores extra characters" $+ listPlane (2,2) (map creaCell ". ..abc") `shouldBe` testPlane++ describe "pastePlane" $ do+ it "pastes a simple plane onto another" $+ pastePlane (cell 'a') (cell 'b') (1,1) `shouldBe` cell 'a'++ describe "stringPlane" $ do+ it "creates plane from spec" $+ stringPlane ".\n.." `shouldBe` testPlane++ describe "stringPlaneTrans" $ do+ it "allows transparency" $+ stringPlaneTrans '.' ".\n.." `shouldBe` addVitrum '.' testPlane++ describe "updatePlane" $ do+ let ma = listPlane (2,1) (map creaCell "ab")+ mb = listPlane (2,1) (map creaCell "xb")+ it "updates a Plane" $+ updatePlane ma [((1,1), creaCell 'x')] `shouldBe` mb+