{-# LANGUAGE RankNTypes #-}
module Game.LambdaHack.Client.UI.Overlay
(
AttrString, blankAttrString, textToAS, textFgToAS, stringToAS
, (<+:>), (<\:>)
, AttrLine, attrLine, emptyAttrLine, attrStringToAL, firstParagraph, linesAttr
, textToAL, textFgToAL, stringToAL, splitAttrString
, indentSplitAttrString, indentSplitAttrString2
, Overlay, offsetOverlay, offsetOverlayX, updateLine
#ifdef EXPOSE_INTERNAL
, splitAttrPhrase
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Data.Char (isSpace)
import qualified Data.Text as T
import Game.LambdaHack.Client.UI.PointUI
import qualified Game.LambdaHack.Definition.Color as Color
type AttrString = [Color.AttrCharW32]
blankAttrString :: Int -> AttrString
blankAttrString :: Int -> AttrString
blankAttrString w :: Int
w = Int -> AttrCharW32 -> AttrString
forall a. Int -> a -> [a]
replicate Int
w AttrCharW32
Color.spaceAttrW32
textToAS :: Text -> AttrString
textToAS :: Text -> AttrString
textToAS !Text
t =
let f :: Char -> AttrString -> AttrString
f c :: Char
c l :: AttrString
l = let !ac :: AttrCharW32
ac = Char -> AttrCharW32
Color.attrChar1ToW32 Char
c
in AttrCharW32
ac AttrCharW32 -> AttrString -> AttrString
forall a. a -> [a] -> [a]
: AttrString
l
in (Char -> AttrString -> AttrString)
-> AttrString -> Text -> AttrString
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr Char -> AttrString -> AttrString
f [] Text
t
textFgToAS :: Color.Color -> Text -> AttrString
textFgToAS :: Color -> Text -> AttrString
textFgToAS !Color
fg !Text
t =
let f :: Char -> AttrString -> AttrString
f ' ' l :: AttrString
l = AttrCharW32
Color.spaceAttrW32 AttrCharW32 -> AttrString -> AttrString
forall a. a -> [a] -> [a]
: AttrString
l
f c :: Char
c l :: AttrString
l = let !ac :: AttrCharW32
ac = Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
fg Char
c
in AttrCharW32
ac AttrCharW32 -> AttrString -> AttrString
forall a. a -> [a] -> [a]
: AttrString
l
in (Char -> AttrString -> AttrString)
-> AttrString -> Text -> AttrString
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr Char -> AttrString -> AttrString
f [] Text
t
stringToAS :: String -> AttrString
stringToAS :: String -> AttrString
stringToAS = (Char -> AttrCharW32) -> String -> AttrString
forall a b. (a -> b) -> [a] -> [b]
map Char -> AttrCharW32
Color.attrChar1ToW32
infixr 6 <+:>
(<+:>) :: AttrString -> AttrString -> AttrString
<+:> :: AttrString -> AttrString -> AttrString
(<+:>) [] l2 :: AttrString
l2 = AttrString
l2
(<+:>) l1 :: AttrString
l1 [] = AttrString
l1
(<+:>) l1 :: AttrString
l1 l2 :: AttrString
l2@(c2 :: AttrCharW32
c2 : _) =
if Char -> Bool
isSpace (AttrCharW32 -> Char
Color.charFromW32 AttrCharW32
c2) Bool -> Bool -> Bool
|| Char -> Bool
isSpace (AttrCharW32 -> Char
Color.charFromW32 (AttrString -> AttrCharW32
forall a. [a] -> a
last AttrString
l1))
then AttrString
l1 AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
l2
else AttrString
l1 AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.spaceAttrW32] AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
l2
infixr 6 <\:>
(<\:>) :: AttrString -> AttrString -> AttrString
<\:> :: AttrString -> AttrString -> AttrString
(<\:>) [] l2 :: AttrString
l2 = AttrString
l2
(<\:>) l1 :: AttrString
l1 [] = AttrString
l1
(<\:>) l1 :: AttrString
l1 l2 :: AttrString
l2@(c2 :: AttrCharW32
c2 : _) =
if AttrCharW32 -> Char
Color.charFromW32 AttrCharW32
c2 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' Bool -> Bool -> Bool
|| AttrCharW32 -> Char
Color.charFromW32 (AttrString -> AttrCharW32
forall a. [a] -> a
last AttrString
l1) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n'
then AttrString
l1 AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
l2
else AttrString
l1 AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ String -> AttrString
stringToAS "\n" AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
l2
nonbreakableRev :: [String]
nonbreakableRev :: [String]
nonbreakableRev = ["eht", "a", "na", "ehT", "A", "nA", "I"]
isPrefixOfNonbreakable :: AttrString -> Bool
isPrefixOfNonbreakable :: AttrString -> Bool
isPrefixOfNonbreakable s :: AttrString
s =
let isPrefixOfNb :: String -> String -> Bool
isPrefixOfNb sRev :: String
sRev nbRev :: String
nbRev = case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
nbRev String
sRev of
Nothing -> Bool
False
Just [] -> Bool
True
Just (c :: Char
c : _) -> Char -> Bool
isSpace Char
c
in (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
isPrefixOfNb (String -> String -> Bool) -> String -> String -> Bool
forall a b. (a -> b) -> a -> b
$ (AttrCharW32 -> Char) -> AttrString -> String
forall a b. (a -> b) -> [a] -> [b]
map AttrCharW32 -> Char
Color.charFromW32 AttrString
s) [String]
nonbreakableRev
breakAtSpace :: AttrString -> (AttrString, AttrString)
breakAtSpace :: AttrString -> (AttrString, AttrString)
breakAtSpace lRev :: AttrString
lRev =
let (pre :: AttrString
pre, post :: AttrString
post) = (AttrCharW32 -> Bool) -> AttrString -> (AttrString, AttrString)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
== AttrCharW32
Color.spaceAttrW32) AttrString
lRev
in case AttrString
post of
c :: AttrCharW32
c : rest :: AttrString
rest | AttrCharW32
c AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
== AttrCharW32
Color.spaceAttrW32 ->
if AttrString -> Bool
isPrefixOfNonbreakable AttrString
rest
then let (pre2 :: AttrString
pre2, post2 :: AttrString
post2) = AttrString -> (AttrString, AttrString)
breakAtSpace AttrString
rest
in (AttrString
pre AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrCharW32
c AttrCharW32 -> AttrString -> AttrString
forall a. a -> [a] -> [a]
: AttrString
pre2, AttrString
post2)
else (AttrString
pre, AttrString
post)
_ -> (AttrString
pre, AttrString
post)
newtype AttrLine = AttrLine {AttrLine -> AttrString
attrLine :: AttrString}
deriving (Int -> AttrLine -> ShowS
[AttrLine] -> ShowS
AttrLine -> String
(Int -> AttrLine -> ShowS)
-> (AttrLine -> String) -> ([AttrLine] -> ShowS) -> Show AttrLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttrLine] -> ShowS
$cshowList :: [AttrLine] -> ShowS
show :: AttrLine -> String
$cshow :: AttrLine -> String
showsPrec :: Int -> AttrLine -> ShowS
$cshowsPrec :: Int -> AttrLine -> ShowS
Show, AttrLine -> AttrLine -> Bool
(AttrLine -> AttrLine -> Bool)
-> (AttrLine -> AttrLine -> Bool) -> Eq AttrLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttrLine -> AttrLine -> Bool
$c/= :: AttrLine -> AttrLine -> Bool
== :: AttrLine -> AttrLine -> Bool
$c== :: AttrLine -> AttrLine -> Bool
Eq)
emptyAttrLine :: AttrLine
emptyAttrLine :: AttrLine
emptyAttrLine = AttrString -> AttrLine
AttrLine []
attrStringToAL :: AttrString -> AttrLine
attrStringToAL :: AttrString -> AttrLine
attrStringToAL s :: AttrString
s =
#ifdef WITH_EXPENSIVE_ASSERTIONS
Bool -> AttrLine -> AttrLine
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ((AttrCharW32 -> Bool) -> AttrString -> Bool
forall a. Show a => (a -> Bool) -> [a] -> Bool
allB (\ac :: AttrCharW32
ac -> AttrCharW32 -> Char
Color.charFromW32 AttrCharW32
ac Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n') AttrString
s) (AttrLine -> AttrLine) -> AttrLine -> AttrLine
forall a b. (a -> b) -> a -> b
$
Bool -> AttrLine -> AttrLine
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (AttrString -> Int
forall a. [a] -> Int
length AttrString
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
|| AttrString -> AttrCharW32
forall a. [a] -> a
last AttrString
s AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
/= AttrCharW32
Color.spaceAttrW32
Bool -> String -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (AttrCharW32 -> Char) -> AttrString -> String
forall a b. (a -> b) -> [a] -> [b]
map AttrCharW32 -> Char
Color.charFromW32 AttrString
s) (AttrLine -> AttrLine) -> AttrLine -> AttrLine
forall a b. (a -> b) -> a -> b
$
#endif
AttrString -> AttrLine
AttrLine AttrString
s
firstParagraph :: AttrString -> AttrLine
firstParagraph :: AttrString -> AttrLine
firstParagraph s :: AttrString
s = case AttrString -> [AttrLine]
linesAttr AttrString
s of
[] -> AttrLine
emptyAttrLine
l :: AttrLine
l : _ -> AttrLine
l
textToAL :: Text -> AttrLine
textToAL :: Text -> AttrLine
textToAL !Text
t =
let f :: Char -> AttrString -> AttrString
f '\n' _ = String -> AttrString
forall a. (?callStack::CallStack) => String -> a
error (String -> AttrString) -> String -> AttrString
forall a b. (a -> b) -> a -> b
$ "illegal end of line in: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t
f c :: Char
c l :: AttrString
l = let !ac :: AttrCharW32
ac = Char -> AttrCharW32
Color.attrChar1ToW32 Char
c
in AttrCharW32
ac AttrCharW32 -> AttrString -> AttrString
forall a. a -> [a] -> [a]
: AttrString
l
s :: AttrString
s = (Char -> AttrString -> AttrString)
-> AttrString -> Text -> AttrString
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr Char -> AttrString -> AttrString
f [] Text
t
in AttrString -> AttrLine
AttrLine (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$
#ifdef WITH_EXPENSIVE_ASSERTIONS
Bool -> AttrString -> AttrString
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (AttrString -> Int
forall a. [a] -> Int
length AttrString
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
|| AttrString -> AttrCharW32
forall a. [a] -> a
last AttrString
s AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
/= AttrCharW32
Color.spaceAttrW32 Bool -> Text -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` Text
t)
#endif
AttrString
s
textFgToAL :: Color.Color -> Text -> AttrLine
textFgToAL :: Color -> Text -> AttrLine
textFgToAL !Color
fg !Text
t =
let f :: Char -> AttrString -> AttrString
f '\n' _ = String -> AttrString
forall a. (?callStack::CallStack) => String -> a
error (String -> AttrString) -> String -> AttrString
forall a b. (a -> b) -> a -> b
$ "illegal end of line in: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t
f ' ' l :: AttrString
l = AttrCharW32
Color.spaceAttrW32 AttrCharW32 -> AttrString -> AttrString
forall a. a -> [a] -> [a]
: AttrString
l
f c :: Char
c l :: AttrString
l = let !ac :: AttrCharW32
ac = Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
fg Char
c
in AttrCharW32
ac AttrCharW32 -> AttrString -> AttrString
forall a. a -> [a] -> [a]
: AttrString
l
s :: AttrString
s = (Char -> AttrString -> AttrString)
-> AttrString -> Text -> AttrString
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr Char -> AttrString -> AttrString
f [] Text
t
in AttrString -> AttrLine
AttrLine (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$
#ifdef WITH_EXPENSIVE_ASSERTIONS
Bool -> AttrString -> AttrString
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (AttrString -> Int
forall a. [a] -> Int
length AttrString
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
|| AttrString -> AttrCharW32
forall a. [a] -> a
last AttrString
s AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
/= AttrCharW32
Color.spaceAttrW32 Bool -> Text -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` Text
t)
#endif
AttrString
s
stringToAL :: String -> AttrLine
stringToAL :: String -> AttrLine
stringToAL s :: String
s = AttrString -> AttrLine
attrStringToAL (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ (Char -> AttrCharW32) -> String -> AttrString
forall a b. (a -> b) -> [a] -> [b]
map Char -> AttrCharW32
Color.attrChar1ToW32 String
s
linesAttr :: AttrString -> [AttrLine]
linesAttr :: AttrString -> [AttrLine]
linesAttr [] = []
linesAttr l :: AttrString
l = (AttrLine, [AttrLine]) -> [AttrLine]
forall a. (a, [a]) -> [a]
cons (case (AttrCharW32 -> Bool) -> AttrString -> (AttrString, AttrString)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\ac :: AttrCharW32
ac -> AttrCharW32 -> Char
Color.charFromW32 AttrCharW32
ac Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n') AttrString
l of
(h :: AttrString
h, t :: AttrString
t) -> (AttrString -> AttrLine
attrStringToAL AttrString
h, case AttrString
t of
[] -> []
_ : tt :: AttrString
tt -> AttrString -> [AttrLine]
linesAttr AttrString
tt))
where
cons :: (a, [a]) -> [a]
cons ~(h :: a
h, t :: [a]
t) = a
h a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
t
splitAttrString :: Int -> Int -> AttrString -> [AttrLine]
splitAttrString :: Int -> Int -> AttrString -> [AttrLine]
splitAttrString w0 :: Int
w0 w1 :: Int
w1 l :: AttrString
l = case AttrString -> [AttrLine]
linesAttr AttrString
l of
[] -> []
x :: AttrLine
x : xs :: [AttrLine]
xs ->
(Int -> Int -> AttrLine -> [AttrLine]
splitAttrPhrase Int
w0 Int
w1
(AttrLine -> [AttrLine])
-> (AttrLine -> AttrLine) -> AttrLine -> [AttrLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrString -> AttrLine
AttrLine (AttrString -> AttrLine)
-> (AttrLine -> AttrString) -> AttrLine -> AttrLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttrCharW32 -> Bool) -> AttrString -> AttrString
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
== AttrCharW32
Color.spaceAttrW32) (AttrString -> AttrString)
-> (AttrLine -> AttrString) -> AttrLine -> AttrString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrLine -> AttrString
attrLine) AttrLine
x
[AttrLine] -> [AttrLine] -> [AttrLine]
forall a. [a] -> [a] -> [a]
++ (AttrLine -> [AttrLine]) -> [AttrLine] -> [AttrLine]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Int -> AttrLine -> [AttrLine]
splitAttrPhrase Int
w1 Int
w1
(AttrLine -> [AttrLine])
-> (AttrLine -> AttrLine) -> AttrLine -> [AttrLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrString -> AttrLine
AttrLine (AttrString -> AttrLine)
-> (AttrLine -> AttrString) -> AttrLine -> AttrLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttrCharW32 -> Bool) -> AttrString -> AttrString
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
== AttrCharW32
Color.spaceAttrW32) (AttrString -> AttrString)
-> (AttrLine -> AttrString) -> AttrLine -> AttrString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrLine -> AttrString
attrLine) [AttrLine]
xs
indentSplitAttrString :: Int -> AttrString -> [AttrLine]
indentSplitAttrString :: Int -> AttrString -> [AttrLine]
indentSplitAttrString w :: Int
w l :: AttrString
l =
let ts :: [AttrLine]
ts = Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
w (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) AttrString
l
in case [AttrLine]
ts of
[] -> []
hd :: AttrLine
hd : tl :: [AttrLine]
tl -> AttrLine
hd AttrLine -> [AttrLine] -> [AttrLine]
forall a. a -> [a] -> [a]
: (AttrLine -> AttrLine) -> [AttrLine] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map (AttrString -> AttrLine
AttrLine (AttrString -> AttrLine)
-> (AttrLine -> AttrString) -> AttrLine -> AttrLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([AttrCharW32
Color.spaceAttrW32] AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++) (AttrString -> AttrString)
-> (AttrLine -> AttrString) -> AttrLine -> AttrString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrLine -> AttrString
attrLine) [AttrLine]
tl
indentSplitAttrString2 :: Bool -> Int -> AttrString -> [AttrLine]
indentSplitAttrString2 :: Bool -> Int -> AttrString -> [AttrLine]
indentSplitAttrString2 isProp :: Bool
isProp w :: Int
w l :: AttrString
l =
let nspaces :: Int
nspaces = if Bool
isProp then 4 else 2
ts :: [AttrLine]
ts = Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
w (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nspaces) AttrString
l
spaces :: AttrString
spaces = Int -> AttrCharW32 -> AttrString
forall a. Int -> a -> [a]
replicate Int
nspaces AttrCharW32
Color.spaceAttrW32
in case [AttrLine]
ts of
[] -> []
hd :: AttrLine
hd : tl :: [AttrLine]
tl -> AttrLine
hd AttrLine -> [AttrLine] -> [AttrLine]
forall a. a -> [a] -> [a]
: (AttrLine -> AttrLine) -> [AttrLine] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map (AttrString -> AttrLine
AttrLine (AttrString -> AttrLine)
-> (AttrLine -> AttrString) -> AttrLine -> AttrLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttrString
spaces AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++) (AttrString -> AttrString)
-> (AttrLine -> AttrString) -> AttrLine -> AttrString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrLine -> AttrString
attrLine) [AttrLine]
tl
splitAttrPhrase :: Int -> Int -> AttrLine -> [AttrLine]
splitAttrPhrase :: Int -> Int -> AttrLine -> [AttrLine]
splitAttrPhrase w0 :: Int
w0 w1 :: Int
w1 (AttrLine xs :: AttrString
xs)
| Int
w0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= AttrString -> Int
forall a. [a] -> Int
length AttrString
xs = [AttrString -> AttrLine
AttrLine AttrString
xs]
| Bool
otherwise =
let (pre :: AttrString
pre, postRaw :: AttrString
postRaw) = Int -> AttrString -> (AttrString, AttrString)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
w0 AttrString
xs
preRev :: AttrString
preRev = AttrString -> AttrString
forall a. [a] -> [a]
reverse AttrString
pre
((ppre :: AttrString
ppre, ppost :: AttrString
ppost), post :: AttrString
post) = case AttrString
postRaw of
c :: AttrCharW32
c : rest :: AttrString
rest | AttrCharW32
c AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
== AttrCharW32
Color.spaceAttrW32
Bool -> Bool -> Bool
&& Bool -> Bool
not (AttrString -> Bool
isPrefixOfNonbreakable AttrString
preRev) ->
(([], AttrString
preRev), AttrString
rest)
_ -> (AttrString -> (AttrString, AttrString)
breakAtSpace AttrString
preRev, AttrString
postRaw)
in if (AttrCharW32 -> Bool) -> AttrString -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
== AttrCharW32
Color.spaceAttrW32) AttrString
ppost
then AttrString -> AttrLine
AttrLine (AttrString -> AttrString
forall a. [a] -> [a]
reverse (AttrString -> AttrString) -> AttrString -> AttrString
forall a b. (a -> b) -> a -> b
$ (AttrCharW32 -> Bool) -> AttrString -> AttrString
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
== AttrCharW32
Color.spaceAttrW32) AttrString
preRev) AttrLine -> [AttrLine] -> [AttrLine]
forall a. a -> [a] -> [a]
:
Int -> Int -> AttrLine -> [AttrLine]
splitAttrPhrase Int
w1 Int
w1 (AttrString -> AttrLine
AttrLine AttrString
post)
else AttrString -> AttrLine
AttrLine (AttrString -> AttrString
forall a. [a] -> [a]
reverse (AttrString -> AttrString) -> AttrString -> AttrString
forall a b. (a -> b) -> a -> b
$ (AttrCharW32 -> Bool) -> AttrString -> AttrString
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
== AttrCharW32
Color.spaceAttrW32) AttrString
ppost)
AttrLine -> [AttrLine] -> [AttrLine]
forall a. a -> [a] -> [a]
: Int -> Int -> AttrLine -> [AttrLine]
splitAttrPhrase Int
w1 Int
w1 (AttrString -> AttrLine
AttrLine (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ AttrString -> AttrString
forall a. [a] -> [a]
reverse AttrString
ppre AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
post)
type Overlay = [(PointUI, AttrLine)]
offsetOverlay :: [AttrLine] -> Overlay
offsetOverlay :: [AttrLine] -> Overlay
offsetOverlay l :: [AttrLine]
l = ((Int, AttrLine) -> (PointUI, AttrLine))
-> [(Int, AttrLine)] -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> PointUI) -> (Int, AttrLine) -> (PointUI, AttrLine)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Int -> PointUI) -> (Int, AttrLine) -> (PointUI, AttrLine))
-> (Int -> PointUI) -> (Int, AttrLine) -> (PointUI, AttrLine)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> PointUI
PointUI 0) ([(Int, AttrLine)] -> Overlay) -> [(Int, AttrLine)] -> Overlay
forall a b. (a -> b) -> a -> b
$ [Int] -> [AttrLine] -> [(Int, AttrLine)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] [AttrLine]
l
offsetOverlayX :: [(Int, AttrLine)] -> Overlay
offsetOverlayX :: [(Int, AttrLine)] -> Overlay
offsetOverlayX l :: [(Int, AttrLine)]
l =
((Int, (Int, AttrLine)) -> (PointUI, AttrLine))
-> [(Int, (Int, AttrLine))] -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map (\(y :: Int
y, (x :: Int
x, al :: AttrLine
al)) -> (Int -> Int -> PointUI
PointUI Int
x Int
y, AttrLine
al)) ([(Int, (Int, AttrLine))] -> Overlay)
-> [(Int, (Int, AttrLine))] -> Overlay
forall a b. (a -> b) -> a -> b
$ [Int] -> [(Int, AttrLine)] -> [(Int, (Int, AttrLine))]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] [(Int, AttrLine)]
l
updateLine :: Int -> (Int -> AttrString -> AttrString) -> Overlay -> Overlay
updateLine :: Int -> (Int -> AttrString -> AttrString) -> Overlay -> Overlay
updateLine y :: Int
y f :: Int -> AttrString -> AttrString
f ov :: Overlay
ov =
let upd :: (PointUI, AttrLine) -> (PointUI, AttrLine)
upd (p :: PointUI
p@(PointUI px :: Int
px py :: Int
py), AttrLine l :: AttrString
l) =
if Int
py Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y then (PointUI
p, AttrString -> AttrLine
AttrLine (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ Int -> AttrString -> AttrString
f Int
px AttrString
l) else (PointUI
p, AttrString -> AttrLine
AttrLine AttrString
l)
in ((PointUI, AttrLine) -> (PointUI, AttrLine)) -> Overlay -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map (PointUI, AttrLine) -> (PointUI, AttrLine)
upd Overlay
ov