From c8b40e953bded8fa0fbe883efc148047aabce103 Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Sat, 11 Nov 2023 20:34:42 -0500
Subject: [PATCH] input/output modes

---
 .../src/Termbox2/Bindings/Hs.hs               | 25 +++++---
 .../Bindings/Hs/Internal/Functions.hs         | 19 +++---
 .../Bindings/Hs/Internal/InputMode.hs         | 15 +----
 .../Bindings/Hs/Internal/OutputMode.hs        | 58 +++++++++++++++++++
 .../termbox2-bindings-hs.cabal                |  1 +
 5 files changed, 90 insertions(+), 28 deletions(-)
 create mode 100644 termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/OutputMode.hs

diff --git a/termbox2-bindings-hs/src/Termbox2/Bindings/Hs.hs b/termbox2-bindings-hs/src/Termbox2/Bindings/Hs.hs
index 8cb6dbb..d54d075 100644
--- a/termbox2-bindings-hs/src/Termbox2/Bindings/Hs.hs
+++ b/termbox2-bindings-hs/src/Termbox2/Bindings/Hs.hs
@@ -93,6 +93,12 @@ module Termbox2.Bindings.Hs
         TB_ERR_UNSUPPORTED_TERM
       ),
     -- Tb_event (..),
+    Tb_input_mode
+      ( Tb_input_mode,
+        TB_INPUT_ALT,
+        TB_INPUT_ESC,
+        TB_INPUT_MOUSE
+      ),
     Tb_key
       ( Tb_key,
         TB_KEY_ARROW_DOWN,
@@ -170,6 +176,14 @@ module Termbox2.Bindings.Hs
         TB_KEY_SPACE,
         TB_KEY_TAB
       ),
+    Tb_output_mode
+      ( Tb_output_mode,
+        TB_OUTPUT_216,
+        TB_OUTPUT_256,
+        TB_OUTPUT_GRAYSCALE,
+        TB_OUTPUT_NORMAL,
+        TB_OUTPUT_TRUECOLOR
+      ),
 
     -- ** Colors
 
@@ -218,15 +232,6 @@ module Termbox2.Bindings.Hs
     -- _TB_INPUT_ESC,
     -- _TB_INPUT_MOUSE,
 
-    -- ** Output modes
-
-    -- _TB_OUTPUT_CURRENT,
-    -- _TB_OUTPUT_216,
-    -- _TB_OUTPUT_256,
-    -- _TB_OUTPUT_GRAYSCALE,
-    -- _TB_OUTPUT_NORMAL,
-    -- _TB_OUTPUT_TRUECOLOR,
-
     -- ** Function types
   )
 where
@@ -267,4 +272,6 @@ import Termbox2.Bindings.Hs.Internal.Functions
     tb_strerror,
     tb_width,
   )
+import Termbox2.Bindings.Hs.Internal.InputMode (Tb_input_mode (..))
 import Termbox2.Bindings.Hs.Internal.Key (Tb_key (..))
+import Termbox2.Bindings.Hs.Internal.OutputMode (Tb_output_mode (..))
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 5893f67..bbba798 100644
--- a/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/Functions.hs
+++ b/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/Functions.hs
@@ -44,6 +44,7 @@ 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.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
 
 -- | Clear the back buffer.
@@ -86,9 +87,13 @@ tb_get_input_mode = do
       else Right (Tb_input_mode n)
 
 -- | Get the output mode.
--- tb_get_output_mode :: IO (Either Tb_error Tb_output_mode)
-tb_get_output_mode :: ()
-tb_get_output_mode = ()
+tb_get_output_mode :: IO (Either Tb_error Tb_output_mode)
+tb_get_output_mode = do
+  n <- Termbox.tb_set_output_mode Termbox._TB_OUTPUT_CURRENT
+  pure
+    if n < 0
+      then Left (Tb_error n)
+      else Right (Tb_output_mode n)
 
 -- | Get the terminal height.
 tb_height :: IO (Either Tb_error Int)
@@ -225,10 +230,10 @@ tb_set_input_mode :: Tb_input_mode -> IO (Either Tb_error ())
 tb_set_input_mode (Tb_input_mode mode) =
   check (Termbox.tb_set_input_mode mode)
 
--- | Get or set the output mode.
--- tb_set_output_mode :: CInt -> IO CInt
-tb_set_output_mode :: ()
-tb_set_output_mode = ()
+-- | Get the output mode.
+tb_set_output_mode :: Tb_output_mode -> IO (Either Tb_error ())
+tb_set_output_mode (Tb_output_mode mode) =
+  check (Termbox.tb_set_output_mode mode)
 
 -- | Shutdown the @termbox@ library.
 tb_shutdown :: IO (Either Tb_error ())
diff --git a/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/InputMode.hs b/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/InputMode.hs
index 7782d82..fe99ec6 100644
--- a/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/InputMode.hs
+++ b/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/InputMode.hs
@@ -9,26 +9,17 @@ module Termbox2.Bindings.Hs.Internal.InputMode
 where
 
 import Data.Bits ((.|.))
