some event bindings

termbox2-bindings-hs/src/Termbox2/Bindings/Hs.hs

@@ -23,6 +23,7 @@ module Termbox2.Bindings.Hs
     -- ** Poll for events
     tb_peek_event,
     tb_poll_event,
+    tb_event_mod_has,
     tb_get_fds,
 
     -- ** Set cell contents
@@ -92,7 +93,17 @@ module Termbox2.Bindings.Hs
         TB_ERR_TCSETATTR,
         TB_ERR_UNSUPPORTED_TERM
       ),
-    -- Tb_event (..),
+    Tb_event (..),
+    Tb_event_mod,
+    _TB_MOD_ALT,
+    _TB_MOD_CTRL,
+    _TB_MOD_SHIFT,
+    _TB_MOD_MOTION,
+    Tb_event_type
+      ( TB_EVENT_KEY,
+        TB_EVENT_MOUSE,
+        TB_EVENT_RESIZE
+      ),
     Tb_input_mode
       ( Tb_input_mode,
         TB_INPUT_ALT,
@@ -177,8 +188,7 @@ module Termbox2.Bindings.Hs
         TB_KEY_TAB
       ),
     Tb_output_mode
-      ( Tb_output_mode,
-        TB_OUTPUT_216,
+      ( TB_OUTPUT_216,
         TB_OUTPUT_256,
         TB_OUTPUT_GRAYSCALE,
         TB_OUTPUT_NORMAL,
@@ -212,26 +222,6 @@ module Termbox2.Bindings.Hs
     -- _TB_UNDERLINE,
     -- _TB_UNDERLINE_2,
 
-    -- ** Event types
-
-    -- _TB_EVENT_KEY,
-    -- _TB_EVENT_RESIZE,
-    -- _TB_EVENT_MOUSE,
-
-    -- ** Key modifiers
-
-    -- _TB_MOD_ALT,
-    -- _TB_MOD_CTRL,
-    -- _TB_MOD_MOTION,
-    -- _TB_MOD_SHIFT,
-
-    -- ** Input modes
-
-    -- _TB_INPUT_CURRENT,
-    -- _TB_INPUT_ALT,
-    -- _TB_INPUT_ESC,
-    -- _TB_INPUT_MOUSE,
-
     -- ** Function types
   )
 where
@@ -241,6 +231,9 @@ where
 
 import Termbox2.Bindings.Hs.Internal.Attr (Tb_attr (..))
 import Termbox2.Bindings.Hs.Internal.Error (Tb_error (..))
+import Termbox2.Bindings.Hs.Internal.Event (Tb_event (..))
+import Termbox2.Bindings.Hs.Internal.EventMod (Tb_event_mod, tb_event_mod_has, _TB_MOD_ALT, _TB_MOD_CTRL, _TB_MOD_MOTION, _TB_MOD_SHIFT)
+import Termbox2.Bindings.Hs.Internal.EventType (Tb_event_type (..))
 import Termbox2.Bindings.Hs.Internal.Functions
   ( tb_clear,
     tb_extend_cell,

termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/Event.hs

@@ -0,0 +1,41 @@
+module Termbox2.Bindings.Hs.Internal.Event
+  ( Tb_event (..),
+    makeEvent,
+  )
+where
+
+import Data.Int (Int32)
+import GHC.Generics (Generic)
+import Termbox2.Bindings.C qualified as Termbox
+import Termbox2.Bindings.Hs.Internal.EventMod (Tb_event_mod (..))
+import Termbox2.Bindings.Hs.Internal.EventType (Tb_event_type (..))
+import Termbox2.Bindings.Hs.Internal.Key (Tb_key (..))
+import Termbox2.Bindings.Hs.Internal.Prelude (word32ToChar)
+import Prelude hiding (mod)
+
+-- | An event.
+data Tb_event = Tb_event
+  { type_ :: {-# UNPACK #-} !Tb_event_type,
+    mod :: {-# UNPACK #-} !Tb_event_mod,
+    key :: {-# UNPACK #-} !Tb_key,
+    ch :: {-# UNPACK #-} !Char,
+    w :: {-# UNPACK #-} !Int32,
+    h :: {-# UNPACK #-} !Int32,
+    x :: {-# UNPACK #-} !Int32,
+    y :: {-# UNPACK #-} !Int32
+  }
+  deriving stock (Eq, Generic, Ord, Show)
+
+makeEvent :: Termbox.Tb_event -> Tb_event
+makeEvent Termbox.Tb_event {type_, mod, key, ch, w, h, x, y} =
+  Tb_event
+    { type_ = Tb_event_type type_,
+      mod = Tb_event_mod mod,
+      key = Tb_key key,
+      ch = word32ToChar ch,
+      w,
+      h,
+      x,
+      y
+    }
+{-# INLINE makeEvent #-}

termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/EventMod.hs

@@ -0,0 +1,47 @@
+module Termbox2.Bindings.Hs.Internal.EventMod
+  ( Tb_event_mod (Tb_event_mod),
+    _TB_MOD_ALT,
+    _TB_MOD_CTRL,
+    _TB_MOD_SHIFT,
+    _TB_MOD_MOTION,
+    tb_event_mod_has,
+  )
+where
+
+import Data.Bits ((.&.), (.|.))
+import Data.Coerce (coerce)
+import Data.Word (Word8)
+import Termbox2.Bindings.C qualified as Termbox
+
+-- | An event modifier.
+newtype Tb_event_mod
+  = Tb_event_mod Word8
+  deriving stock (Eq, Ord, Show)
+
+instance Semigroup Tb_event_mod where
+  (<>) = coerce ((.|.) :: Word8 -> Word8 -> Word8)
+
+_TB_MOD_ALT :: Tb_event_mod
+_TB_MOD_ALT =
+  Tb_event_mod Termbox._TB_MOD_ALT
+
+_TB_MOD_CTRL :: Tb_event_mod
+_TB_MOD_CTRL =
+  Tb_event_mod Termbox._TB_MOD_CTRL
+
+_TB_MOD_SHIFT :: Tb_event_mod
+_TB_MOD_SHIFT =
+  Tb_event_mod Termbox._TB_MOD_SHIFT
+
+_TB_MOD_MOTION :: Tb_event_mod
+_TB_MOD_MOTION =
+  Tb_event_mod Termbox._TB_MOD_MOTION
+
+-- | @tb_event_mod_has query modifier@ returns whether @modifier@ contains every modifier in @query@.
+--
+-- For example, to query whether a modifier contains the @ALT@ and @SHIFT@ modifiers:
+--
+-- > tb_event_mod_has (_TB_MOD_ALT <> _TB_MOD_SHIFT)
+tb_event_mod_has :: Tb_event_mod -> Tb_event_mod -> Bool
+tb_event_mod_has (Tb_event_mod query) (Tb_event_mod modifier) =
+  modifier .&. query == query

termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/EventType.hs

@@ -0,0 +1,44 @@
+module Termbox2.Bindings.Hs.Internal.EventType
+  ( Tb_event_type
+      ( Tb_event_type,
+        TB_EVENT_KEY,
+        TB_EVENT_MOUSE,
+        TB_EVENT_RESIZE
+      ),
+  )
+where
+
+import Data.Word (Word8)
+import Termbox2.Bindings.C
+
+-- | An event type.
+newtype Tb_event_type
+  = Tb_event_type Word8
+  deriving stock (Eq, Ord)
+
+instance Show Tb_event_type where
+  show = \case
+    TB_EVENT_KEY -> "TB_EVENT_KEY"
+    TB_EVENT_MOUSE -> "TB_EVENT_MOUSE"
+    TB_EVENT_RESIZE -> "TB_EVENT_RESIZE"
+
+pattern TB_EVENT_KEY :: Tb_event_type
+pattern TB_EVENT_KEY <-
+  ((== Tb_event_type _TB_EVENT_KEY) -> True)
+  where
+    TB_EVENT_KEY = Tb_event_type _TB_EVENT_KEY
+
+pattern TB_EVENT_MOUSE :: Tb_event_type
+pattern TB_EVENT_MOUSE <-
+  ((== Tb_event_type _TB_EVENT_MOUSE) -> True)
+  where
+    TB_EVENT_MOUSE = Tb_event_type _TB_EVENT_MOUSE
+
+pattern TB_EVENT_RESIZE :: Tb_event_type
+pattern TB_EVENT_RESIZE <-
+  ((== Tb_event_type _TB_EVENT_RESIZE) -> True)
+  where
+    TB_EVENT_RESIZE = Tb_event_type _TB_EVENT_RESIZE
+
+-- N.B. This requires Tb_event_type to remain abstract
+{-# COMPLETE TB_EVENT_KEY, TB_EVENT_MOUSE, TB_EVENT_RESIZE #-}

termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/OutputMode.hs

@@ -25,7 +25,6 @@ instance Show Tb_output_mode where
     TB_OUTPUT_GRAYSCALE -> "TB_OUTPUT_GRAYSCALE"
     TB_OUTPUT_NORMAL -> "TB_OUTPUT_NORMAL"
     TB_OUTPUT_TRUECOLOR -> "TB_OUTPUT_TRUECOLOR"
-    Tb_output_mode mode -> show ("Tb_output_mode " ++ show mode)
 
 pattern TB_OUTPUT_216 :: Tb_output_mode
 pattern TB_OUTPUT_216 <-
@@ -56,3 +55,6 @@ pattern TB_OUTPUT_TRUECOLOR <-
   ((== Tb_output_mode _TB_OUTPUT_TRUECOLOR) -> True)
   where
     TB_OUTPUT_TRUECOLOR = Tb_output_mode _TB_OUTPUT_TRUECOLOR
+
+-- N.B. This requires Tb_output_mode to remain abstract
+{-# COMPLETE TB_OUTPUT_216, TB_OUTPUT_256, TB_OUTPUT_GRAYSCALE, TB_OUTPUT_NORMAL, TB_OUTPUT_TRUECOLOR #-}

termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/Prelude.hs

@@ -2,7 +2,7 @@ module Termbox2.Bindings.Hs.Internal.Prelude
   ( charToWord32,
     cintToInt,
     intToCInt,
-    -- word32ToChar,
+    word32ToChar,
   )
 where
 

termbox2-bindings-hs/termbox2-bindings-hs.cabal

@@ -72,6 +72,9 @@ library
   other-modules:
     Termbox2.Bindings.Hs.Internal.Attr
     Termbox2.Bindings.Hs.Internal.Error
+    Termbox2.Bindings.Hs.Internal.Event
+    Termbox2.Bindings.Hs.Internal.EventMod
+    Termbox2.Bindings.Hs.Internal.EventType
     Termbox2.Bindings.Hs.Internal.Functions
     Termbox2.Bindings.Hs.Internal.InputMode
     Termbox2.Bindings.Hs.Internal.Key