Copyright | © 2017-2019 Francesco Ariis |
---|---|
License | GPLv3 (see LICENSE file) |
Maintainer | Francesco Ariis <fa-ml@ariis.it> |
Stability | provisional |
Portability | portable |
Safe Haskell | None |
Language | Haskell2010 |
Machinery and utilities for 2D terminal games.
New? Start from Game
.
Synopsis
- type FPS = Integer
- data Event
- data Game s = Game {
- gScreenWidth :: Width
- gScreenHeight :: Height
- gFPS :: FPS
- gInitState :: s
- gLogicFunction :: s -> Event -> s
- gDrawFunction :: s -> Plane
- gQuitFunction :: s -> Bool
- playGame :: Game s -> IO ()
- data Timed a
- creaTimer :: a -> a -> Integer -> Timed a
- creaBoolTimer :: Integer -> Timed Bool
- creaTimerLoop :: a -> a -> Integer -> Timed a
- creaBoolTimerLoop :: Integer -> Timed Bool
- fetchFrame :: Timed a -> a
- isExpired :: Timed a -> Bool
- type Animation = Timed Plane
- data Loop
- data ExpBehaviour
- creaAnimation :: Loop -> [(Integer, Plane)] -> Animation
- tick :: Timed a -> Timed a
- reset :: Timed a -> Timed a
- fetchAniFrame :: Animation -> Plane
- isAniExpired :: Animation -> Bool
- getFrames :: Timed a -> [(Integer, a)]
- data Plane
- type Coords = (Row, Column)
- type Row = Integer
- type Column = Integer
- type Width = Integer
- type Height = Integer
- blankPlane :: Width -> Height -> Plane
- stringPlane :: String -> Plane
- stringPlaneTrans :: Char -> String -> Plane
- makeTransparent :: Char -> Plane -> Plane
- makeOpaque :: Plane -> Plane
- paperPlane :: Plane -> String
- planeSize :: Plane -> (Width, Height)
- type Draw = Plane -> Plane
- (%) :: Coords -> Plane -> Draw
- (#) :: Plane -> Draw -> Plane
- (&) :: a -> (a -> b) -> b
- mergePlanes :: Plane -> [(Coords, Plane)] -> Plane
- cell :: Char -> Plane
- box :: Char -> Width -> Height -> Plane
- textBox :: String -> Width -> Height -> Plane
- data Color
- data ColorIntensity
- color :: Color -> ColorIntensity -> Plane -> Plane
- bold :: Plane -> Plane
- invert :: Plane -> Plane
- testGame :: Game s -> [Event] -> s
- setupGame :: Game s -> [Event] -> Game s
- recordGame :: Game s -> FilePath -> IO ()
- readRecord :: FilePath -> IO [Event]
- narrateGame :: Game s -> [Event] -> IO s
- errorPress :: IO a -> IO a
Running
Instances
Eq Event Source # | |
Show Event Source # | |
Generic Event Source # | |
Arbitrary Event Source # | |
Serialize Event Source # | |
type Rep Event Source # | |
Defined in Terminal.Game.Layer.Object.Interface type Rep Event = D1 (MetaData "Event" "Terminal.Game.Layer.Object.Interface" "ansi-terminal-game-0.5.0.0-Ip1MpuHsTkxFVdvGo6fHOU" False) (C1 (MetaCons "Tick" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "KeyPress" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Char))) |
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.
Game | |
|
playGame :: Game s -> IO () Source #
Entry point for the game execution, should be called in main
.
You must compile your programs with -threaded
; if you do not do
this the game will crash at start-up. Just add:
ghc-options: -threaded
in your .cabal
file and you will be fine!
Game Logic
Some convenient function dealing with
Timers (Timed
) and Animation
s.
Usage of these is not mandatry: Game
is
parametrised over any state s
, you are free
to implement game logic as you prefer.
Timers
A timed resource is a timer which, at any given moment, points to a specific item (like an animation).
Example:
timer = creaTimedRes (Times 1 Elapse) [(2, "a "), (1, "b "), (2, "c ")] test t | isExpired t = putStrLn "Fine." | otherwise = do putStr (fetchFrame t) test (tick t) -- λ> test timer -- a a b c c Fine.
Instances
creaTimer :: a -> a -> Integer -> Timed a #
A simple off/on timer expiring in fixed number of ticks.
Example:
timer = creaTimer Nothing (Just "Over!") 4 test t | isExpired t = print (fetchFrame t) | otherwise = do print (fetchFrame t) test (tick t) -- λ> test timer -- Nothing -- Nothing -- Nothing -- Nothing -- Just "Over"!
creaTimerLoop :: a -> a -> Integer -> Timed a #
A looped version of creaTimer
.
creaBoolTimerLoop :: Integer -> Timed Bool #
Shorthand for:
.creaTimerLoop
False True i
fetchFrame :: Timed a -> a #
Fetches the current resource of the timer.
isExpired :: Timed a -> Bool #
Checks wheter the timer is expired (an expired timer will not
respond to tick
).
Animations
Number of times to repeat the animation.
AlwaysLoop | Loops forever, never expires. |
Times Integer ExpBehaviour | Repeats the cycle for a fixed number of times. |
Instances
Eq Loop | |
Show Loop | |
Generic Loop | |
type Rep Loop | |
Defined in Control.Timer.Tick type Rep Loop = D1 (MetaData "Loop" "Control.Timer.Tick" "timers-tick-0.4.1.0-86aYijwsL07macaL4hOFs" False) (C1 (MetaCons "AlwaysLoop" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "Times" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Integer) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 ExpBehaviour))) |
data ExpBehaviour #
Expire behaviour.
Instances
Eq ExpBehaviour | |
Defined in Control.Timer.Tick (==) :: ExpBehaviour -> ExpBehaviour -> Bool # (/=) :: ExpBehaviour -> ExpBehaviour -> Bool # | |
Show ExpBehaviour | |
Defined in Control.Timer.Tick showsPrec :: Int -> ExpBehaviour -> ShowS # show :: ExpBehaviour -> String # showList :: [ExpBehaviour] -> ShowS # | |
Generic ExpBehaviour | |
Defined in Control.Timer.Tick type Rep ExpBehaviour :: Type -> Type # from :: ExpBehaviour -> Rep ExpBehaviour x # to :: Rep ExpBehaviour x -> ExpBehaviour # | |
type Rep ExpBehaviour | |
fetchAniFrame :: Animation -> Plane Source #
Alias for fetchFrame
.
Drawing
To get to the gist of drawing, check the
documentation of %
.
Plane
A two-dimensional surface (Row, Column) where to blit stuff.
stringPlane :: String -> Plane Source #
stringPlaneTrans :: Char -> String -> Plane Source #
Same as stringPlane
, but with transparent Char
.
makeTransparent :: Char -> Plane -> Plane Source #
Adds transparency to a plane, matching a given character
makeOpaque :: Plane -> Plane Source #
Changes every transparent cell in the Plane
to an opaque ' '
character.
paperPlane :: Plane -> String Source #
A String (n
divided and ended) representing the Plane
. Useful
for debugging/testing purposes.
Draw
ANSI's eight standard colors. They come in two intensities, which are
controlled by ColorIntensity
. Many terminals allow the colors of the
standard palette to be customised, so that, for example,
setSGR [ SetColor Foreground Vivid Green ]
may not result in bright green
characters.
data ColorIntensity #
ANSI's standard colors come in two intensities
Instances
Testing
testGame :: Game s -> [Event] -> s Source #
Tests a game in a pure environment. You can
supply the Event
s yourself or use recordGame
to obtain them.
errorPress :: IO a -> IO a Source #
Wraps an IO
computation so that any error
gets displayed along
with a <press any key to quit>
prompt.
Some terminals shut-down immediately upon program end: errorPress
makes it easier to beta-test games on those terminals.
Cross platform
Good practices for cross-compatibility:
- choose game dimensions of no more than 24 rows and 80 columns. This ensures compatibility with the trickiest terminals (i.e. Win32 console);
- use ASCII characters only. Again this is for Win32 console compatibility, until this GHC bug gets fixed;
- employ colour sparingly: as some users will play your game in a light-background terminal and some in a dark one, choose only colours that go well with either (blue, red, etc.);
- some terminals/multiplexers (i.e. tmux) do not make a distinction between vivid/dull, do not base your game mechanics on that difference.