-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Entity and terrain coloring.
--
-- This module is the sole "ground truth" for color
-- assignment of entities and terrain.
-- More specifically, it sets colors for "attributes",
-- and the attributes are referenced by entities\/terrain.
module Swarm.Game.Entity.Cosmetic.Assignment where

import Data.Bifunctor (bimap)
import Data.Colour.SRGB (RGB (..))
import Data.Map (Map)
import Data.Map qualified as M
import Swarm.Game.Entity.Cosmetic

-- * Entities and Terrain

entity :: (WorldAttr, PreservableColor)
entity :: (WorldAttr, PreservableColor)
entity = (String -> WorldAttr
WorldAttr String
"entity", TrueColor -> PreservableColor
forall a. a -> ColorLayers a
FgOnly (TrueColor -> PreservableColor) -> TrueColor -> PreservableColor
forall a b. (a -> b) -> a -> b
$ NamedColor -> TrueColor
AnsiColor NamedColor
White)

water :: (WorldAttr, PreservableColor)
water :: (WorldAttr, PreservableColor)
water = (String -> WorldAttr
WorldAttr String
"water", TrueColor -> TrueColor -> PreservableColor
forall a. a -> a -> ColorLayers a
FgAndBg (NamedColor -> TrueColor
AnsiColor NamedColor
White) (NamedColor -> TrueColor
AnsiColor NamedColor
Blue))

rock :: (WorldAttr, PreservableColor)
rock :: (WorldAttr, PreservableColor)
rock = (String -> WorldAttr
WorldAttr String
"rock", TrueColor -> PreservableColor
forall a. a -> ColorLayers a
FgOnly (TrueColor -> PreservableColor) -> TrueColor -> PreservableColor
forall a b. (a -> b) -> a -> b
$ RGBColor -> TrueColor
Triple (RGBColor -> TrueColor) -> RGBColor -> TrueColor
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> RGBColor
forall a. a -> a -> a -> RGB a
RGB Word8
80 Word8
80 Word8
80)

plant :: (WorldAttr, PreservableColor)
plant :: (WorldAttr, PreservableColor)
plant = (String -> WorldAttr
WorldAttr String
"plant", TrueColor -> PreservableColor
forall a. a -> ColorLayers a
FgOnly (TrueColor -> PreservableColor) -> TrueColor -> PreservableColor
forall a b. (a -> b) -> a -> b
$ NamedColor -> TrueColor
AnsiColor NamedColor
Green)

dirt :: (WorldAttr, PreservableColor)
dirt :: (WorldAttr, PreservableColor)
dirt = (String -> WorldAttr
WorldAttr String
"dirt", TrueColor -> PreservableColor
forall a. a -> ColorLayers a
BgOnly (TrueColor -> PreservableColor) -> TrueColor -> PreservableColor
forall a b. (a -> b) -> a -> b
$ RGBColor -> TrueColor
Triple (RGBColor -> TrueColor) -> RGBColor -> TrueColor
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> RGBColor
forall a. a -> a -> a -> RGB a
RGB Word8
87 Word8
47 Word8
47)

grass :: (WorldAttr, PreservableColor)
grass :: (WorldAttr, PreservableColor)
grass = (String -> WorldAttr
WorldAttr String
"grass", TrueColor -> PreservableColor
forall a. a -> ColorLayers a
BgOnly (TrueColor -> PreservableColor) -> TrueColor -> PreservableColor
forall a b. (a -> b) -> a -> b
$ RGBColor -> TrueColor
Triple (RGBColor -> TrueColor) -> RGBColor -> TrueColor
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> RGBColor
forall a. a -> a -> a -> RGB a
RGB Word8
0 Word8
47 Word8
0) -- dark green

stone :: (WorldAttr, PreservableColor)
stone :: (WorldAttr, PreservableColor)
stone = (String -> WorldAttr
WorldAttr String
"stone", TrueColor -> PreservableColor
forall a. a -> ColorLayers a
BgOnly (TrueColor -> PreservableColor) -> TrueColor -> PreservableColor
forall a b. (a -> b) -> a -> b
$ RGBColor -> TrueColor
Triple (RGBColor -> TrueColor) -> RGBColor -> TrueColor
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> RGBColor
forall a. a -> a -> a -> RGB a
RGB Word8
47 Word8
47 Word8
47)

ice :: (WorldAttr, PreservableColor)
ice :: (WorldAttr, PreservableColor)
ice = (String -> WorldAttr
WorldAttr String
"ice", TrueColor -> PreservableColor
forall a. a -> ColorLayers a
BgOnly (TrueColor -> PreservableColor) -> TrueColor -> PreservableColor
forall a b. (a -> b) -> a -> b
$ NamedColor -> TrueColor
AnsiColor NamedColor
White)

burnt :: (WorldAttr, PreservableColor)
burnt :: (WorldAttr, PreservableColor)
burnt = (String -> WorldAttr
WorldAttr String
"burnt", TrueColor -> PreservableColor
forall a. a -> ColorLayers a
BgOnly (TrueColor -> PreservableColor) -> TrueColor -> PreservableColor
forall a b. (a -> b) -> a -> b
$ RGBColor -> TrueColor
Triple (RGBColor -> TrueColor) -> RGBColor -> TrueColor
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> RGBColor
forall a. a -> a -> a -> RGB a
RGB Word8
40 Word8
24 Word8
0) -- dark brown

