module Termbox
( C.Cell
, C.changeCell
, C.clear
, C.height
, C.present
, C.putCell
, C.setClearAttr
, C.setCursor
, C.shutdown
, C.width
, Event(..)
, InputMode(..)
, OutputMode(..)
, getInputMode
, getOutputMode
, hideCursor
, init
, inputMode
, peekEvent
, pollEvent
, setInputMode
, setOutputMode
) where
import Control.Arrow (left)
import Control.Monad (void)
import Data.Bits
import Data.Int
import Data.Word
import Foreign.C.Types
import Foreign.Ptr
import Foreign.Storable
import Prelude hiding (init, mod)
import qualified Termbox.C as C
import qualified Termbox.Enums as E
data Event
= KeyEvent Word8 Word16 Word32
| ResizeEvent Int32 Int32
| MouseEvent Int32 Int32 Word16
deriving (Show, Eq)
data InputMode = InputMode
{ isEsc :: Bool
, isAlt :: Bool
, isMouse :: Bool
} deriving (Show, Eq)
inputMode :: InputMode
inputMode = InputMode False False False
data OutputMode
= Normal
| M256
| M216
| Grayscale
| Unknown Int
deriving (Show, Eq)
init :: IO (Either String ())
init = check <$> C.tb_init
where
check e
| e == 1 = Left "tb_init: unsupported terminal"
| e == 2 = Left "tb_init: failed to open TTY"
| e == 3 = Left "tb_init: pipe trap failed"
| e < 0 = Left ("tb_init: errno " ++ (show e))
| otherwise = Right ()
hideCursor :: IO ()
hideCursor = C.setCursor x x where x = 1
getInputMode :: IO InputMode
getInputMode = conv <$> (C.tb_select_input_mode 0)
where
conv bits = InputMode { isEsc = 0 /= bits .&. 1
, isAlt = 0 /= bits .&. 2
, isMouse = 0 /= bits .&. 4
}
setInputMode :: InputMode -> IO ()
setInputMode = void . C.tb_select_input_mode . conv
where conv mode = let e = if isEsc mode then 1 else 0
a = if isAlt mode then 2 else 0
m = if isMouse mode then 4 else 0
in e .|. a .|. m
getOutputMode :: IO OutputMode
getOutputMode = (conv . toEnum) <$> C.tb_select_output_mode 0
where
conv i
| i == E.TB_OUTPUT_NORMAL = Normal
| i == E.TB_OUTPUT_256 = M256
| i == E.TB_OUTPUT_216 = M216
| i == E.TB_OUTPUT_GRAYSCALE = Grayscale
| otherwise = Unknown (fromEnum i)
setOutputMode :: OutputMode -> IO ()
setOutputMode = void . C.tb_select_output_mode . conv
where
conv Normal = 1
conv M256 = 2
conv M216 = 3
conv Grayscale = 4
conv (Unknown i) = fromIntegral i
peekEvent :: Int -> IO (Maybe Event)
peekEvent t = fmap (either (const Nothing) Just)
(C.tb_peek_event t >>= (flip C.withEvent) handleEvent)
pollEvent :: IO (Either String Event)
pollEvent = fmap (left showError)
(C.tb_poll_event >>= (flip C.withEvent) handleEvent)
where showError i = "tb_poll_event: invalid event type" ++ (show i)
handleEvent :: Ptr C.Event -> IO (Either Int Event)
handleEvent p = (\ptr -> do {peekByteOff ptr 0 :: IO CUChar}) p >>= conv
where
conv :: CUChar -> IO (Either Int Event)
conv 1 = fmap Right $
KeyEvent <$> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 1 :: IO CUChar}) p)
<*> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 2 :: IO CUShort}) p)
<*> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 4 :: IO CUInt}) p)
conv 2 = fmap Right $
ResizeEvent <$> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 8 :: IO CInt}) p)
<*> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 12 :: IO CInt}) p)
conv 3 = fmap Right $
MouseEvent <$> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 16 :: IO CInt}) p)
<*> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 20 :: IO CInt}) p)
<*> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 2 :: IO CUShort}) p)
conv i = return (Left (fromIntegral i))