packages feed

termbox 0.2.0.1 → 0.3.0

raw patch · 12 files changed

+1025/−1092 lines, 12 filesdep −arraydep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: array

Dependency ranges changed: base

API changes (from Hackage documentation)

- Termbox: InputModeAlt :: MouseMode -> InputMode
- Termbox: InputModeEsc :: MouseMode -> InputMode
- Termbox: KeyBackspace2 :: Key
- Termbox: KeyCtrl2 :: Key
- Termbox: KeyCtrl3 :: Key
- Termbox: KeyCtrl4 :: Key
- Termbox: KeyCtrl5 :: Key
- Termbox: KeyCtrl7 :: Key
- Termbox: KeyCtrlH :: Key
- Termbox: KeyCtrlI :: Key
- Termbox: KeyCtrlLsqBracket :: Key
- Termbox: KeyCtrlM :: Key
- Termbox: KeyCtrlUnderscore :: Key
- Termbox: MouseModeNo :: MouseMode
- Termbox: MouseModeYes :: MouseMode
- Termbox: OutputMode216 :: OutputMode
- Termbox: OutputMode256 :: OutputMode
- Termbox: OutputModeGrayscale :: OutputMode
- Termbox: OutputModeNormal :: OutputMode
- Termbox: clear :: Attr -> Attr -> IO ()
- Termbox: data InputMode
- Termbox: data MouseMode
- Termbox: data OutputMode
- Termbox: flush :: IO ()
- Termbox: getCells :: IO (Array (Int, Int) Cell)
- Termbox: getInputMode :: HasCallStack => IO InputMode
- Termbox: getOutputMode :: HasCallStack => IO OutputMode
- Termbox: getSize :: IO (Int, Int)
- Termbox: hideCursor :: IO ()
- Termbox: instance Foreign.Storable.Storable Termbox.Cell
- Termbox: instance GHC.Base.Monoid Termbox.Attr
- Termbox: instance GHC.Base.Semigroup Termbox.Attr
- Termbox: instance GHC.Classes.Eq Termbox.Attr
- Termbox: instance GHC.Classes.Eq Termbox.Cell
- Termbox: instance GHC.Classes.Eq Termbox.Event
- Termbox: instance GHC.Classes.Eq Termbox.InputMode
- Termbox: instance GHC.Classes.Eq Termbox.Key
- Termbox: instance GHC.Classes.Eq Termbox.Mouse
- Termbox: instance GHC.Classes.Eq Termbox.MouseMode
- Termbox: instance GHC.Classes.Eq Termbox.OutputMode
- Termbox: instance GHC.Classes.Ord Termbox.InputMode
- Termbox: instance GHC.Classes.Ord Termbox.Key
- Termbox: instance GHC.Classes.Ord Termbox.Mouse
- Termbox: instance GHC.Classes.Ord Termbox.MouseMode
- Termbox: instance GHC.Classes.Ord Termbox.OutputMode
- Termbox: instance GHC.Exception.Type.Exception Termbox.PollError
- Termbox: instance GHC.Num.Num Termbox.Attr
- Termbox: instance GHC.Show.Show Termbox.Cell
- Termbox: instance GHC.Show.Show Termbox.Event
- Termbox: instance GHC.Show.Show Termbox.InputMode
- Termbox: instance GHC.Show.Show Termbox.Key
- Termbox: instance GHC.Show.Show Termbox.Mouse
- Termbox: instance GHC.Show.Show Termbox.MouseMode
- Termbox: instance GHC.Show.Show Termbox.OutputMode
- Termbox: instance GHC.Show.Show Termbox.PollError
- Termbox: poll :: IO Event
- Termbox: run_ :: IO a -> IO a
- Termbox: setCursor :: Int -> Int -> IO ()
- Termbox: setInputMode :: InputMode -> IO ()
- Termbox: setOutputMode :: OutputMode -> IO ()
+ Termbox: Cursor :: !Int -> !Int -> Cursor
+ Termbox: KeyCtrlBackspace :: Key
+ Termbox: NoCursor :: Cursor
+ Termbox: data Cells
+ Termbox: data Cursor
+ Termbox: pattern KeyCtrl2 :: Key
+ Termbox: pattern KeyCtrl3 :: Key
+ Termbox: pattern KeyCtrl4 :: Key
+ Termbox: pattern KeyCtrl5 :: Key
+ Termbox: pattern KeyCtrl7 :: Key
+ Termbox: pattern KeyCtrlH :: Key
+ Termbox: pattern KeyCtrlI :: Key
+ Termbox: pattern KeyCtrlLsqBracket :: Key
+ Termbox: pattern KeyCtrlM :: Key
+ Termbox: pattern KeyCtrlUnderscore :: Key
+ Termbox.Internal: TbEvent :: !Word8 -> Word8 -> Word16 -> Word32 -> Int32 -> Int32 -> Int32 -> Int32 -> TbEvent
+ Termbox.Internal: data TbEvent
+ Termbox.Internal: instance Foreign.Storable.Storable Termbox.Internal.TbEvent
+ Termbox.Internal: tB_BLACK :: Word16
+ Termbox.Internal: tB_BLUE :: Word16
+ Termbox.Internal: tB_BOLD :: Word16
+ Termbox.Internal: tB_CYAN :: Word16
+ Termbox.Internal: tB_DEFAULT :: Word16
+ Termbox.Internal: tB_EFAILED_TO_OPEN_TTY :: Int
+ Termbox.Internal: tB_EPIPE_TRAP_ERROR :: Int
+ Termbox.Internal: tB_EUNSUPPORTED_TERMINAL :: Int
+ Termbox.Internal: tB_EVENT_KEY :: Word8
+ Termbox.Internal: tB_EVENT_MOUSE :: Word8
+ Termbox.Internal: tB_EVENT_RESIZE :: Word8
+ Termbox.Internal: tB_GREEN :: Word16
+ Termbox.Internal: tB_HIDE_CURSOR :: Int
+ Termbox.Internal: tB_INPUT_ALT :: Int
+ Termbox.Internal: tB_INPUT_CURRENT :: Int
+ Termbox.Internal: tB_INPUT_ESC :: Int
+ Termbox.Internal: tB_INPUT_MOUSE :: Int
+ Termbox.Internal: tB_KEY_ARROW_DOWN :: Word16
+ Termbox.Internal: tB_KEY_ARROW_LEFT :: Word16
+ Termbox.Internal: tB_KEY_ARROW_RIGHT :: Word16
+ Termbox.Internal: tB_KEY_ARROW_UP :: Word16
+ Termbox.Internal: tB_KEY_BACKSPACE :: Word16
+ Termbox.Internal: tB_KEY_BACKSPACE2 :: Word16
+ Termbox.Internal: tB_KEY_CTRL_2 :: Word16
+ Termbox.Internal: tB_KEY_CTRL_3 :: Word16
+ Termbox.Internal: tB_KEY_CTRL_4 :: Word16
+ Termbox.Internal: tB_KEY_CTRL_5 :: Word16
+ Termbox.Internal: tB_KEY_CTRL_6 :: Word16
+ Termbox.Internal: tB_KEY_CTRL_7 :: Word16
+ Termbox.Internal: tB_KEY_CTRL_8 :: Word16
+ Termbox.Internal: tB_KEY_CTRL_A :: Word16
+ Termbox.Internal: tB_KEY_CTRL_B :: Word16
+ Termbox.Internal: tB_KEY_CTRL_BACKSLASH :: Word16
+ Termbox.Internal: tB_KEY_CTRL_C :: Word16
+ Termbox.Internal: tB_KEY_CTRL_D :: Word16
+ Termbox.Internal: tB_KEY_CTRL_E :: Word16
+ Termbox.Internal: tB_KEY_CTRL_F :: Word16
+ Termbox.Internal: tB_KEY_CTRL_G :: Word16
+ Termbox.Internal: tB_KEY_CTRL_H :: Word16
+ Termbox.Internal: tB_KEY_CTRL_I :: Word16
+ Termbox.Internal: tB_KEY_CTRL_J :: Word16
+ Termbox.Internal: tB_KEY_CTRL_K :: Word16
+ Termbox.Internal: tB_KEY_CTRL_L :: Word16
+ Termbox.Internal: tB_KEY_CTRL_LSQ_BRACKET :: Word16
+ Termbox.Internal: tB_KEY_CTRL_M :: Word16
+ Termbox.Internal: tB_KEY_CTRL_N :: Word16
+ Termbox.Internal: tB_KEY_CTRL_O :: Word16
+ Termbox.Internal: tB_KEY_CTRL_P :: Word16
+ Termbox.Internal: tB_KEY_CTRL_Q :: Word16
+ Termbox.Internal: tB_KEY_CTRL_R :: Word16
+ Termbox.Internal: tB_KEY_CTRL_RSQ_BRACKET :: Word16
+ Termbox.Internal: tB_KEY_CTRL_S :: Word16
+ Termbox.Internal: tB_KEY_CTRL_SLASH :: Word16
+ Termbox.Internal: tB_KEY_CTRL_T :: Word16
+ Termbox.Internal: tB_KEY_CTRL_TILDE :: Word16
+ Termbox.Internal: tB_KEY_CTRL_U :: Word16
+ Termbox.Internal: tB_KEY_CTRL_UNDERSCORE :: Word16
+ Termbox.Internal: tB_KEY_CTRL_V :: Word16
+ Termbox.Internal: tB_KEY_CTRL_W :: Word16
+ Termbox.Internal: tB_KEY_CTRL_X :: Word16
+ Termbox.Internal: tB_KEY_CTRL_Y :: Word16
+ Termbox.Internal: tB_KEY_CTRL_Z :: Word16
+ Termbox.Internal: tB_KEY_DELETE :: Word16
+ Termbox.Internal: tB_KEY_END :: Word16
+ Termbox.Internal: tB_KEY_ENTER :: Word16
+ Termbox.Internal: tB_KEY_ESC :: Word16
+ Termbox.Internal: tB_KEY_F1 :: Word16
+ Termbox.Internal: tB_KEY_F10 :: Word16
+ Termbox.Internal: tB_KEY_F11 :: Word16
+ Termbox.Internal: tB_KEY_F12 :: Word16
+ Termbox.Internal: tB_KEY_F2 :: Word16
+ Termbox.Internal: tB_KEY_F3 :: Word16
+ Termbox.Internal: tB_KEY_F4 :: Word16
+ Termbox.Internal: tB_KEY_F5 :: Word16
+ Termbox.Internal: tB_KEY_F6 :: Word16
+ Termbox.Internal: tB_KEY_F7 :: Word16
+ Termbox.Internal: tB_KEY_F8 :: Word16
+ Termbox.Internal: tB_KEY_F9 :: Word16
+ Termbox.Internal: tB_KEY_HOME :: Word16
+ Termbox.Internal: tB_KEY_INSERT :: Word16
+ Termbox.Internal: tB_KEY_MOUSE_LEFT :: Word16
+ Termbox.Internal: tB_KEY_MOUSE_MIDDLE :: Word16
+ Termbox.Internal: tB_KEY_MOUSE_RELEASE :: Word16
+ Termbox.Internal: tB_KEY_MOUSE_RIGHT :: Word16
+ Termbox.Internal: tB_KEY_MOUSE_WHEEL_DOWN :: Word16
+ Termbox.Internal: tB_KEY_MOUSE_WHEEL_UP :: Word16
+ Termbox.Internal: tB_KEY_PGDN :: Word16
+ Termbox.Internal: tB_KEY_PGUP :: Word16
+ Termbox.Internal: tB_KEY_SPACE :: Word16
+ Termbox.Internal: tB_KEY_TAB :: Word16
+ Termbox.Internal: tB_MAGENTA :: Word16
+ Termbox.Internal: tB_MOD_ALT :: Word8
+ Termbox.Internal: tB_OUTPUT_216 :: Int
+ Termbox.Internal: tB_OUTPUT_256 :: Int
+ Termbox.Internal: tB_OUTPUT_CURRENT :: Int
+ Termbox.Internal: tB_OUTPUT_GRAYSCALE :: Int
+ Termbox.Internal: tB_OUTPUT_NORMAL :: Int
+ Termbox.Internal: tB_RED :: Word16
+ Termbox.Internal: tB_REVERSE :: Word16
+ Termbox.Internal: tB_UNDERLINE :: Word16
+ Termbox.Internal: tB_WHITE :: Word16
+ Termbox.Internal: tB_YELLOW :: Word16
+ Termbox.Internal: tb_change_cell :: Int -> Int -> Word32 -> Word16 -> Word16 -> IO ()
+ Termbox.Internal: tb_clear :: IO ()
+ Termbox.Internal: tb_height :: IO Int
+ Termbox.Internal: tb_init :: IO Int
+ Termbox.Internal: tb_peek_event :: Ptr TbEvent -> Int -> IO Int
+ Termbox.Internal: tb_poll_event :: Ptr TbEvent -> IO Int
+ Termbox.Internal: tb_present :: IO ()
+ Termbox.Internal: tb_select_input_mode :: Int -> IO Int
+ Termbox.Internal: tb_select_output_mode :: Int -> IO Int
+ Termbox.Internal: tb_set_clear_attributes :: Word16 -> Word16 -> IO ()
+ Termbox.Internal: tb_set_cursor :: Int -> Int -> IO ()
+ Termbox.Internal: tb_shutdown :: IO ()
+ Termbox.Internal: tb_width :: IO Int
- Termbox: EventKey :: !Key -> !Bool -> Event
+ Termbox: EventKey :: !Key -> Event
- Termbox: run :: IO a -> IO (Either InitError a)
+ Termbox: run :: (Int -> Int -> (Cells -> Cursor -> IO ()) -> IO Event -> IO a) -> IO a
- Termbox: set :: Int -> Int -> Cell -> IO ()
+ Termbox: set :: Int -> Int -> Cell -> Cells

