-- | 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 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