diff --git a/termbox-bindings-hs/CHANGELOG.md b/termbox-bindings-hs/CHANGELOG.md index b93ea78..851fa8e 100644 --- a/termbox-bindings-hs/CHANGELOG.md +++ b/termbox-bindings-hs/CHANGELOG.md @@ -2,6 +2,7 @@ - Rework `Tb_attr` and `Tb_color` into `Tb_color_and_attrs` - Rework `Tb_select_input_mode` and `Tb_input_mode` +- Rework `Tb_select_output_mode` and `Tb_output_mode` - Make `mod` field of `Tb_event` a `Maybe Tb_event_mod` rather than a `Tb_event_mod` - Make `Show` instance of `Tb_key` not call `error` on unknown keys - Hide representation of `Tb_event_mod` diff --git a/termbox-bindings-hs/src/Termbox/Bindings/Hs.hs b/termbox-bindings-hs/src/Termbox/Bindings/Hs.hs index cd4ed00..e0928df 100644 --- a/termbox-bindings-hs/src/Termbox/Bindings/Hs.hs +++ b/termbox-bindings-hs/src/Termbox/Bindings/Hs.hs @@ -16,8 +16,12 @@ module Termbox.Bindings.Hs tb_init_file, tb_shutdown, - -- ** Get or set input or output mode + -- ** Get or set input mode + tb_get_input_mode, tb_select_input_mode, + + -- ** Get or set output mode + tb_get_output_mode, tb_select_output_mode, -- ** Get terminal dimensions @@ -148,8 +152,7 @@ module Termbox.Bindings.Hs TB_KEY_TAB ), Tb_output_mode - ( TB_OUTPUT_CURRENT, - TB_OUTPUT_216, + ( TB_OUTPUT_216, TB_OUTPUT_256, TB_OUTPUT_GRAYSCALE, TB_OUTPUT_NORMAL @@ -179,6 +182,8 @@ import Termbox.Bindings.Hs.Internal.EventMod (Tb_event_mod (..)) import Termbox.Bindings.Hs.Internal.EventType (Tb_event_type (..)) import Termbox.Bindings.Hs.Internal.Functions ( tb_change_cell, + tb_get_input_mode, + tb_get_output_mode, tb_height, tb_init, tb_init_fd, diff --git a/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/Functions.hs b/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/Functions.hs index 65bc798..b665aa4 100644 --- a/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/Functions.hs +++ b/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/Functions.hs @@ -1,6 +1,7 @@ module Termbox.Bindings.Hs.Internal.Functions ( tb_change_cell, tb_get_input_mode, + tb_get_output_mode, tb_height, tb_init, tb_init_fd, @@ -53,6 +54,11 @@ tb_get_input_mode :: IO Tb_input_mode tb_get_input_mode = coerce Termbox.tb_select_input_mode Termbox._TB_INPUT_CURRENT +-- | Get the output mode. +tb_get_output_mode :: IO Tb_output_mode +tb_get_output_mode = + coerce Termbox.tb_select_output_mode Termbox._TB_OUTPUT_CURRENT + -- | Get the terminal height. tb_height :: IO Int tb_height = @@ -128,13 +134,13 @@ tb_put_cell cx cy cell = -- | Set the input mode. tb_select_input_mode :: Tb_input_mode -> IO () -tb_select_input_mode = - void . coerce @(CInt -> IO CInt) @(Tb_input_mode -> IO Tb_input_mode) Termbox.tb_select_input_mode +tb_select_input_mode (Tb_input_mode mode) = + void (Termbox.tb_select_input_mode mode) --- | Get or set the output mode. -tb_select_output_mode :: Tb_output_mode -> IO Tb_output_mode -tb_select_output_mode = - coerce Termbox.tb_select_output_mode +-- | Set the output mode. +tb_select_output_mode :: Tb_output_mode -> IO () +tb_select_output_mode (Tb_output_mode mode) = + void (Termbox.tb_select_output_mode mode) -- | Set the foreground and background attributes that 'tb_clear' clears the back buffer with. tb_set_clear_attributes :: diff --git a/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/InitError.hs b/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/InitError.hs index 3999aa1..45ef4de 100644 --- a/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/InitError.hs +++ b/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/InitError.hs @@ -15,8 +15,8 @@ import Termbox.Bindings.C (_TB_EFAILED_TO_OPEN_TTY, _TB_EPIPE_TRAP_ERROR, _TB_EU -- | A 'tb_init' error. newtype Tb_init_error = Tb_init_error CInt - deriving stock (Eq) deriving anyclass (Exception) + deriving stock (Eq) instance Show Tb_init_error where show = \case diff --git a/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/OutputMode.hs b/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/OutputMode.hs index 69e32fc..20fa882 100644 --- a/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/OutputMode.hs +++ b/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/OutputMode.hs @@ -1,7 +1,6 @@ module Termbox.Bindings.Hs.Internal.OutputMode ( Tb_output_mode ( Tb_output_mode, - TB_OUTPUT_CURRENT, TB_OUTPUT_216, TB_OUTPUT_256, TB_OUTPUT_GRAYSCALE, @@ -11,7 +10,12 @@ module Termbox.Bindings.Hs.Internal.OutputMode where import Foreign.C.Types (CInt) -import qualified Termbox.Bindings.C +import Termbox.Bindings.C + ( _TB_OUTPUT_216, + _TB_OUTPUT_256, + _TB_OUTPUT_GRAYSCALE, + _TB_OUTPUT_NORMAL, + ) -- | The output mode. newtype Tb_output_mode @@ -20,40 +24,34 @@ newtype Tb_output_mode instance Show Tb_output_mode where show = \case - TB_OUTPUT_CURRENT -> "TB_OUTPUT_CURRENT" TB_OUTPUT_216 -> "TB_OUTPUT_216" TB_OUTPUT_256 -> "TB_OUTPUT_256" TB_OUTPUT_GRAYSCALE -> "TB_OUTPUT_GRAYSCALE" TB_OUTPUT_NORMAL -> "TB_OUTPUT_NORMAL" -pattern TB_OUTPUT_CURRENT :: Tb_output_mode -pattern TB_OUTPUT_CURRENT <- - ((== Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_CURRENT) -> True) - where - TB_OUTPUT_CURRENT = Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_CURRENT - pattern TB_OUTPUT_216 :: Tb_output_mode pattern TB_OUTPUT_216 <- - ((== Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_216) -> True) + ((== Tb_output_mode _TB_OUTPUT_216) -> True) where - TB_OUTPUT_216 = Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_216 + TB_OUTPUT_216 = Tb_output_mode _TB_OUTPUT_216 pattern TB_OUTPUT_256 :: Tb_output_mode pattern TB_OUTPUT_256 <- - ((== Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_256) -> True) + ((== Tb_output_mode _TB_OUTPUT_256) -> True) where - TB_OUTPUT_256 = Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_256 + TB_OUTPUT_256 = Tb_output_mode _TB_OUTPUT_256 pattern TB_OUTPUT_GRAYSCALE :: Tb_output_mode pattern TB_OUTPUT_GRAYSCALE <- - ((== Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_GRAYSCALE) -> True) + ((== Tb_output_mode _TB_OUTPUT_GRAYSCALE) -> True) where - TB_OUTPUT_GRAYSCALE = Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_GRAYSCALE + TB_OUTPUT_GRAYSCALE = Tb_output_mode _TB_OUTPUT_GRAYSCALE pattern TB_OUTPUT_NORMAL :: Tb_output_mode pattern TB_OUTPUT_NORMAL <- - ((== Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_NORMAL) -> True) + ((== Tb_output_mode _TB_OUTPUT_NORMAL) -> True) where - TB_OUTPUT_NORMAL = Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_NORMAL + TB_OUTPUT_NORMAL = Tb_output_mode _TB_OUTPUT_NORMAL -{-# COMPLETE TB_OUTPUT_CURRENT, TB_OUTPUT_216, TB_OUTPUT_256, TB_OUTPUT_GRAYSCALE, TB_OUTPUT_NORMAL #-} +-- N.B. This requires Tb_output_mode to remain abstract +{-# COMPLETE TB_OUTPUT_216, TB_OUTPUT_256, TB_OUTPUT_GRAYSCALE, TB_OUTPUT_NORMAL #-} diff --git a/termbox/src/Termbox/Internal/Main.hs b/termbox/src/Termbox/Internal/Main.hs index ea492d7..a38cfcf 100644 --- a/termbox/src/Termbox/Internal/Main.hs +++ b/termbox/src/Termbox/Internal/Main.hs @@ -41,11 +41,11 @@ initialize = TB_EUNSUPPORTED_TERMINAL -> UnsupportedTerminal Right () -> do tb_select_input_mode _TB_INPUT_MOUSE - _ <- tb_select_output_mode TB_OUTPUT_256 + tb_select_output_mode TB_OUTPUT_256 pure (Right ()) -- | Shut down a @termbox@ program. finalize :: IO () finalize = do - _ <- tb_select_output_mode TB_OUTPUT_NORMAL + tb_select_output_mode TB_OUTPUT_NORMAL tb_shutdown