From a2f6f424188b7a32864f8df18215c672fde2c719 Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Sun, 12 Nov 2023 00:10:52 -0500
Subject: [PATCH] more work

---
 .../Termbox2/Bindings/C/Internal/Functions.hs |   2 +-
 .../src/Termbox2/Bindings/Hs.hs               |  50 +++-----
 .../Termbox2/Bindings/Hs/Internal/Color.hs    |  85 ++++++++++++++
 .../Bindings/Hs/Internal/Functions.hs         | 108 +++++++++++++-----
 .../Termbox2/Bindings/Hs/Internal/Prelude.hs  |  18 ++-
 .../termbox2-bindings-hs.cabal                |   2 +
 6 files changed, 196 insertions(+), 69 deletions(-)
 create mode 100644 termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/Color.hs

diff --git a/termbox2-bindings-c/src/Termbox2/Bindings/C/Internal/Functions.hs b/termbox2-bindings-c/src/Termbox2/Bindings/C/Internal/Functions.hs
index c011cdc..cbd0078 100644
--- a/termbox2-bindings-c/src/Termbox2/Bindings/C/Internal/Functions.hs
+++ b/termbox2-bindings-c/src/Termbox2/Bindings/C/Internal/Functions.hs
@@ -113,7 +113,7 @@ foreign import capi unsafe "termbox2.h tb_print_ex"
 
 -- | Send raw bytes to the terminal.
 foreign import capi unsafe "termbox2.h tb_send"
-  tb_send :: CString -> CSize -> IO CInt
+  tb_send :: Ptr CChar -> CSize -> IO CInt
 
 -- | Set a cell value in the back buffer.
 foreign import capi unsafe "termbox2.h tb_set_cell"
diff --git a/termbox2-bindings-hs/src/Termbox2/Bindings/Hs.hs b/termbox2-bindings-hs/src/Termbox2/Bindings/Hs.hs
index b97af4a..a6d8230 100644
--- a/termbox2-bindings-hs/src/Termbox2/Bindings/Hs.hs
+++ b/termbox2-bindings-hs/src/Termbox2/Bindings/Hs.hs
@@ -45,9 +45,6 @@ module Termbox2.Bindings.Hs
     tb_present,
     tb_invalidate,
 
-    -- ** Custom escape sequences
-    tb_set_func,
-
     -- ** Error utils
     tb_last_errno,
     tb_strerror,
@@ -67,6 +64,19 @@ module Termbox2.Bindings.Hs
         TB_UNDERLINE,
         TB_UNDERLINE_2
       ),
+    Tb_color
+      ( Tb_color,
+        TB_DEFAULT,
+        TB_BLACK,
+        TB_BLUE,
+        TB_CYAN,
+        TB_GREEN,
+        TB_HI_BLACK,
+        TB_MAGENTA,
+        TB_RED,
+        TB_WHITE,
+        TB_YELLOW
+      ),
     Tb_error
       ( Tb_error,
         TB_ERR,
@@ -191,42 +201,11 @@ module Termbox2.Bindings.Hs
         TB_OUTPUT_NORMAL,
         TB_OUTPUT_TRUECOLOR
       ),
-
-    -- ** Colors
-
-    -- _TB_DEFAULT,
-    -- _TB_BLACK,
-    -- _TB_HI_BLACK,
-    -- _TB_BLUE,
-    -- _TB_CYAN,
-    -- _TB_GREEN,
-    -- _TB_MAGENTA,
-    -- _TB_RED,
-    -- _TB_WHITE,
-    -- _TB_YELLOW,
-
-    -- ** Attributes
-
-    -- _TB_BLINK,
-    -- _TB_BOLD,
-    -- _TB_BRIGHT,
-    -- _TB_DIM,
-    -- _TB_INVISIBLE,
-    -- _TB_ITALIC,
-    -- _TB_OVERLINE,
-    -- _TB_REVERSE,
-    -- _TB_STRIKEOUT,
-    -- _TB_UNDERLINE,
-    -- _TB_UNDERLINE_2,
-
-    -- ** Function types
   )
 where
 
--- _TB_FUNC_EXTRACT_PRE,
--- _TB_FUNC_EXTRACT_POST,
-
 import Termbox2.Bindings.Hs.Internal.Attr (Tb_attr (..))
+import Termbox2.Bindings.Hs.Internal.Color (Tb_color (..))
 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_MOD_ALT, _TB_MOD_CTRL, _TB_MOD_MOTION, _TB_MOD_SHIFT)
