module Termbox.Internal.Image
  ( Image (..),
    char,
    at,
    atRow,
    atCol,
    fg,
    bg,
    bold,
    underline,
    blink,
  )
where

import qualified Data.Char as Char
import Foreign.C (CInt (..), CWchar (..))
import Termbox.Bindings.Hs (tb_change_cell)
import Termbox.Internal.Color (Color)
import Termbox.Internal.Pos (Pos (..))
import Termbox.Internal.Style (Style)
import qualified Termbox.Internal.Style as Style

-- | An image.
--
-- * Create an image with 'char'.
-- * Set an image's color with 'fg' \/ 'bg'.
-- * Style an image with 'bold' \/ 'underline' \/ 'blink'.
-- * Translate an image with 'at' \/ 'atRow' \/ 'atCol'.
-- * Overlay an image atop another with @(<>)@.
newtype Image
  = Image (Pos -> Style -> IO ())

instance Monoid Image where
  mempty :: Image
mempty = (Pos -> Style -> IO ()) -> Image
Image Pos -> Style -> IO ()
forall a. Monoid a => a
mempty

instance Semigroup Image where
  Image Pos -> Style -> IO ()
f <> :: Image -> Image -> Image
<> Image Pos -> Style -> IO ()
g =
    (Pos -> Style -> IO ()) -> Image
Image \Pos
pos Style
style -> do
      Pos -> Style -> IO ()
f Pos
pos Style
style
      Pos -> Style -> IO ()
g Pos
pos Style
style

-- | Create an image from a character.
--
-- If the character is not 1 character wide, it will not be displayed.
char :: Char -> Image
char :: Char -> Image
char Char
ch =
  (Pos -> Style -> IO ()) -> Image
Image \Pos {Int
row :: Int
$sel:row:Pos :: Pos -> Int
row, Int
col :: Int
$sel:col:Pos :: Pos -> Int
col} Style
style ->
    Int -> Int -> Char -> Tb_color -> Tb_color -> IO ()
tb_change_cell
      Int
col
      Int
row
      (if CWchar -> CInt
wcwidth (Char -> CWchar
charToCWchar Char
ch) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1 then Char
ch else Char
' ')
      (Style -> Tb_color
Style.asForeground Style
style)
      (Style -> Tb_color
Style.asBackground Style
style)

-- | Translate an image.
at :: Pos -> Image -> Image
at :: Pos -> Image -> Image
at Pos
offset (Image Pos -> Style -> IO ()
draw) =
  (Pos -> Style -> IO ()) -> Image
Image \Pos
pos -> Pos -> Style -> IO ()
draw (Pos
pos Pos -> Pos -> Pos
forall a. Semigroup a => a -> a -> a
<> Pos
offset)

-- | Translate an image by a number of rows.
atRow :: Int -> Image -> Image
atRow :: Int -> Image -> Image
atRow Int
row =
  Pos -> Image -> Image
at (Int -> Int -> Pos
Pos Int
row Int
0)

-- | Translate an image by a number of columns.
atCol :: Int -> Image -> Image
atCol :: Int -> Image -> Image
atCol Int
col =
  Pos -> Image -> Image
at (Int -> Int -> Pos
Pos Int
0 Int
col)

styled :: Style -> Image -> Image
styled :: Style -> Image -> Image
styled Style
overrides (Image Pos -> Style -> IO ()
draw) =
  (Pos -> Style -> IO ()) -> Image
Image \Pos
pos Style
style -> Pos -> Style -> IO ()
draw Pos
pos (Style
overrides Style -> Style -> Style
forall a. Semigroup a => a -> a -> a
<> Style
style)

-- | Set the foreground color of an image.
fg :: Color -> Image -> Image
fg :: Color -> Image -> Image
fg =
  Style -> Image -> Image
styled (Style -> Image -> Image)
-> (Color -> Style) -> Color -> Image -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Style
Style.fg

-- | Set the background color of an image.
bg :: Color -> Image -> Image
bg :: Color -> Image -> Image
bg =
  Style -> Image -> Image
styled (Style -> Image -> Image)
-> (Color -> Style) -> Color -> Image -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Style
Style.bg

-- | Make an image bold.
bold :: Image -> Image
bold :: Image -> Image
bold =
  Style -> Image -> Image
styled Style
Style.bold

-- | Make an image underlined.
underline :: Image -> Image
underline :: Image -> Image
underline =
  Style -> Image -> Image
styled Style
Style.underline

-- | Make an image blink.
blink :: Image -> Image
blink :: Image -> Image
blink =
  Style -> Image -> Image
styled Style
Style.blink

charToCWchar :: Char -> CWchar
charToCWchar :: Char -> CWchar
charToCWchar =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CWchar (Int -> CWchar) -> (Char -> Int) -> Char -> 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