-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Preserve color fidelity for non-TUI rendering
module Swarm.Game.Entity.Cosmetic where

import Data.Colour.SRGB (RGB)
import Data.Word (Word8)

data NamedColor
  = White
  | BrightRed
  | Red
  | Green
  | Blue
  | BrightYellow
  | Yellow
  deriving (Int -> NamedColor -> ShowS
[NamedColor] -> ShowS
NamedColor -> String
(Int -> NamedColor -> ShowS)
-> (NamedColor -> String)
-> ([NamedColor] -> ShowS)
-> Show NamedColor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NamedColor -> ShowS
showsPrec :: Int -> NamedColor -> ShowS
$cshow :: NamedColor -> String
show :: NamedColor -> String
$cshowList :: [NamedColor] -> ShowS
showList :: [NamedColor] -> ShowS
Show)

-- | 8-bit color
type RGBColor = RGB Word8

-- | High-fidelity color representation for rendering
-- outside of the TUI.
data TrueColor
  = AnsiColor NamedColor
  | Triple RGBColor
  deriving (Int -> TrueColor -> ShowS
[TrueColor] -> ShowS
TrueColor -> String
(Int -> TrueColor -> ShowS)
-> (TrueColor -> String)
-> ([TrueColor] -> ShowS)
-> Show TrueColor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TrueColor -> ShowS
showsPrec :: Int -> TrueColor -> ShowS
$cshow :: TrueColor -> String
show :: TrueColor -> String
$cshowList :: [TrueColor] -> ShowS
showList :: [TrueColor] -> ShowS
Show)

-- |
-- A value of type @ColorLayers a@ represents the assignment of
-- foreground and\/or background color to an 'Entity' or terrain,
-- where @a@ may be a medium-independent (i.e. "authoritative") color
-- representation, or medium-specific (e.g. a @vty@ color).
-- The 'Functor' instance facilitates easy conversion from the
-- authoritative color to the specialized representation.
--
-- Ignores @vty@ "styles", such as bold\/italic\/underline.
--
-- This is intended to facilitate multiple rendering mediums:
--
-- * Single pixel per world cell (one color must be chosen
--   between foreground and background, if both are specified)
-- * Pixel block per world cell (can show two colors in some stylized manner)
-- * Glyph per world cell (can render a colored display character on a colored background)
data ColorLayers a
  = FgOnly a
  | BgOnly a
  | FgAndBg
      -- | foreground
      a
      -- | background
      a
  deriving (Int -> ColorLayers a -> ShowS
[ColorLayers a] -> ShowS
ColorLayers a -> String
(Int -> ColorLayers a -> ShowS)
-> (ColorLayers a -> String)
-> ([ColorLayers a] -> ShowS)
-> Show (ColorLayers a)
forall a. Show a => Int -> ColorLayers a -> ShowS
forall a. Show a => [ColorLayers a] -> ShowS
forall a. Show a => ColorLayers a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ColorLayers a -> ShowS
showsPrec :: Int -> ColorLayers a -> ShowS
$cshow :: forall a. Show a => ColorLayers a -> String
show :: ColorLayers a -> String
$cshowList :: forall a. Show a => [ColorLayers a] -> ShowS
showList :: [ColorLayers a] -> ShowS
Show, (forall a b. (a -> b) -> ColorLayers a -> ColorLayers b)
-> (forall a b. a -> ColorLayers b -> ColorLayers a)
-> Functor ColorLayers
forall a b. a -> ColorLayers b -> ColorLayers a
forall a b. (a -> b) -> ColorLayers a -> ColorLayers b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ColorLayers a -> ColorLayers b
fmap :: forall a b. (a -> b) -> ColorLayers a -> ColorLayers b
$c<$ :: forall a b. a -> ColorLayers b -> ColorLayers a
<$ :: forall a b. a -> ColorLayers b -> ColorLayers a
Functor)

type PreservableColor = ColorLayers TrueColor

getBackground :: ColorLayers a -> Maybe a
getBackground :: forall a. ColorLayers a -> Maybe a
getBackground = \case
  FgOnly a
_ -> Maybe a
forall a. Maybe a
Nothing
  BgOnly a
x -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
  FgAndBg a
_ a
x -> a -> Maybe a
forall a. a -> Maybe a
Just a
x

flattenBg :: ColorLayers a -> a
flattenBg :: forall a. ColorLayers a -> a
flattenBg = \case
  FgOnly a
x -> a
x
  BgOnly a
x -> a
x
  FgAndBg a
_ a
x -> a
x

newtype WorldAttr = WorldAttr String
  deriving (WorldAttr -> WorldAttr -> Bool
(WorldAttr -> WorldAttr -> Bool)
-> (WorldAttr -> WorldAttr -> Bool) -> Eq WorldAttr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorldAttr -> WorldAttr -> Bool
== :: WorldAttr -> WorldAttr -> Bool
$c/= :: WorldAttr -> WorldAttr -> Bool
/= :: WorldAttr -> WorldAttr -> Bool
Eq, Eq WorldAttr
Eq WorldAttr =>
(WorldAttr -> WorldAttr -> Ordering)
-> (WorldAttr -> WorldAttr -> Bool)
-> (WorldAttr -> WorldAttr -> Bool)
-> (WorldAttr -> WorldAttr -> Bool)
-> (WorldAttr -> WorldAttr -> Bool)
-> (WorldAttr -> WorldAttr -> WorldAttr)
-> (WorldAttr -> WorldAttr -> WorldAttr)
-> Ord WorldAttr
WorldAttr -> WorldAttr -> Bool
WorldAttr -> WorldAttr -> Ordering
WorldAttr -> WorldAttr -> WorldAttr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WorldAttr -> WorldAttr -> Ordering
compare :: WorldAttr -> WorldAttr -> Ordering
$c< :: WorldAttr -> WorldAttr -> Bool
< :: WorldAttr -> WorldAttr -> Bool
$c<= :: WorldAttr -> WorldAttr -> Bool
<= :: WorldAttr -> WorldAttr -> Bool
$c> :: WorldAttr -> WorldAttr -> Bool
> :: WorldAttr -> WorldAttr -> Bool
$c>= :: WorldAttr -> WorldAttr -> Bool
>= :: WorldAttr -> WorldAttr -> Bool
$cmax :: WorldAttr -> WorldAttr -> WorldAttr
max :: WorldAttr -> WorldAttr -> WorldAttr
$cmin :: WorldAttr -> WorldAttr -> WorldAttr
min :: WorldAttr -> WorldAttr -> WorldAttr
Ord, Int -> WorldAttr -> ShowS
[WorldAttr] -> ShowS
WorldAttr -> String
(Int -> WorldAttr -> ShowS)
-> (WorldAttr -> String)
-> ([WorldAttr] -> ShowS)
-> Show WorldAttr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorldAttr -> ShowS
showsPrec :: Int -> WorldAttr -> ShowS
$cshow :: WorldAttr -> String
show :: WorldAttr -> String
$cshowList :: [WorldAttr] -> ShowS
showList :: [WorldAttr] -> ShowS
Show)