-- | -- This module provides an Elm Architecture interface to @termbox@, a simple C library for writing text-based user -- interfaces: <https://github.com/termbox/termbox> -- -- See also: -- -- * @<https://hackage.haskell.org/package/termbox-banana termbox-banana>@, a @reactive-banana@ FRP interface. -- -- This module is intended to be imported qualified. -- -- ==== __👉 Quick start example__ -- -- This @termbox@ program displays the number of keys pressed. -- -- @ -- {-\# LANGUAGE DerivingStrategies \#-} -- {-\# LANGUAGE DuplicateRecordFields \#-} -- {-\# LANGUAGE ImportQualifiedPost \#-} -- {-\# LANGUAGE LambdaCase \#-} -- {-\# LANGUAGE OverloadedRecordDot \#-} -- {-\# LANGUAGE OverloadedStrings \#-} -- {-\# LANGUAGE NoFieldSelectors \#-} -- -- import Data.Foldable (fold) -- import Data.Void (Void) -- import Termbox.Tea qualified as Termbox -- -- main :: IO () -- main = do -- result <- -- Termbox.'run' -- Termbox.'Termbox.Tea.Program' -- { initialize, -- pollEvent, -- handleEvent, -- render, -- finished -- } -- case result of -- Left err -\> putStrLn (\"Termbox program failed to initialize: \" ++ show err) -- Right state -\> putStrLn (\"Final state: \" ++ show state) -- -- data MyState = MyState -- { keysPressed :: Int, -- pressedEsc :: Bool -- } -- deriving stock (Show) -- -- initialize :: Termbox.'Termbox.Tea.Size' -\> MyState -- initialize _size = -- MyState -- { keysPressed = 0, -- pressedEsc = False -- } -- -- pollEvent :: Maybe (IO Void) -- pollEvent = -- Nothing -- -- handleEvent :: MyState -\> Termbox.'Termbox.Tea.Event' Void -\> IO MyState -- handleEvent state = \\case -- Termbox.'Termbox.Tea.EventKey' key -\> -- pure -- MyState -- { keysPressed = state.keysPressed + 1, -- pressedEsc = -- case key of -- Termbox.'Termbox.Tea.KeyEsc' -\> True -- _ -\> False -- } -- _ -\> pure state -- -- render :: MyState -\> Termbox.'Termbox.Tea.Scene' -- render state = -- fold -- [ string -- Termbox.'Termbox.Tea.Pos' {row = 2, col = 4} -- (\"Number of keys pressed: \" ++ map Termbox.'Termbox.Tea.char' (show state.keysPressed)) -- , string -- Termbox.'Termbox.Tea.Pos' {row = 4, col = 4} -- (\"Press \" ++ map (Termbox.'Termbox.Tea.bold' . Termbox.'Termbox.Tea.char') \"Esc\" ++ \" to quit.\") -- ] -- -- finished :: MyState -\> Bool -- finished state = -- state.pressedEsc -- -- string :: Termbox.'Termbox.Tea.Pos' -\> [Termbox.'Termbox.Tea.Cell'] -\> Termbox.'Termbox.Tea.Scene' -- string pos cells = -- foldMap (\\(i, cell) -\> Termbox.'Termbox.Tea.cell' (Termbox.'Termbox.Tea.posRight' i pos) cell) (zip [0 ..] cells) -- @ module Termbox.Tea ( -- * Main Program (..), run, Termbox.InitError (..), -- * Terminal contents -- ** Scene Termbox.Scene, Termbox.cell, Termbox.fill, Termbox.cursor, -- ** Cell Termbox.Cell, Termbox.char, Termbox.fg, Termbox.bg, Termbox.bold, Termbox.underline, Termbox.blink, -- ** Colors Termbox.Color, -- *** Basic colors Termbox.defaultColor, Termbox.red, Termbox.green, Termbox.yellow, Termbox.blue, Termbox.magenta, Termbox.cyan, Termbox.white, Termbox.bright, -- *** 216 miscellaneous colors Termbox.color, -- *** 24 monochrome colors Termbox.gray, -- * Event handling Termbox.Event (..), Termbox.Key (..), Termbox.Mouse (..), Termbox.MouseButton (..), -- * Miscellaneous types Termbox.Pos (..), Termbox.posUp, Termbox.posDown, Termbox.posLeft, Termbox.posRight, Termbox.Size (..), ) where import Control.Concurrent.MVar import Control.Monad (forever) import qualified Ki import qualified Termbox -- | A @termbox@ program, parameterized by state __@s@__. data Program s = forall e. Program { -- | The initial state, given the initial terminal size. forall s. Program s -> Size -> s initialize :: Termbox.Size -> s, -- | Poll for a user event. Every value that this @IO@ action returns is provided to @handleEvent@. () pollEvent :: Maybe (IO e), -- | Handle an event. () handleEvent :: s -> Termbox.Event e -> IO s, -- | Render the current state. forall s. Program s -> s -> Scene render :: s -> Termbox.Scene, -- | Is the current state finished? forall s. Program s -> s -> Bool finished :: s -> Bool } -- | Run a @termbox@ program. -- -- @run@ either: -- -- * Returns immediately with an 'Termbox.Tea.InitError'. -- * Returns the final state, once it's @finished@. run :: Program s -> IO (Either Termbox.InitError s) run :: forall s. Program s -> IO (Either InitError s) run Program s program = forall a. IO a -> IO (Either InitError a) Termbox.run (forall s. Program s -> IO s run_ Program s program) run_ :: Program s -> IO s run_ :: forall s. Program s -> IO s run_ Program {Size -> s initialize :: Size -> s $sel:initialize:Program :: forall s. Program s -> Size -> s initialize, Maybe (IO e) pollEvent :: Maybe (IO e) $sel:pollEvent:Program :: () pollEvent, s -> Event e -> IO s handleEvent :: s -> Event e -> IO s $sel:handleEvent:Program :: () handleEvent, s -> Scene render :: s -> Scene $sel:render:Program :: forall s. Program s -> s -> Scene render, s -> Bool finished :: s -> Bool $sel:finished:Program :: forall s. Program s -> s -> Bool finished} = do s state0 <- Size -> s initialize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO Size Termbox.getSize let loop0 :: IO (Event e) -> s -> IO s loop0 IO (Event e) doPoll = let loop :: s -> IO s loop s s0 = if s -> Bool finished s s0 then forall (f :: * -> *) a. Applicative f => a -> f a pure s s0 else do Scene -> IO () Termbox.render (s -> Scene render s s0) Event e event <- IO (Event e) doPoll s s1 <- s -> Event e -> IO s handleEvent s s0 Event e event s -> IO s loop s s1 in s -> IO s loop case Maybe (IO e) pollEvent of Maybe (IO e) Nothing -> IO (Event e) -> s -> IO s loop0 forall e. IO (Event e) Termbox.poll s state0 Just IO e pollEvent1 -> do MVar (Event e) eventVar <- forall a. IO (MVar a) newEmptyMVar forall a. (Scope -> IO a) -> IO a Ki.scoped \Scope scope -> do Scope -> IO Void -> IO () Ki.fork_ Scope scope do forall (f :: * -> *) a b. Applicative f => f a -> f b forever do e event <- IO e pollEvent1 forall a. MVar a -> a -> IO () putMVar MVar (Event e) eventVar (forall e. e -> Event e Termbox.EventUser e event) Scope -> IO Void -> IO () Ki.fork_ Scope scope do forall (f :: * -> *) a b. Applicative f => f a -> f b forever do Event e event <- forall e. IO (Event e) Termbox.poll forall a. MVar a -> a -> IO () putMVar MVar (Event e) eventVar Event e event IO (Event e) -> s -> IO s loop0 (forall a. MVar a -> IO a takeMVar MVar (Event e) eventVar) s state0