@@ -255,7 +234,6 @@ import Termbox2.Bindings.Hs.Internal.Functions
     tb_set_cell_ex,
     tb_set_clear_attrs,
     tb_set_cursor,
-    tb_set_func,
     tb_set_input_mode,
     tb_set_output_mode,
     tb_shutdown,
diff --git a/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/Color.hs b/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/Color.hs
new file mode 100644
index 0000000..ac476d5
--- /dev/null
+++ b/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/Color.hs
@@ -0,0 +1,85 @@
+module Termbox2.Bindings.Hs.Internal.Color
+  ( Tb_color
+      ( Tb_color,
+        TB_DEFAULT,
+        TB_BLACK,
+        TB_BLUE,
+        TB_CYAN,
+        TB_GREEN,
+        TB_HI_BLACK,
+        TB_MAGENTA,
+        TB_RED,
+        TB_WHITE,
+        TB_YELLOW
+      ),
+  )
+where
+
+import Data.Word (Word64)
+import Termbox2.Bindings.C
+
+-- | A color.
+newtype Tb_color
+  = Tb_color Word64
+  deriving stock (Eq, Ord)
+  deriving newtype (Num, Show)
+
+pattern TB_DEFAULT :: Tb_color
+pattern TB_DEFAULT <-
+  ((== Tb_color _TB_DEFAULT) -> True)
+  where
+    TB_DEFAULT = Tb_color _TB_DEFAULT
+
+pattern TB_BLACK :: Tb_color
+pattern TB_BLACK <-
+  ((== Tb_color _TB_BLACK) -> True)
+  where
+    TB_BLACK = Tb_color _TB_BLACK
+
+pattern TB_BLUE :: Tb_color
+pattern TB_BLUE <-
+  ((== Tb_color _TB_BLUE) -> True)
+  where
+    TB_BLUE = Tb_color _TB_BLUE
+
+pattern TB_CYAN :: Tb_color
+pattern TB_CYAN <-
+  ((== Tb_color _TB_CYAN) -> True)
+  where
+    TB_CYAN = Tb_color _TB_CYAN
+
+pattern TB_GREEN :: Tb_color
+pattern TB_GREEN <-
+  ((== Tb_color _TB_GREEN) -> True)
+  where
+    TB_GREEN = Tb_color _TB_GREEN
+
+pattern TB_HI_BLACK :: Tb_color
+pattern TB_HI_BLACK <-
+  ((== Tb_color _TB_HI_BLACK) -> True)
+  where
+    TB_HI_BLACK = Tb_color _TB_HI_BLACK
+
+pattern TB_MAGENTA :: Tb_color
+pattern TB_MAGENTA <-
+  ((== Tb_color _TB_MAGENTA) -> True)
+  where
+    TB_MAGENTA = Tb_color _TB_MAGENTA
+
+pattern TB_RED :: Tb_color
+pattern TB_RED <-
+  ((== Tb_color _TB_RED) -> True)
+  where
+    TB_RED = Tb_color _TB_RED
+
+pattern TB_WHITE :: Tb_color
+pattern TB_WHITE <-
+  ((== Tb_color _TB_WHITE) -> True)
+  where
+    TB_WHITE = Tb_color _TB_WHITE
+
+pattern TB_YELLOW :: Tb_color
+pattern TB_YELLOW <-
+  ((== Tb_color _TB_YELLOW) -> True)
+  where
+    TB_YELLOW = Tb_color _TB_YELLOW
diff --git a/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/Functions.hs b/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/Functions.hs
index bbba798..55fc91f 100644
--- a/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/Functions.hs
+++ b/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/Functions.hs
@@ -22,7 +22,6 @@ module Termbox2.Bindings.Hs.Internal.Functions
     tb_set_cell_ex,
     tb_set_clear_attrs,
     tb_set_cursor,
-    tb_set_func,
     tb_set_input_mode,
     tb_set_output_mode,
     tb_shutdown,
@@ -31,18 +30,20 @@ module Termbox2.Bindings.Hs.Internal.Functions
   )
 where
 
+import Data.ByteString (ByteString)
+import Data.ByteString.Unsafe qualified as ByteString
 import Data.Coerce (coerce)
 import Data.Text (Text)
-import Data.Text.Foreign qualified as Text (peekCStringLen)
+import Data.Text.Foreign qualified as Text (peekCStringLen, withCString)
 import Foreign.C (CInt, Errno (..), withCString)
 import Foreign.C.ConstPtr (ConstPtr (..))
