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
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
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)
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)
atRow :: Int -> Image -> Image
atRow :: Int -> Image -> Image
atRow Int
row =
Pos -> Image -> Image
at (Int -> Int -> Pos
Pos Int
row Int
0)
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)
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
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
bold :: Image -> Image
bold :: Image -> Image
bold =
Style -> Image -> Image
styled Style
Style.bold
underline :: Image -> Image
underline :: Image -> Image
underline =
Style -> Image -> Image
styled Style
Style.underline
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