module Termbox
( Event(..)
, Cell(..)
, tbChangeCell
, tbClear
, tbHeight
, tbHideCursor
, tbInit
, tbInputMode
, tbOutputMode
, tbPeekEvent
, tbPollEvent
, tbPresent
, tbPutCell
, tbSelectInputMode
, tbSelectOutputMode
, tbSetClearAttributes
, tbSetCursor
, tbShutdown
, tbWidth
) where
import Control.Monad (void)
import Data.Int
import Data.Word
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable
import Termbox.Modes
( InputMode, OutputMode
, toInputMode, toOutputMode
, fromInputMode, fromOutputMode
)
import Prelude hiding (mod)
data Event = KeyEvent Word8 Word16 Word32
| ResizeEvent Int32 Int32
| MouseEvent Int32 Int32 Word16
deriving (Show, Eq)
newtype Cell = Cell (ForeignPtr (Cell))
withCell :: Cell -> (Ptr Cell -> IO b) -> IO b
withCell (Cell fptr) = withForeignPtr fptr
newtype RawEvent = RawEvent (ForeignPtr (RawEvent))
withRawEvent :: RawEvent -> (Ptr RawEvent -> IO b) -> IO b
withRawEvent (RawEvent fptr) = withForeignPtr fptr
tbInit' :: IO ((Int))
tbInit' =
tbInit''_ >>= \res ->
let {res' = fromIntegral res} in
return (res')
tbInit :: IO (Either String ())
tbInit = fmap go tbInit'
where
go (1) = Left "tb_init: unsupported terminal"
go (2) = Left "tb_init: failed to open TTY"
go (3) = Left "tb_init: pipe trap failed"
go x = if x <= 0 then Right () else Left "tb_init: unknown"
tbShutdown :: IO ()
tbShutdown =
tbShutdown'_ >>
return ()
tbWidth :: IO ((Int))
tbWidth =
tbWidth'_ >>= \res ->
let {res' = fromIntegral res} in
return (res')
tbHeight :: IO ((Int))
tbHeight =
tbHeight'_ >>= \res ->
let {res' = fromIntegral res} in
return (res')
tbClear :: IO ()
tbClear =
tbClear'_ >>
return ()
tbSetClearAttributes :: (CUShort) -> (CUShort) -> IO ()
tbSetClearAttributes a1 a2 =
let {a1' = fromIntegral a1} in
let {a2' = fromIntegral a2} in
tbSetClearAttributes'_ a1' a2' >>
return ()
tbPresent :: IO ()
tbPresent =
tbPresent'_ >>
return ()
tbHideCursor :: IO ()
tbHideCursor = tbSetCursor (1) (1)
tbSetCursor :: (Int) -> (Int) -> IO ()
tbSetCursor a1 a2 =
let {a1' = fromIntegral a1} in
let {a2' = fromIntegral a2} in
tbSetCursor'_ a1' a2' >>
return ()
tbPutCell :: (Int) -> (Int) -> (Cell) -> IO ()
tbPutCell a1 a2 a3 =
let {a1' = fromIntegral a1} in
let {a2' = fromIntegral a2} in
(withCell) a3 $ \a3' ->
tbPutCell'_ a1' a2' a3' >>
return ()
tbChangeCell :: (Int) -> (Int) -> (CUInt) -> (CUShort) -> (CUShort) -> IO ()
tbChangeCell a1 a2 a3 a4 a5 =
let {a1' = fromIntegral a1} in
let {a2' = fromIntegral a2} in
let {a3' = fromIntegral a3} in
let {a4' = fromIntegral a4} in
let {a5' = fromIntegral a5} in
tbChangeCell'_ a1' a2' a3' a4' a5' >>
return ()
tbSelectInputMode' :: (Int) -> IO ((Int))
tbSelectInputMode' a1 =
let {a1' = fromIntegral a1} in
tbSelectInputMode''_ a1' >>= \res ->
let {res' = fromIntegral res} in
return (res')
tbSelectOutputMode' :: (Int) -> IO ((Int))
tbSelectOutputMode' a1 =
let {a1' = fromIntegral a1} in
tbSelectOutputMode''_ a1' >>= \res ->
let {res' = fromIntegral res} in
return (res')
tbInputMode :: IO InputMode
tbInputMode = fmap toInputMode (tbSelectInputMode' 0)
tbSelectInputMode :: InputMode -> IO ()
tbSelectInputMode = void . tbSelectInputMode' . fromInputMode
tbOutputMode :: IO OutputMode
tbOutputMode = fmap toOutputMode (tbSelectOutputMode' 0)
tbSelectOutputMode :: OutputMode -> IO ()
tbSelectOutputMode = void . tbSelectOutputMode' . fromOutputMode
tbPeekEvent :: (Int) -> IO ((RawEvent))
tbPeekEvent a2 =
mallocForeignPtrBytes 24 >>= \a1'' -> withForeignPtr a1'' $ \a1' ->
let {a2' = fromIntegral a2} in
tbPeekEvent'_ a1' a2' >>
return (RawEvent a1'')
tbPollEvent' :: IO ((RawEvent))
tbPollEvent' =
mallocForeignPtrBytes 24 >>= \a1'' -> withForeignPtr a1'' $ \a1' ->
tbPollEvent''_ a1' >>
return (RawEvent a1'')
tbPollEvent :: IO (Either String Event)
tbPollEvent = tbPollEvent' >>= \e -> withRawEvent e peekEvent
peekEvent :: Ptr RawEvent -> IO (Either String Event)
peekEvent p = (\ptr -> do {peekByteOff ptr 0 :: IO CUChar}) p >>= toEvent
where
toEvent 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)
toEvent 2 = fmap Right $
ResizeEvent <$> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 8 :: IO CInt}) p)
<*> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 12 :: IO CInt}) p)
toEvent 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)
toEvent _ = return (Left "tbPollEvent: invalid event type")
foreign import ccall unsafe "Termbox.chs.h tb_init"
tbInit''_ :: (IO CInt)
foreign import ccall unsafe "Termbox.chs.h tb_shutdown"
tbShutdown'_ :: (IO ())
foreign import ccall unsafe "Termbox.chs.h tb_width"
tbWidth'_ :: (IO CInt)
foreign import ccall unsafe "Termbox.chs.h tb_height"
tbHeight'_ :: (IO CInt)
foreign import ccall unsafe "Termbox.chs.h tb_clear"
tbClear'_ :: (IO ())
foreign import ccall unsafe "Termbox.chs.h tb_set_clear_attributes"
tbSetClearAttributes'_ :: (CUShort -> (CUShort -> (IO ())))
foreign import ccall unsafe "Termbox.chs.h tb_present"
tbPresent'_ :: (IO ())
foreign import ccall unsafe "Termbox.chs.h tb_set_cursor"
tbSetCursor'_ :: (CInt -> (CInt -> (IO ())))
foreign import ccall unsafe "Termbox.chs.h tb_put_cell"
tbPutCell'_ :: (CInt -> (CInt -> ((Ptr (Cell)) -> (IO ()))))
foreign import ccall unsafe "Termbox.chs.h tb_change_cell"
tbChangeCell'_ :: (CInt -> (CInt -> (CUInt -> (CUShort -> (CUShort -> (IO ()))))))
foreign import ccall unsafe "Termbox.chs.h tb_select_input_mode"
tbSelectInputMode''_ :: (CInt -> (IO CInt))
foreign import ccall unsafe "Termbox.chs.h tb_select_output_mode"
tbSelectOutputMode''_ :: (CInt -> (IO CInt))
foreign import ccall safe "Termbox.chs.h tb_peek_event"
tbPeekEvent'_ :: ((Ptr (RawEvent)) -> (CInt -> (IO CInt)))
foreign import ccall safe "Termbox.chs.h tb_poll_event"
tbPollEvent''_ :: ((Ptr (RawEvent)) -> (IO CInt))