{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
-- | Colours and text attributes.
module Game.LambdaHack.Definition.Color
  ( -- * Colours
    Color(..)
  , defFG, isBright, darkCol, brightCol, stdCol, legalFgCol
  , cVeryBadEvent, cBadEvent, cRisk, cGraveRisk, cVeryGoodEvent, cGoodEvent
  , cVista, cSleep, cWakeUp, cGreed, cNeutralEvent, cRareNeutralEvent
  , cIdentification, cMeta, cBoring, cGameOver, cTutorialHint
  , colorToRGB
    -- * Complete text attributes
  , Highlight (..), Attr(..)
  , highlightToColor, defAttr
    -- * Characters with attributes
  , AttrChar(..), AttrCharW32(..)
  , attrCharToW32, attrCharFromW32
  , fgFromW32, bgFromW32, charFromW32, attrFromW32
  , spaceAttrW32, nbspAttrW32, spaceCursorAttrW32, trimmedLineAttrW32
  , attrChar2ToW32, attrChar1ToW32
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Control.DeepSeq
import           Data.Binary
import           Data.Bits (unsafeShiftL, unsafeShiftR, (.&.))
import qualified Data.Char as Char
import           GHC.Generics (Generic)

-- | Colours supported by the major frontends.
data Color =
    Black
  | Red
  | Green
  | Brown
  | Blue
  | Magenta
  | Cyan
  | White
  | AltWhite  -- only use for frontend hacks
  | BrBlack
  | BrRed
  | BrGreen
  | BrYellow
  | BrBlue
  | BrMagenta
  | BrCyan
  | BrWhite
  deriving (Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show, ReadPrec [Color]
ReadPrec Color
Int -> ReadS Color
ReadS [Color]
(Int -> ReadS Color)
-> ReadS [Color]
-> ReadPrec Color
-> ReadPrec [Color]
-> Read Color
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Color]
$creadListPrec :: ReadPrec [Color]
readPrec :: ReadPrec Color
$creadPrec :: ReadPrec Color
readList :: ReadS [Color]
$creadList :: ReadS [Color]
readsPrec :: Int -> ReadS Color
$creadsPrec :: Int -> ReadS Color
Read, Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq, Eq Color
Eq Color
-> (Color -> Color -> Ordering)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> Ord Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
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
min :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmax :: Color -> Color -> Color
>= :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c< :: Color -> Color -> Bool
compare :: Color -> Color -> Ordering
$ccompare :: Color -> Color -> Ordering
$cp1Ord :: Eq Color
Ord, Int -> Color
Color -> Int
Color -> [Color]
Color -> Color
Color -> Color -> [Color]
Color -> Color -> Color -> [Color]
(Color -> Color)
-> (Color -> Color)
-> (Int -> Color)
-> (Color -> Int)
-> (Color -> [Color])
-> (Color -> Color -> [Color])
-> (Color -> Color -> [Color])
-> (Color -> Color -> Color -> [Color])
-> Enum Color
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Color -> Color -> Color -> [Color]
$cenumFromThenTo :: Color -> Color -> Color -> [Color]
enumFromTo :: Color -> Color -> [Color]
$cenumFromTo :: Color -> Color -> [Color]
enumFromThen :: Color -> Color -> [Color]
$cenumFromThen :: Color -> Color -> [Color]
enumFrom :: Color -> [Color]
$cenumFrom :: Color -> [Color]
fromEnum :: Color -> Int
$cfromEnum :: Color -> Int
toEnum :: Int -> Color
$ctoEnum :: Int -> Color
pred :: Color -> Color
$cpred :: Color -> Color
succ :: Color -> Color
$csucc :: Color -> Color
Enum, (forall x. Color -> Rep Color x)
-> (forall x. Rep Color x -> Color) -> Generic Color
forall x. Rep Color x -> Color
forall x. Color -> Rep Color x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Color x -> Color
$cfrom :: forall x. Color -> Rep Color x
Generic)

instance Binary Color where
  put :: Color -> Put
put = Word8 -> Put
putWord8 (Word8 -> Put) -> (Color -> Word8) -> Color -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a. Enum a => Int -> a
toEnum (Int -> Word8) -> (Color -> Int) -> Color -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Int
forall a. Enum a => a -> Int
fromEnum
  get :: Get Color
get = (Word8 -> Color) -> Get Word8 -> Get Color
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Color
forall a. Enum a => Int -> a
toEnum (Int -> Color) -> (Word8 -> Int) -> Word8 -> Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a. Enum a => a -> Int
fromEnum) Get Word8
getWord8