+import Data.Coerce (coerce)
 import Foreign.C.Types (CInt)
 import Termbox2.Bindings.C
 
 -- | The input mode.
 newtype Tb_input_mode
   = Tb_input_mode CInt
-  deriving stock (Eq)
-
-instance Show Tb_input_mode where
-  show mode
-    | mode == TB_INPUT_ALT = "TB_INPUT_ALT"
-    | mode == TB_INPUT_ESC = "TB_INPUT_ESC"
-    | mode == TB_INPUT_MOUSE = "TB_INPUT_MOUSE"
-    | mode == TB_INPUT_ALT <> TB_INPUT_MOUSE = "TB_INPUT_ALT <> TB_INPUT_MOUSE"
-    | mode == TB_INPUT_ESC <> TB_INPUT_MOUSE = "TB_INPUT_ESC <> TB_INPUT_MOUSE"
-    | otherwise = "Tb_input_mode " ++ show mode
+  deriving stock (Eq, Show)
 
 instance Semigroup Tb_input_mode where
-  Tb_input_mode x <> Tb_input_mode y =
-    Tb_input_mode (x .|. y)
+  (<>) = coerce ((.|.) :: CInt -> CInt -> CInt)
 
 pattern TB_INPUT_ALT :: Tb_input_mode
 pattern TB_INPUT_ALT <-
diff --git a/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/OutputMode.hs b/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/OutputMode.hs
new file mode 100644
index 0000000..de4205a
--- /dev/null
+++ b/termbox2-bindings-hs/src/Termbox2/Bindings/Hs/Internal/OutputMode.hs
@@ -0,0 +1,58 @@
+module Termbox2.Bindings.Hs.Internal.OutputMode
+  ( Tb_output_mode
+      ( Tb_output_mode,
+        TB_OUTPUT_216,
+        TB_OUTPUT_256,
+        TB_OUTPUT_GRAYSCALE,
+        TB_OUTPUT_NORMAL,
+        TB_OUTPUT_TRUECOLOR
+      ),
+  )
+where
+
+import Foreign.C.Types (CInt)
+import Termbox2.Bindings.C
+
+-- | The output mode.
+newtype Tb_output_mode
+  = Tb_output_mode CInt
+  deriving stock (Eq)
+
+instance Show Tb_output_mode where
+  show = \case
+    TB_OUTPUT_216 -> "TB_OUTPUT_216"
+    TB_OUTPUT_256 -> "TB_OUTPUT_256"
+    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 <-
+  ((== Tb_output_mode _TB_OUTPUT_216) -> True)
+  where
+    TB_OUTPUT_216 = Tb_output_mode _TB_OUTPUT_216
+
+pattern TB_OUTPUT_256 :: Tb_output_mode
+pattern TB_OUTPUT_256 <-
+  ((== Tb_output_mode _TB_OUTPUT_256) -> True)
+  where
+    TB_OUTPUT_256 = Tb_output_mode _TB_OUTPUT_256
+
+pattern TB_OUTPUT_GRAYSCALE :: Tb_output_mode
+pattern TB_OUTPUT_GRAYSCALE <-
+  ((== Tb_output_mode _TB_OUTPUT_GRAYSCALE) -> True)
+  where
+    TB_OUTPUT_GRAYSCALE = Tb_output_mode _TB_OUTPUT_GRAYSCALE
+
+pattern TB_OUTPUT_NORMAL :: Tb_output_mode
+pattern TB_OUTPUT_NORMAL <-
+  ((== Tb_output_mode _TB_OUTPUT_NORMAL) -> True)
+  where
+    TB_OUTPUT_NORMAL = Tb_output_mode _TB_OUTPUT_NORMAL
+
+pattern TB_OUTPUT_TRUECOLOR :: Tb_output_mode
+pattern TB_OUTPUT_TRUECOLOR <-
+  ((== Tb_output_mode _TB_OUTPUT_TRUECOLOR) -> True)
+  where
+    TB_OUTPUT_TRUECOLOR = Tb_output_mode _TB_OUTPUT_TRUECOLOR
diff --git a/termbox2-bindings-hs/termbox2-bindings-hs.cabal b/termbox2-bindings-hs/termbox2-bindings-hs.cabal
index 87fe1a8..0569ba0 100644
--- a/termbox2-bindings-hs/termbox2-bindings-hs.cabal
+++ b/termbox2-bindings-hs/termbox2-bindings-hs.cabal
@@ -75,6 +75,7 @@ library
     Termbox2.Bindings.Hs.Internal.Functions
     Termbox2.Bindings.Hs.Internal.InputMode
     Termbox2.Bindings.Hs.Internal.Key
+    Termbox2.Bindings.Hs.Internal.OutputMode
     Termbox2.Bindings.Hs.Internal.Prelude
 
 -- executable termbox2-bindings-hs-example-demo