-import Foreign.Marshal (alloca)
-import Foreign.Marshal.Array (lengthArray0)
+import Foreign.Marshal (alloca, lengthArray0, withArrayLen)
 import Foreign.Storable qualified as Storable
 import System.Posix.Types (Fd (Fd))
 import Termbox2.Bindings.C qualified as Termbox
 import Termbox2.Bindings.Hs.Internal.Attr (Tb_attr (Tb_attr))
 import Termbox2.Bindings.Hs.Internal.Error (Tb_error (Tb_error))
+import Termbox2.Bindings.Hs.Internal.Event (Tb_event, makeEvent)
 import Termbox2.Bindings.Hs.Internal.InputMode (Tb_input_mode (Tb_input_mode))
 import Termbox2.Bindings.Hs.Internal.OutputMode (Tb_output_mode (Tb_output_mode))
 import Termbox2.Bindings.Hs.Internal.Prelude
@@ -147,14 +148,26 @@ tb_last_errno =
   coerce Termbox.tb_last_errno
 
 -- | Wait up to a number of milliseconds for an event.
--- tb_peek_event :: Ptr Tb_event -> CInt -> IO CInt
-tb_peek_event :: ()
-tb_peek_event = ()
+tb_peek_event :: Int -> IO (Either Tb_error Tb_event)
+tb_peek_event ms =
+  alloca \eventPtr -> do
+    code <- Termbox.tb_peek_event eventPtr (intToCInt ms)
+    if code == Termbox._TB_OK
+      then do
+        event <- Storable.peek eventPtr
+        pure (Right (makeEvent event))
+      else pure (Left (Tb_error code))
 
 -- | Wait for an event.
--- tb_poll_event :: Ptr Tb_event -> IO CInt
-tb_poll_event :: ()
-tb_poll_event = ()
+tb_poll_event :: IO (Either Tb_error Tb_event)
+tb_poll_event =
+  alloca \eventPtr -> do
+    code <- Termbox.tb_poll_event eventPtr
+    if code == Termbox._TB_OK
+      then do
+        event <- Storable.peek eventPtr
+        pure (Right (makeEvent event))
+      else pure (Left (Tb_error code))
 
 -- | Synchronize the back buffer with the terminal.
 tb_present :: IO (Either Tb_error ())
@@ -163,21 +176,53 @@ tb_present =
 
 -- | Print a string to the back buffer.
 -- tb_print :: CInt -> CInt -> Word64 -> Word64 -> CString -> IO CInt
-tb_print :: ()
-tb_print = ()
+tb_print ::
+  -- | x
+  Int ->
+  -- | y
+  Int ->
+  -- | fg
+  Tb_attr ->
+  -- | fg
+  Tb_attr ->
+  -- | str
+  Text ->
+  IO (Either Tb_error ())
+tb_print x y (Tb_attr fg) (Tb_attr bg) str =
+  Text.withCString str \cstr ->
+    check (Termbox.tb_print (intToCInt x) (intToCInt y) fg bg cstr)
 
--- | Print a string to the back buffer.
+-- | Print a string to the back buffer and return its width.
 -- tb_print_ex :: CInt -> CInt -> Word64 -> Word64 -> Ptr CSize -> CString -> IO CInt
-tb_print_ex :: ()
-tb_print_ex = ()
+tb_print_ex ::
+  -- | x
+  Int ->
+  -- | y
+  Int ->
+  -- | fg
+  Tb_attr ->
+  -- | fg
+  Tb_attr ->
+  -- | str
+  Text ->
+  IO (Either Tb_error Int)
+tb_print_ex x y (Tb_attr fg) (Tb_attr bg) str =
+  alloca \sizePtr ->
+    Text.withCString str \cstr -> do
+      code <- Termbox.tb_print_ex (intToCInt x) (intToCInt y) fg bg sizePtr cstr
+      if code == Termbox._TB_OK
+        then do
+          size <- Storable.peek sizePtr
+          pure (Right (csizeToInt size))
+        else pure (Left (Tb_error code))
 
 -- | Send raw bytes to the terminal.
--- tb_send :: CString -> CSize -> IO CInt
-tb_send :: ()
-tb_send = ()
+tb_send :: ByteString -> IO (Either Tb_error ())
+tb_send bytes =
+  ByteString.unsafeUseAsCStringLen bytes \(cstr, len) ->
+    check (Termbox.tb_send cstr (intToCSize len))
 
 -- | Set a cell value in the back buffer.
--- tb_set_cell :: CInt -> CInt -> Word32 -> Word64 -> Word64 -> IO CInt
 tb_set_cell ::
   -- | x
   Int ->
