module Termbox.Bindings.Hs.Internal.Functions
  ( tb_change_cell,
    tb_get_input_mode,
    tb_get_output_mode,
    tb_height,
    tb_init,
    tb_init_fd,
    tb_init_file,
    tb_peek_event,
    tb_poll_event,
    tb_put_cell,
    tb_select_input_mode,
    tb_select_output_mode,
    tb_set_clear_attributes,
    tb_set_cursor,
    tb_width,
  )
where

import Data.Coerce (coerce)
import Data.Functor (void)
import Foreign.C (CInt (..))
import Foreign.C.String (withCString)
import Foreign.Marshal.Alloc (alloca)
import qualified Foreign.Storable as Storable
import System.Posix.Types (Fd (Fd))
import qualified Termbox.Bindings.C as Termbox
import Termbox.Bindings.Hs.Internal.Attrs (Tb_attrs (..))
import Termbox.Bindings.Hs.Internal.Cell (Tb_cell, cellToCCell)
import Termbox.Bindings.Hs.Internal.Event (Tb_event, ceventToEvent)
import Termbox.Bindings.Hs.Internal.InitError (Tb_init_error (..))
import Termbox.Bindings.Hs.Internal.InputMode (Tb_input_mode (..))
import Termbox.Bindings.Hs.Internal.OutputMode (Tb_output_mode (..))
import Termbox.Bindings.Hs.Internal.Prelude (charToWord32, cintToInt, intToCInt)

-- | Set a cell value in the back buffer.
tb_change_cell ::
  -- | x
  Int ->
  -- | y
  Int ->
  -- | ch
  Char ->
  -- | fg
  Tb_attrs ->
  -- | bg
  Tb_attrs ->
  IO ()
tb_change_cell :: Int -> Int -> Char -> Tb_attrs -> Tb_attrs -> IO ()
tb_change_cell Int
cx Int
cy Char
c (Tb_attrs Word16
foreground) (Tb_attrs Word16
background) =
  CInt -> CInt -> Word32 -> Word16 -> Word16 -> IO ()
Termbox.tb_change_cell (Int -> CInt
intToCInt Int
cx) (Int -> CInt
intToCInt Int
cy) (Char -> Word32
charToWord32 Char
c) Word16
foreground Word16
background

-- | Get the input mode.
tb_get_input_mode :: IO Tb_input_mode
tb_get_input_mode :: IO Tb_input_mode
tb_get_input_mode =
  (CInt -> IO CInt) -> CInt -> IO Tb_input_mode
forall a b. Coercible a b => a -> b
coerce CInt -> IO CInt
Termbox.tb_select_input_mode CInt
Termbox._TB_INPUT_CURRENT

-- | Get the output mode.
tb_get_output_mode :: IO Tb_output_mode
tb_get_output_mode :: IO Tb_output_mode
tb_get_output_mode =
  (CInt -> IO CInt) -> CInt -> IO Tb_output_mode
forall a b. Coercible a b => a -> b
coerce CInt -> IO CInt
Termbox.tb_select_output_mode CInt
Termbox._TB_OUTPUT_CURRENT

-- | Get the terminal height.
tb_height :: IO Int
tb_height :: IO Int
tb_height =
  CInt -> Int
