diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,10 @@ -## [1.0.0] - Unreleased +## [1.1.0] - 2022-11-03 + +- Split off Elm Architecture wrapper into `termbox-tea` package, and expose `run`/`initialize`/`finalize` instead. +- Rename `Mouse` to `MouseButton`, rename its constructors, and add `Mouse` type (`MouseButton` + `Pos`) + +## [1.0.0] - 2022-10-25 + - Rework `run`; add `Program` record of callbacks - Add user events to `Event` type - Overhaul `Attr`+`Cell`+`Cells`+`Cursor` API; now it's `Cell`+`Color`+`Scene` @@ -14,6 +20,7 @@ - Drop support for GHC < 8.8 ## [0.3.0] - 2020-09-20 + - Add `Cells` and `Cursor` types - Export `Termbox.Internal` module that roughly corresponds to the C library - Add a few arguments to the action provided to `run` @@ -29,9 +36,11 @@ - Remove support for GHC < 8.2 ## [0.2.0.1] - 2020-06-27 + - Bump `base` upper bound ## [0.2.0] - 2019-06-21 + - Add `getCells` function - Add `run` function - Rename `size` to `getSize` @@ -41,4 +50,5 @@ - Remove `buffer` function ## [0.1.0] - 2018-07-18 + - Initial release diff --git a/examples/Demo.hs b/examples/Demo.hs deleted file mode 100644 --- a/examples/Demo.hs +++ /dev/null @@ -1,292 +0,0 @@ -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 -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 diff --git a/src/Termbox.hs b/src/Termbox.hs --- a/src/Termbox.hs +++ b/src/Termbox.hs @@ -1,111 +1,25 @@ -- | --- -- This module provides a high-level wrapper around @termbox@, a simple C library for writing text-based user -- interfaces: -- --- 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 qualified --- --- main :: IO () --- main = do --- result <- --- Termbox.'run' --- Termbox.'Program' --- { initialize, --- pollEvent, --- handleEvent, --- handleEventError, --- 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.'Size' -> MyState --- initialize _size = --- MyState --- { keysPressed = 0, --- pressedEsc = False --- } --- --- pollEvent :: Maybe (IO Void) --- pollEvent = --- Nothing --- --- handleEvent :: MyState -> Termbox.'Event' Void -> IO MyState --- handleEvent state = \\case --- Termbox.'EventKey' key -> --- pure --- MyState --- { keysPressed = state.keysPressed + 1, --- pressedEsc = --- case key of --- Termbox.'KeyEsc' -> True --- _ -> False --- } --- _ -> pure state --- --- handleEventError :: MyState -> IO MyState --- handleEventError state = --- pure state --- --- render :: MyState -> Termbox.'Scene' --- render state = --- fold --- [ string --- Termbox.'Pos' {row = 2, col = 4} --- ("Number of keys pressed: " ++ map Termbox.'char' (show state.keysPressed)) --- , string --- Termbox.'Pos' {row = 4, col = 4} --- ("Press " ++ map (Termbox.'bold' . Termbox.'char') "Esc" ++ " to quit.") --- ] +-- You may prefer to use one of the following interfaces instead: -- --- finished :: MyState -> Bool --- finished state = --- state.pressedEsc +-- * @@, a @reactive-banana@ FRP interface. +-- * @@, an Elm Architecture interface. -- --- string :: Termbox.'Pos' -> [Termbox.'Cell'] -> Termbox.'Scene' --- string pos cells = --- foldMap --- (\\(i, cell) -> --- Termbox.'cell' --- Termbox.'Pos' {row = pos.row, col = pos.col + i} --- cell) --- (zip [0 ..] cells) --- @ +-- This module is intended to be imported qualified. module Termbox - ( -- * Termbox - Program (..), + ( -- * Main run, + initialize, + finalize, InitError (..), -- * Terminal contents -- ** Scene Scene, + render, cell, fill, cursor, @@ -155,6 +69,8 @@ KeyCtrlUnderscore ), Mouse (..), + MouseButton (..), + poll, -- * Miscellaneous types Pos (..), @@ -163,14 +79,10 @@ posLeft, posRight, Size (..), + getSize, ) where -import Control.Concurrent.MVar -import Control.Exception -import Control.Monad (forever) -import qualified Ki -import qualified Termbox.Bindings.Hs import Termbox.Internal.Cell (Cell, bg, blink, bold, char, fg, underline) import Termbox.Internal.Color ( Color, @@ -200,106 +112,18 @@ pattern KeyCtrlM, pattern KeyCtrlUnderscore, ) +import Termbox.Internal.Main (InitError (..), finalize, initialize, run) import Termbox.Internal.Mouse - ( Mouse - ( MouseLeft, - MouseMiddle, - MouseRelease, - MouseRight, - MouseWheelDown, - MouseWheelUp + ( Mouse (..), + MouseButton + ( LeftClick, + MiddleClick, + ReleaseClick, + RightClick, + WheelDown, + WheelUp ), ) import Termbox.Internal.Pos (Pos (..), posDown, posLeft, posRight, posUp) -import Termbox.Internal.Scene (Scene, cell, cursor, drawScene, fill) -import Termbox.Internal.Size (Size (..)) - --- | @termbox@ initialization errors. -data InitError - = FailedToOpenTTY - | PipeTrapError - | UnsupportedTerminal - deriving stock (Show) - -instance Exception InitError - --- | A @termbox@ program, parameterized by state __@s@__. -data Program s = forall e. Program - { -- | The initial state, given the initial terminal size. - initialize :: 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 -> Event e -> IO s, - -- | Render the current state. - render :: s -> Scene, - -- | Is the current state finished? - finished :: s -> Bool - } - --- | Run a @termbox@ program. --- --- Either returns immediately with an 'InitError', or once the program state is finished with the final state. -run :: Program s -> IO (Either InitError s) -run program = do - mask \unmask -> - Termbox.Bindings.Hs.tb_init >>= \case - Left err -> - (pure . Left) case err of - Termbox.Bindings.Hs.TB_EFAILED_TO_OPEN_TTY -> FailedToOpenTTY - Termbox.Bindings.Hs.TB_EPIPE_TRAP_ERROR -> PipeTrapError - Termbox.Bindings.Hs.TB_EUNSUPPORTED_TERMINAL -> UnsupportedTerminal - Right () -> do - result <- unmask (runProgram program) `onException` shutdown - shutdown - pure (Right result) - -runProgram :: Program s -> IO s -runProgram Program {initialize, pollEvent, handleEvent, render, finished} = do - _ <- Termbox.Bindings.Hs.tb_select_input_mode Termbox.Bindings.Hs.TB_INPUT_MOUSE - _ <- Termbox.Bindings.Hs.tb_select_output_mode Termbox.Bindings.Hs.TB_OUTPUT_256 - width <- Termbox.Bindings.Hs.tb_width - height <- Termbox.Bindings.Hs.tb_height - - let state0 = - initialize Size {width, height} - - let loop0 doPoll = - let loop s0 = - if finished s0 - then pure s0 - else do - drawScene (render s0) - event <- doPoll - s1 <- handleEvent s0 event - loop s1 - in loop - - case pollEvent of - Nothing -> loop0 pollIgnoringErrors state0 - Just pollEvent1 -> do - eventVar <- newEmptyMVar - - Ki.scoped \scope -> do - Ki.fork_ scope do - forever do - event <- pollEvent1 - putMVar eventVar (EventUser event) - - Ki.fork_ scope do - forever do - event <- pollIgnoringErrors - putMVar eventVar event - - loop0 (takeMVar eventVar) state0 - -pollIgnoringErrors :: IO (Event e) -pollIgnoringErrors = - poll >>= \case - Left () -> pollIgnoringErrors - Right event -> pure event - -shutdown :: IO () -shutdown = do - _ <- Termbox.Bindings.Hs.tb_select_output_mode Termbox.Bindings.Hs.TB_OUTPUT_NORMAL - Termbox.Bindings.Hs.tb_shutdown +import Termbox.Internal.Scene (Scene, cell, cursor, fill, render) +import Termbox.Internal.Size (Size (..), getSize) diff --git a/src/Termbox/Internal/Event.hs b/src/Termbox/Internal/Event.hs --- a/src/Termbox/Internal/Event.hs +++ b/src/Termbox/Internal/Event.hs @@ -8,7 +8,7 @@ import GHC.Generics (Generic) import qualified Termbox.Bindings.Hs import Termbox.Internal.Key (Key (KeyChar), parseKey) -import Termbox.Internal.Mouse (Mouse (Mouse)) +import Termbox.Internal.Mouse (Mouse (..), MouseButton (..)) import Termbox.Internal.Pos (Pos (..)) import Termbox.Internal.Size (Size (..)) import Prelude hiding (mod) @@ -20,14 +20,20 @@ | -- | Resize event EventResize !Size | -- | Mouse event - EventMouse !Mouse !Pos + EventMouse !Mouse | -- | User event EventUser !e deriving stock (Eq, Generic, Show) --- Block until an Event arrives. -poll :: IO (Either () (Event e)) -poll = do +-- | Poll for an event. +poll :: IO (Event e) +poll = + poll_ >>= \case + Left () -> poll + Right event -> pure event + +poll_ :: IO (Either () (Event e)) +poll_ = do result <- Termbox.Bindings.Hs.tb_poll_event pure (parseEvent <$> result) @@ -54,8 +60,11 @@ } Termbox.Bindings.Hs.TB_EVENT_MOUSE -> EventMouse - (Mouse key) - Pos - { row = fromIntegral @Int32 @Int y, - col = fromIntegral @Int32 @Int x + Mouse + { button = MouseButton key, + pos = + Pos + { row = fromIntegral @Int32 @Int y, + col = fromIntegral @Int32 @Int x + } } diff --git a/src/Termbox/Internal/Main.hs b/src/Termbox/Internal/Main.hs new file mode 100644 --- /dev/null +++ b/src/Termbox/Internal/Main.hs @@ -0,0 +1,51 @@ +module Termbox.Internal.Main + ( run, + initialize, + finalize, + InitError (..), + ) +where + +import Control.Exception (Exception, mask, onException) +import qualified Termbox.Bindings.Hs + +-- | @termbox@ initialization errors. +data InitError + = FailedToOpenTTY + | PipeTrapError + | UnsupportedTerminal + deriving anyclass (Exception) + deriving stock (Show) + +-- | Initialize a @termbox@ program, and if that succeeds, run the provided action, then finalize the @termbox@ program. +run :: IO a -> IO (Either InitError a) +run action = + mask \unmask -> + initialize >>= \case + Left err -> pure (Left err) + Right () -> do + result <- unmask action `onException` finalize + finalize + pure (Right result) + +-- | Initialize a @termbox@ program. +-- +-- If @initialize@ succeeds, it must be paired with a call to 'finalize'. +initialize :: IO (Either InitError ()) +initialize = + Termbox.Bindings.Hs.tb_init >>= \case + Left err -> + (pure . Left) case err of + Termbox.Bindings.Hs.TB_EFAILED_TO_OPEN_TTY -> FailedToOpenTTY + Termbox.Bindings.Hs.TB_EPIPE_TRAP_ERROR -> PipeTrapError + Termbox.Bindings.Hs.TB_EUNSUPPORTED_TERMINAL -> UnsupportedTerminal + Right () -> do + _ <- Termbox.Bindings.Hs.tb_select_input_mode Termbox.Bindings.Hs.TB_INPUT_MOUSE + _ <- Termbox.Bindings.Hs.tb_select_output_mode Termbox.Bindings.Hs.TB_OUTPUT_256 + pure (Right ()) + +-- | Shut down a @termbox@ program. +finalize :: IO () +finalize = do + _ <- Termbox.Bindings.Hs.tb_select_output_mode Termbox.Bindings.Hs.TB_OUTPUT_NORMAL + Termbox.Bindings.Hs.tb_shutdown diff --git a/src/Termbox/Internal/Mouse.hs b/src/Termbox/Internal/Mouse.hs --- a/src/Termbox/Internal/Mouse.hs +++ b/src/Termbox/Internal/Mouse.hs @@ -1,48 +1,58 @@ module Termbox.Internal.Mouse - ( Mouse - ( Mouse, - MouseLeft, - MouseMiddle, - MouseRelease, - MouseRight, - MouseWheelUp, - MouseWheelDown + ( Mouse (..), + MouseButton + ( MouseButton, + LeftClick, + MiddleClick, + RightClick, + ReleaseClick, + WheelDown, + WheelUp ), ) where +import GHC.Generics (Generic) import qualified Termbox.Bindings.Hs +import Termbox.Internal.Pos (Pos) -- | A mouse event. -newtype Mouse - = Mouse Termbox.Bindings.Hs.Tb_key +data Mouse = Mouse + { button :: !MouseButton, + pos :: !Pos + } + deriving stock (Eq, Generic, Ord, Show) + +-- | A mouse button. +newtype MouseButton + = MouseButton Termbox.Bindings.Hs.Tb_key deriving stock (Eq, Ord) -instance Show Mouse where +instance Show MouseButton where show = \case - MouseLeft -> "MouseLeft" - MouseMiddle -> "MouseMiddle" - MouseRelease -> "MouseRelease" - MouseRight -> "MouseRight" - MouseWheelDown -> "MouseWheelDown" - MouseWheelUp -> "MouseWheelUp" + LeftClick -> "LeftClick" + MiddleClick -> "MiddleClick" + ReleaseClick -> "ReleaseClick" + RightClick -> "RightClick" + WheelDown -> "WheelDown" + WheelUp -> "WheelUp" -pattern MouseLeft :: Mouse -pattern MouseLeft = Mouse Termbox.Bindings.Hs.TB_KEY_MOUSE_LEFT +pattern LeftClick :: MouseButton +pattern LeftClick = MouseButton Termbox.Bindings.Hs.TB_KEY_MOUSE_LEFT -pattern MouseMiddle :: Mouse -pattern MouseMiddle = Mouse Termbox.Bindings.Hs.TB_KEY_MOUSE_MIDDLE +pattern MiddleClick :: MouseButton +pattern MiddleClick = MouseButton Termbox.Bindings.Hs.TB_KEY_MOUSE_MIDDLE -pattern MouseRelease :: Mouse -pattern MouseRelease = Mouse Termbox.Bindings.Hs.TB_KEY_MOUSE_RELEASE +pattern RightClick :: MouseButton +pattern RightClick = MouseButton Termbox.Bindings.Hs.TB_KEY_MOUSE_RIGHT -pattern MouseRight :: Mouse -pattern MouseRight = Mouse Termbox.Bindings.Hs.TB_KEY_MOUSE_RIGHT +pattern ReleaseClick :: MouseButton +pattern ReleaseClick = MouseButton Termbox.Bindings.Hs.TB_KEY_MOUSE_RELEASE -pattern MouseWheelDown :: Mouse -pattern MouseWheelDown = Mouse Termbox.Bindings.Hs.TB_KEY_MOUSE_WHEEL_DOWN +pattern WheelDown :: MouseButton +pattern WheelDown = MouseButton Termbox.Bindings.Hs.TB_KEY_MOUSE_WHEEL_DOWN -pattern MouseWheelUp :: Mouse -pattern MouseWheelUp = Mouse Termbox.Bindings.Hs.TB_KEY_MOUSE_WHEEL_UP +pattern WheelUp :: MouseButton +pattern WheelUp = MouseButton Termbox.Bindings.Hs.TB_KEY_MOUSE_WHEEL_UP -{-# COMPLETE MouseLeft, MouseMiddle, MouseRelease, MouseRight, MouseWheelDown, MouseWheelUp #-} +{-# COMPLETE LeftClick, MiddleClick, ReleaseClick, RightClick, WheelDown, WheelUp #-} diff --git a/src/Termbox/Internal/Scene.hs b/src/Termbox/Internal/Scene.hs --- a/src/Termbox/Internal/Scene.hs +++ b/src/Termbox/Internal/Scene.hs @@ -1,6 +1,6 @@ module Termbox.Internal.Scene ( Scene, - drawScene, + render, cell, fill, cursor, @@ -43,9 +43,9 @@ draw1 color } --- Draw a scene. -drawScene :: Scene -> IO () -drawScene Scene {sceneFill, sceneDraw} = do +-- | Render a scene. +render :: Scene -> IO () +render Scene {sceneFill, sceneDraw} = do let background = case sceneFill of Nothing -> Termbox.Bindings.Hs.TB_DEFAULT diff --git a/src/Termbox/Internal/Size.hs b/src/Termbox/Internal/Size.hs --- a/src/Termbox/Internal/Size.hs +++ b/src/Termbox/Internal/Size.hs @@ -1,9 +1,11 @@ module Termbox.Internal.Size ( Size (..), + getSize, ) where import GHC.Generics (Generic) +import qualified Termbox.Bindings.Hs -- | A terminal size. data Size = Size @@ -11,3 +13,10 @@ height :: {-# UNPACK #-} !Int } deriving stock (Eq, Generic, Ord, Show) + +-- | Get the current terminal size. +getSize :: IO Size +getSize = do + width <- Termbox.Bindings.Hs.tb_width + height <- Termbox.Bindings.Hs.tb_height + pure Size {width, height} diff --git a/termbox.cabal b/termbox.cabal --- a/termbox.cabal +++ b/termbox.cabal @@ -11,16 +11,18 @@ . See also: . + * @@ for a @reactive-banana@ FRP interface. + * @@ for an Elm Architecture interface. * @@ for lower-level bindings. * @@ for even lower-level bindings. homepage: https://github.com/termbox/termbox-haskell -license-file: LICENSE license: BSD-3-Clause +license-file: LICENSE maintainer: Mitchell Rosen name: termbox synopsis: termbox tested-with: GHC == 9.0.2, GHC == 9.2.4, GHC == 9.4.2 -version: 1.0.0 +version: 1.1.0 extra-source-files: CHANGELOG.md @@ -29,10 +31,6 @@ type: git location: git://github.com/termbox/termbox-haskell.git -flag build-examples - default: False - manual: True - common component default-extensions: BlockArguments @@ -76,7 +74,6 @@ build-depends: base ^>= 4.13 || ^>= 4.14 || ^>= 4.15 || ^>= 4.16 || ^>= 4.17, termbox-bindings-hs ^>= 0.1, - ki ^>= 1.0, exposed-modules: Termbox hs-source-dirs: src other-modules: @@ -84,21 +81,8 @@ Termbox.Internal.Color Termbox.Internal.Event Termbox.Internal.Key + Termbox.Internal.Main Termbox.Internal.Mouse Termbox.Internal.Pos Termbox.Internal.Size Termbox.Internal.Scene - -executable termbox-example-demo - import: component - if !flag(build-examples) - buildable: False - build-depends: - base, - ki ^>= 1.0, - termbox, - ghc-options: - -rtsopts - -threaded - hs-source-dirs: examples - main-is: Demo.hs