@@ -194,12 +239,23 @@ tb_set_cell x y ch (Tb_attr fg) (Tb_attr bg) =
   check (Termbox.tb_set_cell (intToCInt x) (intToCInt y) (charToWord32 ch) fg bg)
 
 -- | Set a cell value in the back buffer.
--- tb_set_cell_ex :: CInt -> CInt -> Ptr Word32 -> CSize -> Word64 -> Word64 -> IO CInt
-tb_set_cell_ex :: ()
-tb_set_cell_ex = ()
+tb_set_cell_ex ::
+  -- | x
+  Int ->
+  -- | y
+  Int ->
+  -- | chs
+  [Char] ->
+  -- | fg
+  Tb_attr ->
+  -- | bg
+  Tb_attr ->
+  IO (Either Tb_error ())
+tb_set_cell_ex x y chs (Tb_attr fg) (Tb_attr bg) =
+  withArrayLen (map charToWord32 chs) \len cchs ->
+    check (Termbox.tb_set_cell_ex (intToCInt x) (intToCInt y) cchs (intToCSize len) fg bg)
 
 -- | Set the foreground and background attributes that @tb_clear@ clears the back buffer with.
--- tb_set_clear_attrs :: Word64 -> Word64 -> IO CInt
 tb_set_clear_attrs ::
   -- | fg
   Tb_attr ->
@@ -210,7 +266,6 @@ tb_set_clear_attrs (Tb_attr fg) (Tb_attr bg) =
   check (Termbox.tb_set_clear_attrs fg bg)
 
 -- | Set the cursor in the back buffer.
--- tb_set_cursor :: CInt -> CInt -> IO CInt
 tb_set_cursor ::
   -- | x
   Int ->
@@ -220,11 +275,6 @@ tb_set_cursor ::
 tb_set_cursor x y =
   check (Termbox.tb_set_cursor (intToCInt x) (intToCInt y))
 
--- | Set or clear custom escape sequence functions.
--- tb_set_func :: CInt -> FunPtr (Ptr Tb_event -> Ptr CSize -> IO CInt) -> IO CInt
-tb_set_func :: ()
-tb_set_func = ()
-
 -- | Set the input mode.
 tb_set_input_mode :: Tb_input_mode -> IO (Either Tb_error ())
 tb_set_input_mode (Tb_input_mode mode) =
diff --git a/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/Prelude.hs b/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/Prelude.hs
index 470980e..c693f53 100644
--- a/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/Prelude.hs
+++ b/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/Prelude.hs
@@ -1,14 +1,16 @@
 module Termbox2.Bindings.Hs.Internal.Prelude
   ( charToWord32,
+    word32ToChar,
     cintToInt,
     intToCInt,
-    word32ToChar,
+    csizeToInt,
+    intToCSize,
   )
 where
 
-import qualified Data.Char as Char
+import Data.Char qualified as Char
 import Data.Word (Word32)
-import Foreign.C.Types (CInt)
+import Foreign.C.Types (CInt, CSize)
 
 charToWord32 :: Char -> Word32
 charToWord32 =
@@ -29,3 +31,13 @@ intToCInt :: Int -> CInt
 intToCInt =
   fromIntegral
 {-# INLINE intToCInt #-}
+
+csizeToInt :: CSize -> Int
+csizeToInt =
+  fromIntegral
+{-# INLINE csizeToInt #-}
+
+intToCSize :: Int -> CSize
+intToCSize =
+  fromIntegral
+{-# INLINE intToCSize #-}
diff --git a/termbox2-bindings-hs/termbox2-bindings-hs.cabal b/termbox2-bindings-hs/termbox2-bindings-hs.cabal
index 173e1d7..af04c1a 100644
--- a/termbox2-bindings-hs/termbox2-bindings-hs.cabal
+++ b/termbox2-bindings-hs/termbox2-bindings-hs.cabal
@@ -57,6 +57,7 @@ library
   import: component
   build-depends:
     base ^>= 4.18 || ^>= 4.19,
+    bytestring ^>= 0.11 || ^>= 0.12,
     termbox2-bindings-c ^>= 1.0.0,
     text ^>= 2.0 || ^>= 2.1,
   default-extensions:
@@ -71,6 +72,7 @@ library
   hs-source-dirs: src
   other-modules:
     Termbox2.Bindings.Hs.Internal.Attr
+    Termbox2.Bindings.Hs.Internal.Color
     Termbox2.Bindings.Hs.Internal.Error
     Termbox2.Bindings.Hs.Internal.Event
     Termbox2.Bindings.Hs.Internal.EventMod