module Termbox.Internal.Cell
  ( -- * Cell
    Cell,
    drawCell,
    char,

    -- ** Color
    fg,
    bg,

    -- ** Style
    bold,
    underline,
    blink,
  )
where

import qualified Data.Char as Char
import Data.String (IsString (..))
import Foreign.C.Types (CInt (CInt), CWchar (CWchar))
import qualified Termbox.Bindings.Hs
import Termbox.Internal.Color (Color (Color))

-- | A single cell.
--
-- * Create a cell with 'char', or with a string literal.
-- * Set a cell's color with 'fg', 'bg'.
-- * Style a cell with 'bold', 'underline', 'blink'.
data Cell
  = CellFg
      {-# UNPACK #-} !Char -- invariant: char is width 1
      {-# UNPACK #-} !Termbox.Bindings.Hs.Tb_color -- fg
  | CellFgBlink
      {-# UNPACK #-} !Char -- invariant: char is width 1
      {-# UNPACK #-} !Termbox.Bindings.Hs.Tb_color -- fg
  | CellFgBg
      {-# UNPACK #-} !Char -- invariant: char is width 1
      {-# UNPACK #-} !Termbox.Bindings.Hs.Tb_color -- fg
      {-# UNPACK #-} !Termbox.Bindings.Hs.Tb_color -- bg

instance {-# OVERLAPS #-} IsString [Cell] where
  fromString :: String -> [Cell]
fromString =
    forall a b. (a -> b) -> [a] -> [b]
map Char -> Cell
char

drawCell :: Termbox.Bindings.Hs.Tb_color -> Int -> Int -> Cell -> IO ()
drawCell :: Tb_color -> Int -> Int -> Cell -> IO ()
drawCell Tb_color
bg0 Int
col Int
row = \case
  CellFg Char
ch Tb_color
fg_ -> Int -> Int -> Char -> Tb_color -> Tb_color -> IO ()
Termbox.Bindings.Hs.tb_change_cell Int
col Int
row Char
ch Tb_color
fg_ Tb_color
bg0
  CellFgBlink Char
ch Tb_color
fg_ -> Int -> Int -> Char -> Tb_color -> Tb_color -> IO ()
Termbox.Bindings.Hs.tb_change_cell Int
col Int
row Char
ch Tb_color
fg_ (Tb_color -> Tb_color
makeBold Tb_color
bg0) -- bold background = blink
  CellFgBg Char
ch Tb_color
fg_ Tb_color
bg_ -> Int -> Int -> Char -> Tb_color -> Tb_color -> IO ()
Termbox.Bindings.Hs.tb_change_cell Int
col Int
row Char
ch Tb_color
fg_ Tb_color
bg_

-- | Create a cell from a character.
--
-- If the character is not 1 character wide, it will not be displayed.
char :: Char -> Cell
char :: Char -> Cell
char Char
ch =
  Char -> Tb_color -> Cell
CellFg (if CWchar -> CInt
wcwidth (Char -> CWchar
charToCWchar Char
ch) forall a. Eq a => a -> a -> Bool
== CInt
1 then Char
ch else Char
' ') Tb_color
Termbox.Bindings.Hs.TB_DEFAULT

-- | Set the foreground color of a cell.
fg :: Color -> Cell -> Cell
fg :: Color -> Cell -> Cell
fg (Color Tb_color
color) = \case
  CellFg Char
ch Tb_color
_ -> Char -> Tb_color -> Cell
CellFg Char
ch Tb_color
color
  CellFgBlink Char
ch Tb_color
_ -> Char -> Tb_color -> Cell
CellFgBlink Char
ch Tb_color
color
  CellFgBg Char
ch Tb_color
_ Tb_color
bg_ -> Char -> Tb_color -> Tb_color -> Cell
CellFgBg Char
ch Tb_color
color Tb_color
bg_

-- | Set the background color of a cell.
bg :: Color -> Cell -> Cell
bg :: Color -> Cell -> Cell
bg (Color Tb_color
color) = \case
  CellFg Char
ch Tb_color
fg_ -> Char -> Tb_color -> Tb_color -> Cell
CellFgBg Char
ch Tb_color
fg_ Tb_color
color
  CellFgBlink Char
ch Tb_color
fg_ -> Char -> Tb_color -> Tb_color -> Cell
CellFgBg Char
ch Tb_color
fg_ (Tb_color -> Tb_color
makeBold Tb_color
color) -- bold background = blink
  CellFgBg Char
ch Tb_color
fg_ Tb_color
_ -> Char -> Tb_color -> Tb_color -> Cell
CellFgBg Char
ch Tb_color
fg_ Tb_color
color

-- | Make a cell bold.
bold :: Cell -> Cell
bold :: Cell -> Cell
bold = \case
  CellFg Char
ch Tb_color
fg_ -> Char -> Tb_color -> Cell
CellFg Char
ch (Tb_color -> Tb_color
makeBold Tb_color
fg_)
  CellFgBlink Char
ch Tb_color
fg_ -> Char -> Tb_color -> Cell
CellFgBlink Char
ch (Tb_color -> Tb_color
makeBold Tb_color
fg_)
  CellFgBg Char
ch Tb_color
fg_ Tb_color
bg_ -> Char -> Tb_color -> Tb_color -> Cell
CellFgBg Char
ch (Tb_color -> Tb_color
makeBold Tb_color
fg_) Tb_color
bg_

-- | Make a cell underlined.
underline :: Cell -> Cell
underline :: Cell -> Cell
underline = \case
  CellFg Char
ch Tb_color
fg_ -> Char -> Tb_color -> Cell
CellFg Char
ch (Tb_color -> Tb_color
makeUnderline Tb_color
fg_)
  CellFgBlink Char
ch Tb_color
fg_ -> Char -> Tb_color -> Cell
CellFgBlink Char
ch (Tb_color -> Tb_color
makeUnderline Tb_color
fg_)
  CellFgBg Char
ch Tb_color
fg_ Tb_color
bg_ -> Char -> Tb_color -> Tb_color -> Cell
CellFgBg Char
ch (Tb_color -> Tb_color
makeUnderline Tb_color
fg_) Tb_color
bg_

-- | Make a cell blink.
blink :: Cell -> Cell
blink :: Cell -> Cell
blink = \case
  CellFg Char
ch Tb_color
fg_ -> Char -> Tb_color -> Cell
CellFgBlink Char
ch Tb_color
fg_
  CellFgBlink Char
ch Tb_color
fg_ -> Char -> Tb_color -> Cell
CellFgBlink Char
ch Tb_color
fg_
  CellFgBg Char
ch Tb_color
fg_ Tb_color
bg_ -> Char -> Tb_color -> Tb_color -> Cell
CellFgBg Char
ch Tb_color
fg_ (Tb_color -> Tb_color
makeBold Tb_color
bg_) -- bold background = blink

makeBold :: Termbox.Bindings.Hs.Tb_color -> Termbox.Bindings.Hs.Tb_color
makeBold :: Tb_color -> Tb_color
makeBold =
  Tb_attr -> Tb_color -> Tb_color
Termbox.Bindings.Hs.tb_attr Tb_attr
Termbox.Bindings.Hs.TB_BOLD

makeUnderline :: Termbox.Bindings.Hs.Tb_color -> Termbox.Bindings.Hs.Tb_color
makeUnderline :: Tb_color -> Tb_color
makeUnderline =
  Tb_attr -> Tb_color -> Tb_color
Termbox.Bindings.Hs.tb_attr Tb_attr
Termbox.Bindings.Hs.TB_UNDERLINE

charToCWchar :: Char -> CWchar
charToCWchar :: Char -> CWchar
charToCWchar =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CWchar forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
Char.ord

foreign import capi unsafe "wchar.h wcwidth"
  wcwidth :: CWchar -> CInt