module Termbox.Internal.Style
( Style,
asForeground,
asBackground,
maybeFill,
fg,
bg,
bold,
underline,
blink,
)
where
import Termbox.Bindings.Hs hiding (bg, fg)
import Termbox.Internal.Color (Color, MaybeColor, justColor, nothingColor, unMaybeColor)
data Style = Style
{ Style -> ColorAndAttrs
foreground :: {-# UNPACK #-} !ColorAndAttrs,
Style -> ColorAndAttrs
background :: {-# UNPACK #-} !ColorAndAttrs
}
instance Monoid Style where
mempty :: Style
mempty =
ColorAndAttrs -> ColorAndAttrs -> Style
Style ColorAndAttrs
forall a. Monoid a => a
mempty ColorAndAttrs
forall a. Monoid a => a
mempty
instance Semigroup Style where
Style ColorAndAttrs
a1 ColorAndAttrs
b1 <> :: Style -> Style -> Style
<> Style ColorAndAttrs
a2 ColorAndAttrs
b2 =
ColorAndAttrs -> ColorAndAttrs -> Style
Style (ColorAndAttrs
a2 ColorAndAttrs -> ColorAndAttrs -> ColorAndAttrs
forall a. Semigroup a => a -> a -> a
<> ColorAndAttrs
a1) (ColorAndAttrs
b2 ColorAndAttrs -> ColorAndAttrs -> ColorAndAttrs
forall a. Semigroup a => a -> a -> a
<> ColorAndAttrs
b1)
asForeground :: Style -> Tb_attrs
asForeground :: Style -> Tb_attrs
asForeground Style {ColorAndAttrs
$sel:foreground:Style :: Style -> ColorAndAttrs
foreground :: ColorAndAttrs
foreground} =
ColorAndAttrs -> Tb_attrs
renderColorAndAttr ColorAndAttrs
foreground
asBackground :: Style -> Tb_attrs
asBackground :: Style -> Tb_attrs
asBackground Style {ColorAndAttrs
$sel:background:Style :: Style -> ColorAndAttrs
background :: ColorAndAttrs
background} =
ColorAndAttrs -> Tb_attrs
renderColorAndAttr ColorAndAttrs
background
onlyForeground :: ColorAndAttrs -> Style
onlyForeground :: ColorAndAttrs -> Style
onlyForeground ColorAndAttrs
style =
Style
forall a. Monoid a => a
mempty {foreground = style}
onlyBackground :: ColorAndAttrs -> Style
onlyBackground :: ColorAndAttrs -> Style
onlyBackground ColorAndAttrs
style =
Style
forall a. Monoid a => a
mempty {background = style}
maybeFill :: MaybeColor -> Style
maybeFill :: MaybeColor -> Style
maybeFill MaybeColor
color =
ColorAndAttrs -> Style
onlyBackground ColorAndAttrs {MaybeColor
color :: MaybeColor
$sel:color:ColorAndAttrs :: MaybeColor
color, $sel:attrs:ColorAndAttrs :: Tb_attrs
attrs = Tb_attrs
forall a. Monoid a => a
mempty}
fg :: Color -> Style
fg :: Color -> Style
fg =
ColorAndAttrs -> Style
onlyForeground (ColorAndAttrs -> Style)
-> (Color -> ColorAndAttrs) -> Color -> Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> ColorAndAttrs
onlyColor
bg :: Color -> Style
bg :: Color -> Style
bg =
ColorAndAttrs -> Style
onlyBackground (ColorAndAttrs -> Style)
-> (Color -> ColorAndAttrs) -> Color -> Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> ColorAndAttrs
onlyColor
bold :: Style
bold :: Style
bold =
ColorAndAttrs -> Style
onlyForeground (Tb_attrs -> ColorAndAttrs
onlyAttr Tb_attrs
_TB_BOLD)
underline :: Style
underline :: Style
underline =
ColorAndAttrs -> Style
onlyForeground (Tb_attrs -> ColorAndAttrs
onlyAttr Tb_attrs
_TB_UNDERLINE)
blink :: Style
blink :: Style
blink =
ColorAndAttrs -> Style
onlyBackground (Tb_attrs -> ColorAndAttrs
onlyAttr Tb_attrs
_TB_BOLD)
data ColorAndAttrs = ColorAndAttrs
{ ColorAndAttrs -> MaybeColor
color :: {-# UNPACK #-} !MaybeColor,
ColorAndAttrs -> Tb_attrs
attrs :: {-# UNPACK #-} !Tb_attrs
}
instance Monoid ColorAndAttrs where
mempty :: ColorAndAttrs
mempty =
MaybeColor -> Tb_attrs -> ColorAndAttrs
ColorAndAttrs MaybeColor
nothingColor Tb_attrs
forall a. Monoid a => a
mempty
instance Semigroup ColorAndAttrs where
ColorAndAttrs MaybeColor
color1 Tb_attrs
attr1 <> :: ColorAndAttrs -> ColorAndAttrs -> ColorAndAttrs
<> ColorAndAttrs MaybeColor
color2 Tb_attrs
attr2 =
MaybeColor -> Tb_attrs -> ColorAndAttrs
ColorAndAttrs
(if MaybeColor
color2 MaybeColor -> MaybeColor -> Bool
forall a. Eq a => a -> a -> Bool
== MaybeColor
nothingColor then MaybeColor
color1 else MaybeColor
color2)
(Tb_attrs
attr1 Tb_attrs -> Tb_attrs -> Tb_attrs
forall a. Semigroup a => a -> a -> a
<> Tb_attrs
attr2)
renderColorAndAttr :: ColorAndAttrs -> Tb_attrs
renderColorAndAttr :: ColorAndAttrs -> Tb_attrs
renderColorAndAttr ColorAndAttrs {MaybeColor
$sel:color:ColorAndAttrs :: ColorAndAttrs -> MaybeColor
color :: MaybeColor
color, Tb_attrs
$sel:attrs:ColorAndAttrs :: ColorAndAttrs -> Tb_attrs
attrs :: Tb_attrs
attrs} =
Tb_attrs
attrs Tb_attrs -> Tb_attrs -> Tb_attrs
forall a. Semigroup a => a -> a -> a
<> MaybeColor -> Tb_attrs
unMaybeColor MaybeColor
color
onlyColor :: Color -> ColorAndAttrs
onlyColor :: Color -> ColorAndAttrs
onlyColor Color
color =
ColorAndAttrs
forall a. Monoid a => a
mempty {color = justColor color}
onlyAttr :: Tb_attrs -> ColorAndAttrs
onlyAttr :: Tb_attrs -> ColorAndAttrs
onlyAttr Tb_attrs
attrs =
ColorAndAttrs
forall a. Monoid a => a
mempty {attrs}