cintToInt (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
Termbox.tb_height

-- | Initialize the @termbox@ library.
tb_init :: IO (Either Tb_init_error ())
tb_init :: IO (Either Tb_init_error ())
tb_init = do
  CInt
code <- IO CInt
Termbox.tb_init
  Either Tb_init_error () -> IO (Either Tb_init_error ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    if CInt
code CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
      then () -> Either Tb_init_error ()
forall a b. b -> Either a b
Right ()
      else Tb_init_error -> Either Tb_init_error ()
forall a b. a -> Either a b
Left (CInt -> Tb_init_error
Tb_init_error CInt
code)

-- | Initialize the @termbox@ library.
--
-- > tb_init = tb_init_fd(0)
tb_init_fd :: Fd -> IO (Either Tb_init_error ())
tb_init_fd :: Fd -> IO (Either Tb_init_error ())
tb_init_fd (Fd CInt
fd) = do
  CInt
code <- CInt -> IO CInt
Termbox.tb_init_fd CInt
fd
  Either Tb_init_error () -> IO (Either Tb_init_error ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    if CInt
code CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
      then () -> Either Tb_init_error ()
forall a b. b -> Either a b
Right ()
      else Tb_init_error -> Either Tb_init_error ()
forall a b. a -> Either a b
Left (CInt -> Tb_init_error
Tb_init_error CInt
code)

-- | Initialize the @termbox@ library.
--
-- > tb_init = tb_init_file("/dev/tty")
tb_init_file :: FilePath -> IO (Either Tb_init_error ())
tb_init_file :: FilePath -> IO (Either Tb_init_error ())
tb_init_file FilePath
file = do
  CInt
code <-
    FilePath -> (CString -> IO CInt) -> IO CInt
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
file \CString
c_file ->
      CString -> IO CInt
Termbox.tb_init_file CString
c_file
  Either Tb_init_error () -> IO (Either Tb_init_error ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    if CInt
code CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
      then () -> Either Tb_init_error ()
forall a b. b -> Either a b
Right ()
      else Tb_init_error -> Either Tb_init_error ()
forall a b. a -> Either a b
Left (CInt -> Tb_init_error
Tb_init_error CInt
code)

-- | Wait up to a number of milliseconds for an event.
tb_peek_event :: Int -> IO (Either () (Maybe Tb_event))
tb_peek_event :: Int -> IO (Either () (Maybe Tb_event))
tb_peek_event Int
timeout =
  (Ptr Tb_event -> IO (Either () (Maybe Tb_event)))
-> IO (Either () (Maybe Tb_event))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Tb_event
c_event -> do
    CInt
result <- Ptr Tb_event -> CInt -> IO CInt
Termbox.tb_peek_event Ptr Tb_event
c_event (Int -> CInt
intToCInt Int
timeout)
    if CInt
result CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
      then Either () (Maybe Tb_event) -> IO (Either () (Maybe Tb_event))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either () (Maybe Tb_event)
forall a b. a -> Either a b
Left ())
      else
        if CInt
result CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
          then Either () (Maybe Tb_event) -> IO (Either () (Maybe Tb_event))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Tb_event -> Either () (Maybe Tb_event)
forall a b. b -> Either a b
Right Maybe Tb_event
forall a. Maybe a
Nothing)
          else Maybe Tb_event -> Either () (Maybe Tb_event)
forall a b. b -> Either a b
Right (Maybe Tb_event -> Either () (Maybe Tb_event))
-> (Tb_event -> Maybe Tb_event)
-> Tb_event
-> Either () (Maybe Tb_event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tb_event -> Maybe Tb_event
forall a. a -> Maybe a
Just (Tb_event -> Maybe Tb_event)
-> (Tb_event -> Tb_event) -> Tb_event -> Maybe Tb_event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tb_event -> Tb_event
ceventToEvent (Tb_event -> Either () (Maybe Tb_event))
-> IO Tb_event -> IO (Either () (Maybe Tb_event))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Tb_event -> IO Tb_event
forall a. Storable a => Ptr a -> IO a
Storable.peek Ptr Tb_event
c_event

-- | Wait for an event.
tb_poll_event :: IO (Either () Tb_event)
tb_poll_event :: IO (Either () Tb_event)
tb_poll_event =
  (Ptr Tb_event -> IO (Either () Tb_event))
-> IO (Either () Tb_event)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Tb_event
c_event -> do
    CInt
result <- Ptr Tb_event -> IO CInt
Termbox.tb_poll_event Ptr Tb_event
c_event
    if CInt
result CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
      then Either () Tb_event -> IO (Either () Tb_event)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either () Tb_event
forall a b. a -> Either a b
Left ())
      else Tb_event -> Either () Tb_event
forall a b. b -> Either a b
Right (Tb_event -> Either () Tb_event)
-> (Tb_event -> Tb_event) -> Tb_event -> Either () Tb_event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tb_event -> Tb_event
ceventToEvent (Tb_event -> Either () Tb_event)
-> IO Tb_event -> IO (Either () Tb_event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Tb_event -> IO Tb_event
forall a. Storable a => Ptr a -> IO a
Storable.peek Ptr Tb_event
c_event

-- | Set a cell value in the back buffer.
tb_put_cell ::
  -- | x
  Int ->
  -- | y
  Int ->
  -- | cell
  Tb_cell ->
  IO ()
tb_put_cell :: Int -> Int -> Tb_cell -> IO ()
tb_put_cell Int
cx Int
cy Tb_cell
cell =
  (Ptr Tb_cell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Tb_cell
c_cell -> do
    Ptr Tb_cell -> Tb_cell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
Storable.poke Ptr Tb_cell
c_cell (Tb_cell -> Tb_cell
cellToCCell Tb_cell
cell)
    CInt -> CInt -> Ptr Tb_cell -> IO ()
Termbox.tb_put_cell (Int -> CInt
intToCInt Int
cx) (Int -> CInt
intToCInt Int
cy) Ptr Tb_cell
c_cell

-- | Set the input mode.
tb_select_input_mode :: Tb_input_mode -> IO ()
tb_select_input_mode :: Tb_input_mode -> IO ()
tb_select_input_mode (Tb_input_mode CInt
mode) =
  IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CInt -> IO CInt
Termbox.tb_select_input_mode CInt
mode)

-- | Set the output mode.
tb_select_output_mode :: Tb_output_mode -> IO ()
tb_select_output_mode :: Tb_output_mode -> IO ()
tb_select_output_mode (Tb_output_mode CInt
mode) =
  IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CInt -> IO CInt
Termbox.tb_select_output_mode CInt
mode)

-- | Set the foreground and background attributes that 'tb_clear' clears the back buffer with.
tb_set_clear_attributes ::
  -- | fg
  Tb_attrs ->
  -- | bg
  Tb_attrs ->
  IO ()
tb_set_clear_attributes :: Tb_attrs -> Tb_attrs -> IO ()
tb_set_clear_attributes =
  (Word16 -> Word16 -> IO ()) -> Tb_attrs -> Tb_attrs -> IO ()
forall a b. Coercible a b => a -> b
coerce Word16 -> Word16 -> IO ()
Termbox.tb_set_clear_attributes

-- | Set or hide the cursor location.
tb_set_cursor ::
  -- | x, y
  Maybe (Int, Int) ->
  IO ()
tb_set_cursor :: Maybe (Int, Int) -> IO ()
tb_set_cursor = \case
  Maybe (Int, Int)
Nothing -> CInt -> CInt -> IO ()
Termbox.tb_set_cursor CInt
Termbox._TB_HIDE_CURSOR CInt
Termbox._TB_HIDE_CURSOR
  Just (Int
cx, Int
cy) -> CInt -> CInt -> IO ()
Termbox.tb_set_cursor (Int -> CInt
intToCInt Int
cx) (Int -> CInt
intToCInt Int
cy)

-- | Get the terminal width.
tb_width :: IO Int
tb_width :: IO Int
tb_width =
  CInt -> Int
cintToInt (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
Termbox.tb_width