{-# LINE 1 "src/Termbox2.hsc" #-}
{-|
Module: Termbox2
Description: Bindings to the termbox2 console UI library.
License: AGPL-3-or-later
Maintainer: gatlin@niltag.net
Stability: experimental
Portability: POSIX

Bindings to the C-language termbox2 console UI library.
 -}
module Termbox2
  (
  -- * Termbox2 monad
    Termbox2
  , runTermbox2
  , init
  , initFile
  , initFd
  , initRwFd
  , shutdown
  , width
  , height
  , present
  , clear
  , setClearAttrs
  , setCursor
  , hideCursor
  , setCell
  , setInputMode
  , setOutputMode
  , print
  , pollEvent
  , peekEvent
  -- * Events
  , Tb2Event(..)
  -- * Constants
  -- ** Errors
  , Tb2Err(..)
  , errOk
  , errErr
  , errNeedMore
  , errInitAlready
  , errInitOpen
  , errMem
  , errNoEvent
  , errNoTerm
  , errNotInit
  , errOutOfBounds
  , errRead
  , errResizeIOCTL
  , errResizePipe
  , errResizeSigaction
  , errPoll
  , errUnsupportedTerm
  , errResizeWrite
  , errResizePoll
  , errResizeRead
  , errResizeSscanf
  , errCapCollision
  -- ** Keys
  , Tb2Key(..)
  , keyCtrlTilde
  , keyCtrl2
  , keyCtrlA
  , keyCtrlB
  , keyCtrlC
  , keyCtrlD
  , keyCtrlE
  , keyCtrlF
  , keyCtrlG
  , keyBackspace
  , keyCtrlH
  , keyCtrlTab
  , keyCtrlI
  , keyCtrlJ
  , keyCtrlK
  , keyCtrlL
  , keyCtrlEnter
  , keyCtrlM
  , keyCtrlN
  , keyCtrlO
  , keyCtrlP
  , keyCtrlQ
  , keyCtrlR
  , keyCtrlS
  , keyCtrlT
  , keyCtrlU
  , keyCtrlV
  , keyCtrlW
  , keyCtrlX
  , keyCtrlY
  , keyCtrlZ
  , keyCtrlEsc
  , keyCtrlLsqBracket
  , keyCtrl3
  , keyCtrl4
  , keyCtrlBackslash
  , keyCtrl5
  , keyCtrlRsqBracket
  , keyCtrl6
  , keyCtrl7
  , keyCtrlSlash
  , keyCtrlUnderscore
  , keySpace
  , keyBackspace2
  , keyCtrl8
  , keyF1
  , keyF2
  , keyF3
  , keyF4
  , keyF5
  , keyF6
  , keyF7
  , keyF8
  , keyF9
  , keyF10
  , keyF11
  , keyF12
  , keyInsert
  , keyDelete
  , keyHome
  , keyEnd
  , keyPgUp
  , keyPgDn
  , keyArrowUp
  , keyArrowDown
  , keyArrowLeft
  , keyArrowRight
  , keyBackTab
  , keyMouseLeft
  , keyMouseRight
  , keyMouseMiddle
  , keyMouseRelease
  , keyMouseWheelUp
  , keyMouseWheelDown
  -- ** Modifiers
  , Tb2Mod(..)
  , modAlt
  , modCtrl
  , modShift
  , modMotion
  -- ** Caps
  , Tb2Cap(..)
  , capF1
  , capF2
  , capF3
  , capF4
  , capF5
  , capF6
  , capF7
  , capF8
  , capF9
  , capF10
  , capF11
  , capF12
  , capInsert
  , capDelete
  , capHome
  , capEnd
  , capPgUp
  , capPgDn
  , capArrowUp
  , capArrowDown
  , capArrowLeft
  , capArrowRight
  , capBackTab
  , capEnterCA
  , capExitCA
  , capShowCursor
  , capHideCursor
  , capClearScreen
  , capSGR0
  , capUnderline
  , capBold
  , capBlink
  , capItalic
  , capReverse
  , capEnterKeypad
  , capExitKeypad
  -- ** Event types
  , Tb2EventType(..)
  , eventKey
  , eventResize
  , eventMouse
  -- ** Colors & Attributes
  , Tb2ColorAttr(..)
  , colorBlack
  , colorRed
  , colorGreen
  , colorYellow
  , colorBlue
  , colorMagenta
  , colorCyan
  , colorWhite
  , colorDefault
  , attrBold
  , attrUnderline
  , attrReverse
  , attrItalic
  , attrBlink
  -- ** Input modes
  , Tb2Input(..)
  , inputCurrent
  , inputEsc
  , inputAlt
  , inputMouse
  -- ** Output modes
  , Tb2Output(..)
  , outputCurrent
  , outputNormal
  , output256
  , output216
  , outputGrayscale
  )
where

import Prelude hiding (init, print)
import Data.Bits (Bits(..), (.|.))
import Data.Functor ((<&>))
import Data.Int (Int32)
import Data.Word (Word8, Word16, Word32)
import Foreign.C (CInt(..))
import Foreign.C.Error (Errno(..), eINTR)
import Foreign.C.String (CString, withCString)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (Ptr)
import Foreign.Storable (Storable(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask)



-- * Events

-- | Incoming event from the tty.
data Tb2Event = Tb2Event
  { Tb2Event -> Tb2EventType
_type :: !Tb2EventType -- ^ one of TB_EVENT_* constants
  , Tb2Event -> Tb2Mod
_mod  :: !Tb2Mod       -- ^ bitwise TB_MOD_* constants
  , Tb2Event -> Tb2Key
_key  :: !Tb2Key       -- ^ one of TB_KEY_* constants
  , Tb2Event -> Word32
_ch   :: !Word32       -- ^ a Unicode code point
  , Tb2Event -> Int32
_w    :: !Int32        -- ^ resize width
  , Tb2Event -> Int32
_h    :: !Int32        -- ^ resize height
  , Tb2Event -> Int32
_x    :: !Int32        -- ^ mouse x
  , Tb2Event -> Int32
_y    :: !Int32        -- ^ mouse y
  } deriving (Int -> Tb2Event -> ShowS
[Tb2Event] -> ShowS
Tb2Event -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tb2Event] -> ShowS
$cshowList :: [Tb2Event] -> ShowS
show :: Tb2Event -> String
$cshow :: Tb2Event -> String
showsPrec :: Int -> Tb2Event -> ShowS
$cshowsPrec :: Int -> Tb2Event -> ShowS
Show, Tb2Event -> Tb2Event -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tb2Event -> Tb2Event -> Bool
$c/= :: Tb2Event -> Tb2Event -> Bool
== :: Tb2Event -> Tb2Event -> Bool
$c== :: Tb2Event -> Tb2Event -> Bool
Eq, Eq Tb2Event
Tb2Event -> Tb2Event -> Bool
Tb2Event -> Tb2Event -> Ordering
Tb2Event -> Tb2Event -> Tb2Event
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tb2Event -> Tb2Event -> Tb2Event
$cmin :: Tb2Event -> Tb2Event -> Tb2Event
max :: Tb2Event -> Tb2Event -> Tb2Event
$cmax :: Tb2Event -> Tb2Event -> Tb2Event
>= :: Tb2Event -> Tb2Event -> Bool
$c>= :: Tb2Event -> Tb2Event -> Bool
> :: Tb2Event -> Tb2Event -> Bool
$c> :: Tb2Event -> Tb2Event -> Bool
<= :: Tb2Event -> Tb2Event -> Bool
$c<= :: Tb2Event -> Tb2Event -> Bool
< :: Tb2Event -> Tb2Event -> Bool
$c< :: Tb2Event -> Tb2Event -> Bool
compare :: Tb2Event -> Tb2Event -> Ordering
$ccompare :: Tb2Event -> Tb2Event -> Ordering
Ord)

instance Storable Tb2Event where
  alignment :: Tb2Event -> Int
alignment Tb2Event
_ = (Int
4)
{-# LINE 249 "src/Termbox2.hsc" #-}
  sizeOf    _ = ((24))
{-# LINE 250 "src/Termbox2.hsc" #-}
  peek ptr    = Tb2Event
    <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 252 "src/Termbox2.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 1)) ptr
{-# LINE 253 "src/Termbox2.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 2)) ptr
{-# LINE 254 "src/Termbox2.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 255 "src/Termbox2.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 256 "src/Termbox2.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 257 "src/Termbox2.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 258 "src/Termbox2.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
{-# LINE 259 "src/Termbox2.hsc" #-}
  poke ptr (Tb2Event _t _m _k _c _w _h _x _y) = do
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr _t
{-# LINE 261 "src/Termbox2.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 1)) ptr  _m
{-# LINE 262 "src/Termbox2.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) ptr  _k
{-# LINE 263 "src/Termbox2.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr   _c
{-# LINE 264 "src/Termbox2.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr    _w
{-# LINE 265 "src/Termbox2.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr    _h
{-# LINE 266 "src/Termbox2.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr    _x
{-# LINE 267 "src/Termbox2.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr    _y
{-# LINE 268 "src/Termbox2.hsc" #-}

-- Foreign functions

foreign import ccall unsafe "tb_init"
  ffi_tb_init :: IO CInt
foreign import ccall unsafe "tb_init_file"
  ffi_tb_init_file :: CString -> IO CInt
foreign import ccall unsafe "tb_init_fd"
  ffi_tb_init_fd :: CInt -> IO CInt
foreign import ccall unsafe "tb_init_rwfd"
  ffi_tb_init_rwfd :: CInt -> CInt -> IO CInt
foreign import ccall unsafe "tb_shutdown"
  ffi_tb_shutdown :: IO CInt
foreign import ccall unsafe "tb_width"
  ffi_tb_width :: IO CInt
foreign import ccall unsafe "tb_height"
  ffi_tb_height :: IO CInt
foreign import ccall unsafe "tb_clear"
  ffi_tb_clear:: IO CInt
foreign import ccall unsafe "tb_set_clear_attrs"
  ffi_tb_set_clear_attrs :: CInt -> CInt -> IO CInt
foreign import ccall unsafe "tb_present"
  ffi_tb_present :: IO CInt
foreign import ccall unsafe "tb_set_cursor"
  ffi_tb_set_cursor :: CInt -> CInt -> IO CInt
foreign import ccall unsafe "tb_hide_cursor"
  ffi_tb_hide_cursor :: IO CInt
foreign import ccall unsafe "tb_set_cell"
  ffi_tb_set_cell :: CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt
foreign import ccall unsafe "tb_set_input_mode"
  ffi_tb_set_input_mode :: CInt -> IO CInt
foreign import ccall unsafe "tb_set_output_mode"
  ffi_tb_set_output_mode :: CInt -> IO CInt
foreign import ccall unsafe "tb_peek_event"
  ffi_tb_peek_event :: Ptr Tb2Event -> CInt -> IO CInt
foreign import ccall unsafe "tb_poll_event"
  ffi_tb_poll_event :: Ptr Tb2Event -> IO CInt
foreign import ccall unsafe "tb_print"
  ffi_tb_print :: CInt -> CInt -> CInt -> CInt -> CString -> IO CInt
foreign import ccall unsafe "tb_last_errno"
  ffi_tb_last_errno :: IO CInt

-- * Constants
newtype Tb2Key = Tb2Key Word16
  deriving (Int -> Tb2Key -> ShowS
[Tb2Key] -> ShowS
Tb2Key -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tb2Key] -> ShowS
$cshowList :: [Tb2Key] -> ShowS
show :: Tb2Key -> String
$cshow :: Tb2Key -> String
showsPrec :: Int -> Tb2Key -> ShowS
$cshowsPrec :: Int -> Tb2Key -> ShowS
Show, Tb2Key -> Tb2Key -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tb2Key -> Tb2Key -> Bool
$c/= :: Tb2Key -> Tb2Key -> Bool
== :: Tb2Key -> Tb2Key -> Bool
$c== :: Tb2Key -> Tb2Key -> Bool
Eq, Eq Tb2Key
Tb2Key -> Tb2Key -> Bool
Tb2Key -> Tb2Key -> Ordering
Tb2Key -> Tb2Key -> Tb2Key
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tb2Key -> Tb2Key -> Tb2Key
$cmin :: Tb2Key -> Tb2Key -> Tb2Key
max :: Tb2Key -> Tb2Key -> Tb2Key
$cmax :: Tb2Key -> Tb2Key -> Tb2Key
>= :: Tb2Key -> Tb2Key -> Bool
$c>= :: Tb2Key -> Tb2Key -> Bool
> :: Tb2Key -> Tb2Key -> Bool
$c> :: Tb2Key -> Tb2Key -> Bool
<= :: Tb2Key -> Tb2Key -> Bool
$c<= :: Tb2Key -> Tb2Key -> Bool
< :: Tb2Key -> Tb2Key -> Bool
$c< :: Tb2Key -> Tb2Key -> Bool
compare :: Tb2Key -> Tb2Key -> Ordering
$ccompare :: Tb2Key -> Tb2Key -> Ordering
Ord, Int -> Tb2Key
Tb2Key -> Int
Tb2Key -> [Tb2Key]
Tb2Key -> Tb2Key
Tb2Key -> Tb2Key -> [Tb2Key]
Tb2Key -> Tb2Key -> Tb2Key -> [Tb2Key]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Tb2Key -> Tb2Key -> Tb2Key -> [Tb2Key]
$cenumFromThenTo :: Tb2Key -> Tb2Key -> Tb2Key -> [Tb2Key]
enumFromTo :: Tb2Key -> Tb2Key -> [Tb2Key]
$cenumFromTo :: Tb2Key -> Tb2Key -> [Tb2Key]
enumFromThen :: Tb2Key -> Tb2Key -> [Tb2Key]
$cenumFromThen :: Tb2Key -> Tb2Key -> [Tb2Key]
enumFrom :: Tb2Key -> [Tb2Key]
$cenumFrom :: Tb2Key -> [Tb2Key]
fromEnum :: Tb2Key -> Int
$cfromEnum :: Tb2Key -> Int
toEnum :: Int -> Tb2Key
$ctoEnum :: Int -> Tb2Key
pred :: Tb2Key -> Tb2Key
$cpred :: Tb2Key -> Tb2Key
succ :: Tb2Key -> Tb2Key
$csucc :: Tb2Key -> Tb2Key
Enum, Integer -> Tb2Key
Tb2Key -> Tb2Key
Tb2Key -> Tb2Key -> Tb2Key
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Tb2Key
$cfromInteger :: Integer -> Tb2Key
signum :: Tb2Key -> Tb2Key
$csignum :: Tb2Key -> Tb2Key
abs :: Tb2Key -> Tb2Key
$cabs :: Tb2Key -> Tb2Key
negate :: Tb2Key -> Tb2Key
$cnegate :: Tb2Key -> Tb2Key
* :: Tb2Key -> Tb2Key -> Tb2Key
$c* :: Tb2Key -> Tb2Key -> Tb2Key
- :: Tb2Key -> Tb2Key -> Tb2Key
$c- :: Tb2Key -> Tb2Key -> Tb2Key
+ :: Tb2Key -> Tb2Key -> Tb2Key
$c+ :: Tb2Key -> Tb2Key -> Tb2Key
Num, Num Tb2Key
Ord Tb2Key
Tb2Key -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Tb2Key -> Rational
$ctoRational :: Tb2Key -> Rational
Real, Enum Tb2Key
Real Tb2Key
Tb2Key -> Integer
Tb2Key -> Tb2Key -> (Tb2Key, Tb2Key)
Tb2Key -> Tb2Key -> Tb2Key
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Tb2Key -> Integer
$ctoInteger :: Tb2Key -> Integer
divMod :: Tb2Key -> Tb2Key -> (Tb2Key, Tb2Key)
$cdivMod :: Tb2Key -> Tb2Key -> (Tb2Key, Tb2Key)
quotRem :: Tb2Key -> Tb2Key -> (Tb2Key, Tb2Key)
$cquotRem :: Tb2Key -> Tb2Key -> (Tb2Key, Tb2Key)
mod :: Tb2Key -> Tb2Key -> Tb2Key
$cmod :: Tb2Key -> Tb2Key -> Tb2Key
div :: Tb2Key -> Tb2Key -> Tb2Key
$cdiv :: Tb2Key -> Tb2Key -> Tb2Key
rem :: Tb2Key -> Tb2Key -> Tb2Key
$crem :: Tb2Key -> Tb2Key -> Tb2Key
quot :: Tb2Key -> Tb2Key -> Tb2Key
$cquot :: Tb2Key -> Tb2Key -> Tb2Key
Integral, Ptr Tb2Key -> IO Tb2Key
Ptr Tb2Key -> Int -> IO Tb2Key
Ptr Tb2Key -> Int -> Tb2Key -> IO ()
Ptr Tb2Key -> Tb2Key -> IO ()
Tb2Key -> Int
forall b. Ptr b -> Int -> IO Tb2Key
forall b. Ptr b -> Int -> Tb2Key -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Tb2Key -> Tb2Key -> IO ()
$cpoke :: Ptr Tb2Key -> Tb2Key -> IO ()
peek :: Ptr Tb2Key -> IO Tb2Key
$cpeek :: Ptr Tb2Key -> IO Tb2Key
pokeByteOff :: forall b. Ptr b -> Int -> Tb2Key -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Tb2Key -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO Tb2Key
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Tb2Key
pokeElemOff :: Ptr Tb2Key -> Int -> Tb2Key -> IO ()
$cpokeElemOff :: Ptr Tb2Key -> Int -> Tb2Key -> IO ()
peekElemOff :: Ptr Tb2Key -> Int -> IO Tb2Key
$cpeekElemOff :: Ptr Tb2Key -> Int -> IO Tb2Key
alignment :: Tb2Key -> Int
$calignment :: Tb2Key -> Int
sizeOf :: Tb2Key -> Int
$csizeOf :: Tb2Key -> Int
Storable)
keyCtrlTilde               :: Tb2Key
keyCtrlTilde :: Tb2Key
keyCtrlTilde               = Word16 -> Tb2Key
Tb2Key Word16
0
keyCtrl2                   :: Tb2Key
keyCtrl2 :: Tb2Key
keyCtrl2                   = Word16 -> Tb2Key
Tb2Key Word16
0
keyCtrlA                   :: Tb2Key
keyCtrlA :: Tb2Key
keyCtrlA                   = Word16 -> Tb2Key
Tb2Key Word16
1
keyCtrlB                   :: Tb2Key
keyCtrlB :: Tb2Key
keyCtrlB                   = Word16 -> Tb2Key
Tb2Key Word16
2
keyCtrlC                   :: Tb2Key
keyCtrlC :: Tb2Key
keyCtrlC                   = Word16 -> Tb2Key
Tb2Key Word16
3
keyCtrlD                   :: Tb2Key
keyCtrlD :: Tb2Key
keyCtrlD                   = Word16 -> Tb2Key
Tb2Key Word16
4
keyCtrlE                   :: Tb2Key
keyCtrlE :: Tb2Key
keyCtrlE                   = Word16 -> Tb2Key
Tb2Key Word16
5
keyCtrlF                   :: Tb2Key
keyCtrlF :: Tb2Key
keyCtrlF                   = Word16 -> Tb2Key
Tb2Key Word16
6
keyCtrlG                   :: Tb2Key
keyCtrlG :: Tb2Key
keyCtrlG                   = Word16 -> Tb2Key
Tb2Key Word16
7
keyBackspace               :: Tb2Key
keyBackspace :: Tb2Key
keyBackspace               = Word16 -> Tb2Key
Tb2Key Word16
8
keyCtrlH                   :: Tb2Key
keyCtrlH :: Tb2Key
keyCtrlH                   = Word16 -> Tb2Key
Tb2Key Word16
8
keyCtrlTab                 :: Tb2Key
keyCtrlTab :: Tb2Key
keyCtrlTab                 = Word16 -> Tb2Key
Tb2Key Word16
9
keyCtrlI                   :: Tb2Key
keyCtrlI :: Tb2Key
keyCtrlI                   = Word16 -> Tb2Key
Tb2Key Word16
9
keyCtrlJ                   :: Tb2Key
keyCtrlJ :: Tb2Key
keyCtrlJ                   = Word16 -> Tb2Key
Tb2Key Word16
10
keyCtrlK                   :: Tb2Key
keyCtrlK :: Tb2Key
keyCtrlK                   = Word16 -> Tb2Key
Tb2Key Word16
11
keyCtrlL                   :: Tb2Key
keyCtrlL :: Tb2Key
keyCtrlL                   = Word16 -> Tb2Key
Tb2Key Word16
12
keyCtrlEnter               :: Tb2Key
keyCtrlEnter :: Tb2Key
keyCtrlEnter               = Word16 -> Tb2Key
Tb2Key Word16
13
keyCtrlM                   :: Tb2Key
keyCtrlM :: Tb2Key
keyCtrlM                   = Word16 -> Tb2Key
Tb2Key Word16
13
keyCtrlN                   :: Tb2Key
keyCtrlN :: Tb2Key
keyCtrlN                   = Word16 -> Tb2Key
Tb2Key Word16
14
keyCtrlO                   :: Tb2Key
keyCtrlO :: Tb2Key
keyCtrlO                   = Word16 -> Tb2Key
Tb2Key Word16
15
keyCtrlP                   :: Tb2Key
keyCtrlP :: Tb2Key
keyCtrlP                   = Word16 -> Tb2Key
Tb2Key Word16
16
keyCtrlQ                   :: Tb2Key
keyCtrlQ :: Tb2Key
keyCtrlQ                   = Word16 -> Tb2Key
Tb2Key Word16
17
keyCtrlR                   :: Tb2Key
keyCtrlR :: Tb2Key
keyCtrlR                   = Word16 -> Tb2Key
Tb2Key Word16
18
keyCtrlS                   :: Tb2Key
keyCtrlS :: Tb2Key
keyCtrlS                   = Word16 -> Tb2Key
Tb2Key Word16
19
keyCtrlT                   :: Tb2Key
keyCtrlT :: Tb2Key
keyCtrlT                   = Word16 -> Tb2Key
Tb2Key Word16
20
keyCtrlU                   :: Tb2Key
keyCtrlU :: Tb2Key
keyCtrlU                   = Word16 -> Tb2Key
Tb2Key Word16
21
keyCtrlV                   :: Tb2Key
keyCtrlV :: Tb2Key
keyCtrlV                   = Word16 -> Tb2Key
Tb2Key Word16
22
keyCtrlW                   :: Tb2Key
keyCtrlW :: Tb2Key
keyCtrlW                   = Word16 -> Tb2Key
Tb2Key Word16
23
keyCtrlX                   :: Tb2Key
keyCtrlX :: Tb2Key
keyCtrlX                   = Word16 -> Tb2Key
Tb2Key Word16
24
keyCtrlY                   :: Tb2Key
keyCtrlY :: Tb2Key
keyCtrlY                   = Word16 -> Tb2Key
Tb2Key Word16
25
keyCtrlZ                   :: Tb2Key
keyCtrlZ :: Tb2Key
keyCtrlZ                   = Word16 -> Tb2Key
Tb2Key Word16
26
keyCtrlEsc                 :: Tb2Key
keyCtrlEsc :: Tb2Key
keyCtrlEsc                 = Word16 -> Tb2Key
Tb2Key Word16
27
keyCtrlLsqBracket          :: Tb2Key
keyCtrlLsqBracket :: Tb2Key
keyCtrlLsqBracket          = Word16 -> Tb2Key
Tb2Key Word16
27
keyCtrl3                   :: Tb2Key
keyCtrl3 :: Tb2Key
keyCtrl3                   = Word16 -> Tb2Key
Tb2Key Word16
27
keyCtrl4                   :: Tb2Key
keyCtrl4 :: Tb2Key
keyCtrl4                   = Word16 -> Tb2Key
Tb2Key Word16
28
keyCtrlBackslash           :: Tb2Key
keyCtrlBackslash :: Tb2Key
keyCtrlBackslash           = Word16 -> Tb2Key
Tb2Key Word16
28
keyCtrl5                   :: Tb2Key
keyCtrl5 :: Tb2Key
keyCtrl5                   = Word16 -> Tb2Key
Tb2Key Word16
29
keyCtrlRsqBracket          :: Tb2Key
keyCtrlRsqBracket :: Tb2Key
keyCtrlRsqBracket          = Word16 -> Tb2Key
Tb2Key Word16
29
keyCtrl6                   :: Tb2Key
keyCtrl6 :: Tb2Key
keyCtrl6                   = Tb2Key 30
keyCtrl7                   :: Tb2Key
keyCtrl7 :: Tb2Key
keyCtrl7                   = Tb2Key Word16
31
keyCtrlSlash               :: Tb2Key
keyCtrlSlash :: Tb2Key
keyCtrlSlash               = Tb2Key Word16
31
keyCtrlUnderscore          :: Tb2Key
keyCtrlUnderscore :: Tb2Key
keyCtrlUnderscore          = Tb2Key Word16
31
keySpace                   :: Tb2Key
keySpace :: Tb2Key
keySpace                   = Tb2Key Word16
32
keyBackspace2              :: Tb2Key
keyBackspace2 :: Tb2Key
keyBackspace2              = Tb2Key Word16
127
keyCtrl8                   :: Tb2Key
keyCtrl8 :: Tb2Key
keyCtrl8                   = Tb2Key Word16
127
capF6 :: Tb2Cap
keyF1                      :: Tb2Key
keyF1 :: Tb2Key
keyF1                      = Tb2Key Word16
65535
capF7 :: Tb2Cap
keyF2                      :: Tb2Key
keyF2 :: Tb2Key
keyF2                      = Tb2Key Word16
65534
capF8 :: Tb2Cap
keyF3                      :: Tb2Key
keyF3 :: Tb2Key
keyF3                      = Tb2Key Word16
65533
capF9 :: Tb2Cap
keyF4                      :: Tb2Key
keyF4 :: Tb2Key
keyF4                      = Tb2Key Word16
65532
keyF5                      :: Tb2Key
keyF5 :: Tb2Key
keyF5                      = Tb2Key Word16
65531
keyF6                      :: Tb2Key
keyF6 :: Tb2Key
keyF6                      = Tb2Key Word16
65530
keyF7                      :: Tb2Key
keyF7 :: Tb2Key
keyF7                      = Tb2Key Word16
65529
keyF8                      :: Tb2Key
keyF8 :: Tb2Key
keyF8                      = Tb2Key Word16
65528
keyF9                      :: Tb2Key
keyF9 :: Tb2Key
keyF9                      = Tb2Key Word16
65527
keyF10                     :: Tb2Key
keyF10 :: Tb2Key
keyF10                     = Tb2Key Word16
65526
capEnd :: Tb2Cap
keyF11                     :: Tb2Key
keyF11 :: Tb2Key
keyF11                     = Tb2Key Word16
65525
keyF12                     :: Tb2Key
keyF12 :: Tb2Key
keyF12                     = Tb2Key Word16
65524
keyInsert                  :: Tb2Key
keyInsert :: Tb2Key
keyInsert                  = Tb2Key Word16
65523
keyDelete                  :: Tb2Key
keyDelete :: Tb2Key
keyDelete                  = Tb2Key Word16
65522
keyHome                    :: Tb2Key
keyHome :: Tb2Key
keyHome                    = Tb2Key 65521
keyEnd                     :: Tb2Key
keyEnd :: Tb2Key
keyEnd                     = Tb2Key Word16
65520
keyPgUp                    :: Tb2Key
keyPgUp :: Tb2Key
keyPgUp                    = Tb2Key Word16
65519
keyPgDn                    :: Tb2Key
keyPgDn :: Tb2Key
keyPgDn                    = Tb2Key Word16
65518
capEnterCA :: Tb2Cap
keyArrowUp                 :: Tb2Key
keyArrowUp :: Tb2Key
keyArrowUp                 = Tb2Key Word16
65517
keyArrowDown               :: Tb2Key
keyArrowDown :: Tb2Key
keyArrowDown               = Tb2Key Word16
65516
keyArrowLeft               :: Tb2Key
colorMagenta :: Tb2ColorAttr
keyArrowLeft :: Tb2Key
keyArrowLeft               = Tb2Key Word16
65515
capHideCursor :: Tb2Cap
keyArrowRight              :: Tb2Key
keyArrowRight :: Tb2Key
keyArrowRight              = Tb2Key Word16
65514
keyBackTab                 :: Tb2Key
colorWhite :: Tb2ColorAttr
keyBackTab :: Tb2Key
keyBackTab                 = Tb2Key Word16
65513
keyMouseLeft               :: Tb2Key
colorDefault :: Tb2ColorAttr
keyMouseLeft :: Tb2Key
keyMouseLeft               = Tb2Key 65512
keyMouseRight              :: Tb2Key
keyMouseRight :: Tb2Key
keyMouseRight              = Tb2Key Word16
65511
keyMouseMiddle             :: Tb2Key
keyMouseMiddle :: Tb2Key
keyMouseMiddle             = Tb2Key 65510
keyMouseRelease            :: Tb2Key
keyMouseRelease :: Tb2Key
keyMouseRelease            = Tb2Key Word16
65509
keyMouseWheelUp            :: Tb2Key
keyMouseWheelUp :: Tb2Key
keyMouseWheelUp            = Tb2Key Word16
65508
keyMouseWheelDown          :: Tb2Key
keyMouseWheelDown :: Tb2Key
keyMouseWheelDown          = Tb2Key Word16
65507

{-# LINE 389 "src/Termbox2.hsc" #-}

newtype Tb2Cap = Tb2Cap CInt
  deriving (Show, Eq, Ord, Num, Enum, Real, Integral)
capF1                      :: Tb2Cap
capF1                      = Tb2Cap 0
capF2                      :: Tb2Cap
capF2                      = Tb2Cap 1
capF3                      :: Tb2Cap
capF3                      = Tb2Cap 2
capF4                      :: Tb2Cap
capF4                      = Tb2Cap 3
capF5                      :: Tb2Cap
capF5                      = Tb2Cap 4
capF6                      :: Tb2Cap
capF6                      = Tb2Cap 5
capF7                      :: Tb2Cap
capF7                      = Tb2Cap 6
capF8                      :: Tb2Cap
capF8                      = Tb2Cap 7
capF9                      :: Tb2Cap
capF9                      = Tb2Cap 8
capF10                     :: Tb2Cap
capF10                     = Tb2Cap 9
capF11                     :: Tb2Cap
capF11                     = Tb2Cap 10
capF12                     :: Tb2Cap
capF12                     = Tb2Cap 11
capInsert                  :: Tb2Cap
capInsert                  = Tb2Cap 12
capDelete                  :: Tb2Cap
capDelete                  = Tb2Cap 13
capHome                    :: Tb2Cap
capHome                    = Tb2Cap 14
capEnd                     :: Tb2Cap
capEnd                     = Tb2Cap 15
capPgUp                    :: Tb2Cap
capPgUp                    = Tb2Cap 16
capPgDn                    :: Tb2Cap
capPgDn                    = Tb2Cap 17
capArrowUp                 :: Tb2Cap
capArrowUp                 = Tb2Cap 18
capArrowDown               :: Tb2Cap
capArrowDown               = Tb2Cap 19
capArrowLeft               :: Tb2Cap
capArrowLeft               = Tb2Cap 20
capArrowRight              :: Tb2Cap
capArrowRight              = Tb2Cap 21
capBackTab                 :: Tb2Cap
capBackTab                 = Tb2Cap 22
capEnterCA                 :: Tb2Cap
capEnterCA                 = Tb2Cap 23
capExitCA                  :: Tb2Cap
capExitCA                  = Tb2Cap 24
capShowCursor              :: Tb2Cap
capShowCursor              = Tb2Cap 25
capHideCursor              :: Tb2Cap
capHideCursor              = Tb2Cap 26
capClearScreen             :: Tb2Cap
capClearScreen             = Tb2Cap 27
capSGR0                    :: Tb2Cap
capSGR0                    = Tb2Cap 28
capUnderline               :: Tb2Cap
capUnderline               = Tb2Cap 29
capBold                    :: Tb2Cap
capBold                    = Tb2Cap 30
capBlink                   :: Tb2Cap
capBlink                   = Tb2Cap 31
capItalic                  :: Tb2Cap
capItalic                  = Tb2Cap 32
capReverse                 :: Tb2Cap
capReverse                 = Tb2Cap 33
capEnterKeypad             :: Tb2Cap
capEnterKeypad             = Tb2Cap 34
capExitKeypad              :: Tb2Cap
capExitKeypad              = Tb2Cap 35

{-# LINE 430 "src/Termbox2.hsc" #-}

newtype Tb2ColorAttr = Tb2ColorAttr CInt
  deriving (Show, Eq, Ord, Num, Enum, Real, Integral, Bits)
colorBlack                 :: Tb2ColorAttr
colorBlack                 = Tb2ColorAttr 1
colorRed                   :: Tb2ColorAttr
colorRed                   = Tb2ColorAttr 2
colorGreen                 :: Tb2ColorAttr
colorGreen                 = Tb2ColorAttr 3
colorYellow                :: Tb2ColorAttr
colorYellow                = Tb2ColorAttr 4
colorBlue                  :: Tb2ColorAttr
colorBlue                  = Tb2ColorAttr 5
colorMagenta               :: Tb2ColorAttr
colorMagenta               = Tb2ColorAttr 6
colorCyan                  :: Tb2ColorAttr
colorCyan                  = Tb2ColorAttr 7
colorWhite                 :: Tb2ColorAttr
colorWhite                 = Tb2ColorAttr 8
colorDefault               :: Tb2ColorAttr
colorDefault               = Tb2ColorAttr 8192
attrBold                   :: Tb2ColorAttr
attrBold                   = Tb2ColorAttr 256
attrUnderline              :: Tb2ColorAttr
attrUnderline              = Tb2ColorAttr 512
attrReverse                :: Tb2ColorAttr
attrReverse                = Tb2ColorAttr 1024
attrItalic                 :: Tb2ColorAttr
attrItalic                 = Tb2ColorAttr 2048
attrBlink                  :: Tb2ColorAttr
attrBlink                  = Tb2ColorAttr 4096

{-# LINE 449 "src/Termbox2.hsc" #-}

instance Semigroup Tb2ColorAttr where
  (<>) = (.|.)

newtype Tb2EventType = Tb2EventType Word8
  deriving (Eq, Ord, Num, Enum, Real, Integral, Storable)
eventKey                   :: Tb2EventType
eventKey                   = Tb2EventType 1
eventResize                :: Tb2EventType
eventResize                = Tb2EventType 2
eventMouse                 :: Tb2EventType
eventMouse                 = Tb2EventType 3

{-# LINE 460 "src/Termbox2.hsc" #-}

instance Show Tb2EventType where
  show evt@(Tb2EventType raw)
    | evt == eventKey = "[Key]"
    | evt == eventResize = "[Resize]"
    | evt == eventMouse = "[Mouse]"
    | otherwise = concat ["[Unknown event type: ", show raw, "]" ]

newtype Tb2Mod = Tb2Mod Word8
  deriving (Int -> Tb2Mod -> ShowS
[Tb2Mod] -> ShowS
Tb2Mod -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tb2Mod] -> ShowS
$cshowList :: [Tb2Mod] -> ShowS
show :: Tb2Mod -> String
$cshow :: Tb2Mod -> String
showsPrec :: Int -> Tb2Mod -> ShowS
$cshowsPrec :: Int -> Tb2Mod -> ShowS
Show, Tb2Mod -> Tb2Mod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tb2Mod -> Tb2Mod -> Bool
$c/= :: Tb2Mod -> Tb2Mod -> Bool
== :: Tb2Mod -> Tb2Mod -> Bool
$c== :: Tb2Mod -> Tb2Mod -> Bool
Eq, Eq Tb2Mod
Tb2Mod -> Tb2Mod -> Bool
Tb2Mod -> Tb2Mod -> Ordering
Tb2Mod -> Tb2Mod -> Tb2Mod
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tb2Mod -> Tb2Mod -> Tb2Mod
$cmin :: Tb2Mod -> Tb2Mod -> Tb2Mod
max :: Tb2Mod -> Tb2Mod -> Tb2Mod
$cmax :: Tb2Mod -> Tb2Mod -> Tb2Mod
>= :: Tb2Mod -> Tb2Mod -> Bool
$c>= :: Tb2Mod -> Tb2Mod -> Bool
> :: Tb2Mod -> Tb2Mod -> Bool
$c> :: Tb2Mod -> Tb2Mod -> Bool
<= :: Tb2Mod -> Tb2Mod -> Bool
$c<= :: Tb2Mod -> Tb2Mod -> Bool
< :: Tb2Mod -> Tb2Mod -> Bool
$c< :: Tb2Mod -> Tb2Mod -> Bool
compare :: Tb2Mod -> Tb2Mod -> Ordering
$ccompare :: Tb2Mod -> Tb2Mod -> Ordering
Ord, Integer -> Tb2Mod
Tb2Mod -> Tb2Mod
Tb2Mod -> Tb2Mod -> Tb2Mod
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Tb2Mod
$cfromInteger :: Integer -> Tb2Mod
signum :: Tb2Mod -> Tb2Mod
$csignum :: Tb2Mod -> Tb2Mod
abs :: Tb2Mod -> Tb2Mod
$cabs :: Tb2Mod -> Tb2Mod
negate :: Tb2Mod -> Tb2Mod
$cnegate :: Tb2Mod -> Tb2Mod
* :: Tb2Mod -> Tb2Mod -> Tb2Mod
$c* :: Tb2Mod -> Tb2Mod -> Tb2Mod
- :: Tb2Mod -> Tb2Mod -> Tb2Mod
$c- :: Tb2Mod -> Tb2Mod -> Tb2Mod
+ :: Tb2Mod -> Tb2Mod -> Tb2Mod
$c+ :: Tb2Mod -> Tb2Mod -> Tb2Mod
Num, Int -> Tb2Mod
Tb2Mod -> Int
Tb2Mod -> [Tb2Mod]
Tb2Mod -> Tb2Mod
Tb2Mod -> Tb2Mod -> [Tb2Mod]
Tb2Mod -> Tb2Mod -> Tb2Mod -> [Tb2Mod]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Tb2Mod -> Tb2Mod -> Tb2Mod -> [Tb2Mod]
$cenumFromThenTo :: Tb2Mod -> Tb2Mod -> Tb2Mod -> [Tb2Mod]
enumFromTo :: Tb2Mod -> Tb2Mod -> [Tb2Mod]
$cenumFromTo :: Tb2Mod -> Tb2Mod -> [Tb2Mod]
enumFromThen :: Tb2Mod -> Tb2Mod -> [Tb2Mod]
$cenumFromThen :: Tb2Mod -> Tb2Mod -> [Tb2Mod]
enumFrom :: Tb2Mod -> [Tb2Mod]
$cenumFrom :: Tb2Mod -> [Tb2Mod]
fromEnum :: Tb2Mod -> Int
$cfromEnum :: Tb2Mod -> Int
toEnum :: Int -> Tb2Mod
$ctoEnum :: Int -> Tb2Mod
pred :: Tb2Mod -> Tb2Mod
$cpred :: Tb2Mod -> Tb2Mod
succ :: Tb2Mod -> Tb2Mod
$csucc :: Tb2Mod -> Tb2Mod
Enum, Num Tb2Mod
Ord Tb2Mod
Tb2Mod -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Tb2Mod -> Rational
$ctoRational :: Tb2Mod -> Rational
Real, Enum Tb2Mod
Real Tb2Mod
Tb2Mod -> Integer
Tb2Mod -> Tb2Mod -> (Tb2Mod, Tb2Mod)
Tb2Mod -> Tb2Mod -> Tb2Mod
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Tb2Mod -> Integer
$ctoInteger :: Tb2Mod -> Integer
divMod :: Tb2Mod -> Tb2Mod -> (Tb2Mod, Tb2Mod)
$cdivMod :: Tb2Mod -> Tb2Mod -> (Tb2Mod, Tb2Mod)
quotRem :: Tb2Mod -> Tb2Mod -> (Tb2Mod, Tb2Mod)
$cquotRem :: Tb2Mod -> Tb2Mod -> (Tb2Mod, Tb2Mod)
mod :: Tb2Mod -> Tb2Mod -> Tb2Mod
$cmod :: Tb2Mod -> Tb2Mod -> Tb2Mod
div :: Tb2Mod -> Tb2Mod -> Tb2Mod
$cdiv :: Tb2Mod -> Tb2Mod -> Tb2Mod
rem :: Tb2Mod -> Tb2Mod -> Tb2Mod
$crem :: Tb2Mod -> Tb2Mod -> Tb2Mod
quot :: Tb2Mod -> Tb2Mod -> Tb2Mod
$cquot :: Tb2Mod -> Tb2Mod -> Tb2Mod
Integral, Eq Tb2Mod
Tb2Mod
Int -> Tb2Mod
Tb2Mod -> Bool
Tb2Mod -> Int
Tb2Mod -> Maybe Int
Tb2Mod -> Tb2Mod
Tb2Mod -> Int -> Bool
Tb2Mod -> Int -> Tb2Mod
Tb2Mod -> Tb2Mod -> Tb2Mod
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: Tb2Mod -> Int
$cpopCount :: Tb2Mod -> Int
rotateR :: Tb2Mod -> Int -> Tb2Mod
$crotateR :: Tb2Mod -> Int -> Tb2Mod
rotateL :: Tb2Mod -> Int -> Tb2Mod
$crotateL :: Tb2Mod -> Int -> Tb2Mod
unsafeShiftR :: Tb2Mod -> Int -> Tb2Mod
$cunsafeShiftR :: Tb2Mod -> Int -> Tb2Mod
shiftR :: Tb2Mod -> Int -> Tb2Mod
$cshiftR :: Tb2Mod -> Int -> Tb2Mod
unsafeShiftL :: Tb2Mod -> Int -> Tb2Mod
$cunsafeShiftL :: Tb2Mod -> Int -> Tb2Mod
shiftL :: Tb2Mod -> Int -> Tb2Mod
$cshiftL :: Tb2Mod -> Int -> Tb2Mod
isSigned :: Tb2Mod -> Bool
$cisSigned :: Tb2Mod -> Bool
bitSize :: Tb2Mod -> Int
$cbitSize :: Tb2Mod -> Int
bitSizeMaybe :: Tb2Mod -> Maybe Int
$cbitSizeMaybe :: Tb2Mod -> Maybe Int
testBit :: Tb2Mod -> Int -> Bool
$ctestBit :: Tb2Mod -> Int -> Bool
complementBit :: Tb2Mod -> Int -> Tb2Mod
$ccomplementBit :: Tb2Mod -> Int -> Tb2Mod
clearBit :: Tb2Mod -> Int -> Tb2Mod
$cclearBit :: Tb2Mod -> Int -> Tb2Mod
setBit :: Tb2Mod -> Int -> Tb2Mod
$csetBit :: Tb2Mod -> Int -> Tb2Mod
bit :: Int -> Tb2Mod
$cbit :: Int -> Tb2Mod
zeroBits :: Tb2Mod
$czeroBits :: Tb2Mod
rotate :: Tb2Mod -> Int -> Tb2Mod
$crotate :: Tb2Mod -> Int -> Tb2Mod
shift :: Tb2Mod -> Int -> Tb2Mod
$cshift :: Tb2Mod -> Int -> Tb2Mod
complement :: Tb2Mod -> Tb2Mod
$ccomplement :: Tb2Mod -> Tb2Mod
xor :: Tb2Mod -> Tb2Mod -> Tb2Mod
$cxor :: Tb2Mod -> Tb2Mod -> Tb2Mod
.|. :: Tb2Mod -> Tb2Mod -> Tb2Mod
$c.|. :: Tb2Mod -> Tb2Mod -> Tb2Mod
.&. :: Tb2Mod -> Tb2Mod -> Tb2Mod
$c.&. :: Tb2Mod -> Tb2Mod -> Tb2Mod
Bits, Ptr Tb2Mod -> IO Tb2Mod
Ptr Tb2Mod -> Int -> IO Tb2Mod
Ptr Tb2Mod -> Int -> Tb2Mod -> IO ()
Ptr Tb2Mod -> Tb2Mod -> IO ()
Tb2Mod -> Int
forall b. Ptr b -> Int -> IO Tb2Mod
forall b. Ptr b -> Int -> Tb2Mod -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Tb2Mod -> Tb2Mod -> IO ()
$cpoke :: Ptr Tb2Mod -> Tb2Mod -> IO ()
peek :: Ptr Tb2Mod -> IO Tb2Mod
$cpeek :: Ptr Tb2Mod -> IO Tb2Mod
pokeByteOff :: forall b. Ptr b -> Int -> Tb2Mod -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Tb2Mod -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO Tb2Mod
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Tb2Mod
pokeElemOff :: Ptr Tb2Mod -> Int -> Tb2Mod -> IO ()
$cpokeElemOff :: Ptr Tb2Mod -> Int -> Tb2Mod -> IO ()
peekElemOff :: Ptr Tb2Mod -> Int -> IO Tb2Mod
$cpeekElemOff :: Ptr Tb2Mod -> Int -> IO Tb2Mod
alignment :: Tb2Mod -> Int
$calignment :: Tb2Mod -> Int
sizeOf :: Tb2Mod -> Int
$csizeOf :: Tb2Mod -> Int
Storable)
modAlt                     :: Tb2Mod
modAlt :: Tb2Mod
modAlt                     = Word8 -> Tb2Mod
Tb2Mod Word8
1
modCtrl                    :: Tb2Mod
modCtrl :: Tb2Mod
modCtrl                    = Word8 -> Tb2Mod
Tb2Mod Word8
2
modShift                   :: Tb2Mod
modShift :: Tb2Mod
modShift                   = Word8 -> Tb2Mod
Tb2Mod Word8
4
modMotion                  :: Tb2Mod
modMotion :: Tb2Mod
modMotion                  = Word8 -> Tb2Mod
Tb2Mod Word8
8

{-# LINE 476 "src/Termbox2.hsc" #-}

instance Semigroup Tb2Mod where
  (<>) = (.|.)

newtype Tb2Input = Tb2Input CInt
  deriving (Int -> Tb2Input -> ShowS
[Tb2Input] -> ShowS
Tb2Input -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tb2Input] -> ShowS
$cshowList :: [Tb2Input] -> ShowS
show :: Tb2Input -> String
$cshow :: Tb2Input -> String
showsPrec :: Int -> Tb2Input -> ShowS
$cshowsPrec :: Int -> Tb2Input -> ShowS
Show, Tb2Input -> Tb2Input -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tb2Input -> Tb2Input -> Bool
$c/= :: Tb2Input -> Tb2Input -> Bool
== :: Tb2Input -> Tb2Input -> Bool
$c== :: Tb2Input -> Tb2Input -> Bool
Eq, Eq Tb2Input
Tb2Input -> Tb2Input -> Bool
Tb2Input -> Tb2Input -> Ordering
Tb2Input -> Tb2Input -> Tb2Input
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tb2Input -> Tb2Input -> Tb2Input
$cmin :: Tb2Input -> Tb2Input -> Tb2Input
max :: Tb2Input -> Tb2Input -> Tb2Input
$cmax :: Tb2Input -> Tb2Input -> Tb2Input
>= :: Tb2Input -> Tb2Input -> Bool
$c>= :: Tb2Input -> Tb2Input -> Bool
> :: Tb2Input -> Tb2Input -> Bool
$c> :: Tb2Input -> Tb2Input -> Bool
<= :: Tb2Input -> Tb2Input -> Bool
$c<= :: Tb2Input -> Tb2Input -> Bool
< :: Tb2Input -> Tb2Input -> Bool
$c< :: Tb2Input -> Tb2Input -> Bool
compare :: Tb2Input -> Tb2Input -> Ordering
$ccompare :: Tb2Input -> Tb2Input -> Ordering
Ord, Integer -> Tb2Input
Tb2Input -> Tb2Input
Tb2Input -> Tb2Input -> Tb2Input
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Tb2Input
$cfromInteger :: Integer -> Tb2Input
signum :: Tb2Input -> Tb2Input
$csignum :: Tb2Input -> Tb2Input
abs :: Tb2Input -> Tb2Input
$cabs :: Tb2Input -> Tb2Input
negate :: Tb2Input -> Tb2Input
$cnegate :: Tb2Input -> Tb2Input
* :: Tb2Input -> Tb2Input -> Tb2Input
$c* :: Tb2Input -> Tb2Input -> Tb2Input
- :: Tb2Input -> Tb2Input -> Tb2Input
$c- :: Tb2Input -> Tb2Input -> Tb2Input
+ :: Tb2Input -> Tb2Input -> Tb2Input
$c+ :: Tb2Input -> Tb2Input -> Tb2Input
Num, Int -> Tb2Input
Tb2Input -> Int
Tb2Input -> [Tb2Input]
Tb2Input -> Tb2Input
Tb2Input -> Tb2Input -> [Tb2Input]
Tb2Input -> Tb2Input -> Tb2Input -> [Tb2Input]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Tb2Input -> Tb2Input -> Tb2Input -> [Tb2Input]
$cenumFromThenTo :: Tb2Input -> Tb2Input -> Tb2Input -> [Tb2Input]
enumFromTo :: Tb2Input -> Tb2Input -> [Tb2Input]
$cenumFromTo :: Tb2Input -> Tb2Input -> [Tb2Input]
enumFromThen :: Tb2Input -> Tb2Input -> [Tb2Input]
$cenumFromThen :: Tb2Input -> Tb2Input -> [Tb2Input]
enumFrom :: Tb2Input -> [Tb2Input]
$cenumFrom :: Tb2Input -> [Tb2Input]
fromEnum :: Tb2Input -> Int
$cfromEnum :: Tb2Input -> Int
toEnum :: Int -> Tb2Input
$ctoEnum :: Int -> Tb2Input
pred :: Tb2Input -> Tb2Input
$cpred :: Tb2Input -> Tb2Input
succ :: Tb2Input -> Tb2Input
$csucc :: Tb2Input -> Tb2Input
Enum,   Num Tb2Input
Ord Tb2Input
Tb2Input -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Tb2Input -> Rational
$ctoRational :: Tb2Input -> Rational
Real, Enum Tb2Input
Real Tb2Input
Tb2Input -> Integer
Tb2Input -> Tb2Input -> (Tb2Input, Tb2Input)
Tb2Input -> Tb2Input -> Tb2Input
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Tb2Input -> Integer
$ctoInteger :: Tb2Input -> Integer
divMod :: Tb2Input -> Tb2Input -> (Tb2Input, Tb2Input)
$cdivMod :: Tb2Input -> Tb2Input -> (Tb2Input, Tb2Input)
quotRem :: Tb2Input -> Tb2Input -> (Tb2Input, Tb2Input)
$cquotRem :: Tb2Input -> Tb2Input -> (Tb2Input, Tb2Input)
mod :: Tb2Input -> Tb2Input -> Tb2Input
$cmod :: Tb2Input -> Tb2Input -> Tb2Input
div :: Tb2Input -> Tb2Input -> Tb2Input
$cdiv :: Tb2Input -> Tb2Input -> Tb2Input
rem :: Tb2Input -> Tb2Input -> Tb2Input
$crem :: Tb2Input -> Tb2Input -> Tb2Input
quot :: Tb2Input -> Tb2Input -> Tb2Input
$cquot :: Tb2Input -> Tb2Input -> Tb2Input
Integral, Eq Tb2Input
Tb2Input
Int -> Tb2Input
Tb2Input -> Bool
Tb2Input -> Int
Tb2Input -> Maybe Int
Tb2Input -> Tb2Input
Tb2Input -> Int -> Bool
Tb2Input -> Int -> Tb2Input
Tb2Input -> Tb2Input -> Tb2Input
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: Tb2Input -> Int
$cpopCount :: Tb2Input -> Int
rotateR :: Tb2Input -> Int -> Tb2Input
$crotateR :: Tb2Input -> Int -> Tb2Input
rotateL :: Tb2Input -> Int -> Tb2Input
$crotateL :: Tb2Input -> Int -> Tb2Input
unsafeShiftR :: Tb2Input -> Int -> Tb2Input
$cunsafeShiftR :: Tb2Input -> Int -> Tb2Input
shiftR :: Tb2Input -> Int -> Tb2Input
$cshiftR :: Tb2Input -> Int -> Tb2Input
unsafeShiftL :: Tb2Input -> Int -> Tb2Input
$cunsafeShiftL :: Tb2Input -> Int -> Tb2Input
shiftL :: Tb2Input -> Int -> Tb2Input
$cshiftL :: Tb2Input -> Int -> Tb2Input
isSigned :: Tb2Input -> Bool
$cisSigned :: Tb2Input -> Bool
bitSize :: Tb2Input -> Int
$cbitSize :: Tb2Input -> Int
bitSizeMaybe :: Tb2Input -> Maybe Int
$cbitSizeMaybe :: Tb2Input -> Maybe Int
testBit :: Tb2Input -> Int -> Bool
$ctestBit :: Tb2Input -> Int -> Bool
complementBit :: Tb2Input -> Int -> Tb2Input
$ccomplementBit :: Tb2Input -> Int -> Tb2Input
clearBit :: Tb2Input -> Int -> Tb2Input
$cclearBit :: Tb2Input -> Int -> Tb2Input
setBit :: Tb2Input -> Int -> Tb2Input
$csetBit :: Tb2Input -> Int -> Tb2Input
bit :: Int -> Tb2Input
$cbit :: Int -> Tb2Input
zeroBits :: Tb2Input
$czeroBits :: Tb2Input
rotate :: Tb2Input -> Int -> Tb2Input
$crotate :: Tb2Input -> Int -> Tb2Input
shift :: Tb2Input -> Int -> Tb2Input
$cshift :: Tb2Input -> Int -> Tb2Input
complement :: Tb2Input -> Tb2Input
$ccomplement :: Tb2Input -> Tb2Input
xor :: Tb2Input -> Tb2Input -> Tb2Input
$cxor :: Tb2Input -> Tb2Input -> Tb2Input
.|. :: Tb2Input -> Tb2Input -> Tb2Input
$c.|. :: Tb2Input -> Tb2Input -> Tb2Input
.&. :: Tb2Input -> Tb2Input -> Tb2Input
$c.&. :: Tb2Input -> Tb2Input -> Tb2Input
Bits)
inputCurrent               :: Tb2Input
inputCurrent :: Tb2Input
inputCurrent               = CInt -> Tb2Input
Tb2Input CInt
0
inputEsc                   :: Tb2Input
inputEsc :: Tb2Input
inputEsc                   = CInt -> Tb2Input
Tb2Input CInt
1
inputAlt                   :: Tb2Input
inputAlt :: Tb2Input
inputAlt                   = CInt -> Tb2Input
Tb2Input CInt
2
inputMouse                 :: Tb2Input
inputMouse :: Tb2Input
inputMouse                 = CInt -> Tb2Input
Tb2Input CInt
4

{-# LINE 488 "src/Termbox2.hsc" #-}

instance Semigroup Tb2Input where
  (<>) = (.|.)

newtype Tb2Output = Tb2Output CInt
  deriving (Int -> Tb2Output -> ShowS
[Tb2Output] -> ShowS
Tb2Output -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tb2Output] -> ShowS
$cshowList :: [Tb2Output] -> ShowS
show :: Tb2Output -> String
$cshow :: Tb2Output -> String
showsPrec :: Int -> Tb2Output -> ShowS
$cshowsPrec :: Int -> Tb2Output -> ShowS
Show, Tb2Output -> Tb2Output -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tb2Output -> Tb2Output -> Bool
$c/= :: Tb2Output -> Tb2Output -> Bool
== :: Tb2Output -> Tb2Output -> Bool
$c== :: Tb2Output -> Tb2Output -> Bool
Eq, Eq Tb2Output
Tb2Output -> Tb2Output -> Bool
Tb2Output -> Tb2Output -> Ordering
Tb2Output -> Tb2Output -> Tb2Output
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tb2Output -> Tb2Output -> Tb2Output
$cmin :: Tb2Output -> Tb2Output -> Tb2Output
max :: Tb2Output -> Tb2Output -> Tb2Output
$cmax :: Tb2Output -> Tb2Output -> Tb2Output
>= :: Tb2Output -> Tb2Output -> Bool
$c>= :: Tb2Output -> Tb2Output -> Bool
> :: Tb2Output -> Tb2Output -> Bool
$c> :: Tb2Output -> Tb2Output -> Bool
<= :: Tb2Output -> Tb2Output -> Bool
$c<= :: Tb2Output -> Tb2Output -> Bool
< :: Tb2Output -> Tb2Output -> Bool
$c< :: Tb2Output -> Tb2Output -> Bool
compare :: Tb2Output -> Tb2Output -> Ordering
$ccompare :: Tb2Output -> Tb2Output -> Ordering
Ord, Integer -> Tb2Output
Tb2Output -> Tb2Output
Tb2Output -> Tb2Output -> Tb2Output
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Tb2Output
$cfromInteger :: Integer -> Tb2Output
signum :: Tb2Output -> Tb2Output
$csignum :: Tb2Output -> Tb2Output
abs :: Tb2Output -> Tb2Output
$cabs :: Tb2Output -> Tb2Output
negate :: Tb2Output -> Tb2Output
$cnegate :: Tb2Output -> Tb2Output
* :: Tb2Output -> Tb2Output -> Tb2Output
$c* :: Tb2Output -> Tb2Output -> Tb2Output
- :: Tb2Output -> Tb2Output -> Tb2Output
$c- :: Tb2Output -> Tb2Output -> Tb2Output
+ :: Tb2Output -> Tb2Output -> Tb2Output
$c+ :: Tb2Output -> Tb2Output -> Tb2Output
Num, Int -> Tb2Output
Tb2Output -> Int
Tb2Output -> [Tb2Output]
Tb2Output -> Tb2Output
Tb2Output -> Tb2Output -> [Tb2Output]
Tb2Output -> Tb2Output -> Tb2Output -> [Tb2Output]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Tb2Output -> Tb2Output -> Tb2Output -> [Tb2Output]
$cenumFromThenTo :: Tb2Output -> Tb2Output -> Tb2Output -> [Tb2Output]
enumFromTo :: Tb2Output -> Tb2Output -> [Tb2Output]
$cenumFromTo :: Tb2Output -> Tb2Output -> [Tb2Output]
enumFromThen :: Tb2Output -> Tb2Output -> [Tb2Output]
$cenumFromThen :: Tb2Output -> Tb2Output -> [Tb2Output]
enumFrom :: Tb2Output -> [Tb2Output]
$cenumFrom :: Tb2Output -> [Tb2Output]
fromEnum :: Tb2Output -> Int
$cfromEnum :: Tb2Output -> Int
toEnum :: Int -> Tb2Output
$ctoEnum :: Int -> Tb2Output
pred :: Tb2Output -> Tb2Output
$cpred :: Tb2Output -> Tb2Output
succ :: Tb2Output -> Tb2Output
$csucc :: Tb2Output -> Tb2Output
Enum, Num Tb2Output
Ord Tb2Output
Tb2Output -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Tb2Output -> Rational
$ctoRational :: Tb2Output -> Rational
Real, Enum Tb2Output
Real Tb2Output
Tb2Output -> Integer
Tb2Output -> Tb2Output -> (Tb2Output, Tb2Output)
Tb2Output -> Tb2Output -> Tb2Output
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Tb2Output -> Integer
$ctoInteger :: Tb2Output -> Integer
divMod :: Tb2Output -> Tb2Output -> (Tb2Output, Tb2Output)
$cdivMod :: Tb2Output -> Tb2Output -> (Tb2Output, Tb2Output)
quotRem :: Tb2Output -> Tb2Output -> (Tb2Output, Tb2Output)
$cquotRem :: Tb2Output -> Tb2Output -> (Tb2Output, Tb2Output)
mod :: Tb2Output -> Tb2Output -> Tb2Output
$cmod :: Tb2Output -> Tb2Output -> Tb2Output
div :: Tb2Output -> Tb2Output -> Tb2Output
$cdiv :: Tb2Output -> Tb2Output -> Tb2Output
rem :: Tb2Output -> Tb2Output -> Tb2Output
$crem :: Tb2Output -> Tb2Output -> Tb2Output
quot :: Tb2Output -> Tb2Output -> Tb2Output
$cquot :: Tb2Output -> Tb2Output -> Tb2Output
Integral, Eq Tb2Output
Tb2Output
Int -> Tb2Output
Tb2Output -> Bool
Tb2Output -> Int
Tb2Output -> Maybe Int
Tb2Output -> Tb2Output
Tb2Output -> Int -> Bool
Tb2Output -> Int -> Tb2Output
Tb2Output -> Tb2Output -> Tb2Output
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: Tb2Output -> Int
$cpopCount :: Tb2Output -> Int
rotateR :: Tb2Output -> Int -> Tb2Output
$crotateR :: Tb2Output -> Int -> Tb2Output
rotateL :: Tb2Output -> Int -> Tb2Output
$crotateL :: Tb2Output -> Int -> Tb2Output
unsafeShiftR :: Tb2Output -> Int -> Tb2Output
$cunsafeShiftR :: Tb2Output -> Int -> Tb2Output
shiftR :: Tb2Output -> Int -> Tb2Output
$cshiftR :: Tb2Output -> Int -> Tb2Output
unsafeShiftL :: Tb2Output -> Int -> Tb2Output
$cunsafeShiftL :: Tb2Output -> Int -> Tb2Output
shiftL :: Tb2Output -> Int -> Tb2Output
$cshiftL :: Tb2Output -> Int -> Tb2Output
isSigned :: Tb2Output -> Bool
$cisSigned :: Tb2Output -> Bool
bitSize :: Tb2Output -> Int
$cbitSize :: Tb2Output -> Int
bitSizeMaybe :: Tb2Output -> Maybe Int
$cbitSizeMaybe :: Tb2Output -> Maybe Int
testBit :: Tb2Output -> Int -> Bool
$ctestBit :: Tb2Output -> Int -> Bool
complementBit :: Tb2Output -> Int -> Tb2Output
$ccomplementBit :: Tb2Output -> Int -> Tb2Output
clearBit :: Tb2Output -> Int -> Tb2Output
$cclearBit :: Tb2Output -> Int -> Tb2Output
setBit :: Tb2Output -> Int -> Tb2Output
$csetBit :: Tb2Output -> Int -> Tb2Output
bit :: Int -> Tb2Output
$cbit :: Int -> Tb2Output
zeroBits :: Tb2Output
$czeroBits :: Tb2Output
rotate :: Tb2Output -> Int -> Tb2Output
$crotate :: Tb2Output -> Int -> Tb2Output
shift :: Tb2Output -> Int -> Tb2Output
$cshift :: Tb2Output -> Int -> Tb2Output
complement :: Tb2Output -> Tb2Output
$ccomplement :: Tb2Output -> Tb2Output
xor :: Tb2Output -> Tb2Output -> Tb2Output
$cxor :: Tb2Output -> Tb2Output -> Tb2Output
.|. :: Tb2Output -> Tb2Output -> Tb2Output
$c.|. :: Tb2Output -> Tb2Output -> Tb2Output
.&. :: Tb2Output -> Tb2Output -> Tb2Output
$c.&. :: Tb2Output -> Tb2Output -> Tb2Output
Bits)
outputCurrent              :: Tb2Output
outputCurrent :: Tb2Output
outputCurrent              = CInt -> Tb2Output
Tb2Output CInt
0
outputNormal               :: Tb2Output
outputNormal :: Tb2Output
outputNormal               = CInt -> Tb2Output
Tb2Output CInt
1
output256                  :: Tb2Output
output256 :: Tb2Output
output256                  = CInt -> Tb2Output
Tb2Output CInt
2
output216                  :: Tb2Output
output216 :: Tb2Output
output216                  = CInt -> Tb2Output
Tb2Output CInt
3
outputGrayscale            :: Tb2Output
outputGrayscale            = Tb2Output 4

{-# LINE 501 "src/Termbox2.hsc" #-}

instance Semigroup Tb2Output where
  (<>) = (.|.)

newtype Tb2Err = Tb2Err CInt
  deriving (Show, Eq, Ord, Num, Enum, Real, Integral)
errOk                      :: Tb2Err
errOk :: Tb2Err
errOk                      = CInt -> Tb2Err
Tb2Err CInt
0
errErr                     :: Tb2Err
errErr :: Tb2Err
errErr                     = CInt -> Tb2Err
Tb2Err (-CInt
1)
errNeedMore                :: Tb2Err
errNeedMore :: Tb2Err
errNeedMore                = CInt -> Tb2Err
Tb2Err (-CInt
2)
errInitAlready             :: Tb2Err
errInitAlready :: Tb2Err
errInitAlready             = CInt -> Tb2Err
Tb2Err (-CInt
3)
errInitOpen                :: Tb2Err
errInitOpen :: Tb2Err
errInitOpen                = CInt -> Tb2Err
Tb2Err (-CInt
4)
errMem                     :: Tb2Err
errMem :: Tb2Err
errMem                     = CInt -> Tb2Err
Tb2Err (-CInt
5)
errNoEvent                 :: Tb2Err
errNoEvent :: Tb2Err
errNoEvent                 = CInt -> Tb2Err
Tb2Err (-CInt
6)
errNoTerm                  :: Tb2Err
errNoTerm :: Tb2Err
errNoTerm                  = CInt -> Tb2Err
Tb2Err (-CInt
7)
errNotInit                 :: Tb2Err
errNotInit :: Tb2Err
errNotInit                 = CInt -> Tb2Err
Tb2Err (-CInt
8)
errOutOfBounds             :: Tb2Err
errOutOfBounds :: Tb2Err
errOutOfBounds             = CInt -> Tb2Err
Tb2Err (-CInt
9)
errRead                    :: Tb2Err
errRead :: Tb2Err
errRead                    = CInt -> Tb2Err
Tb2Err (-CInt
10)
errResizeIOCTL             :: Tb2Err
errResizeIOCTL :: Tb2Err
errResizeIOCTL             = CInt -> Tb2Err
Tb2Err (-CInt
11)
errResizePipe              :: Tb2Err
errResizePipe :: Tb2Err
errResizePipe              = Tb2Err (-12)
errResizeSigaction         :: Tb2Err
errResizeSigaction :: Tb2Err
errResizeSigaction         = CInt -> Tb2Err
Tb2Err (-CInt
13)
errPoll                    :: Tb2Err
errPoll :: Tb2Err
errPoll                    = Tb2Err (-14)
errUnsupportedTerm         :: Tb2Err
errUnsupportedTerm :: Tb2Err
errUnsupportedTerm         = Tb2Err (-CInt
17)
errResizeWrite             :: Tb2Err
errResizeWrite :: Tb2Err
errResizeWrite             = CInt -> Tb2Err
Tb2Err (-CInt
18)
errResizePoll              :: Tb2Err
errResizePoll :: Tb2Err
errResizePoll              = CInt -> Tb2Err
Tb2Err (-CInt
19)
errResizeRead              :: Tb2Err
errResizeRead :: Tb2Err
errResizeRead              = CInt -> Tb2Err
Tb2Err (-CInt
20)
errResizeSscanf            :: Tb2Err
errResizeSscanf :: Tb2Err
errResizeSscanf            = CInt -> Tb2Err
Tb2Err (-CInt
21)
errCapCollision            :: Tb2Err
errCapCollision :: Tb2Err
errCapCollision            = CInt -> Tb2Err
Tb2Err (-CInt
22)

{-# LINE 530 "src/Termbox2.hsc" #-}

-- | Enables writing text-based user interfaces with termbox2.
type Termbox2 = ReaderT (Ptr Tb2Event) IO

-- | Allocates the 'Tb2Event' struct pointer, runs the UI, and frees.
runTermbox2 :: Termbox2 a -> IO a
runTermbox2 = alloca . runReaderT

wrap :: (MonadIO m) => IO CInt -> m ()
wrap expr = do
  ret <- (liftIO expr) <&> Tb2Err
  if errOk == ret
    then return ()
    else error $! show ret
{-# INLINE wrap #-}

-- | Must be called before anything else. The termbox2 documentation notes that
-- handling some exceptions requires calling 'shutdown' followed by 'init'
-- again, hence this is not invoked automatically by 'runTermbox2'.
init :: Termbox2 ()
init = wrap ffi_tb_init

initFile :: String -> Termbox2 ()
initFile :: String -> Termbox2 ()
initFile String
filePath = forall (m :: * -> *). MonadIO m => IO CInt -> m ()
wrap forall a b. (a -> b) -> a -> b
$! forall a. String -> (CString -> IO a) -> IO a
withCString String
filePath CString -> IO CInt
ffi_tb_init_file

initFd :: (Integral n) => n -> Termbox2 ()
initFd :: forall n. Integral n => n -> Termbox2 ()
initFd n
fd = forall (m :: * -> *). MonadIO m => IO CInt -> m ()
wrap forall a b. (a -> b) -> a -> b
$! CInt -> IO CInt
ffi_tb_init_fd (forall a b. (Integral a, Num b) => a -> b
fromIntegral n
fd)

initRwFd :: (Integral n, Integral o) => n -> o -> Termbox2 ()
initRwFd :: forall n o. (Integral n, Integral o) => n -> o -> Termbox2 ()
initRwFd n
rfd o
wfd =
  forall (m :: * -> *). MonadIO m => IO CInt -> m ()
wrap forall a b. (a -> b) -> a -> b
$! CInt -> CInt -> IO CInt
ffi_tb_init_rwfd (forall a b. (Integral a, Num b) => a -> b
fromIntegral n
rfd) (forall a b. (Integral a, Num b) => a -> b
fromIntegral o
wfd)

-- | Call this when you're finished or your terminal will act funky after exit!
shutdown :: Termbox2 ()
shutdown :: Termbox2 ()
shutdown = forall (m :: * -> *). MonadIO m => IO CInt -> m ()
wrap IO CInt
ffi_tb_shutdown

-- | Width of the drawing space in characters.
width :: Integral n => Termbox2 n
width :: forall n. Integral n => Termbox2 n
width = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO CInt
ffi_tb_width forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Height of the drawing space in lines.
height :: Integral n => Termbox2 n
height :: forall n. Integral n => Termbox2 n
height = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO CInt
ffi_tb_height forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Draws the buffer to the screen.
present :: Termbox2 ()
present :: Termbox2 ()
present = forall (m :: * -> *). MonadIO m => IO CInt -> m ()
wrap IO CInt
ffi_tb_present

-- | Clears the screen.
clear :: Termbox2 ()
clear :: Termbox2 ()
clear = forall (m :: * -> *). MonadIO m => IO CInt -> m ()
wrap IO CInt
ffi_tb_clear

-- | Specify the foreground and background attributes to be applied when
-- 'clearing the buffer.
setClearAttrs :: Tb2ColorAttr -> Tb2ColorAttr -> Termbox2 ()
setClearAttrs :: Tb2ColorAttr -> Tb2ColorAttr -> Termbox2 ()
setClearAttrs (Tb2ColorAttr CInt
fg) (Tb2ColorAttr CInt
bg) =
  forall (m :: * -> *). MonadIO m => IO CInt -> m ()
wrap forall a b. (a -> b) -> a -> b
$! CInt -> CInt -> IO CInt
ffi_tb_set_clear_attrs CInt
fg CInt
bg

-- | Set the location of the cursor (upper-left character is origin).
setCursor :: Int -> Int -> Termbox2 ()
setCursor :: Int -> Int -> Termbox2 ()
setCursor Int
x Int
y =
  forall (m :: * -> *). MonadIO m => IO CInt -> m ()
wrap forall a b. (a -> b) -> a -> b
$! CInt -> CInt -> IO CInt
ffi_tb_set_cursor (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)

-- | Hide the mouse pointer.
hideCursor :: Termbox2 ()
hideCursor :: Termbox2 ()
hideCursor = forall (m :: * -> *). MonadIO m => IO CInt -> m ()
wrap IO CInt
ffi_tb_hide_cursor

-- | Draw a single cell on the screen.
setCell
  :: Int
  -> Int
  -> Int32          -- ^ Unicode code point
  -> Tb2ColorAttr
  -> Tb2ColorAttr
  -> Termbox2 ()
setCell :: Int -> Int -> Int32 -> Tb2ColorAttr -> Tb2ColorAttr -> Termbox2 ()
setCell Int
x Int
y Int32
ch (Tb2ColorAttr CInt
fg) (Tb2ColorAttr CInt
bg) = forall (m :: * -> *). MonadIO m => IO CInt -> m ()
wrap forall a b. (a -> b) -> a -> b
$!
  CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt
ffi_tb_set_cell
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
ch)
    CInt
fg
    CInt
bg

-- | Prints a string of text to the screen.
print
  :: Int
  -> Int
  -> Tb2ColorAttr
  -> Tb2ColorAttr
  -> String
  -> Termbox2 ()
print :: Int -> Int -> Tb2ColorAttr -> Tb2ColorAttr -> String -> Termbox2 ()
print Int
x Int
y (Tb2ColorAttr CInt
fg) (Tb2ColorAttr CInt
bg) String
str = forall (m :: * -> *). MonadIO m => IO CInt -> m ()
wrap forall a b. (a -> b) -> a -> b
$!
  forall a. String -> (CString -> IO a) -> IO a
withCString String
str forall a b. (a -> b) -> a -> b
$! CInt -> CInt -> CInt -> CInt -> CString -> IO CInt
ffi_tb_print
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)
    CInt
fg
    CInt
bg

-- | NB: If the argument is 'inputCurrent' then the function acts as a query
-- and returns the current input mode.
setInputMode :: Tb2Input -> Termbox2 (Maybe Tb2Input)
setInputMode :: Tb2Input -> Termbox2 (Maybe Tb2Input)
setInputMode im :: Tb2Input
im@(Tb2Input CInt
inputMode) = do
  CInt
ret <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$! CInt -> IO CInt
ffi_tb_set_input_mode CInt
inputMode
  if Tb2Input
im forall a. Eq a => a -> a -> Bool
== Tb2Input
inputCurrent
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just (CInt -> Tb2Input
Tb2Input CInt
ret)
    else if Tb2Err
errOk forall a. Eq a => a -> a -> Bool
== CInt -> Tb2Err
Tb2Err CInt
ret
      then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$! forall a. Show a => a -> String
show CInt
ret

-- | NB: If the argument is 'outputCurrent' then the function acts as a query
-- and returns the current output mode.
setOutputMode :: Tb2Output -> Termbox2 (Maybe Tb2Output)
setOutputMode :: Tb2Output -> Termbox2 (Maybe Tb2Output)
setOutputMode om :: Tb2Output
om@(Tb2Output CInt
outputMode) = do
  CInt
ret <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$! CInt -> IO CInt
ffi_tb_set_output_mode CInt
outputMode
  if Tb2Output
om forall a. Eq a => a -> a -> Bool
== Tb2Output
outputCurrent
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just (CInt -> Tb2Output
Tb2Output CInt
ret)
    else if Tb2Err
errOk forall a. Eq a => a -> a -> Bool
== CInt -> Tb2Err
Tb2Err CInt
ret
      then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$! forall a. Show a => a -> String
show CInt
ret

_waitEvent
  :: (MonadIO m, Storable a)
  => (Ptr a -> IO CInt)
  -> ReaderT (Ptr a) m (Maybe a)
_waitEvent :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
(Ptr a -> IO CInt) -> ReaderT (Ptr a) m (Maybe a)
_waitEvent Ptr a -> IO CInt
fn = do
  Ptr a
ptr <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  Tb2Err
ret <- (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$! Ptr a -> IO CInt
fn Ptr a
ptr) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CInt -> Tb2Err
Tb2Err
  if Tb2Err
errOk forall a. Eq a => a -> a -> Bool
== Tb2Err
ret
    then (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$! forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a. a -> Maybe a
Just
    else if Tb2Err
errPoll forall a. Eq a => a -> a -> Bool
== Tb2Err
ret
      then do
        Errno
lastErr <- (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO CInt
ffi_tb_last_errno) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CInt -> Errno
Errno
        if Errno
lastErr forall a. Eq a => a -> a -> Bool
== Errno
eINTR
          then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
          else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$! forall a. Show a => a -> String
show Tb2Err
ret
      else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$! forall a. Show a => a -> String
show Tb2Err
ret
{-# INLINE _waitEvent #-}

-- | Blocks until an exception is thrown or an event is observed.
-- The documentation for termbox2 says that sometimes this function returns
-- TB_ERR_POLL which means simply "try again".
-- Instead of imposing a specific loop implementation on client code this
-- function returns a 'Maybe Tb2Event`.
pollEvent :: Termbox2 (Maybe Tb2Event)
pollEvent :: Termbox2 (Maybe Tb2Event)
pollEvent = forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
(Ptr a -> IO CInt) -> ReaderT (Ptr a) m (Maybe a)
_waitEvent Ptr Tb2Event -> IO CInt
ffi_tb_poll_event

-- | Blocks for the specified number of MILLISECONDS until an exception is
-- thrown or an event is received; returns 'Nothing' if the timeout is reached
-- without incident or event.
-- The documentation for termbox2 says that sometimes this function returns
-- TB_ERR_POLL which means simply "try again".
-- Instead of imposing a specific loop implementation on client code this
-- function returns a 'Maybe Tb2Event'.
peekEvent :: Int -> Termbox2 (Maybe Tb2Event)
peekEvent :: Int -> Termbox2 (Maybe Tb2Event)
peekEvent = forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
(Ptr a -> IO CInt) -> ReaderT (Ptr a) m (Maybe a)
_waitEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Tb2Event -> CInt -> IO CInt
ffi_tb_peek_event forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral