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

import Data.Bits ((.|.))
import Data.Coerce (coerce)
import Data.Word (Word16)
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
import Termbox.Bindings.Hs.Internal.Attr (Tb_attr (..))
import Termbox.Bindings.Hs.Internal.Cell (Tb_cell, cellToCCell)
import Termbox.Bindings.Hs.Internal.Color (Tb_color (..))
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 the attribute of a color.
tb_attr :: Tb_attr -> Tb_color -> Tb_color
tb_attr :: Tb_attr -> Tb_color -> Tb_color
tb_attr =
  (Word16 -> Word16 -> Word16) -> Tb_attr -> Tb_color -> Tb_color
forall a b. Coercible a b => a -> b
coerce (Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
(.|.) :: Word16 -> Word16 -> Word16)

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

-- | 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.Bindings.C.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.Bindings.C.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.Bindings.C.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.Bindings.C.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.Bindings.C.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.Bindings.C.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.Bindings.C.tb_put_cell (Int -> CInt
intToCInt Int
cx) (Int -> CInt
intToCInt Int
cy) Ptr Tb_cell
c_cell

-- | Get\/set the input mode.
tb_select_input_mode :: Tb_input_mode -> IO Tb_input_mode
tb_select_input_mode :: Tb_input_mode -> IO Tb_input_mode
tb_select_input_mode =
  (CInt -> IO CInt) -> Tb_input_mode -> IO Tb_input_mode
forall a b. Coercible a b => a -> b
coerce CInt -> IO CInt
Termbox.Bindings.C.tb_select_input_mode

-- | Get\/set the output mode.
tb_select_output_mode :: Tb_output_mode -> IO Tb_output_mode
tb_select_output_mode :: Tb_output_mode -> IO Tb_output_mode
tb_select_output_mode =
  (CInt -> IO CInt) -> Tb_output_mode -> IO Tb_output_mode
forall a b. Coercible a b => a -> b
coerce CInt -> IO CInt
Termbox.Bindings.C.tb_select_output_mode

-- | Set the foreground and background attributes that 'tb_clear' clears the back buffer with.
tb_set_clear_attributes ::
  -- | fg
  Tb_color ->
  -- | bg
  Tb_color ->
  IO ()
tb_set_clear_attributes :: Tb_color -> Tb_color -> IO ()
tb_set_clear_attributes (Tb_color Word16
foreground) (Tb_color Word16
background) =
  Word16 -> Word16 -> IO ()
Termbox.Bindings.C.tb_set_clear_attributes Word16
foreground Word16
background

-- | Set the cursor location, or hide it.
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.Bindings.C.tb_set_cursor CInt
Termbox.Bindings.C._TB_HIDE_CURSOR CInt
Termbox.Bindings.C._TB_HIDE_CURSOR
  Just (Int
cx, Int
cy) -> CInt -> CInt -> IO ()
Termbox.Bindings.C.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.Bindings.C.tb_width