instance NFData Color

-- | The default colours, to optimize attribute setting.
defFG :: Color
defFG :: Color
defFG = Color
White

-- | A helper for the terminal frontends that display bright via bold.
isBright :: Color -> Bool
isBright :: Color -> Bool
isBright Color
c = Color
c Color -> Color -> Bool
forall a. Ord a => a -> a -> Bool
> Color
BrBlack

-- | Colour sets. Sorted.
darkCol, brightCol, stdCol, legalFgCol :: [Color]
darkCol :: [Color]
darkCol = [Color
Red .. Color
Cyan]
brightCol :: [Color]
brightCol = [Color
BrRed .. Color
BrCyan]  -- BrBlack is not really that bright
stdCol :: [Color]
stdCol = [Color]
darkCol [Color] -> [Color] -> [Color]
forall a. [a] -> [a] -> [a]
++ [Color]
brightCol
legalFgCol :: [Color]
legalFgCol = [Color]
darkCol [Color] -> [Color] -> [Color]
forall a. [a] -> [a] -> [a]
++ [Color
White, Color
BrBlack] [Color] -> [Color] -> [Color]
forall a. [a] -> [a] -> [a]
++ [Color]
brightCol [Color] -> [Color] -> [Color]
forall a. [a] -> [a] -> [a]
++ [Color
BrWhite]

-- See the discussion of colours and the table of colours at
-- https://github.com/LambdaHack/LambdaHack/wiki/Display#colours
-- Another mention of colours, concerning terrain, is in PLAYING.md manual.
-- The manual and this code should follow the wiki.
cVeryBadEvent, cBadEvent, cRisk, cGraveRisk, cVeryGoodEvent, cGoodEvent, cVista, cSleep, cWakeUp, cGreed, cNeutralEvent, cRareNeutralEvent, cIdentification, cMeta, cBoring, cGameOver, cTutorialHint :: Color
cVeryBadEvent :: Color
cVeryBadEvent = Color
Red
cBadEvent :: Color
cBadEvent = Color
BrRed
cRisk :: Color
cRisk = Color
Magenta
cGraveRisk :: Color
cGraveRisk = Color
BrMagenta
cVeryGoodEvent :: Color
cVeryGoodEvent = Color
Green
cGoodEvent :: Color
cGoodEvent = Color
BrGreen
cVista :: Color
cVista = Color
BrGreen
cSleep :: Color
cSleep = Color
Blue
cWakeUp :: Color
cWakeUp = Color
BrBlue
cGreed :: Color
cGreed = Color
BrBlue
cNeutralEvent :: Color
cNeutralEvent = Color
Cyan
cRareNeutralEvent :: Color
cRareNeutralEvent = Color
BrCyan
cIdentification :: Color
cIdentification = Color
Brown
cMeta :: Color
cMeta = Color
BrYellow
cBoring :: Color
cBoring = Color
White
cGameOver :: Color
cGameOver = Color
BrWhite
cTutorialHint :: Color
cTutorialHint = Color
BrMagenta

-- | Translationg to heavily modified Linux console color RGB values.
--
-- Warning: SDL frontend sadly duplicates this code.
colorToRGB :: Color -> Text
colorToRGB :: Color -> Text
colorToRGB Color
Black     = Text
"#000000"
colorToRGB Color
Red       = Text
"#D50505"
colorToRGB Color
Green     = Text
"#059D05"
colorToRGB Color
Brown     = Text
"#CA4A05"
colorToRGB Color
Blue      = Text
"#0556F4"
colorToRGB Color
Magenta   = Text
"#AF0EAF"
colorToRGB Color
Cyan      = Text
"#059696"
colorToRGB Color
White     = Text
"#B8BFCB"
colorToRGB Color
AltWhite  = Text
"#C4BEB1"
colorToRGB Color
BrBlack   = Text
"#6F5F5F"
colorToRGB Color
BrRed     = Text
"#FF5555"
colorToRGB Color
BrGreen   = Text
"#65F136"
colorToRGB Color
BrYellow  = Text
"#EBD642"
colorToRGB Color
BrBlue    = Text
"#4D98F4"
colorToRGB Color
BrMagenta = Text
"#FF77FF"
colorToRGB Color
BrCyan    = Text
"#52F4E5"
colorToRGB Color
BrWhite   = Text
"#FFFFFF"

