-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.TUI.View.Attribute.Util where

import Brick.Util (on)
import Data.Colour.CIE (luminance)
import Data.Colour.Palette.BrewerSet (Kolor)
import Data.Colour.SRGB (RGB (..), toSRGB24)
import Graphics.Vty qualified as V
import Graphics.Vty.Attributes

kolorToAttrColor :: Kolor -> Color
kolorToAttrColor :: Kolor -> Color
kolorToAttrColor Kolor
c =
  Word8 -> Word8 -> Word8 -> Color
RGBColor Word8
r Word8
g Word8
b
 where
  RGB Word8
r Word8
g Word8
b = forall b. (RealFrac b, Floating b) => Colour b -> RGB Word8
toSRGB24 Kolor
c

-- | Automatically selects black or white for the foreground
-- based on the luminance of the supplied background.
bgWithAutoForeground :: Kolor -> Attr
bgWithAutoForeground :: Kolor -> Attr
bgWithAutoForeground Kolor
c = Color
fgColor Color -> Color -> Attr
`on` Kolor -> Color
kolorToAttrColor Kolor
c
 where
  fgColor :: Color
fgColor =
    -- "white" is actually gray-ish, so we nudge the threshold
    -- below 0.5.
    if forall a. Fractional a => Colour a -> a
luminance Kolor
c forall a. Ord a => a -> a -> Bool
> Double
0.4
      then Color
V.black
      else Color
V.white