-- | Colors of entities in the world.
worldAttributes :: Map WorldAttr PreservableColor
worldAttributes :: Map WorldAttr PreservableColor
worldAttributes =
  [(WorldAttr, PreservableColor)] -> Map WorldAttr PreservableColor
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(WorldAttr, PreservableColor)] -> Map WorldAttr PreservableColor)
-> [(WorldAttr, PreservableColor)]
-> Map WorldAttr PreservableColor
forall a b. (a -> b) -> a -> b
$
    -- these few are referenced elsewhere,
    -- so they have their own toplevel definition
    [ (WorldAttr, PreservableColor)
entity
    , (WorldAttr, PreservableColor)
water
    , (WorldAttr, PreservableColor)
rock
    , (WorldAttr, PreservableColor)
plant
    , (WorldAttr, PreservableColor)
dirt
    , (WorldAttr, PreservableColor)
grass
    , (WorldAttr, PreservableColor)
stone
    , (WorldAttr, PreservableColor)
ice
    , (WorldAttr, PreservableColor)
burnt
    ]
      [(WorldAttr, PreservableColor)]
-> [(WorldAttr, PreservableColor)]
-> [(WorldAttr, PreservableColor)]
forall a. Semigroup a => a -> a -> a
<> ((String, TrueColor) -> (WorldAttr, PreservableColor))
-> [(String, TrueColor)] -> [(WorldAttr, PreservableColor)]
forall a b. (a -> b) -> [a] -> [b]
map
        ((String -> WorldAttr)
-> (TrueColor -> PreservableColor)
-> (String, TrueColor)
-> (WorldAttr, PreservableColor)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> WorldAttr
WorldAttr TrueColor -> PreservableColor
forall a. a -> ColorLayers a
FgOnly)
        [ (String
"device", NamedColor -> TrueColor
AnsiColor NamedColor
BrightYellow)
        , (String
"wood", RGBColor -> TrueColor
Triple (RGBColor -> TrueColor) -> RGBColor -> TrueColor
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> RGBColor
forall a. a -> a -> a -> RGB a
RGB Word8
139 Word8
69 Word8
19)
        , (String
"flower", RGBColor -> TrueColor
Triple (RGBColor -> TrueColor) -> RGBColor -> TrueColor
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> RGBColor
forall a. a -> a -> a -> RGB a
RGB Word8
200 Word8
0 Word8
200)
        , (String
"rubber", RGBColor -> TrueColor
Triple (RGBColor -> TrueColor) -> RGBColor -> TrueColor
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> RGBColor
forall a. a -> a -> a -> RGB a
RGB Word8
245 Word8
224 Word8
179)
        , (String
"copper", NamedColor -> TrueColor
AnsiColor NamedColor
Yellow)
        , (String
"copper'", RGBColor -> TrueColor
Triple (RGBColor -> TrueColor) -> RGBColor -> TrueColor
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> RGBColor
forall a. a -> a -> a -> RGB a
RGB Word8
78 Word8
117 Word8
102)
        , (String
"iron", RGBColor -> TrueColor
Triple (RGBColor -> TrueColor) -> RGBColor -> TrueColor
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> RGBColor
forall a. a -> a -> a -> RGB a
RGB Word8
97 Word8
102 Word8
106)
        , (String
"iron'", RGBColor -> TrueColor
Triple (RGBColor -> TrueColor) -> RGBColor -> TrueColor
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> RGBColor
forall a. a -> a -> a -> RGB a
RGB Word8
183 Word8
65 Word8
14)
        , (String
"quartz", NamedColor -> TrueColor
AnsiColor NamedColor
White)
        , (String
"silver", RGBColor -> TrueColor
Triple (RGBColor -> TrueColor) -> RGBColor -> TrueColor
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> RGBColor
forall a. a -> a -> a -> RGB a
RGB Word8
192 Word8
192 Word8
192)
        , (String
"gold", RGBColor -> TrueColor
Triple (RGBColor -> TrueColor) -> RGBColor -> TrueColor
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> RGBColor
forall a. a -> a -> a -> RGB a
RGB Word8
255 Word8
215 Word8
0)
        , (String
"snow", NamedColor -> TrueColor
AnsiColor NamedColor
White)
        , (String
"sand", RGBColor -> TrueColor
Triple (RGBColor -> TrueColor) -> RGBColor -> TrueColor
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> RGBColor
forall a. a -> a -> a -> RGB a
RGB Word8
194 Word8
178 Word8
128)
        , (String
"fire", NamedColor -> TrueColor
AnsiColor NamedColor
BrightRed)
        , (String
"red", NamedColor -> TrueColor
AnsiColor NamedColor
Red)
        , (String
"green", NamedColor -> TrueColor
AnsiColor NamedColor
Green)
        , (String
"blue", NamedColor -> TrueColor
AnsiColor NamedColor
Blue)
        ]