-- -- | For reference, the original Linux console colors.
-- -- Good old retro feel and more useful than xterm (e.g. brown).
-- colorToRGB :: Color -> Text
-- colorToRGB Black     = "#000000"
-- colorToRGB Red       = "#AA0000"
-- colorToRGB Green     = "#00AA00"
-- colorToRGB Brown     = "#AA5500"
-- colorToRGB Blue      = "#0000AA"
-- colorToRGB Magenta   = "#AA00AA"
-- colorToRGB Cyan      = "#00AAAA"
-- colorToRGB White     = "#AAAAAA"
-- colorToRGB AltWhite  = "#AAAAAA"
-- colorToRGB BrBlack   = "#555555"
-- colorToRGB BrRed     = "#FF5555"
-- colorToRGB BrGreen   = "#55FF55"
-- colorToRGB BrYellow  = "#FFFF55"
-- colorToRGB BrBlue    = "#5555FF"
-- colorToRGB BrMagenta = "#FF55FF"
-- colorToRGB BrCyan    = "#55FFFF"
-- colorToRGB BrWhite   = "#FFFFFF"

-- | Additional map cell highlight, e.g., a colorful square around the cell
-- or a colorful background.
--
-- Warning: the highlight underscored by the terminal cursor is
-- the maximal element of this type present on a screen,
-- so don't add new highlights to the end.
data Highlight =
    HighlightNone
  | HighlightBackground
  | HighlightGreen
  | HighlightBlue
  | HighlightBrown
  | HighlightCyan
  | HighlightGrey
  | HighlightWhite
  | HighlightMagenta
  | HighlightRed
  | HighlightYellow
  | HighlightYellowAim
  | HighlightRedAim
  | HighlightNoneCursor
  deriving (Int -> Highlight -> ShowS
[Highlight] -> ShowS
Highlight -> String
(Int -> Highlight -> ShowS)
-> (Highlight -> String)
-> ([Highlight] -> ShowS)
-> Show Highlight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Highlight] -> ShowS
$cshowList :: [Highlight] -> ShowS
show :: Highlight -> String
$cshow :: Highlight -> String
showsPrec :: Int -> Highlight -> ShowS
$cshowsPrec :: Int -> Highlight -> ShowS
Show, Highlight -> Highlight -> Bool
(Highlight -> Highlight -> Bool)
-> (Highlight -> Highlight -> Bool) -> Eq Highlight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Highlight -> Highlight -> Bool
$c/= :: Highlight -> Highlight -> Bool
== :: Highlight -> Highlight -> Bool
$c== :: Highlight -> Highlight -> Bool
Eq, Eq Highlight
Eq Highlight
-> (Highlight -> Highlight -> Ordering)
-> (Highlight -> Highlight -> Bool)
-> (Highlight -> Highlight -> Bool)
-> (Highlight -> Highlight -> Bool)
-> (Highlight -> Highlight -> Bool)
-> (Highlight -> Highlight -> Highlight)
-> (Highlight -> Highlight -> Highlight)
-> Ord Highlight
Highlight -> Highlight -> Bool
Highlight -> Highlight -> Ordering
Highlight -> Highlight -> Highlight
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
min :: Highlight -> Highlight -> Highlight
$cmin :: Highlight -> Highlight -> Highlight
max :: Highlight -> Highlight -> Highlight
$cmax :: Highlight -> Highlight -> Highlight
>= :: Highlight -> Highlight -> Bool
$c>= :: Highlight -> Highlight -> Bool
> :: Highlight -> Highlight -> Bool
$c> :: Highlight -> Highlight -> Bool
<= :: Highlight -> Highlight -> Bool
$c<= :: Highlight -> Highlight -> Bool
< :: Highlight -> Highlight -> Bool
$c< :: Highlight -> Highlight -> Bool
compare :: Highlight -> Highlight -> Ordering
$ccompare :: Highlight -> Highlight -> Ordering
$cp1Ord :: Eq Highlight
Ord, Int -> Highlight
Highlight -> Int
Highlight -> [Highlight]
Highlight -> Highlight
Highlight -> Highlight -> [Highlight]
Highlight -> Highlight -> Highlight -> [Highlight]
(Highlight -> Highlight)
-> (Highlight -> Highlight)
-> (Int -> Highlight)
-> (Highlight -> Int)
-> (Highlight -> [Highlight])
-> (Highlight -> Highlight -> [Highlight])
-> (Highlight -> Highlight -> [Highlight])
-> (Highlight -> Highlight -> Highlight -> [Highlight])
-> Enum Highlight
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Highlight -> Highlight -> Highlight -> [Highlight]
$cenumFromThenTo :: Highlight -> Highlight -> Highlight -> [Highlight]
enumFromTo :: Highlight -> Highlight -> [Highlight]
$cenumFromTo :: Highlight -> Highlight -> [Highlight]
enumFromThen :: Highlight -> Highlight -> [Highlight]
$cenumFromThen :: Highlight -> Highlight -> [Highlight]
enumFrom :: Highlight -> [Highlight]
$cenumFrom :: Highlight -> [Highlight]
fromEnum :: Highlight -> Int
$cfromEnum :: Highlight -> Int
toEnum :: Int -> Highlight
$ctoEnum :: Int -> Highlight
pred :: Highlight -> Highlight
$cpred :: Highlight -> Highlight
succ :: Highlight -> Highlight
$csucc :: Highlight -> Highlight
Enum, Highlight
Highlight -> Highlight -> Bounded Highlight
forall a. a -> a -> Bounded a
maxBound :: Highlight
$cmaxBound :: Highlight
minBound :: Highlight
$cminBound :: Highlight
Bounded)

