commit 1f1b8b479d047877b2f7c76cda5c4722ad2410e9
parent 530bf8e13c7416a7fd8dc9ab7c656ca557833fb1
Author: jrvieira <github@jrvieira.com>
Date: Sun, 4 Dec 2022 18:56:05 +0000
add extended color support
Diffstat:
5 files changed, 44 insertions(+), 8 deletions(-)
diff --git a/ansi-terminal-game.cabal b/ansi-terminal-game.cabal
@@ -67,7 +67,8 @@ library
split == 0.2.*,
terminal-size == 0.3.*,
unidecode >= 0.1.0 && < 0.2,
- timers-tick > 0.5 && < 0.6
+ timers-tick > 0.5 && < 0.6,
+ colour >= 2.3.6
hs-source-dirs: src
default-language: Haskell2010
ghc-options: -Wall
@@ -120,7 +121,8 @@ test-suite test
split == 0.2.*,
terminal-size == 0.3.*,
unidecode >= 0.1.0 && < 0.2,
- timers-tick > 0.5 && < 0.6
+ timers-tick > 0.5 && < 0.6,
+ colour >= 2.3.6
-- the above plus hspec
, hspec
build-tool-depends: hspec-discover:hspec-discover
diff --git a/src/Terminal/Game.hs b/src/Terminal/Game.hs
@@ -101,6 +101,11 @@ module Terminal.Game ( -- * Running
Color(..), ColorIntensity(..),
color, bold, invert,
+ -- Non-standard colors
+ rgbColor, paletteColor,
+ sRGB24, sRGBBounded, sRGB, sRGB24read,
+ xterm6LevelRGB, xterm24LevelGray, xtermSystem,
+
-- *** Alternative origins
-- $origins
(%^>), (%.<), (%.>),
@@ -142,6 +147,7 @@ import Terminal.Game.Layer.Object as O
import Terminal.Game.Plane
import Terminal.Game.Random
import Text.LineBreak
+import Data.Colour.SRGB ( sRGB24, sRGBBounded, sRGB, sRGB24read )
import qualified Control.Monad as CM
diff --git a/src/Terminal/Game/Draw.hs b/src/Terminal/Game/Draw.hs
@@ -18,6 +18,8 @@ import qualified Data.Function as F ( (&) )
import qualified Data.List as L
import qualified System.Console.ANSI as CA
+import Data.Word ( Word8 )
+import Data.Colour.RGBSpace ( Colour )
-----------
-- TYPES --
@@ -128,6 +130,13 @@ bold p = mapPlane boldCell p
invert :: Plane -> Plane
invert p = mapPlane reverseCell p
+-- | Set RGB color
+rgbColor :: Colour Float -> Plane -> Plane
+rgbColor k p = mapPlane (rgbColorCell k) p
+
+-- | Set Palette color
+paletteColor :: Word8 -> Plane -> Plane
+paletteColor k p = mapPlane (paletteColorCell k) p
-------------
diff --git a/src/Terminal/Game/Layer/Object/IO.hs b/src/Terminal/Game/Layer/Object/IO.hs
@@ -286,8 +286,10 @@ putCellStyle c = CA.setSGR ([CA.Reset] ++ sgrb ++ sgrr ++ sgrc) >>
sgrr | isReversed c = [CA.SetSwapForegroundBackground True]
| otherwise = []
- sgrc | Just (k, i) <- cellColor c = [CA.SetColor CA.Foreground i k]
- | otherwise = []
+ sgrc | Just (ANSIColorInfo (k, i)) <- cellColor c = [CA.SetColor CA.Foreground i k]
+ | Just (RGBColorInfo k) <- cellColor c = [CA.SetRGBColor CA.Foreground k]
+ | Just (PaletteColorInfo k) <- cellColor c = [CA.SetPaletteColor CA.Foreground k]
+ | otherwise = []
oneTickSec :: Integer
oneTickSec = 10 ^ (6 :: Integer)
diff --git a/src/Terminal/Game/Plane.hs b/src/Terminal/Game/Plane.hs
@@ -18,6 +18,8 @@ import qualified Data.Tuple as T
import qualified GHC.Generics as G
import qualified System.Console.ANSI as CA
+import Data.Word ( Word8 )
+import Data.Colour.RGBSpace ( Colour )
----------------
-- DATA TYPES --
@@ -39,9 +41,16 @@ type Height = Int
type Bold = Bool
type Reversed = Bool
+data ColorInfo = ANSIColorInfo (CA.Color, CA.ColorIntensity)
+ | RGBColorInfo (Colour Float)
+ | PaletteColorInfo Word8
+ deriving (Show, Eq, Ord)
+
+instance Eq a => Ord (Colour a) where
+ compare _ _ = EQ
+
-- can be an ASCIIChar or a special, transparent character
-data Cell = CellChar Char Bold
- Reversed (Maybe (CA.Color, CA.ColorIntensity))
+data Cell = CellChar Char Bold Reversed (Maybe ColorInfo)
| Transparent
deriving (Show, Eq, Ord, G.Generic)
-- I found no meaningful speed improvements by making this
@@ -88,9 +97,17 @@ creaCell ch = CellChar chm False False Nothing
chm = win32SafeChar ch
colorCell :: CA.Color -> CA.ColorIntensity -> Cell -> Cell
-colorCell k i (CellChar c b r _) = CellChar c b r (Just (k, i))
+colorCell k i (CellChar c b r _) = CellChar c b r (Just $ ANSIColorInfo (k, i))
colorCell _ _ Transparent = Transparent
+rgbColorCell :: Colour Float -> Cell -> Cell
+rgbColorCell k (CellChar c b r _) = CellChar c b r (Just $ RGBColorInfo k)
+rgbColorCell _ Transparent = Transparent
+
+paletteColorCell :: Word8 -> Cell -> Cell
+paletteColorCell k (CellChar c b r _) = CellChar c b r (Just $ PaletteColorInfo k)
+paletteColorCell _ Transparent = Transparent
+
boldCell :: Cell -> Cell
boldCell (CellChar c _ r k) = CellChar c True r k
boldCell Transparent = Transparent
@@ -180,7 +197,7 @@ cellChar :: Cell -> Char
cellChar (CellChar c _ _ _) = c
cellChar Transparent = ' '
-cellColor :: Cell -> Maybe (CA.Color, CA.ColorIntensity)
+cellColor :: Cell -> Maybe ColorInfo
cellColor (CellChar _ _ _ k) = k
cellColor Transparent = Nothing
