termbox-tea (empty) → 0.1.0
raw patch · 5 files changed
+611/−0 lines, 5 filesdep +basedep +kidep +termbox
Dependencies added: base, ki, termbox, termbox-tea
Files
- CHANGELOG.md +3/−0
- LICENSE +11/−0
- examples/Demo.hs +292/−0
- src/Termbox/Tea.hs +212/−0
- termbox-tea.cabal +93/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## [0.1.0] - 2022-11-03++- Initial release
+ LICENSE view
@@ -0,0 +1,11 @@+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:++1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ examples/Demo.hs view
@@ -0,0 +1,292 @@+module Main (main) where++import Control.Concurrent (threadDelay)+import Control.Concurrent.MVar+import Control.Monad (forever)+import GHC.Clock (getMonotonicTime)+import qualified Ki+import qualified Termbox.Tea as Termbox+import Text.Printf (printf)++main :: IO ()+main = do+ t0 <- getMonotonicTime+ result <-+ Ki.scoped \scope -> do+ timeVar <- newEmptyMVar+ Ki.fork_ scope do+ forever do+ threadDelay 100_000+ getMonotonicTime >>= putMVar timeVar+ Termbox.run+ Termbox.Program+ { initialize,+ pollEvent = pollEvent t0 timeVar,+ handleEvent,+ render,+ finished+ }+ case result of+ Left err -> print err+ Right _state -> pure ()++data State = State+ { elapsed :: Double,+ lastKey :: Maybe Termbox.Key,+ bright :: Bool+ }++initialize :: Termbox.Size -> State+initialize _size =+ State+ { elapsed = 0,+ lastKey = Nothing,+ bright = False+ }++pollEvent :: Double -> MVar Double -> Maybe (IO Double)+pollEvent t0 timeVar =+ Just do+ t1 <- takeMVar timeVar+ pure (t1 - t0)++handleEvent :: State -> Termbox.Event Double -> IO State+handleEvent State {elapsed, lastKey, bright} = \case+ Termbox.EventKey key ->+ pure+ State+ { elapsed,+ lastKey = Just key,+ bright =+ case key of+ Termbox.KeyChar '*' -> not bright+ _ -> bright+ }+ Termbox.EventUser elapsed1 ->+ pure+ State+ { elapsed = elapsed1,+ lastKey,+ bright+ }+ _ ->+ pure+ State+ { elapsed,+ lastKey,+ bright+ }++render :: State -> Termbox.Scene+render State {elapsed, lastKey, bright} =+ renderBox Termbox.Pos {row = 1, col = 2} $+ vcat+ [ string "Welcome to Termbox. Try typing, clicking, and resizing the terminal!",+ string " ",+ hcat+ [ string "Elapsed time: ",+ string (map Termbox.char (printf "%.1fs" elapsed))+ ],+ hcat+ [ string "Latest key press: ",+ case lastKey of+ Nothing -> emptyBox+ Just event -> string (map (Termbox.bold . Termbox.char) (show event))+ ],+ string " ",+ string "default red green yellow blue magenta cyan white",+ hcat+ [ rect+ Rect+ { size = Termbox.Size {width = 7, height = 2},+ color = brighten Termbox.defaultColor+ },+ string " ",+ rect+ Rect+ { size = Termbox.Size {width = 3, height = 2},+ color = brighten Termbox.red+ },+ string " ",+ rect+ Rect+ { size = Termbox.Size {width = 5, height = 2},+ color = brighten Termbox.green+ },+ string " ",+ rect+ Rect+ { size = Termbox.Size {width = 6, height = 2},+ color = brighten Termbox.yellow+ },+ string " ",+ rect+ Rect+ { size = Termbox.Size {width = 4, height = 2},+ color = brighten Termbox.blue+ },+ string " ",+ rect+ Rect+ { size = Termbox.Size {width = 7, height = 2},+ color = brighten Termbox.magenta+ },+ string " ",+ rect+ Rect+ { size = Termbox.Size {width = 4, height = 2},+ color = brighten Termbox.cyan+ },+ string " ",+ rect+ Rect+ { size = Termbox.Size {width = 5, height = 2},+ color = brighten Termbox.white+ },+ string " ",+ vcat+ [ string ("Press " ++ [Termbox.bold (Termbox.char '*')] ++ " to toggle brightness."),+ string+ ( let selected = map (Termbox.bg (Termbox.gray 20) . Termbox.fg (Termbox.gray 0))+ in if bright+ then "normal " ++ selected "bright"+ else selected "normal" ++ " bright"+ )+ ]+ ],+ string " ",+ string "color 0 .. color 215",+ vcat+ ( map+ ( \is ->+ hcat+ ( map+ ( \i ->+ acat+ [ rect+ Rect+ { size = Termbox.Size {width = 4, height = 2},+ color = Termbox.color i+ },+ string (map (Termbox.bg (Termbox.color i) . Termbox.char) (show i))+ ]+ )+ is+ )+ )+ (chunksOf 24 [0 .. 215])+ ),+ string " ",+ string "gray 0 .. gray 23",+ hcat+ ( map+ ( \i ->+ acat+ [ rect+ Rect+ { size = Termbox.Size {width = 4, height = 2},+ color = Termbox.gray i+ },+ string (map (Termbox.bg (Termbox.gray i) . Termbox.char) (show i))+ ]+ )+ [0 .. 23]+ ),+ string " ",+ hcat+ [ string (map Termbox.bold "This text is bold."),+ string " ",+ string (map Termbox.underline "This text is underlined."),+ string " ",+ string (map Termbox.blink "This text is blinking (maybe).")+ ],+ string " ",+ hcat+ [ string "Press ",+ string (map Termbox.bold "Esc"),+ string " to quit!"+ ]+ ]+ where+ brighten :: Termbox.Color -> Termbox.Color+ brighten =+ if bright+ then Termbox.bright+ else id++finished :: State -> Bool+finished State {lastKey} =+ case lastKey of+ Just Termbox.KeyEsc -> True+ _ -> False++data Box+ = Box !Termbox.Size Content++data Content+ = E+ | O !Termbox.Cell+ | A !Box !Box+ | H !Box !Box+ | V !Box !Box++emptyBox :: Box+emptyBox =+ Box (Termbox.Size 0 0) E++one :: Termbox.Cell -> Box+one cell =+ Box (Termbox.Size 1 1) (O cell) -- assume it's not an empty cell *shrug*++acat :: [Box] -> Box+acat =+ foldr f emptyBox+ where+ f :: Box -> Box -> Box+ f box1@(Box (Termbox.Size w1 h1) _) box2@(Box (Termbox.Size w2 h2) _) =+ Box (Termbox.Size (max w1 w2) (max h1 h2)) (A box1 box2)++hcat :: [Box] -> Box+hcat =+ foldr f emptyBox+ where+ f :: Box -> Box -> Box+ f box1@(Box (Termbox.Size w1 h1) _) box2@(Box (Termbox.Size w2 h2) _) =+ Box (Termbox.Size (w1 + w2) (max h1 h2)) (H box1 box2)++vcat :: [Box] -> Box+vcat =+ foldr f emptyBox+ where+ f :: Box -> Box -> Box+ f box1@(Box (Termbox.Size w1 h1) _) box2@(Box (Termbox.Size w2 h2) _) =+ Box (Termbox.Size (max w1 w2) (h1 + h2)) (V box1 box2)++renderBox :: Termbox.Pos -> Box -> Termbox.Scene+renderBox pos (Box _ content) =+ case content of+ E -> mempty+ O cell -> Termbox.cell pos cell+ A box1 box2 -> renderBox pos box1 <> renderBox pos box2+ H box1@(Box (Termbox.Size w1 _) _) box2 -> renderBox pos box1 <> renderBox (Termbox.posRight w1 pos) box2+ V box1@(Box (Termbox.Size _ h1) _) box2 -> renderBox pos box1 <> renderBox (Termbox.posDown h1 pos) box2++string :: [Termbox.Cell] -> Box+string =+ hcat . map one++data Rect = Rect+ { size :: Termbox.Size,+ color :: Termbox.Color+ }++rect :: Rect -> Box+rect Rect {size = Termbox.Size {width, height}, color} =+ vcat (replicate height (string (replicate width (Termbox.bg color (Termbox.char ' ')))))++chunksOf :: Int -> [a] -> [[a]]+chunksOf n = \case+ [] -> []+ xs ->+ let (ys, zs) = splitAt n xs+ in ys : chunksOf n zs
+ src/Termbox/Tea.hs view
@@ -0,0 +1,212 @@+-- |+-- 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.+ 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.+ render :: s -> Termbox.Scene,+ -- | Is the current state finished?+ finished :: s -> Bool+ }++-- | Run a @termbox@ program.+--+-- @run@ either:+--+-- * Returns immediately with an 'InitError'.+-- * Returns the final state, once it's @finished@.+run :: Program s -> IO (Either Termbox.InitError s)+run program =+ Termbox.run (run_ program)++run_ :: Program s -> IO s+run_ Program {initialize, pollEvent, handleEvent, render, finished} = do+ state0 <- initialize <$> Termbox.getSize++ let loop0 doPoll =+ let loop s0 =+ if finished s0+ then pure s0+ else do+ Termbox.render (render s0)+ event <- doPoll+ s1 <- handleEvent s0 event+ loop s1+ in loop++ case pollEvent of+ Nothing -> loop0 Termbox.poll state0+ Just pollEvent1 -> do+ eventVar <- newEmptyMVar++ Ki.scoped \scope -> do+ Ki.fork_ scope do+ forever do+ event <- pollEvent1+ putMVar eventVar (Termbox.EventUser event)++ Ki.fork_ scope do+ forever do+ event <- Termbox.poll+ putMVar eventVar event++ loop0 (takeMVar eventVar) state0
+ termbox-tea.cabal view
@@ -0,0 +1,93 @@+cabal-version: 2.4++author: Mitchell Rosen+bug-reports: https://github.com/termbox/termbox-haskell/issues+build-type: Simple+category: User Interfaces+copyright: (c) 2018-2022, Mitchell Rosen+description:+ This package provides an Elm Architecture interface to @termbox@ programs.+ .+ See also:+ .+ * @<https://hackage.haskell.org/package/termbox-banana termbox-banana>@ for a @reactive-banana@ FRP interface.+homepage: https://github.com/termbox/termbox-haskell+license: BSD-3-Clause+license-file: LICENSE+maintainer: Mitchell Rosen <mitchellwrosen@gmail.com>+name: termbox-tea+synopsis: termbox + The Elm Architecture+tested-with: GHC == 9.0.2, GHC == 9.2.4, GHC == 9.4.2+version: 0.1.0++extra-source-files:+ CHANGELOG.md++source-repository head+ type: git+ location: git://github.com/termbox/termbox-haskell.git++flag build-examples+ default: False+ manual: True++common component+ default-extensions:+ BlockArguments+ CApiFFI+ DeriveAnyClass+ DeriveFunctor+ DeriveGeneric+ DerivingStrategies+ DerivingVia+ DuplicateRecordFields+ ExistentialQuantification+ FlexibleInstances+ GeneralizedNewtypeDeriving+ InstanceSigs+ LambdaCase+ NamedFieldPuns+ NumericUnderscores+ OverloadedStrings+ PatternSynonyms+ TypeApplications+ default-language: Haskell2010+ ghc-options:+ -Weverything+ -Wno-all-missed-specialisations+ -Wno-implicit-prelude+ -Wno-missing-import-lists+ -Wno-missing-local-signatures+ -Wno-monomorphism-restriction+ -Wno-safe+ -Wno-unsafe+ if impl(ghc >= 8.10)+ ghc-options:+ -Wno-missing-safe-haskell-mode+ -Wno-prepositive-qualified-module+ if impl(ghc >= 9.2)+ ghc-options:+ -Wno-missing-kind-signatures++library+ import: component+ build-depends:+ base ^>= 4.13 || ^>= 4.14 || ^>= 4.15 || ^>= 4.16 || ^>= 4.17,+ termbox ^>= 1.1.0,+ ki ^>= 1.0,+ exposed-modules: Termbox.Tea+ hs-source-dirs: src++executable termbox-example-demo+ import: component+ if !flag(build-examples)+ buildable: False+ build-depends:+ base,+ ki ^>= 1.0,+ termbox-tea,+ ghc-options:+ -rtsopts+ -threaded+ hs-source-dirs: examples+ main-is: Demo.hs