module Termbox.Internal.Color
  ( -- * Color
    Color (..),
    defaultColor,
    red,
    green,
    yellow,
    blue,
    magenta,
    cyan,
    white,
    bright,
    color,
    gray,

    -- * MaybeColor
    MaybeColor,
    unMaybeColor,
    nothingColor,
    justColor,
  )
where

import Data.Coerce (coerce)
import Data.Word (Word16)
import Termbox.Bindings.Hs

-- | A color.
--
-- There are three classes of colors:
--
-- * Basic named colors and their bright variants, such as 'red' and 'bright' 'blue'.
-- * Miscellaneous colors, such as @'color' 33@.
-- * Monochrome colors that range from black (@'gray' 0@) to white (@'gray' 23@).
newtype Color
  = Color Tb_color
  deriving newtype (Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
/= :: Color -> Color -> Bool
Eq)

defaultColor :: Color
defaultColor :: Color
defaultColor =
  Tb_color -> Color
Color Tb_color
0

red :: Color
red :: Color
red =
  Tb_color -> Color
Color Tb_color
1

green :: Color
green :: Color
green =
  Tb_color -> Color
Color Tb_color
2

yellow :: Color
yellow :: Color
yellow =
  Tb_color -> Color
Color Tb_color
3

blue :: Color
blue :: Color
blue =
  Tb_color -> Color
Color Tb_color
4

magenta :: Color
magenta :: Color
magenta =
  Tb_color -> Color
Color Tb_color
5

cyan :: Color
cyan :: Color
cyan =
  Tb_color -> Color
Color Tb_color
6

white :: Color
white :: Color
white =
  Tb_color -> Color
Color Tb_color
7

-- | Make a basic color bright.
bright :: Color -> Color
bright :: Color -> Color
bright =
  (Tb_color -> Tb_color) -> Color -> Color
forall a b. Coercible a b => a -> b
coerce Tb_color -> Tb_color
bright_

bright_ :: Tb_color -> Tb_color
bright_ :: Tb_color -> Tb_color
bright_ Tb_color
c
  | Tb_color
c Tb_color -> Tb_color -> Bool
forall a. Ord a => a -> a -> Bool
<= Tb_color
7 = Tb_color
c Tb_color -> Tb_color -> Tb_color
forall a. Num a => a -> a -> a
+ Tb_color
8
  | Bool
otherwise = Tb_color
c

-- | A miscellaneous color.
--
-- Valid values are in the range @[0, 215]@; values outside of this range are clamped.
color :: Int -> Color
color :: Int -> Color
color =
  (Int -> Word16) -> Int -> Color
forall a b. Coercible a b => a -> b
coerce (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word16 (Int -> Word16) -> (Int -> Int) -> Int -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
215)

-- | A monochrome color; black is 0 and white is 23.
--
-- Valid values are in the range @[0, 23]@; values outside of this range are clamped.
gray :: Int -> Color
gray :: Int -> Color
gray =
  (Int -> Word16) -> Int -> Color
forall a b. Coercible a b => a -> b
coerce (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word16 (Int -> Word16) -> (Int -> Int) -> Int -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
232) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
23)

-- This is a more efficient `Maybe Color`; we represent Nothing by WORD_MAX (which isn't a valid termbox color)
newtype MaybeColor
  = MaybeColor Color
  deriving stock (MaybeColor -> MaybeColor -> Bool
(MaybeColor -> MaybeColor -> Bool)
-> (MaybeColor -> MaybeColor -> Bool) -> Eq MaybeColor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaybeColor -> MaybeColor -> Bool
== :: MaybeColor -> MaybeColor -> Bool
$c/= :: MaybeColor -> MaybeColor -> Bool
/= :: MaybeColor -> MaybeColor -> Bool
Eq)

unMaybeColor :: MaybeColor -> Tb_color
unMaybeColor :: MaybeColor -> Tb_color
unMaybeColor (MaybeColor (Color (Tb_color Word16
c)))
  | Word16
c Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
forall a. Bounded a => a
maxBound = Tb_color
TB_DEFAULT
  | Bool
otherwise = Word16 -> Tb_color
Tb_color Word16
c

nothingColor :: MaybeColor
nothingColor :: MaybeColor
nothingColor =
  Color -> MaybeColor
MaybeColor (Tb_color -> Color
Color (Word16 -> Tb_color
Tb_color Word16
forall a. Bounded a => a
maxBound))

justColor :: Color -> MaybeColor
justColor :: Color -> MaybeColor
justColor =
  Color -> MaybeColor
MaybeColor