highlightToColor :: Highlight -> Color
highlightToColor :: Highlight -> Color
highlightToColor Highlight
hi = case Highlight
hi of
  Highlight
HighlightNone -> Color
Black  -- should be transparent, but is OK in web frontend
  Highlight
HighlightBackground -> Color
BrBlack  -- gets a special colour, but as a background
  Highlight
HighlightGreen -> Color
Green
  Highlight
HighlightBlue -> Color
Blue
  Highlight
HighlightBrown -> Color
Brown
  Highlight
HighlightCyan -> Color
Cyan
  Highlight
HighlightGrey -> Color
BrBlack
  Highlight
HighlightWhite -> Color
White  -- bright, but no saturation, so doesn't obscure much
  Highlight
HighlightMagenta -> Color
BrMagenta  -- very rare, so bright is fine
  Highlight
HighlightRed -> Color
Red
  Highlight
HighlightYellow -> Color
BrYellow  -- obscures, but mostly used around bright white
  Highlight
HighlightYellowAim -> Color
BrYellow
  Highlight
HighlightRedAim -> Color
Red
  Highlight
HighlightNoneCursor -> Color
Black  -- used in ANSI for cursor via @maxIndexByA@

-- | Text attributes: foreground color and highlight.
data Attr = Attr
  { Attr -> Color
fg :: Color      -- ^ foreground colour
  , Attr -> Highlight
bg :: Highlight  -- ^ highlight
  }
  deriving (Int -> Attr -> ShowS
[Attr] -> ShowS
Attr -> String
(Int -> Attr -> ShowS)
-> (Attr -> String) -> ([Attr] -> ShowS) -> Show Attr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attr] -> ShowS
$cshowList :: [Attr] -> ShowS
show :: Attr -> String
$cshow :: Attr -> String
showsPrec :: Int -> Attr -> ShowS
$cshowsPrec :: Int -> Attr -> ShowS
Show, Attr -> Attr -> Bool
(Attr -> Attr -> Bool) -> (Attr -> Attr -> Bool) -> Eq Attr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attr -> Attr -> Bool
$c/= :: Attr -> Attr -> Bool
== :: Attr -> Attr -> Bool
$c== :: Attr -> Attr -> Bool
Eq)

-- | The default attribute, to optimize attribute setting.
defAttr :: Attr
defAttr :: Attr
defAttr = Color -> Highlight -> Attr
Attr Color
defFG Highlight
HighlightNone