Files

CHANGELOG.md view
@@ -5,25 +5,46 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/) and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [0.3.0] - 2020-09-20++### Added+- Add `Cells` and `Cursor` types+- Export `Termbox.Internal` module that roughly corresponds to the C library++### Changed+- Add a few arguments to the action provided to `run`+- Make `run` throw `InitError`s as IO exceptions+- Reset output mode to "normal" on shutdown to work around a small bug in termbox.c that retains the output mode across+  separate invocations of init/shutdown+- Change type of `set` to construct a `Cells` rather than an `IO ()`+- Change a few keys into pattern synonyms because they overlap++### Removed+- Remove the alt modifier field from `KeyEvent`+- Remove `setCursor`, `hideCursor`, `clear`, `flush`, `getCells`, `getSize`, `poll`, `run_`+- Remove `InputMode`, `MouseMode`, and `OutputMode`, providing sane defaults instead+- Remove build dependency on `c2hs`+- Remove support for GHC < 8.2+ ## [0.2.0.1] - 2020-06-27  ### Changed-- Bumped `base` upper bound+- Bump `base` upper bound  ## [0.2.0] - 2019-06-21  ### Added-- `getCells` function-- `run` function+- Add `getCells` function+- Add `run` function  ### Changed-- Renamed `size` to `getSize`-- Renamed `main` to `run_` and return errors as an `Either` instead of throwing.-- Made `Attr`'s `Semigroup` instance right-biased instead of left-biased.-- Made `Attr`'s `Num` instance total.+- Rename `size` to `getSize`+- Rename `main` to `run_` and return errors as an `Either` instead of throwing.+- Make `Attr`'s `Semigroup` instance right-biased instead of left-biased.+- Make `Attr`'s `Num` instance total.  ### Removed-- `buffer` function+- Add `buffer` function  ## [0.1.0] - 2018-07-18 
examples/Colors.hs view
@@ -1,122 +1,42 @@--- | Something like https://github.com/nsf/termbox/blob/8b72969ff4bba120d8b8e4a29bae07102ed71055/src/demo/output.c--import Control.Monad-import Data.Foldable--import qualified Termbox as Tb+import Data.Semigroup ((<>))+import qualified Termbox -main :: IO (Either Tb.InitError ())+main :: IO () main =-  Tb.run $ do-    do-      let-        rectangles :: [(Int, Int, Int, Int)]-        rectangles = do-          y0 <- [0, 4 ..]-          x0 <- [0, 8 .. 24]-          pure (x0, y0, x0+7, y0+3)--      let-        colors :: [(String, Tb.Attr, Tb.Attr)]-        colors =-          [ ("black", Tb.black, Tb.white)-          , ("red", Tb.red, Tb.black)-          , ("green", Tb.green, Tb.black)-          , ("yellow", Tb.yellow, Tb.black)-          , ("blue", Tb.blue, Tb.black)-          , ("magenta", Tb.magenta, Tb.black)-          , ("cyan", Tb.cyan, Tb.black)-          , ("white", Tb.white, Tb.black)-          ]--      zipWithM_-        (\(x0, y0, x1, y1) (name, bg, fg) -> do-          rectangle x0 y0 x1 y1 (Tb.Cell ' ' mempty bg)-          string x0 y0 fg bg name)-        rectangles-        colors--    Tb.flush-    _ <- Tb.poll--    clear-    Tb.setOutputMode Tb.OutputModeGrayscale--    do-      let-        rectangles :: [(Int, Int, Int, Int)]-        rectangles = do-          y0 <- [0, 4 ..]-          x0 <- [0, 8 .. 40]-          pure (x0, y0, x0+7, y0+3)--      zipWithM_-        (\(x0, y0, x1, y1) n -> do-          rectangle x0 y0 x1 y1 (Tb.Cell ' ' mempty (fromInteger n))-          string x0 y0 12 (fromInteger n) (show n))-        rectangles-        [1..23]--    Tb.flush-    _ <- Tb.poll--    clear-    Tb.setOutputMode Tb.OutputMode216--    do-      let-        rectangles :: [(Int, Int, Int, Int)]-        rectangles = do-          y0 <- [0, 2..]-          x0 <- [0, 4 .. 40]-          pure (x0, y0, x0+3, y0+1)--      zipWithM_-        (\(x0, y0, x1, y1) n -> do-          rectangle x0 y0 x1 y1 (Tb.Cell ' ' mempty (fromInteger n))-          string x0 y0 2 (fromInteger n) (show n))-        rectangles-        [1..216]--    Tb.flush-    _ <- Tb.poll--    clear-    Tb.setOutputMode Tb.OutputMode256--    do-      let-        rectangles :: [(Int, Int, Int, Int)]+  Termbox.run $ \_w _h render poll -> do+    let rectangles :: [(Int, Int, Int, Int)]         rectangles = do-          y0 <- [0, 2..]+          y0 <- [0, 2 ..]           x0 <- [0, 4 .. 48]-          pure (x0, y0, x0+3, y0+1)--      zipWithM_-        (\(x0, y0, x1, y1) n -> do-          rectangle x0 y0 x1 y1 (Tb.Cell ' ' mempty (fromInteger n))-          string x0 y0 2 (fromInteger n) (show n))-        rectangles-        [1..255]+          pure (x0, y0, x0 + 3, y0 + 1) -    Tb.flush-    _ <- Tb.poll+    let cells :: Maybe Termbox.Event -> Termbox.Cells+        cells lastEvent =+          mconcat+            ( zipWith+                ( \(x0, y0, x1, y1) n ->+                    rectangle x0 y0 x1 y1 (Termbox.Cell ' ' mempty (fromInteger n))+                      <> string x0 y0 mempty (fromInteger n) (show n)+                )+                rectangles+                [0 .. 255]+            )+            <> string 54 1 mempty mempty "Press Esc to quit."+            <> string 54 3 mempty mempty ("Last event: " ++ show lastEvent) -    pure ()+    let loop :: Maybe Termbox.Event -> IO ()+        loop lastEvent = do+          render (cells lastEvent) Termbox.NoCursor+          poll >>= \case+            Termbox.EventKey Termbox.KeyEsc -> pure ()+            event -> loop (Just event) -clear :: IO ()-clear = do-  Tb.setOutputMode Tb.OutputModeNormal-  Tb.clear mempty mempty-  Tb.flush+    loop Nothing -string :: Int -> Int -> Tb.Attr -> Tb.Attr -> [Char] -> IO ()+string :: Int -> Int -> Termbox.Attr -> Termbox.Attr -> [Char] -> Termbox.Cells string x0 y fg bg =-  zipWithM_-    (\x c -> Tb.set x y (Tb.Cell c fg bg))-    [x0..]+  mconcat . zipWith (\x c -> Termbox.set x y (Termbox.Cell c fg bg)) [x0 ..] -rectangle :: Int -> Int -> Int -> Int -> Tb.Cell -> IO ()+rectangle :: Int -> Int -> Int -> Int -> Termbox.Cell -> Termbox.Cells rectangle x0 y0 x1 y1 c =-  for_ ((,) <$> [x0..x1] <*> [y0..y1]) $ \(x, y) ->-    Tb.set x y c+  foldMap (\(x, y) -> Termbox.set x y c) ((,) <$> [x0 .. x1] <*> [y0 .. y1])
src/Termbox.hs view
@@ -1,18 +1,10 @@-{-# language InstanceSigs        #-}-{-# language LambdaCase          #-}-{-# language RankNTypes          #-}--{-# language ScopedTypeVariables #-}-{-# language TypeFamilies        #-}-{-# language UnicodeSyntax       #-}+{-# LANGUAGE PatternSynonyms #-}  -- | -- A @termbox@ program is typically constructed as an infinite loop that: ----- 1. 'clear's the terminal backbuffer.--- 2. Renders the program state by 'set'ting individual pixels.--- 3. 'flush'es the backbuffer to the terminal.--- 4. 'poll's for an event to update the program state.+-- 1. Renders a scene.+-- 2. Polls for an event. -- -- For example, this progam simply displays the number of keys pressed, and -- quits on @Esc@:@@ -20,31 +12,23 @@ -- @ -- {-\# LANGUAGE LambdaCase \#-} ----- import Data.Foldable (for_) -- import qualified Termbox -- -- main :: IO () -- main =---   Termbox.'run_' (loop 0)+--   Termbox.'run' (\\_width _height render poll -> loop render poll 0) ----- loop :: Int -> IO ()--- loop n = do---   Termbox.'clear' mempty mempty---   render n---   Termbox.'flush'+-- loop :: (Termbox.'Cells' -> Termbox.'Cursor' -> IO ()) -> IO Termbox.'Event' -> Int -> IO ()+-- loop render poll n = do+--   render (string (show n)) Termbox.'NoCursor' -----   Termbox.'poll' >>= \\case---     Termbox.'EventKey' Termbox.'KeyEsc' _ ->---       pure ()---     _ ->---       loop (n+1)+--   poll >>= \\case+--     Termbox.'EventKey' Termbox.'KeyEsc' -> pure ()+--     _ -> loop render poll (n+1) ----- render :: Int -> IO ()--- render n =---   for_---     (zip [0..] (show n))---     (\\(i, c) ->---       Termbox.'set' i 0 (Termbox.'Cell' c mempty mempty))+-- string :: Int -> Int -> String -> Termbox.'Cells'+-- string col row =+--   foldMap (\\(i, c) -> Termbox.'set' (col + i) row (Termbox.'Cell' c 0 0)) . zip [0..] -- @ -- -- Other termbox features include cell attributes (style, color), cursor@@ -53,73 +37,95 @@ -- This module is intended to be imported qualified. module Termbox   ( -- * Initialization-    run-  , run_-  , InitError(..)+    run,+    InitError (..),+     -- * Terminal contents-  , set-  , getCells-  , clear-  , flush-  , Cell(..)-    -- * Terminal size-  , getSize-    -- * Cursor manipulation-  , setCursor-  , hideCursor-    -- * Event handling-  , poll-  , Event(..)-  , Key(..)-  , Mouse(..)-  , PollError(..)-    -- * Attributes-  , black-  , red-  , green-  , yellow-  , blue-  , magenta-  , cyan-  , white-  , bold-  , underline-  , reverse-  , Attr-    -- * Terminal modes-  , getInputMode-  , setInputMode-  , InputMode(..)-  , MouseMode(..)-  , getOutputMode-  , setOutputMode-  , OutputMode(..)-  ) where+    set,+    Cells,+    Cell (..),+    Cursor (..), -import Prelude hiding (mod, reverse)+    -- * Event handling+    Event (..),+    Key (..),+    -- $key-aliases+    pattern KeyCtrlH,+    pattern KeyCtrlLsqBracket,+    pattern KeyCtrl2,+    pattern KeyCtrl3,+    pattern KeyCtrl4,+    pattern KeyCtrl5,+    pattern KeyCtrl7,+    pattern KeyCtrlM,+    pattern KeyCtrlI,+    pattern KeyCtrlUnderscore,+    Mouse (..),+    PollError (..), -import qualified Termbox.Internal as Tb+    -- * Attributes+    Attr,+    black,+    red,+    green,+    yellow,+    blue,+    magenta,+    cyan,+    white,+    bold,+    underline,+    reverse,+  )+where  import Control.Exception-import Control.Monad ((>=>), join)-import Data.Array (Array)-import Data.Bits ((.|.), (.&.))-import Data.Functor (void)-import Data.Semigroup (Semigroup(..))-import Data.Word-import Foreign (ForeignPtr, Ptr, newForeignPtr_)-import Foreign.Marshal.Alloc (alloca)-import Foreign.Storable-import GHC.Stack+import Data.Semigroup (Semigroup (..))+import Termbox.Attr+  ( Attr,+    black,+    blue,+    bold,+    cyan,+    green,+    magenta,+    red,+    reverse,+    underline,+    white,+    yellow,+  )+import Termbox.Cell (Cell (Cell))+import Termbox.Cells (Cells (Cells), set)+import Termbox.Event (Event (..), PollError (..), poll)+import Termbox.Internal+import Termbox.Key+  ( Key (..),+    pattern KeyCtrl2,+    pattern KeyCtrl3,+    pattern KeyCtrl4,+    pattern KeyCtrl5,+    pattern KeyCtrl7,+    pattern KeyCtrlH,+    pattern KeyCtrlI,+    pattern KeyCtrlLsqBracket,+    pattern KeyCtrlM,+    pattern KeyCtrlUnderscore,+  )+import Termbox.Mouse (Mouse (..))+import Prelude hiding (reverse) -import qualified Data.Array.Storable as Array (freeze)-import qualified Data.Array.Storable.Internals as Array+-- | A cursor.+data Cursor+  = -- | Column, then row+    Cursor !Int !Int+  | NoCursor ------------------------------------------------------------------------------------ Initialization---------------------------------------------------------------------------------+-- $key-aliases+-- In a few cases, distinct key sequences map to equivalent key events. The pattern synonyms below are provided for an+-- alternate syntax in these cases, if desired. --- | Termbox initialization errors that can be returned by 'run'.+-- | Termbox initialization errors. data InitError   = FailedToOpenTTY   | PipeTrapError@@ -129,554 +135,50 @@ instance Exception InitError  -- | Run a @termbox@ program and restore the terminal state afterwards.-run :: IO a -> IO (Either InitError a)-run action =-  mask $ \unmask ->-    Tb.init >>= \case-      Tb.InitOk -> do-        result <- unmask action `onException` Tb.shutdown-        Tb.shutdown-        pure (Right result)--      Tb.FailedToOpenTTY     -> pure (Left FailedToOpenTTY)-      Tb.PipeTrapError       -> pure (Left PipeTrapError)-      Tb.UnsupportedTerminal -> pure (Left UnsupportedTerminal)---- | Like 'run', but throws 'InitError's as @IO@ exceptions.-run_ :: IO a -> IO a-run_ =-  run >=> either throwIO pure-------------------------------------------------------------------------------------- Terminal size------------------------------------------------------------------------------------- | Get the terminal size (width, then height).-getSize :: IO (Int, Int)-getSize =-  (,) <$> Tb.width <*> Tb.height-------------------------------------------------------------------------------------- Cursor------------------------------------------------------------------------------------- | Set the cursor coordinates (column, then row).-setCursor :: Int -> Int -> IO ()-setCursor =-  Tb.setCursor---- | Hide the cursor.-hideCursor :: IO ()-hideCursor =-  Tb.setCursor Tb._HIDE_CURSOR Tb._HIDE_CURSOR-------------------------------------------------------------------------------------- Terminal contents------------------------------------------------------------------------------------- | A 'Cell' contains a character, foreground attribute, and background--- attribute.-data Cell-  = Cell !Char !Attr !Attr-  deriving (Eq)--instance Show Cell where-  show (Cell ch fg bg) =-    "Cell " ++ show ch ++ " " ++ show (attrToWord fg) ++ " " ++-      show (attrToWord bg)--instance Storable Cell where-  sizeOf :: Cell -> Int-  sizeOf _ =-    Tb.sizeofCell--  alignment :: Cell -> Int-  alignment _ =-    Tb.alignofCell--  peek :: Ptr Cell -> IO Cell-  peek ptr =-    Cell-      <$> Tb.getCellCh ptr-      <*> (wordToAttr <$>  Tb.getCellFg ptr)-      <*> (wordToAttr <$> Tb.getCellBg ptr)--  poke :: Ptr Cell -> Cell -> IO ()-  poke ptr (Cell ch fg bg) = do-    Tb.setCellCh ptr ch-    Tb.setCellFg ptr (attrToWord fg)-    Tb.setCellBg ptr (attrToWord bg)---- | Set the cell at the given coordinates (column, then row).-set :: Int -> Int -> Cell -> IO ()-set x y (Cell ch fg bg) =-  Tb.changeCell x y ch (attrToWord fg) (attrToWord bg)---- | Get the terminal's two-dimensional array of cells (indexed by row, then--- column).-getCells :: IO (Array (Int, Int) Cell)-getCells =-  join-    (mkbuffer-      <$> (tb_cell_buffer >>= newForeignPtr_)-      <*> Tb.width-      <*> Tb.height)-  where-    mkbuffer-      :: ForeignPtr Cell-      -> Int-      -> Int-      -> IO (Array (Int, Int) Cell)-    mkbuffer buff w h =-      Array.freeze =<<-        Array.unsafeForeignPtrToStorableArray buff ((0, 0), (h-1, w-1))---- | Clear the back buffer with the given foreground and background attributes.-clear :: Attr -> Attr -> IO ()-clear fg bg = do-  Tb.setClearAttributes (attrToWord fg) (attrToWord bg)-  Tb.clear---- | Synchronize the internal back buffer with the terminal.-flush :: IO ()-flush =-  Tb.present------------------------------------------------------------------------------------- Terminal mode------------------------------------------------------------------------------------- | The input modes. ----- * __Esc__. When ESC sequence is in the buffer and it doesn't match any known--- sequence, ESC means 'KeyEsc'.------ * __Alt__. When ESC sequence is in the buffer and it doesn't match any known--- sequence, ESC enables the /alt/ modifier for the next keyboard event.-data InputMode-  = InputModeEsc MouseMode -- ^ Default.-  | InputModeAlt MouseMode-  deriving (Eq, Ord, Show)---- | The mouse mode.------ * __No__. Don't handle mouse events.------ * __Yes__. Handle mouse events.-data MouseMode-  = MouseModeNo -- ^ Default.-  | MouseModeYes-  deriving (Eq, Ord, Show)---- | Get the current input mode.-getInputMode :: HasCallStack => IO InputMode-getInputMode =-  f <$> Tb.selectInputMode Tb._INPUT_CURRENT-  where-    f :: Int -> InputMode-    f = \case-      1 -> InputModeEsc MouseModeNo-      2 -> InputModeAlt MouseModeNo-      5 -> InputModeEsc MouseModeYes-      6 -> InputModeAlt MouseModeYes-      n -> error (show n)---- | Set the input mode.-setInputMode :: InputMode -> IO ()-setInputMode =-  void . Tb.selectInputMode . f-  where-    f :: InputMode -> Int-    f = \case-      InputModeEsc MouseModeNo -> Tb._INPUT_ESC-      InputModeEsc MouseModeYes -> Tb._INPUT_ESC .|. Tb._INPUT_MOUSE-      InputModeAlt MouseModeNo -> Tb._INPUT_ALT-      InputModeAlt MouseModeYes -> Tb._INPUT_ALT .|. Tb._INPUT_MOUSE---- | The output modes.------ * __Normal__. Supports colors /0..8/, which includes all named color--- attributes exported by this library, e.g. 'red'.------ * __Grayscale__. Supports colors /0..23/.------ * __216__. Supports colors /0..216/.------ * __256__. Supports colors /0..255/.-data OutputMode-  = OutputModeNormal -- ^ Default.-  | OutputModeGrayscale-  | OutputMode216-  | OutputMode256-  deriving (Eq, Ord, Show)---- | Get the current output mode.-getOutputMode :: HasCallStack => IO OutputMode-getOutputMode =-  f <$> Tb.selectOutputMode Tb.OutputModeCurrent-  where-    f :: Tb.OutputMode -> OutputMode-    f = \case-      Tb.OutputModeNormal -> OutputModeNormal-      Tb.OutputMode256 -> OutputMode256-      Tb.OutputMode216 -> OutputMode216-      Tb.OutputModeGrayscale -> OutputModeGrayscale-      Tb.OutputModeCurrent -> error "OutputModeCurrent"---- | Set the output mode.-setOutputMode :: OutputMode -> IO ()-setOutputMode =-  void . Tb.selectOutputMode . f-  where-    f :: OutputMode -> Tb.OutputMode-    f = \case-      OutputModeNormal -> Tb.OutputModeNormal-      OutputMode256 -> Tb.OutputMode256-      OutputMode216 -> Tb.OutputMode216-      OutputModeGrayscale -> Tb.OutputModeGrayscale------------------------------------------------------------------------------------- Event handling------------------------------------------------------------------------------------- | A input event.-data Event-  = EventKey !Key !Bool -- ^ Key event. The bool indicates the /alt/ modifier.-  | EventResize !Int !Int -- ^ Resize event (width, then height)-  | EventMouse !Mouse !Int !Int -- ^ Mouse event (column, then row)-  deriving (Eq, Show)---- | A key event.-data Key-  = KeyChar Char-  | KeyArrowDown-  | KeyArrowLeft-  | KeyArrowRight-  | KeyArrowUp-  | KeyBackspace-  | KeyBackspace2-  | KeyCtrl2-  | KeyCtrl3-  | KeyCtrl4-  | KeyCtrl5-  | KeyCtrl6-  | KeyCtrl7-  | KeyCtrl8-  | KeyCtrlA-  | KeyCtrlB-  | KeyCtrlBackslash-  | KeyCtrlC-  | KeyCtrlD-  | KeyCtrlE-  | KeyCtrlF-  | KeyCtrlG-  | KeyCtrlH-  | KeyCtrlI-  | KeyCtrlJ-  | KeyCtrlK-  | KeyCtrlL-  | KeyCtrlLsqBracket-  | KeyCtrlM-  | KeyCtrlN-  | KeyCtrlO-  | KeyCtrlP-  | KeyCtrlQ-  | KeyCtrlR-  | KeyCtrlRsqBracket-  | KeyCtrlS-  | KeyCtrlSlash-  | KeyCtrlT-  | KeyCtrlTilde-  | KeyCtrlU-  | KeyCtrlUnderscore-  | KeyCtrlV-  | KeyCtrlW-  | KeyCtrlX-  | KeyCtrlY-  | KeyCtrlZ-  | KeyDelete-  | KeyEnd-  | KeyEnter-  | KeyEsc-  | KeyF1-  | KeyF10-  | KeyF11-  | KeyF12-  | KeyF2-  | KeyF3-  | KeyF4-  | KeyF5-  | KeyF6-  | KeyF7-  | KeyF8-  | KeyF9-  | KeyHome-  | KeyInsert-  | KeyPageDn-  | KeyPageUp-  | KeySpace-  | KeyTab-  deriving (Eq, Ord, Show)---- | A mouse event.-data Mouse-  = MouseLeft-  | MouseMiddle-  | MouseRelease-  | MouseRight-  | MouseWheelDown-  | MouseWheelUp-  deriving (Eq, Ord, Show)---- | Block until an 'Event' arrives.------ /Note/: @termbox v1.1.2@ does not properly handle OS signals that interrupt--- the underlying @select@ system call, so unfortunately the familiar @Ctrl-C@--- will not be able to stop a program stuck in 'pollEvent'.------ You can work around this issue by polling in a background thread using the--- @threaded@ runtime, or simply writing event-handling code that is responsive--- to intuitive "quit" keys like @q@ and @Esc@.+-- The function provided to @run@ is provided: ----- /Throws/: 'PollError'-poll :: IO Event-poll =-  alloca $ \ptr ->-    Tb.pollEvent ptr >>= \case-      -1 ->-        throwIO PollError-      _ ->-        parseEvent <$> peek ptr---- | An error occurred when 'poll'ing, due to mysterious circumstances that are--- not well-documented in the original C codebase.-data PollError-  = PollError-  deriving Show--instance Exception PollError---- | Parse an 'Event' from a 'Tb.Event'.-parseEvent :: Tb.Event -> Event-parseEvent = \case-  Tb.Event Tb.EventKey mod key ch _ _ _ _ ->-    parseEventKey mod key ch-  Tb.Event Tb.EventResize _ _ _ w h _ _ ->-    EventResize w h-  Tb.Event Tb.EventMouse _ key _ _ _ x y ->-    EventMouse (parseMouse key) x y---- | Parse a key 'Event'.-parseEventKey :: Tb.Mod -> Tb.Key -> Char -> Event-parseEventKey mod key ch =-  EventKey key' alt-  where-    key' :: Key-    key' =-      case ch of-        '\0' -> parseKey key-        _ -> KeyChar ch--    alt :: Bool-    alt =-      case mod of-        Tb.ModAlt -> True-        _ -> False---- | Parse a 'Key' from a 'Tb.Key'.-parseKey :: HasCallStack => Tb.Key -> Key-parseKey = \case-  Tb.KeyArrowDown -> KeyArrowDown-  Tb.KeyArrowLeft -> KeyArrowLeft-  Tb.KeyArrowRight -> KeyArrowRight-  Tb.KeyArrowUp -> KeyArrowUp-  Tb.KeyBackspace -> KeyBackspace-  Tb.KeyBackspace2 -> KeyBackspace2-  Tb.KeyCtrl2 -> KeyCtrl2-  Tb.KeyCtrl3 -> KeyCtrl3-  Tb.KeyCtrl4 -> KeyCtrl4-  Tb.KeyCtrl5 -> KeyCtrl5-  Tb.KeyCtrl6 -> KeyCtrl6-  Tb.KeyCtrl7 -> KeyCtrl7-  Tb.KeyCtrl8 -> KeyCtrl8-  Tb.KeyCtrlA -> KeyCtrlA-  Tb.KeyCtrlB -> KeyCtrlB-  Tb.KeyCtrlBackslash -> KeyCtrlBackslash-  Tb.KeyCtrlC -> KeyCtrlC-  Tb.KeyCtrlD -> KeyCtrlD-  Tb.KeyCtrlE -> KeyCtrlE-  Tb.KeyCtrlF -> KeyCtrlF-  Tb.KeyCtrlG -> KeyCtrlG-  Tb.KeyCtrlH -> KeyCtrlH-  Tb.KeyCtrlI -> KeyCtrlI-  Tb.KeyCtrlJ -> KeyCtrlJ-  Tb.KeyCtrlK -> KeyCtrlK-  Tb.KeyCtrlL -> KeyCtrlL-  Tb.KeyCtrlLsqBracket -> KeyCtrlLsqBracket-  Tb.KeyCtrlM -> KeyCtrlM-  Tb.KeyCtrlN -> KeyCtrlN-  Tb.KeyCtrlO -> KeyCtrlO-  Tb.KeyCtrlP -> KeyCtrlP-  Tb.KeyCtrlQ -> KeyCtrlQ-  Tb.KeyCtrlR -> KeyCtrlR-  Tb.KeyCtrlRsqBracket -> KeyCtrlRsqBracket-  Tb.KeyCtrlS -> KeyCtrlS-  Tb.KeyCtrlSlash -> KeyCtrlSlash-  Tb.KeyCtrlT -> KeyCtrlT-  Tb.KeyCtrlTilde -> KeyCtrlTilde-  Tb.KeyCtrlU -> KeyCtrlU-  Tb.KeyCtrlUnderscore -> KeyCtrlUnderscore-  Tb.KeyCtrlV -> KeyCtrlV-  Tb.KeyCtrlW -> KeyCtrlW-  Tb.KeyCtrlX -> KeyCtrlX-  Tb.KeyCtrlY -> KeyCtrlY-  Tb.KeyCtrlZ -> KeyCtrlZ-  Tb.KeyDelete -> KeyDelete-  Tb.KeyEnd -> KeyEnd-  Tb.KeyEnter -> KeyEnter-  Tb.KeyEsc -> KeyEsc-  Tb.KeyF1 -> KeyF1-  Tb.KeyF10 -> KeyF10-  Tb.KeyF11 -> KeyF11-  Tb.KeyF12 -> KeyF12-  Tb.KeyF2 -> KeyF2-  Tb.KeyF3 -> KeyF3-  Tb.KeyF4 -> KeyF4-  Tb.KeyF5 -> KeyF5-  Tb.KeyF6 -> KeyF6-  Tb.KeyF7 -> KeyF7-  Tb.KeyF8 -> KeyF8-  Tb.KeyF9 -> KeyF9-  Tb.KeyHome -> KeyHome-  Tb.KeyInsert -> KeyInsert-  Tb.KeyPageDn -> KeyPageDn-  Tb.KeyPageUp -> KeyPageUp-  Tb.KeySpace -> KeySpace-  Tb.KeyTab -> KeyTab-  key -> error (show key)---- | Parse a 'Mouse' from a 'Tb.Key'.-parseMouse :: HasCallStack => Tb.Key -> Mouse-parseMouse = \case-  Tb.KeyMouseLeft -> MouseLeft-  Tb.KeyMouseMiddle -> MouseMiddle-  Tb.KeyMouseRelease -> MouseRelease-  Tb.KeyMouseRight -> MouseRight-  Tb.KeyMouseWheelDown -> MouseWheelDown-  Tb.KeyMouseWheelUp -> MouseWheelUp-  key -> error (show key)------------------------------------------------------------------------------------- Attributes------------------------------------------------------------------------------------- | A cell attribute, which includes its color, and whether or not it is--- bold, underlined, and/or reversed.+--   * The initial terminal width+--   * The initial terminal height+--   * An action that renders a scene+--   * An action that polls for an event indefinitely ----- A cell can only have one color, but may be (for example) bold /and/--- underlined. The 'Monoid' instance combines 'Attr's this way, with a right--- bias.-data Attr-  = Attr !Word16 {- color -} !Word16 {- attr -}-  deriving (Eq)--instance Monoid Attr where-  mempty :: Attr-  mempty =-    Attr Tb._DEFAULT 0--  mappend :: Attr -> Attr -> Attr-  mappend =-    (<>)---- | Provided for numeric literals.-instance Num Attr where-  fromInteger :: Integer -> Attr-  fromInteger n =-    Attr (fromIntegral (n `rem` 256)) 0--  (+) = (<>)-  (*) = (<>)-  (-) = (<>)-  abs = id-  signum = id---- | Left-biased color; attributes are merged.-instance Semigroup Attr where-  (<>) :: Attr -> Attr -> Attr-  Attr  0 ax <> Attr cy ay = Attr cy (ax .|. ay)-  Attr cx ax <> Attr  0 ay = Attr cx (ax .|. ay)-  Attr  _ ax <> Attr cy ay = Attr cy (ax .|. ay)--wordToAttr :: Word16 -> Attr-wordToAttr w =-  Attr (w .&. 0x00FF) (w .&. 0xFF00)--attrToWord :: Attr -> Word16-attrToWord (Attr x y) =-  x .|. y---- | @black = 1@.-black :: Attr-black =-  Attr Tb._BLACK 0---- | @red = 2@.-red :: Attr-red =-  Attr Tb._RED 0---- | @green = 3@.-green :: Attr-green =-  Attr Tb._GREEN 0---- | @yellow = 4@.-yellow :: Attr-yellow =-  Attr Tb._YELLOW 0---- | @blue = 5@.-blue :: Attr-blue =-  Attr Tb._BLUE 0---- | @magenta = 6@.-magenta :: Attr-magenta =-  Attr Tb._MAGENTA 0---- | @cyan = 7@.-cyan :: Attr-cyan =-  Attr Tb._CYAN 0---- | @white = 8@.-white :: Attr-white =-  Attr Tb._WHITE 0---- | Bold modifier attribute.-bold :: Attr-bold =-  Attr Tb._DEFAULT Tb._BOLD---- | Underline modifier attribute.-underline :: Attr-underline =-  Attr Tb._DEFAULT Tb._UNDERLINE---- | Reverse modifier attribute.-reverse :: Attr-reverse =-  Attr Tb._DEFAULT Tb._REVERSE+-- /Throws/: 'InitError'+run :: (Int -> Int -> (Cells -> Cursor -> IO ()) -> IO Event -> IO a) -> IO a+run action = do+  mask $ \unmask -> do+    initResult <- tb_init+    case () of+      _ | initResult == 0 -> do+        result <-+          unmask+            ( do+                _ <- tb_select_input_mode tB_INPUT_MOUSE+                _ <- tb_select_output_mode tB_OUTPUT_256+                width <- tb_width+                height <- tb_height+                action width height render poll+            )+            `onException` shutdown+        shutdown+        pure result+      _ | initResult == tB_EFAILED_TO_OPEN_TTY -> throwIO FailedToOpenTTY+      _ | initResult == tB_EPIPE_TRAP_ERROR -> throwIO PipeTrapError+      _ | initResult == tB_EUNSUPPORTED_TERMINAL -> throwIO UnsupportedTerminal+      _ -> error ("termbox: unknown tb_init error " ++ show initResult) ------------------------------------------------------------------------------------ Foreign imports---------------------------------------------------------------------------------+-- | Render a scene.+render :: Cells -> Cursor -> IO ()+render (Cells cells) cursor = do+  tb_set_clear_attributes 0 0+  tb_clear+  cells+  case cursor of+    Cursor col row -> tb_set_cursor col row+    NoCursor -> tb_set_cursor tB_HIDE_CURSOR tB_HIDE_CURSOR+  tb_present -foreign import ccall safe "termbox.h tb_cell_buffer"-  tb_cell_buffer :: IO (Ptr Cell)+shutdown :: IO ()+shutdown = do+  _ <- tb_select_output_mode tB_OUTPUT_NORMAL+  tb_shutdown
+ src/Termbox/Attr.hs view
@@ -0,0 +1,124 @@+module Termbox.Attr+  ( Attr,+    black,+    blue,+    bold,+    cyan,+    green,+    magenta,+    red,+    reverse,+    underline,+    white,+    yellow,+    --+    attrToWord,+    wordToAttr,+  )+where++import Data.Bits ((.&.), (.|.))+import Data.Semigroup (Semigroup (..))+import Data.Word (Word16)+import Termbox.Internal+import Prelude hiding (reverse)++-- | A cell attribute, which includes its color, and whether or not it is+-- bold, underlined, and/or reversed.+--+-- A cell can only have one color, but may be (for example) bold /and/+-- underlined. The 'Monoid' instance combines 'Attr's this way, with a right bias.+data Attr+  = Attr !Word16 {- color -} !Word16 {- attr -}+  deriving (Eq, Show)++instance Monoid Attr where+  mempty :: Attr+  mempty =+    Attr tB_DEFAULT 0++  mappend :: Attr -> Attr -> Attr+  mappend =+    (<>)++-- | Provided for numeric literals.+instance Num Attr where+  fromInteger :: Integer -> Attr+  fromInteger n =+    Attr (fromIntegral (n `rem` 256)) 0++  (+) = (<>)+  (*) = (<>)+  (-) = (<>)+  abs = id+  signum = id++-- | Right-biased color; attributes are merged.+instance Semigroup Attr where+  (<>) :: Attr -> Attr -> Attr+  Attr 0 ax <> Attr cy ay = Attr cy (ax .|. ay)+  Attr cx ax <> Attr 0 ay = Attr cx (ax .|. ay)+  Attr _ ax <> Attr cy ay = Attr cy (ax .|. ay)++wordToAttr :: Word16 -> Attr+wordToAttr w =+  Attr (w .&. 0x00FF) (w .&. 0xFF00)++attrToWord :: Attr -> Word16+attrToWord (Attr x y) =+  x .|. y++-- | @black = 1@.+black :: Attr+black =+  Attr tB_BLACK 0++-- | @red = 2@.+red :: Attr+red =+  Attr tB_RED 0++-- | @green = 3@.+green :: Attr+green =+  Attr tB_GREEN 0++-- | @yellow = 4@.+yellow :: Attr+yellow =+  Attr tB_YELLOW 0++-- | @blue = 5@.+blue :: Attr+blue =+  Attr tB_BLUE 0++-- | @magenta = 6@.+magenta :: Attr+magenta =+  Attr tB_MAGENTA 0++-- | @cyan = 7@.+cyan :: Attr+cyan =+  Attr tB_CYAN 0++-- | @white = 8@.+white :: Attr+white =+  Attr tB_WHITE 0++-- | Bold modifier attribute.+bold :: Attr+bold =+  Attr tB_DEFAULT tB_BOLD++-- | Underline modifier attribute.+underline :: Attr+underline =+  Attr tB_DEFAULT tB_UNDERLINE++-- | Reverse modifier attribute.+reverse :: Attr+reverse =+  Attr tB_DEFAULT tB_REVERSE
+ src/Termbox/Cell.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE TypeApplications #-}++module Termbox.Cell+  ( Cell (..),+  )+where++import Data.Char (chr, ord)+import Data.Word (Word32)+import Foreign.Ptr (Ptr)+import Foreign.Storable+import Termbox.Attr (Attr, attrToWord, wordToAttr)++-- | A cell contains a character, foreground attribute, and background attribute.+data Cell+  = Cell !Char !Attr !Attr+  deriving (Eq, Show)++instance Storable Cell where+  sizeOf :: Cell -> Int+  sizeOf _ =+    8++  alignment :: Cell -> Int+  alignment _ =+    4++  peek :: Ptr Cell -> IO Cell+  peek ptr = do+    Cell+      <$> (chr . fromIntegral @Word32 @Int <$> peekByteOff ptr 0)+      <*> (wordToAttr <$> peekByteOff ptr 4)+      <*> (wordToAttr <$> peekByteOff ptr 6)++  poke :: Ptr Cell -> Cell -> IO ()+  poke ptr (Cell ch fg bg) = do+    pokeByteOff ptr 0 (fromIntegral @Int @Word32 (ord ch))+    pokeByteOff ptr 4 (attrToWord fg)+    pokeByteOff ptr 6 (attrToWord bg)
+ src/Termbox/Cells.hs view
@@ -0,0 +1,21 @@+module Termbox.Cells+  ( Cells (..),+    set,+  )+where++import Data.Char (ord)+import Data.Semigroup (Semigroup)+import Termbox.Attr (attrToWord)+import Termbox.Cell (Cell (Cell))+import Termbox.Internal (tb_change_cell)++-- | A grid of cells. Create with 'set' and combine with ('<>').+newtype Cells+  = Cells (IO ())+  deriving {- newtype -} (Monoid, Semigroup)++-- | Set a single cell's value (column, then row).+set :: Int -> Int -> Cell -> Cells+set col row (Cell ch fg bg) =+  Cells (tb_change_cell col row (fromIntegral (ord ch)) (attrToWord fg) (attrToWord bg))
+ src/Termbox/Event.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE TypeApplications #-}++module Termbox.Event+  ( Event (..),+    poll,+    PollError (..),+  )+where++import Control.Exception (Exception, throwIO)+import Data.Char (chr)+import Data.Int (Int32)+import Data.Semigroup (Semigroup (..))+import Data.Word (Word32)+import Foreign.Marshal.Alloc (alloca)+import Foreign.Storable (peek)+import Termbox.Internal+import Termbox.Key (Key (KeyChar), parseKey)+import Termbox.Mouse (Mouse, parseMouse)+import Prelude hiding (mod)++-- | A input event.+data Event+  = -- | Key event+    EventKey !Key+  | -- | Resize event (width, then height)+    EventResize !Int !Int+  | -- | Mouse event (column, then row)+    EventMouse !Mouse !Int !Int+  deriving (Eq, Show)++-- | Block until an 'Event' arrives.+--+-- /Throws/: 'PollError'+poll :: IO Event+poll =+  alloca $ \ptr ->+    tb_poll_event ptr >>= \case+      -1 -> throwIO PollError+      _ -> parseEvent <$> peek ptr++-- | An error occurred when polling, due to mysterious circumstances that are not well-documented in the original C+-- codebase.+data PollError+  = PollError+  deriving (Show)++instance Exception PollError++-- | Parse an 'Event' from a 'TbEvent'.+parseEvent :: TbEvent -> Event+parseEvent (TbEvent typ _mod key ch w h x y)+  | typ == tB_EVENT_KEY =+    EventKey (if ch == 0 then parseKey key else KeyChar (chr (fromIntegral @Word32 @Int ch)))+  | typ == tB_EVENT_RESIZE = EventResize (fromIntegral @Int32 @Int w) (fromIntegral @Int32 @Int h)+  | typ == tB_EVENT_MOUSE = EventMouse (parseMouse key) (fromIntegral @Int32 @Int x) (fromIntegral @Int32 @Int y)+  | otherwise = error ("termbox: unknown event type " ++ show typ)
− src/Termbox/Internal.chs
@@ -1,312 +0,0 @@--- | Lowest-level termbox bindings. No creativity here, just a 1:1 mapping.--- Some of the enums are hand-written (source copied from generated module) so--- I can insert haddocks.--{-# language InstanceSigs #-}--module Termbox.Internal where--#include <termbox.h>--import Data.Char (ord)-import Data.Word-import Foreign-import Foreign.C-import Prelude hiding (mod)------------------------------------------------------------------------------------- Constants-----------------------------------------------------------------------------------_INPUT_CURRENT, _INPUT_ESC, _INPUT_ALT, _INPUT_MOUSE :: Int-_HIDE_CURSOR :: Int-_BOLD, _UNDERLINE, _REVERSE :: Word16-_DEFAULT, _BLACK, _RED, _GREEN, _YELLOW, _BLUE, _MAGENTA, _CYAN, _WHITE :: Word16--_INPUT_CURRENT = {# const TB_INPUT_CURRENT #}-_INPUT_ESC     = {# const TB_INPUT_ESC     #}-_INPUT_ALT     = {# const TB_INPUT_ALT     #}-_INPUT_MOUSE   = {# const TB_INPUT_MOUSE   #}--_HIDE_CURSOR   = {# const TB_HIDE_CURSOR #}--_BOLD          = {# const TB_BOLD #}-_UNDERLINE     = {# const TB_UNDERLINE #}-_REVERSE       = {# const TB_REVERSE #}--_DEFAULT       = {# const TB_DEFAULT #}-_BLACK         = {# const TB_BLACK #}-_RED           = {# const TB_RED #}-_GREEN         = {# const TB_GREEN #}-_YELLOW        = {# const TB_YELLOW #}-_BLUE          = {# const TB_BLUE #}-_MAGENTA       = {# const TB_MAGENTA #}-_CYAN          = {# const TB_CYAN #}-_WHITE         = {# const TB_WHITE #}------------------------------------------------------------------------------------- Enums-----------------------------------------------------------------------------------{#-  enum define EventType-    { TB_EVENT_KEY as EventKey-    , TB_EVENT_RESIZE as EventResize-    , TB_EVENT_MOUSE as EventMouse-    }-#}--{#-  enum define InitResult-    { 0 as InitOk-    , TB_EUNSUPPORTED_TERMINAL as UnsupportedTerminal-    , TB_EFAILED_TO_OPEN_TTY as FailedToOpenTTY-    , TB_EPIPE_TRAP_ERROR as PipeTrapError-    }-#}--{#-  enum define Key-    { TB_KEY_F1 as KeyF1-    , TB_KEY_F2 as KeyF2-    , TB_KEY_F3 as KeyF3-    , TB_KEY_F4 as KeyF4-    , TB_KEY_F5 as KeyF5-    , TB_KEY_F6 as KeyF6-    , TB_KEY_F7 as KeyF7-    , TB_KEY_F8 as KeyF8-    , TB_KEY_F9 as KeyF9-    , TB_KEY_F10 as KeyF10-    , TB_KEY_F11 as KeyF11-    , TB_KEY_F12 as KeyF12-    , TB_KEY_INSERT as KeyInsert-    , TB_KEY_DELETE as KeyDelete-    , TB_KEY_HOME as KeyHome-    , TB_KEY_END as KeyEnd-    , TB_KEY_PGUP as KeyPageUp-    , TB_KEY_PGDN as KeyPageDn-    , TB_KEY_ARROW_UP as KeyArrowUp-    , TB_KEY_ARROW_DOWN as KeyArrowDown-    , TB_KEY_ARROW_LEFT as KeyArrowLeft-    , TB_KEY_ARROW_RIGHT as KeyArrowRight-    , TB_KEY_MOUSE_LEFT as KeyMouseLeft-    , TB_KEY_MOUSE_RIGHT as KeyMouseRight-    , TB_KEY_MOUSE_MIDDLE as KeyMouseMiddle-    , TB_KEY_MOUSE_RELEASE as KeyMouseRelease-    , TB_KEY_MOUSE_WHEEL_UP as KeyMouseWheelUp-    , TB_KEY_MOUSE_WHEEL_DOWN as KeyMouseWheelDown-    , TB_KEY_CTRL_TILDE as KeyCtrlTilde-    , TB_KEY_CTRL_2 as KeyCtrl2-    , TB_KEY_CTRL_A as KeyCtrlA-    , TB_KEY_CTRL_B as KeyCtrlB-    , TB_KEY_CTRL_C as KeyCtrlC-    , TB_KEY_CTRL_D as KeyCtrlD-    , TB_KEY_CTRL_E as KeyCtrlE-    , TB_KEY_CTRL_F as KeyCtrlF-    , TB_KEY_CTRL_G as KeyCtrlG-    , TB_KEY_BACKSPACE as KeyBackspace-    , TB_KEY_CTRL_H as KeyCtrlH-    , TB_KEY_TAB as KeyTab-    , TB_KEY_CTRL_I as KeyCtrlI-    , TB_KEY_CTRL_J as KeyCtrlJ-    , TB_KEY_CTRL_K as KeyCtrlK-    , TB_KEY_CTRL_L as KeyCtrlL-    , TB_KEY_ENTER as KeyEnter-    , TB_KEY_CTRL_M as KeyCtrlM-    , TB_KEY_CTRL_N as KeyCtrlN-    , TB_KEY_CTRL_O as KeyCtrlO-    , TB_KEY_CTRL_P as KeyCtrlP-    , TB_KEY_CTRL_Q as KeyCtrlQ-    , TB_KEY_CTRL_R as KeyCtrlR-    , TB_KEY_CTRL_S as KeyCtrlS-    , TB_KEY_CTRL_T as KeyCtrlT-    , TB_KEY_CTRL_U as KeyCtrlU-    , TB_KEY_CTRL_V as KeyCtrlV-    , TB_KEY_CTRL_W as KeyCtrlW-    , TB_KEY_CTRL_X as KeyCtrlX-    , TB_KEY_CTRL_Y as KeyCtrlY-    , TB_KEY_CTRL_Z as KeyCtrlZ-    , TB_KEY_ESC as KeyEsc-    , TB_KEY_CTRL_LSQ_BRACKET as KeyCtrlLsqBracket-    , TB_KEY_CTRL_3 as KeyCtrl3-    , TB_KEY_CTRL_4 as KeyCtrl4-    , TB_KEY_CTRL_BACKSLASH as KeyCtrlBackslash-    , TB_KEY_CTRL_5 as KeyCtrl5-    , TB_KEY_CTRL_RSQ_BRACKET as KeyCtrlRsqBracket-    , TB_KEY_CTRL_6 as KeyCtrl6-    , TB_KEY_CTRL_7 as KeyCtrl7-    , TB_KEY_CTRL_SLASH as KeyCtrlSlash-    , TB_KEY_CTRL_UNDERSCORE as KeyCtrlUnderscore-    , TB_KEY_SPACE as KeySpace-    , TB_KEY_BACKSPACE2 as KeyBackspace2-    , TB_KEY_CTRL_8 as KeyCtrl8-    } deriving (Show)-#}--{#-  enum define Mod-    { 0 as ModNone-    , TB_MOD_ALT as ModAlt-    }-#}--{#-  enum define OutputMode-    { TB_OUTPUT_CURRENT as OutputModeCurrent-    , TB_OUTPUT_NORMAL as OutputModeNormal-    , TB_OUTPUT_256 as OutputMode256-    , TB_OUTPUT_216 as OutputMode216-    , TB_OUTPUT_GRAYSCALE as OutputModeGrayscale-    }--#}------------------------------------------------------------------------------------- Types-----------------------------------------------------------------------------------sizeofCell :: Int-sizeofCell =-  {# sizeof tb_cell #}--alignofCell :: Int-alignofCell =-  {# alignof tb_cell #}--getCellCh :: Ptr a -> IO Char-getCellCh =-  fmap (toEnum . fromIntegral) . {# get tb_cell->ch #}--getCellFg :: Ptr a -> IO Word16-getCellFg =-  fmap fromIntegral . {# get tb_cell->fg #}--getCellBg :: Ptr a -> IO Word16-getCellBg =-  fmap fromIntegral . {# get tb_cell->bg #}--setCellCh :: Ptr a -> Char -> IO ()-setCellCh p =-  {# set tb_cell.ch #} p . fromIntegral . fromEnum--setCellFg :: Ptr a -> Word16 -> IO ()-setCellFg p =-  {# set tb_cell.fg #} p . fromIntegral--setCellBg :: Ptr a -> Word16 -> IO ()-setCellBg p =-  {# set tb_cell.bg #} p . fromIntegral--data Event-  = Event !EventType Mod Key Char Int Int Int Int--instance Storable Event where-  sizeOf :: Event -> Int-  sizeOf _ =-    {# sizeof tb_event #}--  alignment :: Event -> Int-  alignment _ =-    {# alignof tb_event #}--  peek :: Ptr Event -> IO Event-  peek p =-    Event-      <$> ((toEnum . fromIntegral) <$> {# get tb_event->type #} p)-      <*> ((toEnum . fromIntegral) <$> {# get tb_event->mod #} p)-      <*> ((toEnum . fromIntegral) <$> {# get tb_event->key #} p)-      <*> ((toEnum . fromIntegral) <$> {# get tb_event->ch #} p)-      <*> (fromIntegral <$> {# get tb_event->w #} p)-      <*> (fromIntegral <$> {# get tb_event->h #} p)-      <*> (fromIntegral <$> {# get tb_event->x #} p)-      <*> (fromIntegral <$> {# get tb_event->y #} p)--  poke :: Ptr Event -> Event -> IO ()-  poke p (Event typ mod key ch w h x y) = do-    {# set tb_event.type #} p (fromIntegral (fromEnum typ))-    {# set tb_event.mod #} p (fromIntegral (fromEnum mod))-    {# set tb_event.key #} p (fromIntegral (fromEnum key))-    {# set tb_event.ch #} p (fromIntegral (fromEnum ch))-    {# set tb_event.w #} p (fromIntegral w)-    {# set tb_event.h #} p (fromIntegral h)-    {# set tb_event.x #} p (fromIntegral x)-    {# set tb_event.y #} p (fromIntegral y)--{# pointer *tb_event as EventPtr -> Event #}------------------------------------------------------------------------------------- Functions-----------------------------------------------------------------------------------{#-  fun tb_change_cell as changeCell-    { `Int', `Int', charToUInt `Char', `Word16', `Word16' } -> `()'-#}--{#-  fun tb_clear as clear-    { } -> `()'-#}--{#-  fun tb_height as height-    { } -> `Int'-#}--{#-  fun tb_init as init-    { } -> `InitResult'-#}--{#-  fun tb_peek_event as peekEvent-    { `EventPtr', `Int' } -> `Int'-#}--{#-  fun tb_poll_event as pollEvent-    { `EventPtr' } -> `Int'-#}--{#-  fun tb_present as present-    { } -> `()'-#}--{#-  fun tb_select_input_mode as selectInputMode-    { `Int' } -> `Int'-#}--{#-  fun tb_select_output_mode as selectOutputMode-    { `OutputMode' } -> `OutputMode'-#}--{#-  fun tb_set_clear_attributes as setClearAttributes-    { `Word16', `Word16' } -> `()'-#}--{#-  fun tb_set_cursor as setCursor-    { `Int', `Int' } -> `()'-#}--{#-  fun tb_shutdown as shutdown-    { } -> `()'-#}--{#-  fun tb_width as width-    { } -> `Int'-#}------------------------------------------------------------------------------------- Misc.-----------------------------------------------------------------------------------charToUInt :: Char -> CUInt-charToUInt =-  fromIntegral . ord
+ src/Termbox/Internal.hs view
@@ -0,0 +1,350 @@+module Termbox.Internal where++import Data.Int (Int32)+import Data.Word+import Foreign.Ptr (Ptr)+import Foreign.Storable+import Prelude hiding (mod)++tB_EUNSUPPORTED_TERMINAL, tB_EFAILED_TO_OPEN_TTY, tB_EPIPE_TRAP_ERROR :: Int+tB_EUNSUPPORTED_TERMINAL = -1+tB_EFAILED_TO_OPEN_TTY = -2+tB_EPIPE_TRAP_ERROR = -3++tB_INPUT_CURRENT, tB_INPUT_ESC, tB_INPUT_ALT, tB_INPUT_MOUSE :: Int+tB_INPUT_CURRENT = 0+tB_INPUT_ESC = 1+tB_INPUT_ALT = 2+tB_INPUT_MOUSE = 4++tB_OUTPUT_CURRENT, tB_OUTPUT_NORMAL, tB_OUTPUT_256, tB_OUTPUT_216, tB_OUTPUT_GRAYSCALE :: Int+tB_OUTPUT_CURRENT = 0+tB_OUTPUT_NORMAL = 1+tB_OUTPUT_256 = 2+tB_OUTPUT_216 = 3+tB_OUTPUT_GRAYSCALE = 4++tB_EVENT_KEY, tB_EVENT_RESIZE, tB_EVENT_MOUSE :: Word8+tB_EVENT_KEY = 1+tB_EVENT_RESIZE = 2+tB_EVENT_MOUSE = 3++tB_MOD_ALT :: Word8+tB_MOD_ALT = 0x01++-- #define TB_MOD_MOTION 0x02++tB_HIDE_CURSOR :: Int+tB_HIDE_CURSOR = -1++tB_BOLD, tB_UNDERLINE, tB_REVERSE :: Word16+tB_BOLD = 0x0100+tB_UNDERLINE = 0x0200+tB_REVERSE = 0x0400++tB_DEFAULT, tB_BLACK, tB_RED, tB_GREEN, tB_YELLOW, tB_BLUE, tB_MAGENTA, tB_CYAN, tB_WHITE :: Word16+tB_DEFAULT = 0x00+tB_BLACK = 0x01+tB_RED = 0x02+tB_GREEN = 0x03+tB_YELLOW = 0x04+tB_BLUE = 0x05+tB_MAGENTA = 0x06+tB_CYAN = 0x07+tB_WHITE = 0x08++tB_KEY_F1 :: Word16+tB_KEY_F1 = 0xFFFF - 0++tB_KEY_F2 :: Word16+tB_KEY_F2 = 0xFFFF - 1++tB_KEY_F3 :: Word16+tB_KEY_F3 = 0xFFFF - 2++tB_KEY_F4 :: Word16+tB_KEY_F4 = 0xFFFF - 3++tB_KEY_F5 :: Word16+tB_KEY_F5 = 0xFFFF - 4++tB_KEY_F6 :: Word16+tB_KEY_F6 = 0xFFFF - 5++tB_KEY_F7 :: Word16+tB_KEY_F7 = 0xFFFF - 6++tB_KEY_F8 :: Word16+tB_KEY_F8 = 0xFFFF - 7++tB_KEY_F9 :: Word16+tB_KEY_F9 = 0xFFFF - 8++tB_KEY_F10 :: Word16+tB_KEY_F10 = 0xFFFF - 9++tB_KEY_F11 :: Word16+tB_KEY_F11 = 0xFFFF - 10++tB_KEY_F12 :: Word16+tB_KEY_F12 = 0xFFFF - 11++tB_KEY_INSERT :: Word16+tB_KEY_INSERT = 0xFFFF - 12++tB_KEY_DELETE :: Word16+tB_KEY_DELETE = 0xFFFF - 13++tB_KEY_HOME :: Word16+tB_KEY_HOME = 0xFFFF - 14++tB_KEY_END :: Word16+tB_KEY_END = 0xFFFF - 15++tB_KEY_PGUP :: Word16+tB_KEY_PGUP = 0xFFFF - 16++tB_KEY_PGDN :: Word16+tB_KEY_PGDN = 0xFFFF - 17++tB_KEY_ARROW_UP :: Word16+tB_KEY_ARROW_UP = 0xFFFF - 18++tB_KEY_ARROW_DOWN :: Word16+tB_KEY_ARROW_DOWN = 0xFFFF - 19++tB_KEY_ARROW_LEFT :: Word16+tB_KEY_ARROW_LEFT = 0xFFFF - 20++tB_KEY_ARROW_RIGHT :: Word16+tB_KEY_ARROW_RIGHT = 0xFFFF - 21++tB_KEY_MOUSE_LEFT :: Word16+tB_KEY_MOUSE_LEFT = 0xFFFF - 22++tB_KEY_MOUSE_RIGHT :: Word16+tB_KEY_MOUSE_RIGHT = 0xFFFF - 23++tB_KEY_MOUSE_MIDDLE :: Word16+tB_KEY_MOUSE_MIDDLE = 0xFFFF - 24++tB_KEY_MOUSE_RELEASE :: Word16+tB_KEY_MOUSE_RELEASE = 0xFFFF - 25++tB_KEY_MOUSE_WHEEL_UP :: Word16+tB_KEY_MOUSE_WHEEL_UP = 0xFFFF - 26++tB_KEY_MOUSE_WHEEL_DOWN :: Word16+tB_KEY_MOUSE_WHEEL_DOWN = 0xFFFF - 27++tB_KEY_CTRL_TILDE :: Word16+tB_KEY_CTRL_TILDE = 0x00++tB_KEY_CTRL_2 :: Word16+tB_KEY_CTRL_2 = 0x00++tB_KEY_CTRL_A :: Word16+tB_KEY_CTRL_A = 0x01++tB_KEY_CTRL_B :: Word16+tB_KEY_CTRL_B = 0x02++tB_KEY_CTRL_C :: Word16+tB_KEY_CTRL_C = 0x03++tB_KEY_CTRL_D :: Word16+tB_KEY_CTRL_D = 0x04++tB_KEY_CTRL_E :: Word16+tB_KEY_CTRL_E = 0x05++tB_KEY_CTRL_F :: Word16+tB_KEY_CTRL_F = 0x06++tB_KEY_CTRL_G :: Word16+tB_KEY_CTRL_G = 0x07++tB_KEY_BACKSPACE :: Word16+tB_KEY_BACKSPACE = 0x08++tB_KEY_CTRL_H :: Word16+tB_KEY_CTRL_H = 0x08++tB_KEY_TAB :: Word16+tB_KEY_TAB = 0x09++tB_KEY_CTRL_I :: Word16+tB_KEY_CTRL_I = 0x09++tB_KEY_CTRL_J :: Word16+tB_KEY_CTRL_J = 0x0A++tB_KEY_CTRL_K :: Word16+tB_KEY_CTRL_K = 0x0B++tB_KEY_CTRL_L :: Word16+tB_KEY_CTRL_L = 0x0C++tB_KEY_ENTER :: Word16+tB_KEY_ENTER = 0x0D++tB_KEY_CTRL_M :: Word16+tB_KEY_CTRL_M = 0x0D++tB_KEY_CTRL_N :: Word16+tB_KEY_CTRL_N = 0x0E++tB_KEY_CTRL_O :: Word16+tB_KEY_CTRL_O = 0x0F++tB_KEY_CTRL_P :: Word16+tB_KEY_CTRL_P = 0x10++tB_KEY_CTRL_Q :: Word16+tB_KEY_CTRL_Q = 0x11++tB_KEY_CTRL_R :: Word16+tB_KEY_CTRL_R = 0x12++tB_KEY_CTRL_S :: Word16+tB_KEY_CTRL_S = 0x13++tB_KEY_CTRL_T :: Word16+tB_KEY_CTRL_T = 0x14++tB_KEY_CTRL_U :: Word16+tB_KEY_CTRL_U = 0x15++tB_KEY_CTRL_V :: Word16+tB_KEY_CTRL_V = 0x16++tB_KEY_CTRL_W :: Word16+tB_KEY_CTRL_W = 0x17++tB_KEY_CTRL_X :: Word16+tB_KEY_CTRL_X = 0x18++tB_KEY_CTRL_Y :: Word16+tB_KEY_CTRL_Y = 0x19++tB_KEY_CTRL_Z :: Word16+tB_KEY_CTRL_Z = 0x1A++tB_KEY_ESC :: Word16+tB_KEY_ESC = 0x1B++tB_KEY_CTRL_LSQ_BRACKET :: Word16+tB_KEY_CTRL_LSQ_BRACKET = 0x1B++tB_KEY_CTRL_3 :: Word16+tB_KEY_CTRL_3 = 0x1B++tB_KEY_CTRL_4 :: Word16+tB_KEY_CTRL_4 = 0x1C++tB_KEY_CTRL_BACKSLASH :: Word16+tB_KEY_CTRL_BACKSLASH = 0x1C++tB_KEY_CTRL_5 :: Word16+tB_KEY_CTRL_5 = 0x1D++tB_KEY_CTRL_RSQ_BRACKET :: Word16+tB_KEY_CTRL_RSQ_BRACKET = 0x1D++tB_KEY_CTRL_6 :: Word16+tB_KEY_CTRL_6 = 0x1E++tB_KEY_CTRL_7 :: Word16+tB_KEY_CTRL_7 = 0x1F++tB_KEY_CTRL_SLASH :: Word16+tB_KEY_CTRL_SLASH = 0x1F++tB_KEY_CTRL_UNDERSCORE :: Word16+tB_KEY_CTRL_UNDERSCORE = 0x1F++tB_KEY_SPACE :: Word16+tB_KEY_SPACE = 0x20++tB_KEY_BACKSPACE2 :: Word16+tB_KEY_BACKSPACE2 = 0x7F++tB_KEY_CTRL_8 :: Word16+tB_KEY_CTRL_8 = 0x7F++data TbEvent+  = TbEvent !Word8 Word8 Word16 Word32 Int32 Int32 Int32 Int32++instance Storable TbEvent where+  sizeOf :: TbEvent -> Int+  sizeOf _ =+    24++  alignment :: TbEvent -> Int+  alignment _ =+    4++  peek :: Ptr TbEvent -> IO TbEvent+  peek ptr =+    TbEvent+      <$> peekByteOff ptr 0+      <*> peekByteOff ptr 1+      <*> peekByteOff ptr 2+      <*> peekByteOff ptr 4+      <*> peekByteOff ptr 8+      <*> peekByteOff ptr 12+      <*> peekByteOff ptr 16+      <*> peekByteOff ptr 20++  poke :: Ptr TbEvent -> TbEvent -> IO ()+  poke ptr (TbEvent typ mod key ch w h x y) = do+    pokeByteOff ptr 0 typ+    pokeByteOff ptr 1 mod+    pokeByteOff ptr 2 key+    pokeByteOff ptr 4 ch+    pokeByteOff ptr 8 w+    pokeByteOff ptr 12 h+    pokeByteOff ptr 16 x+    pokeByteOff ptr 20 y++foreign import ccall unsafe "tb_change_cell"+  tb_change_cell :: Int -> Int -> Word32 -> Word16 -> Word16 -> IO ()++foreign import ccall unsafe "tb_clear"+  tb_clear :: IO ()++foreign import ccall unsafe "tb_height"+  tb_height :: IO Int++foreign import ccall unsafe "tb_init"+  tb_init :: IO Int++foreign import ccall safe "tb_peek_event"+  tb_peek_event :: Ptr TbEvent -> Int -> IO Int++foreign import ccall safe "tb_poll_event"+  tb_poll_event :: Ptr TbEvent -> IO Int++foreign import ccall unsafe "tb_present"+  tb_present :: IO ()++foreign import ccall unsafe "tb_select_input_mode"+  tb_select_input_mode :: Int -> IO Int++foreign import ccall unsafe "tb_select_output_mode"+  tb_select_output_mode :: Int -> IO Int++foreign import ccall unsafe "tb_set_clear_attributes"+  tb_set_clear_attributes :: Word16 -> Word16 -> IO ()++foreign import ccall unsafe "tb_set_cursor"+  tb_set_cursor :: Int -> Int -> IO ()++foreign import ccall unsafe "tb_shutdown"+  tb_shutdown :: IO ()++foreign import ccall unsafe "tb_width"+  tb_width :: IO Int++-- foreign import ccall unsafe "tb_cell_buffer"+--   tb_cell_buffer :: IO (Ptr Cell)
+ src/Termbox/Key.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE PatternSynonyms #-}++module Termbox.Key+  ( Key (..),+    parseKey,+    pattern KeyCtrlH,+    pattern KeyCtrlLsqBracket,+    pattern KeyCtrl2,+    pattern KeyCtrl3,+    pattern KeyCtrl4,+    pattern KeyCtrl5,+    pattern KeyCtrl7,+    pattern KeyCtrlM,+    pattern KeyCtrlI,+    pattern KeyCtrlUnderscore,+  )+where++import Data.Word (Word16)+import Termbox.Internal++-- | A key event.+data Key+  = KeyChar Char+  | KeyArrowDown+  | KeyArrowLeft+  | KeyArrowRight+  | KeyArrowUp+  | KeyBackspace+  | -- | Also: @Ctrl+H@+    KeyCtrlBackspace+  | KeyCtrl6+  | KeyCtrl8+  | KeyCtrlA+  | KeyCtrlB+  | -- | Also: @Ctrl-4@+    KeyCtrlBackslash+  | KeyCtrlC+  | KeyCtrlD+  | KeyCtrlE+  | KeyCtrlF+  | KeyCtrlG+  | KeyCtrlJ+  | KeyCtrlK+  | KeyCtrlL+  | KeyCtrlN+  | KeyCtrlO+  | KeyCtrlP+  | KeyCtrlQ+  | KeyCtrlR+  | -- | Also: @Ctrl-5@+    KeyCtrlRsqBracket+  | KeyCtrlS+  | -- | Also: @Ctrl-/@, @Ctrl-_@+    KeyCtrlSlash+  | -- | Also: @Ctrl+2@+    KeyCtrlTilde+  | KeyCtrlT+  | KeyCtrlU+  | KeyCtrlV+  | KeyCtrlW+  | KeyCtrlX+  | KeyCtrlY+  | KeyCtrlZ+  | KeyDelete+  | KeyEnd+  | -- | Also: @Ctrl-M@+    KeyEnter+  | -- | Also: @Ctrl-[@, @Ctrl-3@+    KeyEsc+  | KeyF1+  | KeyF10+  | KeyF11+  | KeyF12+  | KeyF2+  | KeyF3+  | KeyF4+  | KeyF5+  | KeyF6+  | KeyF7+  | KeyF8+  | KeyF9+  | KeyHome+  | KeyInsert+  | KeyPageDn+  | KeyPageUp+  | KeySpace+  | -- | Also: @Ctrl+I@+    KeyTab+  deriving (Eq, Ord, Show)++pattern KeyCtrlH :: Key+pattern KeyCtrlH = KeyCtrlBackspace++pattern KeyCtrlLsqBracket :: Key+pattern KeyCtrlLsqBracket = KeyEsc++pattern KeyCtrl2 :: Key+pattern KeyCtrl2 = KeyCtrlTilde++pattern KeyCtrl3 :: Key+pattern KeyCtrl3 = KeyEsc++pattern KeyCtrl4 :: Key+pattern KeyCtrl4 = KeyCtrlBackslash++pattern KeyCtrl5 :: Key+pattern KeyCtrl5 = KeyCtrlRsqBracket++pattern KeyCtrl7 :: Key+pattern KeyCtrl7 = KeyCtrlSlash++pattern KeyCtrlM :: Key+pattern KeyCtrlM = KeyEnter++pattern KeyCtrlI :: Key+pattern KeyCtrlI = KeyTab++pattern KeyCtrlUnderscore :: Key+pattern KeyCtrlUnderscore = KeyCtrlSlash++parseKey :: Word16 -> Key+parseKey key+  | key == tB_KEY_ARROW_DOWN = KeyArrowDown+  | key == tB_KEY_ARROW_LEFT = KeyArrowLeft+  | key == tB_KEY_ARROW_RIGHT = KeyArrowRight+  | key == tB_KEY_ARROW_UP = KeyArrowUp+  | key == tB_KEY_BACKSPACE = KeyBackspace+  | key == tB_KEY_CTRL_TILDE = KeyCtrlTilde+  | key == tB_KEY_CTRL_6 = KeyCtrl6+  | key == tB_KEY_CTRL_8 = KeyCtrl8+  | key == tB_KEY_CTRL_A = KeyCtrlA+  | key == tB_KEY_CTRL_B = KeyCtrlB+  | key == tB_KEY_CTRL_BACKSLASH = KeyCtrlBackslash+  | key == tB_KEY_CTRL_C = KeyCtrlC+  | key == tB_KEY_CTRL_D = KeyCtrlD+  | key == tB_KEY_CTRL_E = KeyCtrlE+  | key == tB_KEY_CTRL_F = KeyCtrlF+  | key == tB_KEY_CTRL_G = KeyCtrlG+  | key == tB_KEY_CTRL_H = KeyCtrlBackspace+  | key == tB_KEY_CTRL_J = KeyCtrlJ+  | key == tB_KEY_CTRL_K = KeyCtrlK+  | key == tB_KEY_CTRL_L = KeyCtrlL+  | key == tB_KEY_CTRL_N = KeyCtrlN+  | key == tB_KEY_CTRL_O = KeyCtrlO+  | key == tB_KEY_CTRL_P = KeyCtrlP+  | key == tB_KEY_CTRL_Q = KeyCtrlQ+  | key == tB_KEY_CTRL_R = KeyCtrlR+  | key == tB_KEY_CTRL_RSQ_BRACKET = KeyCtrlRsqBracket+  | key == tB_KEY_CTRL_S = KeyCtrlS+  | key == tB_KEY_CTRL_SLASH = KeyCtrlSlash+  | key == tB_KEY_CTRL_T = KeyCtrlT+  | key == tB_KEY_CTRL_U = KeyCtrlU+  | key == tB_KEY_CTRL_V = KeyCtrlV+  | key == tB_KEY_CTRL_W = KeyCtrlW+  | key == tB_KEY_CTRL_X = KeyCtrlX+  | key == tB_KEY_CTRL_Y = KeyCtrlY+  | key == tB_KEY_CTRL_Z = KeyCtrlZ+  | key == tB_KEY_DELETE = KeyDelete+  | key == tB_KEY_END = KeyEnd+  | key == tB_KEY_ENTER = KeyEnter+  | key == tB_KEY_ESC = KeyEsc+  | key == tB_KEY_F1 = KeyF1+  | key == tB_KEY_F10 = KeyF10+  | key == tB_KEY_F11 = KeyF11+  | key == tB_KEY_F12 = KeyF12+  | key == tB_KEY_F2 = KeyF2+  | key == tB_KEY_F3 = KeyF3+  | key == tB_KEY_F4 = KeyF4+  | key == tB_KEY_F5 = KeyF5+  | key == tB_KEY_F6 = KeyF6+  | key == tB_KEY_F7 = KeyF7+  | key == tB_KEY_F8 = KeyF8+  | key == tB_KEY_F9 = KeyF9+  | key == tB_KEY_HOME = KeyHome+  | key == tB_KEY_INSERT = KeyInsert+  | key == tB_KEY_PGDN = KeyPageDn+  | key == tB_KEY_PGUP = KeyPageUp+  | key == tB_KEY_SPACE = KeySpace+  | key == tB_KEY_TAB = KeyTab+  | otherwise = error ("termbox: unknown key " ++ show key)
+ src/Termbox/Mouse.hs view
@@ -0,0 +1,28 @@+module Termbox.Mouse+  ( Mouse (..),+    parseMouse,+  )+where++import Data.Word (Word16)+import Termbox.Internal++-- | A mouse event.+data Mouse+  = MouseLeft+  | MouseMiddle+  | MouseRelease+  | MouseRight+  | MouseWheelDown+  | MouseWheelUp+  deriving (Eq, Ord, Show)++parseMouse :: Word16 -> Mouse+parseMouse key+  | key == tB_KEY_MOUSE_LEFT = MouseLeft+  | key == tB_KEY_MOUSE_MIDDLE = MouseMiddle+  | key == tB_KEY_MOUSE_RELEASE = MouseRelease+  | key == tB_KEY_MOUSE_RIGHT = MouseRight+  | key == tB_KEY_MOUSE_WHEEL_DOWN = MouseWheelDown+  | key == tB_KEY_MOUSE_WHEEL_UP = MouseWheelUp+  | otherwise = error ("termbox: unknown mouse " ++ show key)
termbox.cabal view
@@ -1,11 +1,11 @@ cabal-version: 2.4  name: termbox-version: 0.2.0.1+version: 0.3.0 category: User Interfaces description:   This package provides a thin wrapper around @termbox v1.1.2@, a simple C-  library for writing text-based user interfaces: <https://github.com/nsf/termbox>+  library for writing text-based user interfaces: <https://github.com/termbox/termbox>   .   The full source of @termbox v1.1.2@ (1000 lines of C) is bundled; you do   not need to install any system packages to use this library.@@ -33,19 +33,12 @@   default: False   manual: True -library-  build-depends:-    array,-    base ^>= 4.9 || ^>= 4.10 || ^>= 4.11 || ^>= 4.12 || ^>= 4.13 || ^>= 4.14-  build-tool-depends:-    c2hs:c2hs-  c-sources:-    cbits/termbox.c-    cbits/utf8.c-  default-language:-    Haskell2010-  exposed-modules:-    Termbox+common component+  default-extensions:+    GeneralizedNewtypeDeriving+    InstanceSigs+    LambdaCase+  default-language: Haskell2010   ghc-options:     -Weverything     -Wno-implicit-prelude@@ -58,26 +51,35 @@     ghc-options:       -Wno-missing-safe-haskell-mode       -Wno-prepositive-qualified-module-  hs-source-dirs:-    src-  include-dirs:-    include-  other-modules:++library+  import: component+  build-depends: base ^>= 4.10 || ^>= 4.11 || ^>= 4.12 || ^>= 4.13 || ^>= 4.14+  c-sources:+    cbits/termbox.c+    cbits/utf8.c+  exposed-modules:+    Termbox     Termbox.Internal+  hs-source-dirs: src+  include-dirs: include+  other-modules:+    Termbox.Attr+    Termbox.Cell+    Termbox.Cells+    Termbox.Event+    Termbox.Key+    Termbox.Mouse  executable termbox-example-colors+  import: component   if !flag(build-examples)     buildable: False   build-depends:     base,     termbox,-  default-language:-    Haskell2010   ghc-options:     -rtsopts     -threaded-    -Wall-  hs-source-dirs:-    examples-  main-is:-    Colors.hs+  hs-source-dirs: examples+  main-is: Colors.hs