| Copyright | © 2017-2018 Francesco Ariis |
|---|---|
| License | GPLv3 (see LICENSE file) |
| Maintainer | Francesco Ariis <fa-ml@ariis.it> |
| Stability | provisional |
| Portability | portable |
| Safe Haskell | None |
| Language | Haskell2010 |
Terminal.Game
Description
Machinery and utilities for 2D terminal games.
- gameLoop :: String -> s -> (s -> Maybe Char -> IO s) -> (s -> Plane) -> (s -> Bool) -> Integer -> IO ()
- data Plane
- type Coords = (Row, Column)
- type Width = Integer
- type Height = Integer
- stringPlane :: Maybe Char -> Integer -> String -> Plane
- blankPlane :: Width -> Height -> Plane
- addVitrum :: Char -> Plane -> Plane
- copyPlane :: Plane -> Coords -> Coords -> Plane
- pastePlane :: Plane -> Plane -> Coords -> Plane
- planeSize :: Plane -> (Width, Height)
- paperPlane :: Plane -> String
- (%) :: Coords -> Plane -> Draw
- (&) :: a -> (a -> b) -> b
- cell :: Char -> Plane
- box :: Char -> Width -> Height -> Plane
- textBox :: String -> Width -> Height -> Plane
- type Animation = Timed Plane
- data Loop :: *
- creaAni :: Loop -> [(Integer, Plane)] -> Animation
- tick :: Timed a -> Timed a
- reset :: Timed a -> Timed a
- getFrames :: Timed a -> [(Integer, a)]
- encodeAni :: FilePath -> Animation -> IO ()
- decodeAni :: FilePath -> IO (Either String Animation)
- data Timed a :: * -> *
- data ExpBehaviour :: *
- creaTimer :: a -> a -> Integer -> Timed a
- creaBoolTimer :: Integer -> Timed Bool
- fetchFrame :: Timed a -> a
- isExpired :: Timed a -> Bool
- screenSize :: IO (Width, Height)
Game Loop
Arguments
| :: 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 () |
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.
Plane
paperPlane :: Plane -> String Source #
Draw
Animations
Number of times to repeat the animation.
Constructors
| AlwaysLoop | Loops forever, never expires. |
| Times Integer ExpBehaviour | Repeats the cycle for a fixed number of times. |
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.
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"!
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).