-- | Character to display, with its attribute.
data AttrChar = AttrChar
  { AttrChar -> Attr
acAttr :: Attr
  , AttrChar -> Char
acChar :: Char
  }
  deriving (Int -> AttrChar -> ShowS
[AttrChar] -> ShowS
AttrChar -> String
(Int -> AttrChar -> ShowS)
-> (AttrChar -> String) -> ([AttrChar] -> ShowS) -> Show AttrChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttrChar] -> ShowS
$cshowList :: [AttrChar] -> ShowS
show :: AttrChar -> String
$cshow :: AttrChar -> String
showsPrec :: Int -> AttrChar -> ShowS
$cshowsPrec :: Int -> AttrChar -> ShowS
Show, AttrChar -> AttrChar -> Bool
(AttrChar -> AttrChar -> Bool)
-> (AttrChar -> AttrChar -> Bool) -> Eq AttrChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttrChar -> AttrChar -> Bool
$c/= :: AttrChar -> AttrChar -> Bool
== :: AttrChar -> AttrChar -> Bool
$c== :: AttrChar -> AttrChar -> Bool
Eq)

-- This implementation is faster than @Int@, because some vector updates
-- can be done without going to and from @Int@.
-- | Optimized representation of 'AttrChar'.
newtype AttrCharW32 = AttrCharW32 {AttrCharW32 -> Word32
attrCharW32 :: Word32}
  deriving (Int -> AttrCharW32 -> ShowS
[AttrCharW32] -> ShowS
AttrCharW32 -> String
(Int -> AttrCharW32 -> ShowS)
-> (AttrCharW32 -> String)
-> ([AttrCharW32] -> ShowS)
-> Show AttrCharW32
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttrCharW32] -> ShowS
$cshowList :: [AttrCharW32] -> ShowS
show :: AttrCharW32 -> String
$cshow :: AttrCharW32 -> String
showsPrec :: Int -> AttrCharW32 -> ShowS
$cshowsPrec :: Int -> AttrCharW32 -> ShowS
Show, AttrCharW32 -> AttrCharW32 -> Bool
(AttrCharW32 -> AttrCharW32 -> Bool)
-> (AttrCharW32 -> AttrCharW32 -> Bool) -> Eq AttrCharW32
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttrCharW32 -> AttrCharW32 -> Bool
$c/= :: AttrCharW32 -> AttrCharW32 -> Bool
== :: AttrCharW32 -> AttrCharW32 -> Bool
$c== :: AttrCharW32 -> AttrCharW32 -> Bool
Eq, Eq AttrCharW32
Eq AttrCharW32
-> (AttrCharW32 -> AttrCharW32 -> Ordering)
-> (AttrCharW32 -> AttrCharW32 -> Bool)
-> (AttrCharW32 -> AttrCharW32 -> Bool)
-> (AttrCharW32 -> AttrCharW32 -> Bool)
-> (AttrCharW32 -> AttrCharW32 -> Bool)
-> (AttrCharW32 -> AttrCharW32 -> AttrCharW32)
-> (AttrCharW32 -> AttrCharW32 -> AttrCharW32)
-> Ord AttrCharW32
AttrCharW32 -> AttrCharW32 -> Bool
AttrCharW32 -> AttrCharW32 -> Ordering
AttrCharW32 -> AttrCharW32 -> AttrCharW32
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
min :: AttrCharW32 -> AttrCharW32 -> AttrCharW32
$cmin :: AttrCharW32 -> AttrCharW32 -> AttrCharW32
max :: AttrCharW32 -> AttrCharW32 -> AttrCharW32
$cmax :: AttrCharW32 -> AttrCharW32 -> AttrCharW32
>= :: AttrCharW32 -> AttrCharW32 -> Bool
$c>= :: AttrCharW32 -> AttrCharW32 -> Bool
> :: AttrCharW32 -> AttrCharW32 -> Bool
$c> :: AttrCharW32 -> AttrCharW32 -> Bool
<= :: AttrCharW32 -> AttrCharW32 -> Bool
$c<= :: AttrCharW32 -> AttrCharW32 -> Bool
< :: AttrCharW32 -> AttrCharW32 -> Bool
$c< :: AttrCharW32 -> AttrCharW32 -> Bool
compare :: AttrCharW32 -> AttrCharW32 -> Ordering
$ccompare :: AttrCharW32 -> AttrCharW32 -> Ordering
$cp1Ord :: Eq AttrCharW32
Ord, Int -> AttrCharW32
AttrCharW32 -> Int
AttrCharW32 -> [AttrCharW32]
AttrCharW32 -> AttrCharW32
AttrCharW32 -> AttrCharW32 -> [AttrCharW32]
AttrCharW32 -> AttrCharW32 -> AttrCharW32 -> [AttrCharW32]
(AttrCharW32 -> AttrCharW32)
-> (AttrCharW32 -> AttrCharW32)
-> (Int -> AttrCharW32)
-> (AttrCharW32 -> Int)
-> (AttrCharW32 -> [AttrCharW32])
-> (AttrCharW32 -> AttrCharW32 -> [AttrCharW32])
-> (AttrCharW32 -> AttrCharW32 -> [AttrCharW32])
-> (AttrCharW32 -> AttrCharW32 -> AttrCharW32 -> [AttrCharW32])
-> Enum AttrCharW32
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AttrCharW32 -> AttrCharW32 -> AttrCharW32 -> [AttrCharW32]
$cenumFromThenTo :: AttrCharW32 -> AttrCharW32 -> AttrCharW32 -> [AttrCharW32]
enumFromTo :: AttrCharW32 -> AttrCharW32 -> [AttrCharW32]
$cenumFromTo :: AttrCharW32 -> AttrCharW32 -> [AttrCharW32]
enumFromThen :: AttrCharW32 -> AttrCharW32 -> [AttrCharW32]
$cenumFromThen :: AttrCharW32 -> AttrCharW32 -> [AttrCharW32]
enumFrom :: AttrCharW32 -> [AttrCharW32]
$cenumFrom :: AttrCharW32 -> [AttrCharW32]
fromEnum :: AttrCharW32 -> Int
$cfromEnum :: AttrCharW32 -> Int
toEnum :: Int -> AttrCharW32
$ctoEnum :: Int -> AttrCharW32
pred :: AttrCharW32 -> AttrCharW32
$cpred :: AttrCharW32 -> AttrCharW32
succ :: AttrCharW32 -> AttrCharW32
$csucc :: AttrCharW32 -> AttrCharW32
Enum, Get AttrCharW32
[AttrCharW32] -> Put
AttrCharW32 -> Put
(AttrCharW32 -> Put)
-> Get AttrCharW32 -> ([AttrCharW32] -> Put) -> Binary AttrCharW32
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [AttrCharW32] -> Put
$cputList :: [AttrCharW32] -> Put
get :: Get AttrCharW32
$cget :: Get AttrCharW32
put :: AttrCharW32 -> Put
$cput :: AttrCharW32 -> Put
Binary)

