module Game.LambdaHack.Client.UI.Frontend.ANSI
( startup, frontendName
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Control.Concurrent.Async
import Data.Char (chr, ord)
import qualified Data.Text as T
import qualified System.Console.ANSI as ANSI
import System.Exit (die)
import qualified System.IO as SIO
import Game.LambdaHack.Client.UI.Content.Screen
import Game.LambdaHack.Client.UI.Frame
import Game.LambdaHack.Client.UI.Frontend.Common
import qualified Game.LambdaHack.Client.UI.Key as K
import Game.LambdaHack.Client.UI.PointUI
import Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import Game.LambdaHack.Content.TileKind (floorSymbol)
import qualified Game.LambdaHack.Definition.Color as Color
frontendName :: String
frontendName :: String
frontendName = String
"ANSI"
startup :: ScreenContent -> IO RawFrontend
startup :: ScreenContent -> IO RawFrontend
startup coscreen :: ScreenContent
coscreen@ScreenContent{X
rwidth :: ScreenContent -> X
rwidth :: X
rwidth, X
rheight :: ScreenContent -> X
rheight :: X
rheight} = do
IO ()
ANSI.clearScreen
Maybe (X, X)
myx <- IO (Maybe (X, X))
ANSI.getTerminalSize
case Maybe (X, X)
myx of
Just (X
y, X
x) | X
x X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
rwidth Bool -> Bool -> Bool
|| X
y X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
rheight ->
String -> IO RawFrontend
forall a. String -> IO a
die (String -> IO RawFrontend) -> String -> IO RawFrontend
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
"The terminal is too small. It should have"
Text -> Text -> Text
<+> X -> Text
forall a. Show a => a -> Text
tshow X
rwidth
Text -> Text -> Text
<+> Text
"columns and"
Text -> Text -> Text
<+> X -> Text
forall a. Show a => a -> Text
tshow X
rheight
Text -> Text -> Text
<+> Text
"rows, but is has"
Text -> Text -> Text
<+> X -> Text
forall a. Show a => a -> Text
tshow X
x
Text -> Text -> Text
<+> Text
"columns and"
Text -> Text -> Text
<+> X -> Text
forall a. Show a => a -> Text
tshow X
y
Text -> Text -> Text
<+> Text
"rows. Resize it and run the program again."
Maybe (X, X)
_ -> do
RawFrontend
rf <- ScreenContent -> (SingleFrame -> IO ()) -> IO () -> IO RawFrontend
createRawFrontend ScreenContent
coscreen (ScreenContent -> SingleFrame -> IO ()
display ScreenContent
coscreen) (ScreenContent -> IO ()
shutdown ScreenContent
coscreen)
let storeKeys :: IO ()
storeKeys :: IO ()
storeKeys = do
Char
c <- IO Char
SIO.getChar
String
s <- do
if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\ESC' then do
Bool
ready <- Handle -> IO Bool
SIO.hReady Handle
SIO.stdin
if Bool
ready then do
Char
c2 <- IO Char
SIO.getChar
case Char
c2 of
Char
'\ESC' -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c]
Char
'[' -> String -> IO String
keycodeInput [Char
c, Char
c2]
Char
'O' -> String -> IO String
keycodeInput [Char
c, Char
c2]
Char
_ -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c, Char
c2]
else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c]
else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c]
let K.KM{Modifier
Key
key :: KM -> Key
modifier :: KM -> Modifier
key :: Key
modifier :: Modifier
..} = String -> KM
keyTranslate String
s
RawFrontend -> Modifier -> Key -> PointUI -> IO ()
saveKMP RawFrontend
rf Modifier
modifier Key
key (X -> X -> PointUI
PointUI X
0 X
0)
IO ()
storeKeys
keycodeInput :: String -> IO String
keycodeInput :: String -> IO String
keycodeInput String
inputSoFar = do
Bool
ready <- Handle -> IO Bool
SIO.hReady Handle
SIO.stdin
if Bool
ready then do
Char
c <- IO Char
SIO.getChar
if Char -> X
ord Char
'@' X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> X
ord Char
c Bool -> Bool -> Bool
&& Char -> X
ord Char
c X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> X
ord Char
'~'
then String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
inputSoFar String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c]
else String -> IO String
keycodeInput (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
inputSoFar String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c]
else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
inputSoFar
Handle -> BufferMode -> IO ()
SIO.hSetBuffering Handle
SIO.stdin BufferMode
SIO.NoBuffering
Handle -> BufferMode -> IO ()
SIO.hSetBuffering Handle
SIO.stderr (BufferMode -> IO ()) -> BufferMode -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe X -> BufferMode
SIO.BlockBuffering (Maybe X -> BufferMode) -> Maybe X -> BufferMode
forall a b. (a -> b) -> a -> b
$
X -> Maybe X
forall a. a -> Maybe a
Just (X -> Maybe X) -> X -> Maybe X
forall a b. (a -> b) -> a -> b
$ X
2 X -> X -> X
forall a. Num a => a -> a -> a
* X
rwidth X -> X -> X
forall a. Num a => a -> a -> a
* X
rheight
IO (Async ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Async ()) -> IO ()) -> IO (Async ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async IO ()
storeKeys
RawFrontend -> IO RawFrontend
forall (m :: * -> *) a. Monad m => a -> m a
return (RawFrontend -> IO RawFrontend) -> RawFrontend -> IO RawFrontend
forall a b. (a -> b) -> a -> b
$! RawFrontend
rf
keyTranslate :: String -> K.KM
keyTranslate :: String -> KM
keyTranslate String
e = (\(Key
key, Modifier
modifier) -> Modifier -> Key -> KM
K.KM Modifier
modifier Key
key) ((Key, Modifier) -> KM) -> (Key, Modifier) -> KM
forall a b. (a -> b) -> a -> b
$
case String
e of
String
"\ESC" -> (Key
K.Esc, Modifier
K.NoModifier)
Char
'\ESC' : Char
'[' : String
rest -> String -> (Key, Modifier)
keycodeTranslate String
rest
Char
'\ESC' : Char
'O' : String
rest -> String -> (Key, Modifier)
ocodeTranslate String
rest
[Char
'\ESC', Char
c] -> (Char -> Key
K.Char Char
c, Modifier
K.Alt)
String
"\b" -> (Key
K.BackSpace, Modifier
K.NoModifier)
String
"\DEL" -> (Key
K.BackSpace, Modifier
K.NoModifier)
String
"\n" -> (Key
K.Return, Modifier
K.NoModifier)
String
"\r" -> (Key
K.Return, Modifier
K.NoModifier)
String
" " -> (Key
K.Space, Modifier
K.NoModifier)
String
"\t" -> (Key
K.Tab, Modifier
K.NoModifier)
[Char
c] | Char -> X
ord Char
'\^A' X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> X
ord Char
c Bool -> Bool -> Bool
&& Char -> X
ord Char
c X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> X
ord Char
'\^Z' ->
(Char -> Key
K.Char (Char -> Key) -> Char -> Key
forall a b. (a -> b) -> a -> b
$ X -> Char
chr (X -> Char) -> X -> Char
forall a b. (a -> b) -> a -> b
$ Char -> X
ord Char
c X -> X -> X
forall a. Num a => a -> a -> a
- Char -> X
ord Char
'\^A' X -> X -> X
forall a. Num a => a -> a -> a
+ Char -> X
ord Char
'a', Modifier
K.Control)
|
Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'1'..Char
'9'] -> (Char -> Key
K.KP Char
c, Modifier
K.NoModifier)
| Bool
otherwise -> (Char -> Key
K.Char Char
c, Modifier
K.NoModifier)
String
_ -> (String -> Key
K.Unknown String
e, Modifier
K.NoModifier)
keycodeTranslate :: String -> (K.Key, K.Modifier)
keycodeTranslate :: String -> (Key, Modifier)
keycodeTranslate String
e =
case String
e of
String
"1~" -> (Key
K.Home, Modifier
K.NoModifier)
String
"2~" -> (Key
K.Insert, Modifier
K.NoModifier)
String
"3~" -> (Key
K.Delete, Modifier
K.NoModifier)
String
"4~" -> (Key
K.End , Modifier
K.NoModifier)
String
"5~" -> (Key
K.PgUp, Modifier
K.NoModifier)
String
"6~" -> (Key
K.PgDn, Modifier
K.NoModifier)
String
"7~" -> (Key
K.Home, Modifier
K.NoModifier)
String
"8~" -> (Key
K.End, Modifier
K.NoModifier)
String
"9~" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"10~" -> (X -> Key
K.Fun X
0, Modifier
K.NoModifier)
String
"11~" -> (X -> Key
K.Fun X
1, Modifier
K.NoModifier)
String
"12~" -> (X -> Key
K.Fun X
2, Modifier
K.NoModifier)
String
"13~" -> (X -> Key
K.Fun X
3, Modifier
K.NoModifier)
String
"14~" -> (X -> Key
K.Fun X
4, Modifier
K.NoModifier)
String
"15~" -> (X -> Key
K.Fun X
5, Modifier
K.NoModifier)
String
"17~" -> (X -> Key
K.Fun X
6, Modifier
K.NoModifier)
String
"18~" -> (X -> Key
K.Fun X
7, Modifier
K.NoModifier)
String
"19~" -> (X -> Key
K.Fun X
8, Modifier
K.NoModifier)
String
"20~" -> (X -> Key
K.Fun X
9, Modifier
K.NoModifier)
String
"21~" -> (X -> Key
K.Fun X
10, Modifier
K.NoModifier)
String
"22~" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"23~" -> (X -> Key
K.Fun X
11, Modifier
K.NoModifier)
String
"24~" -> (X -> Key
K.Fun X
12, Modifier
K.NoModifier)
String
"25~" -> (X -> Key
K.Fun X
13, Modifier
K.NoModifier)
String
"26~" -> (X -> Key
K.Fun X
14, Modifier
K.NoModifier)
String
"27~" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"28~" -> (X -> Key
K.Fun X
15, Modifier
K.NoModifier)
String
"29~" -> (X -> Key
K.Fun X
16, Modifier
K.NoModifier)
String
"30~" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"32~" -> (X -> Key
K.Fun X
18 , Modifier
K.NoModifier)
String
"33~" -> (X -> Key
K.Fun X
19 , Modifier
K.NoModifier)
String
"34~" -> (X -> Key
K.Fun X
20 , Modifier
K.NoModifier)
String
"35~" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"A" -> (Key
K.Up, Modifier
K.NoModifier)
String
"B" -> (Key
K.Down, Modifier
K.NoModifier)
String
"C" -> (Key
K.Right, Modifier
K.NoModifier)
String
"D" -> (Key
K.Left, Modifier
K.NoModifier)
String
"E" -> (Key
K.Begin, Modifier
K.NoModifier)
String
"F" -> (Key
K.End, Modifier
K.NoModifier)
String
"G" -> (Char -> Key
K.KP Char
'5', Modifier
K.NoModifier)
String
"H" -> (Key
K.Home, Modifier
K.NoModifier)
String
"I" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"J" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"K" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"L" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"M" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"N" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"O" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"1P" -> (X -> Key
K.Fun X
1, Modifier
K.NoModifier)
String
"1Q" -> (X -> Key
K.Fun X
2, Modifier
K.NoModifier)
String
"1R" -> (X -> Key
K.Fun X
3, Modifier
K.NoModifier)
String
"1S" -> (X -> Key
K.Fun X
4, Modifier
K.NoModifier)
String
"T" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"U" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"V" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"W" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"X" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"Y" -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
String
"Z" -> (Key
K.BackTab, Modifier
K.NoModifier)
String
_ -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
ocodeTranslate :: String -> (K.Key, K.Modifier)
ocodeTranslate :: String -> (Key, Modifier)
ocodeTranslate String
e =
case String
e of
String
"P" -> (X -> Key
K.Fun X
1, Modifier
K.NoModifier)
String
"Q" -> (X -> Key
K.Fun X
2, Modifier
K.NoModifier)
String
"R" -> (X -> Key
K.Fun X
3, Modifier
K.NoModifier)
String
"S" -> (X -> Key
K.Fun X
4, Modifier
K.NoModifier)
String
"p" -> (Char -> Key
K.KP Char
'0', Modifier
K.Shift)
String
"q" -> (Char -> Key
K.KP Char
'1', Modifier
K.Shift)
String
"r" -> (Char -> Key
K.KP Char
'2', Modifier
K.Shift)
String
"s" -> (Char -> Key
K.KP Char
'3', Modifier
K.Shift)
String
"t" -> (Char -> Key
K.KP Char
'4', Modifier
K.Shift)
String
"u" -> (Char -> Key
K.KP Char
'5', Modifier
K.Shift)
String
"v" -> (Char -> Key
K.KP Char
'6', Modifier
K.Shift)
String
"w" -> (Char -> Key
K.KP Char
'7', Modifier
K.Shift)
String
"x" -> (Char -> Key
K.KP Char
'8', Modifier
K.Shift)
String
"y" -> (Char -> Key
K.KP Char
'9', Modifier
K.Shift)
String
_ -> (String -> Key
K.Unknown (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"\\ESCO" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e, Modifier
K.NoModifier)
shutdown :: ScreenContent -> IO ()
shutdown :: ScreenContent -> IO ()
shutdown ScreenContent{X
rheight :: X
rheight :: ScreenContent -> X
rheight} = do
Handle -> X -> X -> IO ()
ANSI.hSetCursorPosition Handle
SIO.stderr (X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- X
1) X
0
Handle -> IO ()
SIO.hFlush Handle
SIO.stdout IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
SIO.hFlush Handle
SIO.stderr
display :: ScreenContent
-> SingleFrame
-> IO ()
display :: ScreenContent -> SingleFrame -> IO ()
display ScreenContent{X
rwidth :: X
rwidth :: ScreenContent -> X
rwidth} SingleFrame{Array AttrCharW32
singleArray :: SingleFrame -> Array AttrCharW32
singleArray :: Array AttrCharW32
singleArray} = do
Handle -> IO ()
ANSI.hHideCursor Handle
SIO.stderr
let cutInChunks :: [AttrCharW32] -> [[AttrCharW32]]
cutInChunks [] = []
cutInChunks [AttrCharW32]
l = let ([AttrCharW32]
ch, [AttrCharW32]
r) = X -> [AttrCharW32] -> ([AttrCharW32], [AttrCharW32])
forall a. X -> [a] -> ([a], [a])
splitAt X
rwidth [AttrCharW32]
l
in [AttrCharW32]
ch [AttrCharW32] -> [[AttrCharW32]] -> [[AttrCharW32]]
forall a. a -> [a] -> [a]
: [AttrCharW32] -> [[AttrCharW32]]
cutInChunks [AttrCharW32]
r
f :: (X, [AttrCharW32]) -> IO ()
f (!X
y, [AttrCharW32]
chunk) = do
Handle -> X -> X -> IO ()
ANSI.hSetCursorPosition Handle
SIO.stderr X
y X
0
Handle -> String -> IO ()
SIO.hPutStr Handle
SIO.stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [AttrCharW32] -> String
g [AttrCharW32]
chunk
g :: [AttrCharW32] -> String
g = (AttrCharW32 -> String) -> [AttrCharW32] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AttrCharW32 -> String
h
h :: AttrCharW32 -> String
h !AttrCharW32
w =
let acChar :: Char
acChar = Char -> Char
squashChar (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ AttrCharW32 -> Char
Color.charFromW32 AttrCharW32
w
(Color
fg, Color
bg) = Attr -> (Color, Color)
setAttr (Attr -> (Color, Color)) -> Attr -> (Color, Color)
forall a b. (a -> b) -> a -> b
$ AttrCharW32 -> Attr
Color.attrFromW32 AttrCharW32
w
in [SGR] -> String
ANSI.setSGRCode [ (ColorIntensity -> Color -> SGR) -> (ColorIntensity, Color) -> SGR
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
ANSI.Foreground)
((ColorIntensity, Color) -> SGR) -> (ColorIntensity, Color) -> SGR
forall a b. (a -> b) -> a -> b
$ Color -> (ColorIntensity, Color)
colorTranslate Color
fg
, (ColorIntensity -> Color -> SGR) -> (ColorIntensity, Color) -> SGR
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
ANSI.Background)
((ColorIntensity, Color) -> SGR) -> (ColorIntensity, Color) -> SGR
forall a b. (a -> b) -> a -> b
$ Color -> (ColorIntensity, Color)
colorTranslate Color
bg ]
String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
acChar]
((X, [AttrCharW32]) -> IO ()) -> [(X, [AttrCharW32])] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (X, [AttrCharW32]) -> IO ()
f ([(X, [AttrCharW32])] -> IO ()) -> [(X, [AttrCharW32])] -> IO ()
forall a b. (a -> b) -> a -> b
$ [X] -> [[AttrCharW32]] -> [(X, [AttrCharW32])]
forall a b. [a] -> [b] -> [(a, b)]
zip [X
0 ..] ([[AttrCharW32]] -> [(X, [AttrCharW32])])
-> [[AttrCharW32]] -> [(X, [AttrCharW32])]
forall a b. (a -> b) -> a -> b
$ [AttrCharW32] -> [[AttrCharW32]]
cutInChunks ([AttrCharW32] -> [[AttrCharW32]])
-> [AttrCharW32] -> [[AttrCharW32]]
forall a b. (a -> b) -> a -> b
$ Array AttrCharW32 -> [AttrCharW32]
forall c. UnboxRepClass c => Array c -> [c]
PointArray.toListA Array AttrCharW32
singleArray
let Point{X
py :: Point -> X
px :: Point -> X
py :: X
px :: X
..} = (AttrCharW32 -> AttrCharW32 -> Ordering)
-> Array AttrCharW32 -> Point
forall c.
UnboxRepClass c =>
(c -> c -> Ordering) -> Array c -> Point
PointArray.maxIndexByA ((AttrCharW32 -> Highlight)
-> AttrCharW32 -> AttrCharW32 -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing AttrCharW32 -> Highlight
Color.bgFromW32) Array AttrCharW32
singleArray
Handle -> X -> X -> IO ()
ANSI.hSetCursorPosition Handle
SIO.stderr X
py X
px
Handle -> IO ()
ANSI.hShowCursor Handle
SIO.stderr
Handle -> [SGR] -> IO ()
ANSI.hSetSGR Handle
SIO.stderr [(ColorIntensity -> Color -> SGR) -> (ColorIntensity, Color) -> SGR
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
ANSI.Foreground)
((ColorIntensity, Color) -> SGR) -> (ColorIntensity, Color) -> SGR
forall a b. (a -> b) -> a -> b
$ Color -> (ColorIntensity, Color)
colorTranslate Color
Color.White]
Handle -> [SGR] -> IO ()
ANSI.hSetSGR Handle
SIO.stderr [(ColorIntensity -> Color -> SGR) -> (ColorIntensity, Color) -> SGR
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
ANSI.Background)
((ColorIntensity, Color) -> SGR) -> (ColorIntensity, Color) -> SGR
forall a b. (a -> b) -> a -> b
$ Color -> (ColorIntensity, Color)
colorTranslate Color
Color.Black]
Handle -> IO ()
SIO.hFlush Handle
SIO.stderr
squashChar :: Char -> Char
squashChar :: Char -> Char
squashChar Char
c = if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
floorSymbol then Char
'.' else Char
c
setAttr :: Color.Attr -> (Color.Color, Color.Color)
setAttr :: Attr -> (Color, Color)
setAttr Color.Attr{Highlight
Color
bg :: Attr -> Highlight
fg :: Attr -> Color
bg :: Highlight
fg :: Color
..} =
let (Color
fg1, Color
bg1) = case Highlight
bg of
Highlight
Color.HighlightNone -> (Color
fg, Color
Color.Black)
Highlight
Color.HighlightWhite ->
if Color
fg Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
/= Color
Color.Magenta
then (Color
fg, Color
Color.Magenta)
else (Color
fg, Color
Color.BrBlack)
Highlight
Color.HighlightRed ->
if Color
fg Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
/= Color
Color.Red
then (Color
fg, Color
Color.Red)
else (Color
fg, Color
Color.defFG)
Highlight
Color.HighlightYellow -> (Color
fg, Color
Color.Black)
Highlight
Color.HighlightYellowAim -> (Color
Color.Black, Color
Color.defFG)
Highlight
Color.HighlightRedAim ->
if Color
fg Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
/= Color
Color.Red
then (Color
fg, Color
Color.Red)
else (Color
fg, Color
Color.defFG)
Highlight
Color.HighlightNoneCursor -> (Color
fg, Color
Color.Black)
Highlight
_ -> if Color
fg Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
/= Highlight -> Color
Color.highlightToColor Highlight
bg
then (Color
fg, Highlight -> Color
Color.highlightToColor Highlight
bg)
else (Color
fg, if Color
fg Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
Color.BrBlack
then Color
Color.Black
else Color
Color.BrBlack)
in (Color
fg1, Color
bg1)
colorTranslate :: Color.Color -> (ANSI.ColorIntensity, ANSI.Color)
colorTranslate :: Color -> (ColorIntensity, Color)
colorTranslate Color
Color.Black = (ColorIntensity
ANSI.Dull, Color
ANSI.Black)
colorTranslate Color
Color.Red = (ColorIntensity
ANSI.Dull, Color
ANSI.Red)
colorTranslate Color
Color.Green = (ColorIntensity
ANSI.Dull, Color
ANSI.Green)
colorTranslate Color
Color.Brown = (ColorIntensity
ANSI.Dull, Color
ANSI.Yellow)
colorTranslate Color
Color.Blue = (ColorIntensity
ANSI.Dull, Color
ANSI.Blue)
colorTranslate Color
Color.Magenta = (ColorIntensity
ANSI.Dull, Color
ANSI.Magenta)
colorTranslate Color
Color.Cyan = (ColorIntensity
ANSI.Dull, Color
ANSI.Cyan)
colorTranslate Color
Color.White = (ColorIntensity
ANSI.Dull, Color
ANSI.White)
colorTranslate Color
Color.AltWhite = (ColorIntensity
ANSI.Dull, Color
ANSI.White)
colorTranslate Color
Color.BrBlack = (ColorIntensity
ANSI.Vivid, Color
ANSI.Black)
colorTranslate Color
Color.BrRed = (ColorIntensity
ANSI.Vivid, Color
ANSI.Red)
colorTranslate Color
Color.BrGreen = (ColorIntensity
ANSI.Vivid, Color
ANSI.Green)
colorTranslate Color
Color.BrYellow = (ColorIntensity
ANSI.Vivid, Color
ANSI.Yellow)
colorTranslate Color
Color.BrBlue = (ColorIntensity
ANSI.Vivid, Color
ANSI.Blue)
colorTranslate Color
Color.BrMagenta = (ColorIntensity
ANSI.Vivid, Color
ANSI.Magenta)
colorTranslate Color
Color.BrCyan = (ColorIntensity
ANSI.Vivid, Color
ANSI.Cyan)
colorTranslate Color
Color.BrWhite = (ColorIntensity
ANSI.Vivid, Color
ANSI.White)