diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +## [1.0.0] - 2022-11-03 + +- Rework `run` type +- Bump to `termbox-1.1.0`, whose API changes are visible here, too + ## [0.4.0] - 2022-07-16 - Parameterize `TermboxEvent` (now `Event`) by user event diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright 2018 Mitchell Rosen +Copyright 2018-2022 Mitchell Rosen Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: diff --git a/README.md b/README.md deleted file mode 100644 --- a/README.md +++ /dev/null @@ -1,6 +0,0 @@ -# `termbox-banana` - -[![GitHub CI](https://github.com/mitchellwrosen/termbox-banana/workflows/CI/badge.svg)](https://github.com/mitchellwrosen/termbox-banana/actions) -[![Hackage](https://img.shields.io/hackage/v/termbox-banana.svg)](https://hackage.haskell.org/package/termbox-banana) -[![Stackage LTS](https://stackage.org/package/termbox-banana/badge/lts)](https://www.stackage.org/lts/package/termbox-banana) -[![Stackage Nightly](https://stackage.org/package/termbox-banana/badge/nightly)](https://www.stackage.org/nightly/package/termbox-banana) diff --git a/src/Termbox/Banana.hs b/src/Termbox/Banana.hs --- a/src/Termbox/Banana.hs +++ b/src/Termbox/Banana.hs @@ -1,171 +1,202 @@ -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE ScopedTypeVariables #-} - +-- | +-- This module provides a @reactive-banana@ FRP interface to @termbox@, a simple C library for writing text-based user +-- interfaces: +-- +-- See also: +-- +-- * @@, an Elm Architecture interface. +-- +-- This module is intended to be imported qualified. +-- +-- ==== __👉 Quick start example__ +-- +-- This @termbox@ program displays the number of keys pressed. +-- +-- @ +-- {-\# LANGUAGE DuplicateRecordFields \#-} +-- {-\# LANGUAGE ImportQualifiedPost \#-} +-- {-\# LANGUAGE LambdaCase \#-} +-- {-\# LANGUAGE OverloadedRecordDot \#-} +-- {-\# LANGUAGE OverloadedStrings \#-} +-- {-\# LANGUAGE NoFieldSelectors \#-} +-- +-- import Data.Foldable (fold) +-- import Reactive.Banana ((\<\@\>)) +-- import Reactive.Banana qualified as Banana +-- import Termbox.Banana qualified as Termbox +-- +-- main :: IO () +-- main = +-- Termbox.'run' network \>\>= \\case +-- Left err -\> putStrLn (\"Termbox program failed to initialize: \" ++ show err) +-- Right n -\> putStrLn (\"Pressed \" ++ show n ++ \" keys.\") +-- +-- network :: Banana.MonadMoment m =\> Termbox.'Inputs' -\> m (Termbox.'Outputs' Int) +-- network inputs = do +-- keysPressed <- Banana.accumB 0 ((+ 1) \<$ inputs.keys) +-- pure +-- Termbox.'Outputs' +-- { scene = render \<$\> keysPressed, +-- done = Banana.filterJust (isDone \<$\> keysPressed \<\@\> inputs.keys) +-- } +-- where +-- isDone :: Int -\> Termbox.'Termbox.Banana.Key' -\> Maybe Int +-- isDone n = \\case +-- Termbox.'Termbox.Banana.KeyEsc' -\> Just n +-- _ -\> Nothing +-- +-- render :: Int -\> Termbox.'Termbox.Banana.Scene' +-- render keysPressed = +-- fold +-- [ string +-- Termbox.'Termbox.Banana.Pos' {row = 2, col = 4} +-- (\"Number of keys pressed: \" ++ map Termbox.'Termbox.Banana.char' (show keysPressed)), +-- string +-- Termbox.'Termbox.Banana.Pos' {row = 4, col = 4} +-- (\"Press \" ++ map (Termbox.'Termbox.Banana.bold' . Termbox.'Termbox.Banana.char') \"Esc\" ++ \" to quit.\") +-- ] +-- +-- string :: Termbox.'Termbox.Banana.Pos' -\> [Termbox.'Termbox.Banana.Cell'] -\> Termbox.'Termbox.Banana.Scene' +-- string pos cells = +-- foldMap (\\(i, cell) -\> Termbox.'Termbox.Banana.cell' (Termbox.'Termbox.Banana.posRight' i pos) cell) (zip [0 ..] cells) +-- @ module Termbox.Banana - ( -- * Introduction - -- $intro - - -- * Core API - Event (..), - Program, + ( -- * Main + Inputs (..), + Outputs (..), run, + Termbox.InitError (..), - -- * Re-exports from @termbox@ - Termbox.black, - Termbox.blue, + -- * Terminal contents + + -- ** Scene + Termbox.Scene, + Termbox.cell, + Termbox.fill, + Termbox.cursor, + + -- ** Cell + Termbox.Cell, + Termbox.char, + Termbox.fg, + Termbox.bg, Termbox.bold, - Termbox.cyan, + Termbox.underline, + Termbox.blink, + + -- ** Colors + Termbox.Color, + + -- *** Basic colors + Termbox.defaultColor, + Termbox.red, Termbox.green, + Termbox.yellow, + Termbox.blue, Termbox.magenta, - Termbox.red, - Termbox.reverse, - Termbox.underline, + Termbox.cyan, Termbox.white, - Termbox.yellow, - Termbox.set, - Termbox.Attr, - Termbox.Cell (..), - Termbox.Cells, - Termbox.Cursor (..), - Termbox.InitError (..), + Termbox.bright, + + -- *** 216 miscellaneous colors + Termbox.color, + + -- *** 24 monochrome colors + Termbox.gray, + + -- * Event handling Termbox.Key (..), - pattern Termbox.KeyCtrl2, - pattern Termbox.KeyCtrl3, - pattern Termbox.KeyCtrl4, - pattern Termbox.KeyCtrl5, - pattern Termbox.KeyCtrl7, - pattern Termbox.KeyCtrlH, - pattern Termbox.KeyCtrlI, - pattern Termbox.KeyCtrlLsqBracket, - pattern Termbox.KeyCtrlM, - pattern Termbox.KeyCtrlUnderscore, Termbox.Mouse (..), - Termbox.PollError (..), + Termbox.MouseButton (..), + + -- * Miscellaneous types + Termbox.Pos (..), + Termbox.posUp, + Termbox.posDown, + Termbox.posLeft, + Termbox.posRight, + Termbox.Size (..), ) where import Control.Concurrent.MVar import Control.Monad.IO.Class (liftIO) -import Data.Function (fix) +import Data.Void (Void) import qualified Reactive.Banana as Banana import qualified Reactive.Banana.Frameworks as Banana import qualified Termbox --- $intro --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Termbox.Banana as Termbox --- @ --- --- ==== __👉 Quick start example__ --- --- 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.'Termbox.Cells', Termbox.'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.'Termbox.NoCursor' --- pure (bScene, eQuit) +-- | The inputs to a @termbox@ FRP network. +data Inputs = Inputs + { -- | The initial terminal size. + initialSize :: !Termbox.Size, + -- | Key events. + keys :: !(Banana.Event Termbox.Key), + -- | Resize events. + resizes :: !(Banana.Event Termbox.Size), + -- | Mouse events. + mouses :: !(Banana.Event Termbox.Mouse) + } + +-- | The outputs from a @termbox@ FRP network. +data Outputs a = Outputs + { -- | The scene to render. + scene :: !(Banana.Behavior Termbox.Scene), + -- | The events of arbitrary values, on the first of which is relevant, which causes 'run' to return. + -- + -- /Note/: Wrapping this event in 'Banana.once' is not necessary, as this library does so internally. + done :: !(Banana.Event a) + } + +-- | Run a @termbox@ FRP network. -- --- renderEvent :: Show a => Termbox.'Event' a -> Termbox.'Termbox.Cells' --- renderEvent = --- foldMap (\\(i, c) -> Termbox.set i 0 (Termbox.'Termbox.Cell' c mempty mempty)) --- . zip [0..] --- . show +-- @run@ either: -- --- isKeyEsc :: Termbox.'Event' a -> Bool --- isKeyEsc = \\case --- Termbox.'EventKey' Termbox.'Termbox.KeyEsc' -> True --- _ -> False --- @ +-- * Returns immediately with an 'InitError'. +-- * Returns the first value emitted by @done@. +run :: + -- | The FRP network. + (Inputs -> Banana.MomentIO (Outputs a)) -> + -- | The result of the FRP network. + IO (Either Termbox.InitError a) +run program = + Termbox.run (run_ program) --- | A key press, terminal resize, mouse click, or a user event. -data Event a - = EventKey !Termbox.Key - | EventResize !Int !Int - | EventMouse !Termbox.Mouse !Int !Int - | EventUser a - deriving stock (Eq, Ord, Show) +run_ :: (Inputs -> Banana.MomentIO (Outputs a)) -> IO a +run_ program = do + initialSize <- Termbox.getSize -type Program a b = - -- | Callback that produces a user event. - (a -> IO ()) -> - -- | Event stream. - Banana.Event (Event a) -> - -- | Time-varying terminal size (width, then height). - Banana.Behavior (Int, Int) -> - -- | 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'. - Banana.MomentIO (Banana.Behavior (Termbox.Cells, Termbox.Cursor), Banana.Event b) + doneVar <- newEmptyMVar + (keysAddHandler, fireKey) <- Banana.newAddHandler + (resizesAddHandler, fireResize) <- Banana.newAddHandler + (mousesAddHandler, fireMouse) <- Banana.newAddHandler --- | Run a @termbox@ program. -run :: Program a b -> IO b -run program = - Termbox.run $ \initialWidth initialHeight render poll -> do - doneVar <- newEmptyMVar - (eventAddHandler, fireEvent) <- Banana.newAddHandler - (userEventAddHandler, fireUserEvent) <- Banana.newAddHandler + network <- + Banana.compile do + keys <- Banana.fromAddHandler keysAddHandler + resizes <- Banana.fromAddHandler resizesAddHandler + mouses <- Banana.fromAddHandler mousesAddHandler - network <- - Banana.compile $ do - eEvent <- Banana.fromAddHandler eventAddHandler - eUserEvent <- Banana.fromAddHandler userEventAddHandler - let eTermboxEvent = - Banana.unionWith - const - ( ( \case - Termbox.EventKey key -> EventKey key - Termbox.EventResize width height -> EventResize width height - Termbox.EventMouse mouse col row -> EventMouse mouse col row - ) - <$> eEvent - ) - (EventUser <$> eUserEvent) + Outputs {scene, done} <- program Inputs {initialSize, keys, resizes, mouses} + let render = Termbox.render <$> scene - let eResize :: Banana.Event (Int, Int) - eResize = - Banana.filterJust - ( ( \case - Termbox.EventResize w h -> Just (w, h) - _ -> Nothing - ) - <$> eEvent - ) + -- Render the first scene, and again every time it changes. + liftIO =<< Banana.valueB render + Banana.reactimate' =<< Banana.changes render - bSize <- Banana.stepper (initialWidth, initialHeight) eResize - (bScene, eDone) <- program fireUserEvent eTermboxEvent bSize - let bRender = (\(cells, cursor) -> render cells cursor) <$> bScene - eRender <- Banana.changes bRender - do - action <- Banana.valueB bRender - liftIO action - Banana.reactimate (putMVar doneVar <$> eDone) - Banana.reactimate' eRender + -- Smuggle `done` values out via `doneVar` (only the first matters) + done1 <- Banana.once done + Banana.reactimate (putMVar doneVar <$> done1) - Banana.actuate network + Banana.actuate network - fix $ \loop -> do - poll >>= fireEvent - tryReadMVar doneVar >>= maybe loop pure + let loop = do + Termbox.poll @Void >>= \case + Termbox.EventKey key -> fireKey key + Termbox.EventResize size -> fireResize size + Termbox.EventMouse mouse -> fireMouse mouse + tryReadMVar doneVar >>= \case + Nothing -> loop + Just result -> pure result + + loop diff --git a/termbox-banana.cabal b/termbox-banana.cabal --- a/termbox-banana.cabal +++ b/termbox-banana.cabal @@ -1,27 +1,27 @@ cabal-version: 2.4 -name: termbox-banana -version: 0.4.0 +author: Mitchell Rosen +bug-reports: https://github.com/mitchellwrosen/termbox-banana/issues +build-type: Simple category: User Interfaces +copyright: (c) 2018-2022, Mitchell Rosen description: - A @reactive-banana@-based interface to writing @termbox@ programs. + This package provides a @reactive-banana@ FRP interface to @termbox@ programs. . - See also the package for a - lower-level, imperative interface. -synopsis: reactive-banana + termbox -author: Mitchell Rosen -maintainer: Mitchell Rosen + See also: + . + * @@ for an Elm Architecture interface. homepage: https://github.com/mitchellwrosen/termbox-banana -bug-reports: https://github.com/mitchellwrosen/termbox-banana/issues -copyright: (c) 2018-2022, Mitchell Rosen license: BSD-3-Clause license-file: LICENSE -build-type: Simple -tested-with: GHC ==8.10.7, GHC ==9.0.2, GHC ==9.2.1 +maintainer: Mitchell Rosen +name: termbox-banana +synopsis: termbox + reactive-banana +tested-with: GHC == 9.0.2, GHC == 9.2.4, GHC == 9.4.2 +version: 1.0.0 extra-source-files: CHANGELOG.md - README.md source-repository head type: git @@ -29,14 +29,17 @@ library build-depends: - base ^>= 4.11 || ^>= 4.12 || ^>= 4.13 || ^>= 4.14 || ^>= 4.15 || ^>= 4.16, - reactive-banana ^>= 1.2 || ^>= 1.3, - termbox ^>= 0.3, + base ^>= 4.13 || ^>= 4.14 || ^>= 4.15 || ^>= 4.16 || ^>= 4.17, + reactive-banana ^>= 1.3, + termbox ^>= 1.1.0, default-extensions: + BlockArguments DerivingStrategies GeneralizedNewtypeDeriving InstanceSigs LambdaCase + NamedFieldPuns + TypeApplications default-language: Haskell2010 exposed-modules: Termbox.Banana ghc-options: