module Termbox.Bindings.Hs.Internal.Cell
  ( Tb_cell (..),
    cellToCCell,
  )
where

import GHC.Generics (Generic)
import qualified Termbox.Bindings.C as Termbox
import Termbox.Bindings.Hs.Internal.Attrs (Tb_attrs (..))
import Termbox.Bindings.Hs.Internal.Prelude (charToWord32)

-- | A cell.
data Tb_cell = Tb_cell
  { -- | A unicode character.
    Tb_cell -> Char
ch :: {-# UNPACK #-} !Char,
    -- | Foreground attributes.
    Tb_cell -> Tb_attrs
fg :: {-# UNPACK #-} !Tb_attrs,
    -- | Background attributes.
    Tb_cell -> Tb_attrs
bg :: {-# UNPACK #-} !Tb_attrs
  }
  deriving stock (Tb_cell -> Tb_cell -> Bool
(Tb_cell -> Tb_cell -> Bool)
-> (Tb_cell -> Tb_cell -> Bool) -> Eq Tb_cell
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tb_cell -> Tb_cell -> Bool
== :: Tb_cell -> Tb_cell -> Bool
$c/= :: Tb_cell -> Tb_cell -> Bool
/= :: Tb_cell -> Tb_cell -> Bool
Eq, (forall x. Tb_cell -> Rep Tb_cell x)
-> (forall x. Rep Tb_cell x -> Tb_cell) -> Generic Tb_cell
forall x. Rep Tb_cell x -> Tb_cell
forall x. Tb_cell -> Rep Tb_cell x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Tb_cell -> Rep Tb_cell x
from :: forall x. Tb_cell -> Rep Tb_cell x
$cto :: forall x. Rep Tb_cell x -> Tb_cell
to :: forall x. Rep Tb_cell x -> Tb_cell
Generic, Int -> Tb_cell -> ShowS
[Tb_cell] -> ShowS
Tb_cell -> String
(Int -> Tb_cell -> ShowS)
-> (Tb_cell -> String) -> ([Tb_cell] -> ShowS) -> Show Tb_cell
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tb_cell -> ShowS
showsPrec :: Int -> Tb_cell -> ShowS
$cshow :: Tb_cell -> String
show :: Tb_cell -> String
$cshowList :: [Tb_cell] -> ShowS
showList :: [Tb_cell] -> ShowS
Show)

cellToCCell :: Tb_cell -> Termbox.Tb_cell
cellToCCell :: Tb_cell -> Tb_cell
cellToCCell Tb_cell {Char
$sel:ch:Tb_cell :: Tb_cell -> Char
ch :: Char
ch, $sel:fg:Tb_cell :: Tb_cell -> Tb_attrs
fg = Tb_attrs Word16
fg, $sel:bg:Tb_cell :: Tb_cell -> Tb_attrs
bg = Tb_attrs Word16
bg} =
  Termbox.Tb_cell
    { $sel:ch:Tb_cell :: Word32
ch = Char -> Word32
charToWord32 Char
ch,
      Word16
fg :: Word16
$sel:fg:Tb_cell :: Word16
fg,
      Word16
bg :: Word16
$sel:bg:Tb_cell :: Word16
bg
    }
{-# INLINE cellToCCell #-}