termbox-banana-0.4.0: reactive-banana + termbox
Safe HaskellSafe-Inferred
LanguageHaskell2010

Termbox.Banana

Synopsis

Introduction

This module is intended to be imported qualified:

import qualified Termbox.Banana as Termbox

👉 Quick start example

Expand

This is a program that displays the last key pressed, and quits on Esc:

{-# LANGUAGE LambdaCase #-}

module Main where

import Data.Void (Void)
import Reactive.Banana
import Reactive.Banana.Frameworks
import qualified Termbox.Banana as Termbox

main :: IO ()
main =
  Termbox.run moment

moment
  :: (Void -> IO ())
  -> Event (Termbox.Event Void)
  -> Behavior (Int, Int)
  -> MomentIO (Behavior (Termbox.Cells, Termbox.Cursor), Event ())
moment _fireUserEvent eEvent _bSize = do
  let eQuit = () <$ filterE isKeyEsc eEvent
  bLatestEvent <- stepper Nothing (Just <$> eEvent)
  let bCells = maybe mempty renderEvent <$> bLatestEvent
  let bScene = (,) <$> bCells <*> pure Termbox.NoCursor
  pure (bScene, eQuit)

renderEvent :: Show a => Termbox.Event a -> Termbox.Cells
renderEvent =
  foldMap (\(i, c) -> Termbox.set i 0 (Termbox.Cell c mempty mempty))
    . zip [0..]
    . show

isKeyEsc :: Termbox.Event a -> Bool
isKeyEsc = \case
  Termbox.EventKey Termbox.KeyEsc -> True
  _ -> False

Core API

data Event a Source #

A key press, terminal resize, mouse click, or a user event.

Instances

Instances details
Show a => Show (Event a) Source # 
Instance details

Defined in Termbox.Banana

Methods

showsPrec :: Int -> Event a -> ShowS #

show :: Event a -> String #

showList :: [Event a] -> ShowS #

Eq a => Eq (Event a) Source # 
Instance details

Defined in Termbox.Banana

Methods

(==) :: Event a -> Event a -> Bool #

(/=) :: Event a -> Event a -> Bool #

Ord a => Ord (Event a) Source # 
Instance details

Defined in Termbox.Banana

Methods

compare :: Event a -> Event a -> Ordering #

(<) :: Event a -> Event a -> Bool #

(<=) :: Event a -> Event a -> Bool #

(>) :: Event a -> Event a -> Bool #

(>=) :: Event a -> Event a -> Bool #

max :: Event a -> Event a -> Event a #

min :: Event a -> Event a -> Event a #

type Program a b Source #

Arguments

 = (a -> IO ())

Callback that produces a user event.

-> Event (Event a)

Event stream.

-> Behavior (Int, Int)

Time-varying terminal size (width, then height).

-> MomentIO (Behavior (Cells, Cursor), Event b)

The time-varying scene to render, and an event stream of arbitrary values, only the first of which is relevant, which ends the termbox program and returns from run.

run :: Program a b -> IO b Source #

Run a termbox program.

Re-exports from termbox

set :: Int -> Int -> Cell -> Cells #

data Attr #

Instances

Instances details
Monoid Attr 
Instance details

Defined in Termbox.Attr

Methods

mempty :: Attr #

mappend :: Attr -> Attr -> Attr #

mconcat :: [Attr] -> Attr #

Semigroup Attr 
Instance details

Defined in Termbox.Attr

Methods

(<>) :: Attr -> Attr -> Attr #

sconcat :: NonEmpty Attr -> Attr #

stimes :: Integral b => b -> Attr -> Attr #

Num Attr 
Instance details

Defined in Termbox.Attr

Methods

(+) :: Attr -> Attr -> Attr #

(-) :: Attr -> Attr -> Attr #

(*) :: Attr -> Attr -> Attr #

negate :: Attr -> Attr #

abs :: Attr -> Attr #

signum :: Attr -> Attr #

fromInteger :: Integer -> Attr #

Show Attr 
Instance details

Defined in Termbox.Attr

Methods

showsPrec :: Int -> Attr -> ShowS #

show :: Attr -> String #

showList :: [Attr] -> ShowS #

Eq Attr 
Instance details

Defined in Termbox.Attr

Methods

(==) :: Attr -> Attr -> Bool #

(/=) :: Attr -> Attr -> Bool #

data Cell #

Constructors

Cell !Char !Attr !Attr 

Instances

Instances details
Storable Cell 
Instance details

Defined in Termbox.Cell

Methods

sizeOf :: Cell -> Int #

alignment :: Cell -> Int #

peekElemOff :: Ptr Cell -> Int -> IO Cell #

pokeElemOff :: Ptr Cell -> Int -> Cell -> IO () #

peekByteOff :: Ptr b -> Int -> IO Cell #

pokeByteOff :: Ptr b -> Int -> Cell -> IO () #

peek :: Ptr Cell -> IO Cell #

poke :: Ptr Cell -> Cell -> IO () #

Show Cell 
Instance details

Defined in Termbox.Cell

Methods

showsPrec :: Int -> Cell -> ShowS #

show :: Cell -> String #

showList :: [Cell] -> ShowS #

Eq Cell 
Instance details

Defined in Termbox.Cell

Methods

(==) :: Cell -> Cell -> Bool #

(/=) :: Cell -> Cell -> Bool #

data Cells #

Instances

Instances details
Monoid Cells 
Instance details

Defined in Termbox.Cells

Methods

mempty :: Cells #

mappend :: Cells -> Cells -> Cells #

mconcat :: [Cells] -> Cells #

Semigroup Cells 
Instance details

Defined in Termbox.Cells

Methods

(<>) :: Cells -> Cells -> Cells #

sconcat :: NonEmpty Cells -> Cells #

stimes :: Integral b => b -> Cells -> Cells #

data Cursor #

Constructors

Cursor !Int !Int 
NoCursor 

data InitError #

Instances

Instances details
Exception InitError 
Instance details

Defined in Termbox

Show InitError 
Instance details

Defined in Termbox

pattern KeyCtrl2 :: Key #

pattern KeyCtrl3 :: Key #

pattern KeyCtrl4 :: Key #

pattern KeyCtrl5 :: Key #

pattern KeyCtrl7 :: Key #

pattern KeyCtrlH :: Key #

pattern KeyCtrlI :: Key #

pattern KeyCtrlM :: Key #

data Mouse #

Instances

Instances details
Show Mouse 
Instance details

Defined in Termbox.Mouse

Methods

showsPrec :: Int -> Mouse -> ShowS #

show :: Mouse -> String #

showList :: [Mouse] -> ShowS #

Eq Mouse 
Instance details

Defined in Termbox.Mouse

Methods

(==) :: Mouse -> Mouse -> Bool #

(/=) :: Mouse -> Mouse -> Bool #

Ord Mouse 
Instance details

Defined in Termbox.Mouse

Methods

compare :: Mouse -> Mouse -> Ordering #

(<) :: Mouse -> Mouse -> Bool #

(<=) :: Mouse -> Mouse -> Bool #

(>) :: Mouse -> Mouse -> Bool #

(>=) :: Mouse -> Mouse -> Bool #

max :: Mouse -> Mouse -> Mouse #

min :: Mouse -> Mouse -> Mouse #

data PollError #

Constructors

PollError 

Instances

Instances details
Exception PollError 
Instance details

Defined in Termbox.Event

Show PollError 
Instance details

Defined in Termbox.Event