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 +29/−8
- examples/Colors.hs +31/−111
- src/Termbox.hs +136/−634
- src/Termbox/Attr.hs +124/−0
- src/Termbox/Cell.hs +39/−0
- src/Termbox/Cells.hs +21/−0
- src/Termbox/Event.hs +57/−0
- src/Termbox/Internal.chs +0/−312
- src/Termbox/Internal.hs +350/−0
- src/Termbox/Key.hs +181/−0
- src/Termbox/Mouse.hs +28/−0
- termbox.cabal +29/−27
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