attrCharToW32 :: AttrChar -> AttrCharW32
attrCharToW32 :: AttrChar -> AttrCharW32
attrCharToW32 AttrChar{acAttr :: AttrChar -> Attr
acAttr=Attr{Highlight
Color
bg :: Highlight
fg :: Color
bg :: Attr -> Highlight
fg :: Attr -> Color
..}, Char
acChar :: Char
acChar :: AttrChar -> Char
acChar} = Word32 -> AttrCharW32
AttrCharW32 (Word32 -> AttrCharW32) -> Word32 -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a. Enum a => Int -> a
toEnum (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$
  Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftL (Color -> Int
forall a. Enum a => a -> Int
fromEnum Color
fg) Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Highlight -> Int
forall a. Enum a => a -> Int
fromEnum Highlight
bg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftL (Char -> Int
Char.ord Char
acChar) Int
16

attrCharFromW32 :: AttrCharW32 -> AttrChar
attrCharFromW32 :: AttrCharW32 -> AttrChar
attrCharFromW32 !AttrCharW32
w = Attr -> Char -> AttrChar
AttrChar (AttrCharW32 -> Attr
attrFromW32 AttrCharW32
w) (AttrCharW32 -> Char
charFromW32 AttrCharW32
w)

fgFromW32 :: AttrCharW32 -> Color
{-# INLINE fgFromW32 #-}
fgFromW32 :: AttrCharW32 -> Color
fgFromW32 AttrCharW32
w =
  Int -> Color
forall a. Enum a => Int -> a
toEnum (Int -> Color) -> Int -> Color
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR (Word32 -> Int
forall a. Enum a => a -> Int
fromEnum (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ AttrCharW32 -> Word32
attrCharW32 AttrCharW32
w) Int
8 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
8 :: Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

bgFromW32 :: AttrCharW32 -> Highlight
{-# INLINE bgFromW32 #-}
bgFromW32 :: AttrCharW32 -> Highlight
bgFromW32 AttrCharW32
w =
  Int -> Highlight
forall a. Enum a => Int -> a
toEnum (Int -> Highlight) -> Int -> Highlight
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a. Enum a => a -> Int
fromEnum (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ AttrCharW32 -> Word32
attrCharW32 AttrCharW32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
2 Word32 -> Int -> Word32
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
8 :: Int) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1)

charFromW32 :: AttrCharW32 -> Char
{-# INLINE charFromW32 #-}
charFromW32 :: AttrCharW32 -> Char
charFromW32 AttrCharW32
w =
  Int -> Char
Char.chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR (Word32 -> Int
forall a. Enum a => a -> Int
fromEnum (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ AttrCharW32 -> Word32
attrCharW32 AttrCharW32
w) Int
16

attrFromW32 :: AttrCharW32 -> Attr
{-# INLINE attrFromW32 #-}
attrFromW32 :: AttrCharW32 -> Attr
attrFromW32 AttrCharW32
w = Color -> Highlight -> Attr
Attr (AttrCharW32 -> Color
fgFromW32 AttrCharW32
w) (AttrCharW32 -> Highlight
bgFromW32 AttrCharW32
w)

spaceAttrW32 :: AttrCharW32
spaceAttrW32 :: AttrCharW32
spaceAttrW32 = AttrChar -> AttrCharW32
attrCharToW32 (AttrChar -> AttrCharW32) -> AttrChar -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ Attr -> Char -> AttrChar
AttrChar Attr
defAttr Char
' '

nbspAttrW32 :: AttrCharW32
nbspAttrW32 :: AttrCharW32
nbspAttrW32 = AttrChar -> AttrCharW32
attrCharToW32 (AttrChar -> AttrCharW32) -> AttrChar -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ Attr -> Char -> AttrChar
AttrChar Attr
defAttr Char
'\x00a0'

spaceCursorAttrW32 :: AttrCharW32
spaceCursorAttrW32 :: AttrCharW32
spaceCursorAttrW32 =
  AttrChar -> AttrCharW32
attrCharToW32 (AttrChar -> AttrCharW32) -> AttrChar -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ Attr -> Char -> AttrChar
AttrChar (Attr
defAttr {bg :: Highlight
bg = Highlight
HighlightNoneCursor}) Char
' '

trimmedLineAttrW32 :: AttrCharW32
trimmedLineAttrW32 :: AttrCharW32
trimmedLineAttrW32 = Color -> Char -> AttrCharW32
attrChar2ToW32 Color
BrBlack Char
'$'

attrChar2ToW32 :: Color -> Char -> AttrCharW32
{-# INLINE attrChar2ToW32 #-}
attrChar2ToW32 :: Color -> Char -> AttrCharW32
attrChar2ToW32 Color
fg =
  let fgNum :: Int
fgNum = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftL (Color -> Int
forall a. Enum a => a -> Int
fromEnum Color
fg) Int
8
  in \Char
acChar -> Word32 -> AttrCharW32
AttrCharW32 (Word32 -> AttrCharW32) -> Word32 -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a. Enum a => Int -> a
toEnum (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Int
fgNum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftL (Char -> Int
Char.ord Char
acChar) Int
16
--
-- These hacks save one allocation (?) (before fits-in-32bits check) compared
-- to the above, but they fail in GHC 9.2.0 and possibly don't do anything
-- for JS, which is the only real bottleneck, so disabled:
--
--import GHC.Prim (int2Word#)
--  case unsafeShiftL (fromEnum fg) 8 + unsafeShiftL (Char.ord acChar) 16 of
--    I# i -> AttrCharW32 $ W32# (int2Word# i)

attrChar1ToW32 :: Char -> AttrCharW32
{-# INLINE attrChar1ToW32 #-}
attrChar1ToW32 :: Char -> AttrCharW32
attrChar1ToW32 =
  let fgNum :: Int
fgNum = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftL (Color -> Int
forall a. Enum a => a -> Int
fromEnum Color
White) Int
8
  in \Char
acChar -> Word32 -> AttrCharW32
AttrCharW32 (Word32 -> AttrCharW32) -> Word32 -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a. Enum a => Int -> a
toEnum (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Int
fgNum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftL (Char -> Int
Char.ord Char
acChar) Int
16
--
--    case fgNum + unsafeShiftL (Char.ord acChar) 16 of
--      I# i -> AttrCharW32 $ W32# (int2Word# i)