module Game.LambdaHack.Client.UI.Slideshow
( DisplayFont, isSquareFont, isMonoFont, FontOverlayMap, FontSetup(..)
, multiFontSetup, monoFontSetup, singleFontSetup, textSize
, ButtonWidth(..), KYX, OKX, Slideshow(slideshow)
, emptySlideshow, unsnoc, toSlideshow, attrLinesToFontMap
, maxYofOverlay, menuToSlideshow, wrapOKX, splitOverlay, splitOKX
, highSlideshow
#ifdef EXPOSE_INTERNAL
, moreMsg, endMsg, keysOKX, showTable, showNearbyScores
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import Data.Time.LocalTime
import Game.LambdaHack.Client.UI.ItemSlot
import qualified Game.LambdaHack.Client.UI.Key as K
import Game.LambdaHack.Client.UI.Msg
import Game.LambdaHack.Client.UI.Overlay
import Game.LambdaHack.Client.UI.PointUI
import qualified Game.LambdaHack.Common.HighScore as HighScore
import qualified Game.LambdaHack.Definition.Color as Color
data DisplayFont = SquareFont | MonoFont | PropFont
deriving (Int -> DisplayFont -> ShowS
[DisplayFont] -> ShowS
DisplayFont -> String
(Int -> DisplayFont -> ShowS)
-> (DisplayFont -> String)
-> ([DisplayFont] -> ShowS)
-> Show DisplayFont
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisplayFont] -> ShowS
$cshowList :: [DisplayFont] -> ShowS
show :: DisplayFont -> String
$cshow :: DisplayFont -> String
showsPrec :: Int -> DisplayFont -> ShowS
$cshowsPrec :: Int -> DisplayFont -> ShowS
Show, DisplayFont -> DisplayFont -> Bool
(DisplayFont -> DisplayFont -> Bool)
-> (DisplayFont -> DisplayFont -> Bool) -> Eq DisplayFont
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayFont -> DisplayFont -> Bool
$c/= :: DisplayFont -> DisplayFont -> Bool
== :: DisplayFont -> DisplayFont -> Bool
$c== :: DisplayFont -> DisplayFont -> Bool
Eq, Int -> DisplayFont
DisplayFont -> Int
DisplayFont -> [DisplayFont]
DisplayFont -> DisplayFont
DisplayFont -> DisplayFont -> [DisplayFont]
DisplayFont -> DisplayFont -> DisplayFont -> [DisplayFont]
(DisplayFont -> DisplayFont)
-> (DisplayFont -> DisplayFont)
-> (Int -> DisplayFont)
-> (DisplayFont -> Int)
-> (DisplayFont -> [DisplayFont])
-> (DisplayFont -> DisplayFont -> [DisplayFont])
-> (DisplayFont -> DisplayFont -> [DisplayFont])
-> (DisplayFont -> DisplayFont -> DisplayFont -> [DisplayFont])
-> Enum DisplayFont
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 :: DisplayFont -> DisplayFont -> DisplayFont -> [DisplayFont]
$cenumFromThenTo :: DisplayFont -> DisplayFont -> DisplayFont -> [DisplayFont]
enumFromTo :: DisplayFont -> DisplayFont -> [DisplayFont]
$cenumFromTo :: DisplayFont -> DisplayFont -> [DisplayFont]
enumFromThen :: DisplayFont -> DisplayFont -> [DisplayFont]
$cenumFromThen :: DisplayFont -> DisplayFont -> [DisplayFont]
enumFrom :: DisplayFont -> [DisplayFont]
$cenumFrom :: DisplayFont -> [DisplayFont]
fromEnum :: DisplayFont -> Int
$cfromEnum :: DisplayFont -> Int
toEnum :: Int -> DisplayFont
$ctoEnum :: Int -> DisplayFont
pred :: DisplayFont -> DisplayFont
$cpred :: DisplayFont -> DisplayFont
succ :: DisplayFont -> DisplayFont
$csucc :: DisplayFont -> DisplayFont
Enum)
isSquareFont :: DisplayFont -> Bool
isSquareFont :: DisplayFont -> Bool
isSquareFont SquareFont = Bool
True
isSquareFont _ = Bool
False
isMonoFont :: DisplayFont -> Bool
isMonoFont :: DisplayFont -> Bool
isMonoFont MonoFont = Bool
True
isMonoFont _ = Bool
False
type FontOverlayMap = EM.EnumMap DisplayFont Overlay
data FontSetup = FontSetup
{ FontSetup -> DisplayFont
squareFont :: DisplayFont
, FontSetup -> DisplayFont
monoFont :: DisplayFont
, FontSetup -> DisplayFont
propFont :: DisplayFont
}
multiFontSetup :: FontSetup
multiFontSetup :: FontSetup
multiFontSetup = DisplayFont -> DisplayFont -> DisplayFont -> FontSetup
FontSetup DisplayFont
SquareFont DisplayFont
MonoFont DisplayFont
PropFont
monoFontSetup :: FontSetup
monoFontSetup :: FontSetup
monoFontSetup = DisplayFont -> DisplayFont -> DisplayFont -> FontSetup
FontSetup DisplayFont
SquareFont DisplayFont
MonoFont DisplayFont
MonoFont
singleFontSetup :: FontSetup
singleFontSetup :: FontSetup
singleFontSetup = DisplayFont -> DisplayFont -> DisplayFont -> FontSetup
FontSetup DisplayFont
SquareFont DisplayFont
SquareFont DisplayFont
SquareFont
textSize :: DisplayFont -> [a] -> Int
textSize :: DisplayFont -> [a] -> Int
textSize SquareFont l :: [a]
l = 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [a] -> Int
forall a. [a] -> Int
length [a]
l
textSize MonoFont l :: [a]
l = [a] -> Int
forall a. [a] -> Int
length [a]
l
textSize PropFont _ = String -> Int
forall a. HasCallStack => String -> a
error "size of proportional font texts is not defined"
data ButtonWidth = ButtonWidth
{ ButtonWidth -> DisplayFont
buttonFont :: DisplayFont
, ButtonWidth -> Int
buttonWidth :: Int }
deriving (Int -> ButtonWidth -> ShowS
[ButtonWidth] -> ShowS
ButtonWidth -> String
(Int -> ButtonWidth -> ShowS)
-> (ButtonWidth -> String)
-> ([ButtonWidth] -> ShowS)
-> Show ButtonWidth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ButtonWidth] -> ShowS
$cshowList :: [ButtonWidth] -> ShowS
show :: ButtonWidth -> String
$cshow :: ButtonWidth -> String
showsPrec :: Int -> ButtonWidth -> ShowS
$cshowsPrec :: Int -> ButtonWidth -> ShowS
Show, ButtonWidth -> ButtonWidth -> Bool
(ButtonWidth -> ButtonWidth -> Bool)
-> (ButtonWidth -> ButtonWidth -> Bool) -> Eq ButtonWidth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ButtonWidth -> ButtonWidth -> Bool
$c/= :: ButtonWidth -> ButtonWidth -> Bool
== :: ButtonWidth -> ButtonWidth -> Bool
$c== :: ButtonWidth -> ButtonWidth -> Bool
Eq)
type KYX = (Either [K.KM] SlotChar, (PointUI, ButtonWidth))
type OKX = (FontOverlayMap, [KYX])
newtype Slideshow = Slideshow {Slideshow -> [OKX]
slideshow :: [OKX]}
deriving (Int -> Slideshow -> ShowS
[Slideshow] -> ShowS
Slideshow -> String
(Int -> Slideshow -> ShowS)
-> (Slideshow -> String)
-> ([Slideshow] -> ShowS)
-> Show Slideshow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Slideshow] -> ShowS
$cshowList :: [Slideshow] -> ShowS
show :: Slideshow -> String
$cshow :: Slideshow -> String
showsPrec :: Int -> Slideshow -> ShowS
$cshowsPrec :: Int -> Slideshow -> ShowS
Show, Slideshow -> Slideshow -> Bool
(Slideshow -> Slideshow -> Bool)
-> (Slideshow -> Slideshow -> Bool) -> Eq Slideshow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Slideshow -> Slideshow -> Bool
$c/= :: Slideshow -> Slideshow -> Bool
== :: Slideshow -> Slideshow -> Bool
$c== :: Slideshow -> Slideshow -> Bool
Eq)
emptySlideshow :: Slideshow
emptySlideshow :: Slideshow
emptySlideshow = [OKX] -> Slideshow
Slideshow []
unsnoc :: Slideshow -> Maybe (Slideshow, OKX)
unsnoc :: Slideshow -> Maybe (Slideshow, OKX)
unsnoc Slideshow{[OKX]
slideshow :: [OKX]
slideshow :: Slideshow -> [OKX]
slideshow} =
case [OKX] -> [OKX]
forall a. [a] -> [a]
reverse [OKX]
slideshow of
[] -> Maybe (Slideshow, OKX)
forall a. Maybe a
Nothing
okx :: OKX
okx : rest :: [OKX]
rest -> (Slideshow, OKX) -> Maybe (Slideshow, OKX)
forall a. a -> Maybe a
Just ([OKX] -> Slideshow
Slideshow ([OKX] -> Slideshow) -> [OKX] -> Slideshow
forall a b. (a -> b) -> a -> b
$ [OKX] -> [OKX]
forall a. [a] -> [a]
reverse [OKX]
rest, OKX
okx)
toSlideshow :: FontSetup -> [OKX] -> Slideshow
toSlideshow :: FontSetup -> [OKX] -> Slideshow
toSlideshow FontSetup{..} okxs :: [OKX]
okxs = [OKX] -> Slideshow
Slideshow ([OKX] -> Slideshow) -> [OKX] -> Slideshow
forall a b. (a -> b) -> a -> b
$ Bool -> [OKX] -> [OKX]
addFooters Bool
False [OKX]
okxsNotNull
where
okxFilter :: (a, [(Either [a] b, b)]) -> (a, [(Either [a] b, b)])
okxFilter (ov :: a
ov, kyxs :: [(Either [a] b, b)]
kyxs) =
(a
ov, ((Either [a] b, b) -> Bool)
-> [(Either [a] b, b)] -> [(Either [a] b, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (([a] -> Bool) -> (b -> Bool) -> Either [a] b -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall a. [a] -> Bool
null) (Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True) (Either [a] b -> Bool)
-> ((Either [a] b, b) -> Either [a] b) -> (Either [a] b, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either [a] b, b) -> Either [a] b
forall a b. (a, b) -> a
fst) [(Either [a] b, b)]
kyxs)
okxsNotNull :: [OKX]
okxsNotNull = (OKX -> OKX) -> [OKX] -> [OKX]
forall a b. (a -> b) -> [a] -> [b]
map OKX -> OKX
forall a a b b.
(a, [(Either [a] b, b)]) -> (a, [(Either [a] b, b)])
okxFilter [OKX]
okxs
pofOv :: Overlay -> PointUI
pofOv :: Overlay -> PointUI
pofOv [] = Int -> Int -> PointUI
PointUI 0 0
pofOv l :: Overlay
l = let pyAfterLast :: Int
pyAfterLast = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
maxYofOverlay Overlay
l
in Int -> Int -> PointUI
PointUI 0 Int
pyAfterLast
atEnd :: [a] -> [a] -> [a]
atEnd = ([a] -> [a] -> [a]) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)
appendToFontOverlayMap :: FontOverlayMap -> AttrLine
-> (FontOverlayMap, PointUI, DisplayFont)
appendToFontOverlayMap :: FontOverlayMap
-> AttrLine -> (FontOverlayMap, PointUI, DisplayFont)
appendToFontOverlayMap ovs :: FontOverlayMap
ovs al :: AttrLine
al =
let maxYminXofOverlay :: [(PointUI, b)] -> (Int, Int)
maxYminXofOverlay ov :: [(PointUI, b)]
ov = let ymxOfOverlay :: (PointUI, b) -> (Int, Int)
ymxOfOverlay (PointUI x :: Int
x y :: Int
y, _) = (- Int
y, Int
x)
in [(Int, Int)] -> (Int, Int)
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([(Int, Int)] -> (Int, Int)) -> [(Int, Int)] -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ (0, 0) (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: ((PointUI, b) -> (Int, Int)) -> [(PointUI, b)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (PointUI, b) -> (Int, Int)
forall b. (PointUI, b) -> (Int, Int)
ymxOfOverlay [(PointUI, b)]
ov
assocsYX :: [(DisplayFont, (Int, Int))]
assocsYX = ((DisplayFont, (Int, Int))
-> (DisplayFont, (Int, Int)) -> Ordering)
-> [(DisplayFont, (Int, Int))] -> [(DisplayFont, (Int, Int))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((DisplayFont, (Int, Int)) -> (Int, Int))
-> (DisplayFont, (Int, Int))
-> (DisplayFont, (Int, Int))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (DisplayFont, (Int, Int)) -> (Int, Int)
forall a b. (a, b) -> b
snd)
([(DisplayFont, (Int, Int))] -> [(DisplayFont, (Int, Int))])
-> [(DisplayFont, (Int, Int))] -> [(DisplayFont, (Int, Int))]
forall a b. (a -> b) -> a -> b
$ EnumMap DisplayFont (Int, Int) -> [(DisplayFont, (Int, Int))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap DisplayFont (Int, Int) -> [(DisplayFont, (Int, Int))])
-> EnumMap DisplayFont (Int, Int) -> [(DisplayFont, (Int, Int))]
forall a b. (a -> b) -> a -> b
$ (Overlay -> (Int, Int))
-> FontOverlayMap -> EnumMap DisplayFont (Int, Int)
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map Overlay -> (Int, Int)
forall b. [(PointUI, b)] -> (Int, Int)
maxYminXofOverlay FontOverlayMap
ovs
(fontMax :: DisplayFont
fontMax, unique :: Bool
unique) = case [(DisplayFont, (Int, Int))]
assocsYX of
[] -> (DisplayFont
monoFont, Bool
False)
(font :: DisplayFont
font, (y :: Int
y, _x :: Int
_x)) : rest :: [(DisplayFont, (Int, Int))]
rest -> (DisplayFont
font, ((DisplayFont, (Int, Int)) -> Bool)
-> [(DisplayFont, (Int, Int))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(_, (y2 :: Int
y2, _)) -> Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
y2) [(DisplayFont, (Int, Int))]
rest)
insertAl :: Overlay -> (FontOverlayMap, PointUI, DisplayFont)
insertAl ovF :: Overlay
ovF =
let p :: PointUI
p = Overlay -> PointUI
pofOv Overlay
ovF
displayFont :: DisplayFont
displayFont = case DisplayFont
fontMax of
SquareFont | Bool
unique -> DisplayFont
SquareFont
_ -> DisplayFont
monoFont
in ((Overlay -> Overlay -> Overlay)
-> DisplayFont -> Overlay -> FontOverlayMap -> FontOverlayMap
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
atEnd DisplayFont
displayFont [(PointUI
p, AttrLine
al)] FontOverlayMap
ovs, PointUI
p, DisplayFont
displayFont)
in case DisplayFont -> FontOverlayMap -> Maybe Overlay
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup DisplayFont
fontMax FontOverlayMap
ovs of
Just ovF :: Overlay
ovF -> Overlay -> (FontOverlayMap, PointUI, DisplayFont)
insertAl Overlay
ovF
Nothing -> Overlay -> (FontOverlayMap, PointUI, DisplayFont)
insertAl []
addFooters :: Bool -> [OKX] -> [OKX]
addFooters :: Bool -> [OKX] -> [OKX]
addFooters _ [] = String -> [OKX]
forall a. HasCallStack => String -> a
error (String -> [OKX]) -> String -> [OKX]
forall a b. (a -> b) -> a -> b
$ "" String -> [OKX] -> String
forall v. Show v => String -> v -> String
`showFailure` [OKX]
okxsNotNull
addFooters _ [(als :: FontOverlayMap
als, [])] =
let (ovs :: FontOverlayMap
ovs, p :: PointUI
p, font :: DisplayFont
font) = FontOverlayMap
-> AttrLine -> (FontOverlayMap, PointUI, DisplayFont)
appendToFontOverlayMap FontOverlayMap
als (String -> AttrLine
stringToAL String
endMsg)
in [(FontOverlayMap
ovs, [([KM] -> Either [KM] SlotChar
forall a b. a -> Either a b
Left [KM
K.safeSpaceKM], (PointUI
p, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
font 15))])]
addFooters False [(als :: FontOverlayMap
als, kxs :: [KYX]
kxs)] = [(FontOverlayMap
als, [KYX]
kxs)]
addFooters True [(als :: FontOverlayMap
als, kxs :: [KYX]
kxs)] =
let (ovs :: FontOverlayMap
ovs, p :: PointUI
p, font :: DisplayFont
font) = FontOverlayMap
-> AttrLine -> (FontOverlayMap, PointUI, DisplayFont)
appendToFontOverlayMap FontOverlayMap
als (String -> AttrLine
stringToAL String
endMsg)
in [(FontOverlayMap
ovs, [KYX]
kxs [KYX] -> [KYX] -> [KYX]
forall a. [a] -> [a] -> [a]
++ [([KM] -> Either [KM] SlotChar
forall a b. a -> Either a b
Left [KM
K.safeSpaceKM], (PointUI
p, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
font 15))])]
addFooters _ ((als :: FontOverlayMap
als, kxs :: [KYX]
kxs) : rest :: [OKX]
rest) =
let (ovs :: FontOverlayMap
ovs, p :: PointUI
p, font :: DisplayFont
font) = FontOverlayMap
-> AttrLine -> (FontOverlayMap, PointUI, DisplayFont)
appendToFontOverlayMap FontOverlayMap
als (String -> AttrLine
stringToAL String
moreMsg)
in (FontOverlayMap
ovs, [KYX]
kxs [KYX] -> [KYX] -> [KYX]
forall a. [a] -> [a] -> [a]
++ [([KM] -> Either [KM] SlotChar
forall a b. a -> Either a b
Left [KM
K.safeSpaceKM], (PointUI
p, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
font 8))])
OKX -> [OKX] -> [OKX]
forall a. a -> [a] -> [a]
: Bool -> [OKX] -> [OKX]
addFooters Bool
True [OKX]
rest
attrLinesToFontMap :: Int -> [(DisplayFont, [AttrLine])] -> FontOverlayMap
attrLinesToFontMap :: Int -> [(DisplayFont, [AttrLine])] -> FontOverlayMap
attrLinesToFontMap start0 :: Int
start0 blurb :: [(DisplayFont, [AttrLine])]
blurb =
let zipAttrLines :: Int -> [AttrLine] -> (Overlay, Int)
zipAttrLines :: Int -> [AttrLine] -> (Overlay, Int)
zipAttrLines start :: Int
start als :: [AttrLine]
als =
( ((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 [Int
start ..] [AttrLine]
als
, Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [AttrLine] -> Int
forall a. [a] -> Int
length [AttrLine]
als )
addOverlay :: (FontOverlayMap, Int) -> (DisplayFont, [AttrLine])
-> (FontOverlayMap, Int)
addOverlay :: (FontOverlayMap, Int)
-> (DisplayFont, [AttrLine]) -> (FontOverlayMap, Int)
addOverlay (!FontOverlayMap
em, !Int
start) (font :: DisplayFont
font, als :: [AttrLine]
als) =
let (als2 :: Overlay
als2, start2 :: Int
start2) = Int -> [AttrLine] -> (Overlay, Int)
zipAttrLines Int
start [AttrLine]
als
in ( (Overlay -> Overlay -> Overlay)
-> DisplayFont -> Overlay -> FontOverlayMap -> FontOverlayMap
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
font Overlay
als2 FontOverlayMap
em
, Int
start2 )
(ov :: FontOverlayMap
ov, _) = ((FontOverlayMap, Int)
-> (DisplayFont, [AttrLine]) -> (FontOverlayMap, Int))
-> (FontOverlayMap, Int)
-> [(DisplayFont, [AttrLine])]
-> (FontOverlayMap, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (FontOverlayMap, Int)
-> (DisplayFont, [AttrLine]) -> (FontOverlayMap, Int)
addOverlay (FontOverlayMap
forall k a. EnumMap k a
EM.empty, Int
start0) [(DisplayFont, [AttrLine])]
blurb
in FontOverlayMap
ov
moreMsg :: String
moreMsg :: String
moreMsg = "--more--"
endMsg :: String
endMsg :: String
endMsg = "--back to top--"
maxYofOverlay :: Overlay -> Int
maxYofOverlay :: Overlay -> Int
maxYofOverlay ov :: Overlay
ov = let yOfOverlay :: (PointUI, b) -> Int
yOfOverlay (PointUI _ y :: Int
y, _) = Int
y
in [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ 0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ((PointUI, AttrLine) -> Int) -> Overlay -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (PointUI, AttrLine) -> Int
forall b. (PointUI, b) -> Int
yOfOverlay Overlay
ov
menuToSlideshow :: OKX -> Slideshow
(als :: FontOverlayMap
als, kxs :: [KYX]
kxs) =
Bool -> Slideshow -> Slideshow
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (FontOverlayMap -> Bool
forall k a. EnumMap k a -> Bool
EM.null FontOverlayMap
als Bool -> Bool -> Bool
|| [KYX] -> Bool
forall a. [a] -> Bool
null [KYX]
kxs)) (Slideshow -> Slideshow) -> Slideshow -> Slideshow
forall a b. (a -> b) -> a -> b
$ [OKX] -> Slideshow
Slideshow [(FontOverlayMap
als, [KYX]
kxs)]
wrapOKX :: DisplayFont -> Int -> Int -> Int -> [(K.KM, String)]
-> (Overlay, [KYX])
wrapOKX :: DisplayFont
-> Int -> Int -> Int -> [(KM, String)] -> (Overlay, [KYX])
wrapOKX _ _ _ _ [] = ([], [])
wrapOKX displayFont :: DisplayFont
displayFont ystart :: Int
ystart xstart :: Int
xstart width :: Int
width ks :: [(KM, String)]
ks =
let overlayLineFromStrings :: Int -> Int -> [String] -> (PointUI, AttrLine)
overlayLineFromStrings :: Int -> Int -> [String] -> (PointUI, AttrLine)
overlayLineFromStrings xlineStart :: Int
xlineStart y :: Int
y strings :: [String]
strings =
let p :: PointUI
p = Int -> Int -> PointUI
PointUI Int
xlineStart Int
y
in (PointUI
p, String -> AttrLine
stringToAL (String -> AttrLine) -> String -> AttrLine
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
strings))
f :: ((Int, Int), (Int, [String], Overlay, [KYX])) -> (K.KM, String)
-> ((Int, Int), (Int, [String], Overlay, [KYX]))
f :: ((Int, Int), (Int, [String], Overlay, [KYX]))
-> (KM, String) -> ((Int, Int), (Int, [String], Overlay, [KYX]))
f ((y :: Int
y, x :: Int
x), (xlineStart :: Int
xlineStart, kL :: [String]
kL, kV :: Overlay
kV, kX :: [KYX]
kX)) (key :: KM
key, s :: String
s) =
let len :: Int
len = DisplayFont -> String -> Int
forall a. DisplayFont -> [a] -> Int
textSize DisplayFont
displayFont String
s
len1 :: Int
len1 = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DisplayFont -> String -> Int
forall a. DisplayFont -> [a] -> Int
textSize DisplayFont
displayFont " "
in if Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
width
then let iov :: (PointUI, AttrLine)
iov = Int -> Int -> [String] -> (PointUI, AttrLine)
overlayLineFromStrings Int
xlineStart Int
y [String]
kL
in ((Int, Int), (Int, [String], Overlay, [KYX]))
-> (KM, String) -> ((Int, Int), (Int, [String], Overlay, [KYX]))
f ((Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1, 0), (0, [], (PointUI, AttrLine)
iov (PointUI, AttrLine) -> Overlay -> Overlay
forall a. a -> [a] -> [a]
: Overlay
kV, [KYX]
kX)) (KM
key, String
s)
else ( (Int
y, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len1)
, ( Int
xlineStart
, String
s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
kL
, Overlay
kV
, ([KM] -> Either [KM] SlotChar
forall a b. a -> Either a b
Left [KM
key], ( Int -> Int -> PointUI
PointUI Int
x Int
y
, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
displayFont (String -> Int
forall a. [a] -> Int
length String
s) ))
KYX -> [KYX] -> [KYX]
forall a. a -> [a] -> [a]
: [KYX]
kX ) )
((ystop :: Int
ystop, _), (xlineStop :: Int
xlineStop, kL1 :: [String]
kL1, kV1 :: Overlay
kV1, kX1 :: [KYX]
kX1)) =
(((Int, Int), (Int, [String], Overlay, [KYX]))
-> (KM, String) -> ((Int, Int), (Int, [String], Overlay, [KYX])))
-> ((Int, Int), (Int, [String], Overlay, [KYX]))
-> [(KM, String)]
-> ((Int, Int), (Int, [String], Overlay, [KYX]))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Int, Int), (Int, [String], Overlay, [KYX]))
-> (KM, String) -> ((Int, Int), (Int, [String], Overlay, [KYX]))
f ((Int
ystart, Int
xstart), (Int
xstart, [], [], [])) [(KM, String)]
ks
iov1 :: (PointUI, AttrLine)
iov1 = Int -> Int -> [String] -> (PointUI, AttrLine)
overlayLineFromStrings Int
xlineStop Int
ystop [String]
kL1
in (Overlay -> Overlay
forall a. [a] -> [a]
reverse (Overlay -> Overlay) -> Overlay -> Overlay
forall a b. (a -> b) -> a -> b
$ (PointUI, AttrLine)
iov1 (PointUI, AttrLine) -> Overlay -> Overlay
forall a. a -> [a] -> [a]
: Overlay
kV1, [KYX] -> [KYX]
forall a. [a] -> [a]
reverse [KYX]
kX1)
keysOKX :: DisplayFont -> Int -> Int -> Int -> [K.KM] -> (Overlay, [KYX])
keysOKX :: DisplayFont -> Int -> Int -> Int -> [KM] -> (Overlay, [KYX])
keysOKX displayFont :: DisplayFont
displayFont ystart :: Int
ystart xstart :: Int
xstart width :: Int
width keys :: [KM]
keys =
let wrapB :: String -> String
wrapB :: ShowS
wrapB s :: String
s = "[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "]"
ks :: [(KM, String)]
ks = (KM -> (KM, String)) -> [KM] -> [(KM, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\key :: KM
key -> (KM
key, ShowS
wrapB ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ KM -> String
K.showKM KM
key)) [KM]
keys
in DisplayFont
-> Int -> Int -> Int -> [(KM, String)] -> (Overlay, [KYX])
wrapOKX DisplayFont
displayFont Int
ystart Int
xstart Int
width [(KM, String)]
ks
splitOverlay :: FontSetup -> Bool -> Int -> Int -> Int
-> Report -> [K.KM] -> OKX
-> Slideshow
splitOverlay :: FontSetup
-> Bool -> Int -> Int -> Int -> Report -> [KM] -> OKX -> Slideshow
splitOverlay fontSetup :: FontSetup
fontSetup uScreen1PerLine :: Bool
uScreen1PerLine width :: Int
width height :: Int
height wrap :: Int
wrap
report :: Report
report keys :: [KM]
keys (ls0 :: FontOverlayMap
ls0, kxs0 :: [KYX]
kxs0) =
let renderedReport :: [AttrString]
renderedReport = Bool -> Report -> [AttrString]
renderReport Bool
True Report
report
reportAS :: AttrString
reportAS = if Bool
uScreen1PerLine
then (AttrString -> AttrString -> AttrString)
-> AttrString -> [AttrString] -> AttrString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AttrString -> AttrString -> AttrString
(<\:>) [] [AttrString]
renderedReport
else (AttrString -> AttrString -> AttrString)
-> AttrString -> [AttrString] -> AttrString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AttrString -> AttrString -> AttrString
(<+:>) [] [AttrString]
renderedReport
msgLong :: Bool
msgLong = Bool -> Bool
not Bool
uScreen1PerLine
Bool -> Bool -> Bool
&& [KM] -> Bool
forall a. [a] -> Bool
null [KM]
keys Bool -> Bool -> Bool
&& FontOverlayMap -> Bool
forall k a. EnumMap k a -> Bool
EM.null FontOverlayMap
ls0 Bool -> Bool -> Bool
&& [KYX] -> Bool
forall a. [a] -> Bool
null [KYX]
kxs0
Bool -> Bool -> Bool
&& AttrString -> Int
forall a. [a] -> Int
length AttrString
reportAS Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width
Bool -> Bool -> Bool
&& (AttrCharW32 -> Bool) -> AttrString -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n') (Char -> Bool) -> (AttrCharW32 -> Char) -> AttrCharW32 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrCharW32 -> Char
Color.charFromW32) AttrString
reportAS
in FontSetup -> [OKX] -> Slideshow
toSlideshow FontSetup
fontSetup ([OKX] -> Slideshow) -> [OKX] -> Slideshow
forall a b. (a -> b) -> a -> b
$ FontSetup
-> Bool -> Int -> Int -> Int -> AttrString -> [KM] -> OKX -> [OKX]
splitOKX FontSetup
fontSetup Bool
msgLong Int
width Int
height Int
wrap
AttrString
reportAS [KM]
keys (FontOverlayMap
ls0, [KYX]
kxs0)
splitOKX :: FontSetup -> Bool -> Int -> Int -> Int -> AttrString -> [K.KM]
-> OKX
-> [OKX]
splitOKX :: FontSetup
-> Bool -> Int -> Int -> Int -> AttrString -> [KM] -> OKX -> [OKX]
splitOKX FontSetup{..} msgLong :: Bool
msgLong width :: Int
width height :: Int
height wrap :: Int
wrap reportAS :: AttrString
reportAS keys :: [KM]
keys (ls0 :: FontOverlayMap
ls0, kxs0 :: [KYX]
kxs0) =
Bool -> [OKX] -> [OKX]
forall a. HasCallStack => Bool -> a -> a
assert (Int
height Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 2) ([OKX] -> [OKX]) -> [OKX] -> [OKX]
forall a b. (a -> b) -> a -> b
$
let indentSplitSpaces :: Int -> AttrString -> [AttrLine]
indentSplitSpaces = Bool -> Int -> AttrString -> [AttrLine]
indentSplitAttrString2
(Bool -> Bool
not (DisplayFont -> Bool
isMonoFont DisplayFont
propFont Bool -> Bool -> Bool
|| DisplayFont -> Bool
isSquareFont DisplayFont
propFont))
reportParagraphs :: [AttrLine]
reportParagraphs = AttrString -> [AttrLine]
linesAttr AttrString
reportAS
(repProp :: [AttrLine]
repProp, repMono :: AttrLine
repMono) =
if [KM] -> Bool
forall a. [a] -> Bool
null [KM]
keys
then ([AttrLine]
reportParagraphs, AttrLine
emptyAttrLine)
else case [AttrLine] -> [AttrLine]
forall a. [a] -> [a]
reverse [AttrLine]
reportParagraphs of
[] -> ([], AttrLine
emptyAttrLine)
l :: AttrLine
l : rest :: [AttrLine]
rest ->
([AttrLine] -> [AttrLine]
forall a. [a] -> [a]
reverse [AttrLine]
rest, AttrString -> AttrLine
attrStringToAL (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ AttrLine -> AttrString
attrLine AttrLine
l AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.nbspAttrW32])
msgWrap :: Int
msgWrap = if Bool
msgLong Bool -> Bool -> Bool
&& Bool -> Bool
not (DisplayFont -> Bool
isSquareFont DisplayFont
propFont)
then 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width
else Int
wrap
msgWidth :: Int
msgWidth = if Bool
msgLong Bool -> Bool -> Bool
&& Bool -> Bool
not (DisplayFont -> Bool
isSquareFont DisplayFont
propFont)
then 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width
else Int
width
repProp0 :: Overlay
repProp0 = [AttrLine] -> Overlay
offsetOverlay ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ case [AttrLine]
repProp of
[] -> []
r :: AttrLine
r : rs :: [AttrLine]
rs ->
let firstWidth :: Int
firstWidth = if AttrString -> Int
forall a. [a] -> Int
length (AttrLine -> AttrString
attrLine AttrLine
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
msgWidth
then Int
msgWidth
else Int
msgWrap
in (Int -> AttrString -> [AttrLine]
indentSplitSpaces Int
firstWidth (AttrString -> [AttrLine])
-> (AttrLine -> AttrString) -> AttrLine -> [AttrLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrLine -> AttrString
attrLine) AttrLine
r
[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 -> AttrString -> [AttrLine]
indentSplitSpaces Int
msgWrap (AttrString -> [AttrLine])
-> (AttrLine -> AttrString) -> AttrLine -> [AttrLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrLine -> AttrString
attrLine) [AttrLine]
rs
repPropW :: Overlay
repPropW = [AttrLine] -> Overlay
offsetOverlay
([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ (AttrLine -> [AttrLine]) -> [AttrLine] -> [AttrLine]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> AttrString -> [AttrLine]
indentSplitSpaces Int
width (AttrString -> [AttrLine])
-> (AttrLine -> AttrString) -> AttrLine -> [AttrLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrLine -> AttrString
attrLine) [AttrLine]
repProp
monoWidth :: Int
monoWidth = if [AttrLine] -> Bool
forall a. [a] -> Bool
null [AttrLine]
repProp then Int
msgWidth else Int
msgWrap
repMono0 :: Overlay
repMono0 = ((PointUI, AttrLine) -> (PointUI, AttrLine)) -> Overlay -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map (\(PointUI x :: Int
x y :: Int
y, al :: AttrLine
al) ->
(Int -> Int -> PointUI
PointUI Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
forall a. [a] -> Int
length Overlay
repProp0), AttrLine
al))
(Overlay -> Overlay) -> Overlay -> Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay
([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ Int -> AttrString -> [AttrLine]
indentSplitAttrString Int
monoWidth (AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ AttrLine -> AttrString
attrLine AttrLine
repMono
repMonoW :: Overlay
repMonoW = ((PointUI, AttrLine) -> (PointUI, AttrLine)) -> Overlay -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map (\(PointUI x :: Int
x y :: Int
y, al :: AttrLine
al) ->
(Int -> Int -> PointUI
PointUI Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
forall a. [a] -> Int
length Overlay
repPropW), AttrLine
al))
(Overlay -> Overlay) -> Overlay -> Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay
([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ Int -> AttrString -> [AttrLine]
indentSplitAttrString Int
width (AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ AttrLine -> AttrString
attrLine AttrLine
repMono
repWhole0 :: Overlay
repWhole0 = [AttrLine] -> Overlay
offsetOverlay
([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ (AttrLine -> [AttrLine]) -> [AttrLine] -> [AttrLine]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> AttrString -> [AttrLine]
indentSplitSpaces Int
msgWidth (AttrString -> [AttrLine])
-> (AttrLine -> AttrString) -> AttrLine -> [AttrLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrLine -> AttrString
attrLine)
[AttrLine]
reportParagraphs
repWhole1 :: Overlay
repWhole1 = ((PointUI, AttrLine) -> (PointUI, AttrLine)) -> Overlay -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map (\(PointUI x :: Int
x y :: Int
y, al :: AttrLine
al) -> (Int -> Int -> PointUI
PointUI Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1), AttrLine
al)) Overlay
repWhole0
lenOfRep0 :: Int
lenOfRep0 = Overlay -> Int
forall a. [a] -> Int
length Overlay
repProp0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
forall a. [a] -> Int
length Overlay
repMono0
lenOfRepW :: Int
lenOfRepW = Overlay -> Int
forall a. [a] -> Int
length Overlay
repPropW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
forall a. [a] -> Int
length Overlay
repMonoW
startOfKeys :: Int
startOfKeys = if Overlay -> Bool
forall a. [a] -> Bool
null Overlay
repMono0
then 0
else DisplayFont -> AttrString -> Int
forall a. DisplayFont -> [a] -> Int
textSize DisplayFont
monoFont (AttrLine -> AttrString
attrLine (AttrLine -> AttrString) -> AttrLine -> AttrString
forall a b. (a -> b) -> a -> b
$ (PointUI, AttrLine) -> AttrLine
forall a b. (a, b) -> b
snd ((PointUI, AttrLine) -> AttrLine)
-> (PointUI, AttrLine) -> AttrLine
forall a b. (a -> b) -> a -> b
$ Overlay -> (PointUI, AttrLine)
forall a. [a] -> a
last Overlay
repMono0)
startOfKeysW :: Int
startOfKeysW = if Overlay -> Bool
forall a. [a] -> Bool
null Overlay
repMonoW
then 0
else DisplayFont -> AttrString -> Int
forall a. DisplayFont -> [a] -> Int
textSize DisplayFont
monoFont (AttrLine -> AttrString
attrLine (AttrLine -> AttrString) -> AttrLine -> AttrString
forall a b. (a -> b) -> a -> b
$ (PointUI, AttrLine) -> AttrLine
forall a b. (a, b) -> b
snd ((PointUI, AttrLine) -> AttrLine)
-> (PointUI, AttrLine) -> AttrLine
forall a b. (a -> b) -> a -> b
$ Overlay -> (PointUI, AttrLine)
forall a. [a] -> a
last Overlay
repMonoW)
pressAKey :: AttrString
pressAKey = String -> AttrString
stringToAS "A long report is shown. Press a key:"
AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.nbspAttrW32]
(lX0 :: Overlay
lX0, keysX0 :: [KYX]
keysX0) = DisplayFont -> Int -> Int -> Int -> [KM] -> (Overlay, [KYX])
keysOKX DisplayFont
monoFont 0 (AttrString -> Int
forall a. [a] -> Int
length AttrString
pressAKey) Int
width [KM]
keys
(lX1 :: Overlay
lX1, keysX1 :: [KYX]
keysX1) = DisplayFont -> Int -> Int -> Int -> [KM] -> (Overlay, [KYX])
keysOKX DisplayFont
monoFont 1 0 Int
width [KM]
keys
(lX :: Overlay
lX, keysX :: [KYX]
keysX) = DisplayFont -> Int -> Int -> Int -> [KM] -> (Overlay, [KYX])
keysOKX DisplayFont
monoFont (Int
lenOfRep0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int
startOfKeys
(2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width) [KM]
keys
(lXW :: Overlay
lXW, keysXW :: [KYX]
keysXW) = DisplayFont -> Int -> Int -> Int -> [KM] -> (Overlay, [KYX])
keysOKX DisplayFont
monoFont (Int
lenOfRepW Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int
startOfKeysW
(2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width) [KM]
keys
renumber :: Int -> (a, (PointUI, b)) -> (a, (PointUI, b))
renumber dy :: Int
dy (km :: a
km, (PointUI x :: Int
x y :: Int
y, len :: b
len)) = (a
km, (Int -> Int -> PointUI
PointUI Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dy), b
len))
renumberOv :: Int -> [(PointUI, b)] -> [(PointUI, b)]
renumberOv dy :: Int
dy = ((PointUI, b) -> (PointUI, b)) -> [(PointUI, b)] -> [(PointUI, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\(PointUI x :: Int
x y :: Int
y, al :: b
al) -> (Int -> Int -> PointUI
PointUI Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dy), b
al))
splitO :: Int -> (Overlay, Overlay, [KYX]) -> OKX -> [OKX]
splitO :: Int -> (Overlay, Overlay, [KYX]) -> OKX -> [OKX]
splitO yoffset :: Int
yoffset (hdrProp :: Overlay
hdrProp, hdrMono :: Overlay
hdrMono, rk :: [KYX]
rk) (ls :: FontOverlayMap
ls, kxs :: [KYX]
kxs) =
let hdrOff :: Int
hdrOff | Overlay -> Bool
forall a. [a] -> Bool
null Overlay
hdrProp Bool -> Bool -> Bool
&& Overlay -> Bool
forall a. [a] -> Bool
null Overlay
hdrMono = 0
| Bool
otherwise = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
maxYofOverlay Overlay
hdrMono
keyRenumber :: [KYX] -> [KYX]
keyRenumber = (KYX -> KYX) -> [KYX] -> [KYX]
forall a b. (a -> b) -> [a] -> [b]
map ((KYX -> KYX) -> [KYX] -> [KYX]) -> (KYX -> KYX) -> [KYX] -> [KYX]
forall a b. (a -> b) -> a -> b
$ Int -> KYX -> KYX
forall a b. Int -> (a, (PointUI, b)) -> (a, (PointUI, b))
renumber (Int
hdrOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
yoffset)
lineRenumber :: FontOverlayMap -> FontOverlayMap
lineRenumber = (Overlay -> Overlay) -> FontOverlayMap -> FontOverlayMap
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map ((Overlay -> Overlay) -> FontOverlayMap -> FontOverlayMap)
-> (Overlay -> Overlay) -> FontOverlayMap -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ Int -> Overlay -> Overlay
forall b. Int -> [(PointUI, b)] -> [(PointUI, b)]
renumberOv (Int
hdrOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
yoffset)
yoffsetNew :: Int
yoffsetNew = Int
yoffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hdrOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
ltOffset :: (PointUI, a) -> Bool
ltOffset :: (PointUI, a) -> Bool
ltOffset (PointUI _ y :: Int
y, _) = Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
yoffsetNew
(pre :: FontOverlayMap
pre, post :: FontOverlayMap
post) = ( ((PointUI, AttrLine) -> Bool) -> Overlay -> Overlay
forall a. (a -> Bool) -> [a] -> [a]
filter (PointUI, AttrLine) -> Bool
forall a. (PointUI, a) -> Bool
ltOffset (Overlay -> Overlay) -> FontOverlayMap -> FontOverlayMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FontOverlayMap
ls
, ((PointUI, AttrLine) -> Bool) -> Overlay -> Overlay
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((PointUI, AttrLine) -> Bool) -> (PointUI, AttrLine) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PointUI, AttrLine) -> Bool
forall a. (PointUI, a) -> Bool
ltOffset) (Overlay -> Overlay) -> FontOverlayMap -> FontOverlayMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FontOverlayMap
ls )
prependHdr :: FontOverlayMap -> FontOverlayMap
prependHdr = (Overlay -> Overlay -> Overlay)
-> DisplayFont -> Overlay -> FontOverlayMap -> FontOverlayMap
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
propFont Overlay
hdrProp
(FontOverlayMap -> FontOverlayMap)
-> (FontOverlayMap -> FontOverlayMap)
-> FontOverlayMap
-> FontOverlayMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Overlay -> Overlay -> Overlay)
-> DisplayFont -> Overlay -> FontOverlayMap -> FontOverlayMap
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
monoFont Overlay
hdrMono
in if (Overlay -> Bool) -> [Overlay] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Overlay -> Bool
forall a. [a] -> Bool
null ([Overlay] -> Bool) -> [Overlay] -> Bool
forall a b. (a -> b) -> a -> b
$ FontOverlayMap -> [Overlay]
forall k a. EnumMap k a -> [a]
EM.elems FontOverlayMap
post
then [(FontOverlayMap -> FontOverlayMap
prependHdr (FontOverlayMap -> FontOverlayMap)
-> FontOverlayMap -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ FontOverlayMap -> FontOverlayMap
lineRenumber FontOverlayMap
pre, [KYX]
rk [KYX] -> [KYX] -> [KYX]
forall a. [a] -> [a] -> [a]
++ [KYX] -> [KYX]
keyRenumber [KYX]
kxs)]
else let (preX :: [KYX]
preX, postX :: [KYX]
postX) = (KYX -> Bool) -> [KYX] -> ([KYX], [KYX])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\(_, pa :: (PointUI, ButtonWidth)
pa) -> (PointUI, ButtonWidth) -> Bool
forall a. (PointUI, a) -> Bool
ltOffset (PointUI, ButtonWidth)
pa) [KYX]
kxs
in (FontOverlayMap -> FontOverlayMap
prependHdr (FontOverlayMap -> FontOverlayMap)
-> FontOverlayMap -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ FontOverlayMap -> FontOverlayMap
lineRenumber FontOverlayMap
pre, [KYX]
rk [KYX] -> [KYX] -> [KYX]
forall a. [a] -> [a] -> [a]
++ [KYX] -> [KYX]
keyRenumber [KYX]
preX)
OKX -> [OKX] -> [OKX]
forall a. a -> [a] -> [a]
: Int -> (Overlay, Overlay, [KYX]) -> OKX -> [OKX]
splitO Int
yoffsetNew (Overlay
hdrProp, Overlay
hdrMono, [KYX]
rk) (FontOverlayMap
post, [KYX]
postX)
firstParaReport :: AttrLine
firstParaReport = AttrString -> AttrLine
firstParagraph AttrString
reportAS
hdrShortened :: (Overlay, Overlay, [KYX])
hdrShortened = ( [(Int -> Int -> PointUI
PointUI 0 0, AttrLine
firstParaReport)]
, Int -> Overlay -> Overlay
forall a. Int -> [a] -> [a]
take 3 Overlay
lX1
, [KYX]
keysX1 )
((lsInit :: FontOverlayMap
lsInit, kxsInit :: [KYX]
kxsInit), (headerProp :: Overlay
headerProp, headerMono :: Overlay
headerMono, rkxs :: [KYX]
rkxs)) =
if | (Int
lenOfRep0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
forall a. [a] -> Int
length Overlay
lX) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
height ->
((FontOverlayMap
forall k a. EnumMap k a
EM.empty, []), (Overlay
repProp0, Overlay
lX Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
++ Overlay
repMono0, [KYX]
keysX))
| (Int
lenOfRepW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
forall a. [a] -> Int
length Overlay
lXW) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
height ->
((FontOverlayMap
forall k a. EnumMap k a
EM.empty, []), (Overlay
repPropW, Overlay
lXW Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
++ Overlay
repMonoW, [KYX]
keysXW))
| [AttrLine] -> Int
forall a. [a] -> Int
length [AttrLine]
reportParagraphs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
Bool -> Bool -> Bool
&& AttrString -> Int
forall a. [a] -> Int
length (AttrLine -> AttrString
attrLine AttrLine
firstParaReport) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width ->
( (FontOverlayMap
forall k a. EnumMap k a
EM.empty, [])
, (Overlay, Overlay, [KYX])
hdrShortened )
| Bool
otherwise -> case Overlay
lX0 of
[] ->
( (DisplayFont -> Overlay -> FontOverlayMap
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont Overlay
repWhole0, [])
, (Overlay, Overlay, [KYX])
hdrShortened )
lX0first :: (PointUI, AttrLine)
lX0first : _ ->
( ( (Overlay -> Overlay -> Overlay)
-> DisplayFont -> Overlay -> FontOverlayMap -> FontOverlayMap
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
propFont Overlay
repWhole1
(FontOverlayMap -> FontOverlayMap)
-> FontOverlayMap -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ DisplayFont -> Overlay -> FontOverlayMap
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
monoFont
[(Int -> Int -> PointUI
PointUI 0 0, AttrString -> AttrLine
firstParagraph AttrString
pressAKey), (PointUI, AttrLine)
lX0first]
, (KYX -> Bool) -> [KYX] -> [KYX]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(_, (PointUI _ y :: Int
y, _)) -> Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) [KYX]
keysX0 )
, (Overlay, Overlay, [KYX])
hdrShortened )
initSlides :: [OKX]
initSlides = if FontOverlayMap -> Bool
forall k a. EnumMap k a -> Bool
EM.null FontOverlayMap
lsInit
then Bool -> [OKX] -> [OKX]
forall a. HasCallStack => Bool -> a -> a
assert ([KYX] -> Bool
forall a. [a] -> Bool
null [KYX]
kxsInit) []
else Int -> (Overlay, Overlay, [KYX]) -> OKX -> [OKX]
splitO 0 ([], [], []) (FontOverlayMap
lsInit, [KYX]
kxsInit)
mainSlides :: [OKX]
mainSlides = if FontOverlayMap -> Bool
forall k a. EnumMap k a -> Bool
EM.null FontOverlayMap
ls0 Bool -> Bool -> Bool
&& Bool -> Bool
not (FontOverlayMap -> Bool
forall k a. EnumMap k a -> Bool
EM.null FontOverlayMap
lsInit)
then Bool -> [OKX] -> [OKX]
forall a. HasCallStack => Bool -> a -> a
assert ([KYX] -> Bool
forall a. [a] -> Bool
null [KYX]
kxs0) []
else Int -> (Overlay, Overlay, [KYX]) -> OKX -> [OKX]
splitO 0 (Overlay
headerProp, Overlay
headerMono, [KYX]
rkxs) (FontOverlayMap
ls0, [KYX]
kxs0)
in [OKX]
initSlides [OKX] -> [OKX] -> [OKX]
forall a. [a] -> [a] -> [a]
++ [OKX]
mainSlides
highSlideshow :: FontSetup
-> Int
-> Int
-> HighScore.ScoreTable
-> Int
-> Text
-> TimeZone
-> Slideshow
highSlideshow :: FontSetup
-> Int -> Int -> ScoreTable -> Int -> Text -> TimeZone -> Slideshow
highSlideshow fontSetup :: FontSetup
fontSetup@FontSetup{DisplayFont
monoFont :: DisplayFont
monoFont :: FontSetup -> DisplayFont
monoFont} width :: Int
width height :: Int
height table :: ScoreTable
table pos :: Int
pos
gameModeName :: Text
gameModeName tz :: TimeZone
tz =
let entries :: Int
entries = (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 3
msg :: Text
msg = Int -> ScoreTable -> Int -> Text -> Text
HighScore.showAward Int
entries ScoreTable
table Int
pos Text
gameModeName
tts :: [Overlay]
tts = ([AttrLine] -> Overlay) -> [[AttrLine]] -> [Overlay]
forall a b. (a -> b) -> [a] -> [b]
map [AttrLine] -> Overlay
offsetOverlay ([[AttrLine]] -> [Overlay]) -> [[AttrLine]] -> [Overlay]
forall a b. (a -> b) -> a -> b
$ TimeZone -> Int -> ScoreTable -> Int -> [[AttrLine]]
showNearbyScores TimeZone
tz Int
pos ScoreTable
table Int
entries
al :: AttrString
al = Text -> AttrString
textToAS Text
msg
splitScreen :: Overlay -> [OKX]
splitScreen ts :: Overlay
ts =
FontSetup
-> Bool -> Int -> Int -> Int -> AttrString -> [KM] -> OKX -> [OKX]
splitOKX FontSetup
fontSetup Bool
False Int
width Int
height Int
width AttrString
al [KM
K.spaceKM, KM
K.escKM]
(DisplayFont -> Overlay -> FontOverlayMap
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
monoFont Overlay
ts, [])
in FontSetup -> [OKX] -> Slideshow
toSlideshow FontSetup
fontSetup ([OKX] -> Slideshow) -> [OKX] -> Slideshow
forall a b. (a -> b) -> a -> b
$ [[OKX]] -> [OKX]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[OKX]] -> [OKX]) -> [[OKX]] -> [OKX]
forall a b. (a -> b) -> a -> b
$ (Overlay -> [OKX]) -> [Overlay] -> [[OKX]]
forall a b. (a -> b) -> [a] -> [b]
map Overlay -> [OKX]
splitScreen [Overlay]
tts
showTable :: TimeZone -> Int -> HighScore.ScoreTable -> Int -> Int
-> [AttrLine]
showTable :: TimeZone -> Int -> ScoreTable -> Int -> Int -> [AttrLine]
showTable tz :: TimeZone
tz pos :: Int
pos table :: ScoreTable
table start :: Int
start entries :: Int
entries =
let zipped :: [(Int, ScoreRecord)]
zipped = [Int] -> [ScoreRecord] -> [(Int, ScoreRecord)]
forall a b. [a] -> [b] -> [(a, b)]
zip [1..] ([ScoreRecord] -> [(Int, ScoreRecord)])
-> [ScoreRecord] -> [(Int, ScoreRecord)]
forall a b. (a -> b) -> a -> b
$ ScoreTable -> [ScoreRecord]
HighScore.unTable ScoreTable
table
screenful :: [(Int, ScoreRecord)]
screenful = Int -> [(Int, ScoreRecord)] -> [(Int, ScoreRecord)]
forall a. Int -> [a] -> [a]
take Int
entries ([(Int, ScoreRecord)] -> [(Int, ScoreRecord)])
-> ([(Int, ScoreRecord)] -> [(Int, ScoreRecord)])
-> [(Int, ScoreRecord)]
-> [(Int, ScoreRecord)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Int, ScoreRecord)] -> [(Int, ScoreRecord)]
forall a. Int -> [a] -> [a]
drop (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) ([(Int, ScoreRecord)] -> [(Int, ScoreRecord)])
-> [(Int, ScoreRecord)] -> [(Int, ScoreRecord)]
forall a b. (a -> b) -> a -> b
$ [(Int, ScoreRecord)]
zipped
renderScore :: (Int, ScoreRecord) -> [AttrLine]
renderScore (pos1 :: Int
pos1, score1 :: ScoreRecord
score1) =
(Text -> AttrLine) -> [Text] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map (if Int
pos1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
pos then Color -> Text -> AttrLine
textFgToAL Color
Color.BrWhite else Text -> AttrLine
textToAL)
([Text] -> [AttrLine]) -> [Text] -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ TimeZone -> Int -> ScoreRecord -> [Text]
HighScore.showScore TimeZone
tz Int
pos1 ScoreRecord
score1
in AttrLine
emptyAttrLine AttrLine -> [AttrLine] -> [AttrLine]
forall a. a -> [a] -> [a]
: [AttrLine] -> [[AttrLine]] -> [AttrLine]
forall a. [a] -> [[a]] -> [a]
intercalate [AttrLine
emptyAttrLine] (((Int, ScoreRecord) -> [AttrLine])
-> [(Int, ScoreRecord)] -> [[AttrLine]]
forall a b. (a -> b) -> [a] -> [b]
map (Int, ScoreRecord) -> [AttrLine]
renderScore [(Int, ScoreRecord)]
screenful)
showNearbyScores :: TimeZone -> Int -> HighScore.ScoreTable -> Int
-> [[AttrLine]]
showNearbyScores :: TimeZone -> Int -> ScoreTable -> Int -> [[AttrLine]]
showNearbyScores tz :: TimeZone
tz pos :: Int
pos h :: ScoreTable
h entries :: Int
entries =
if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
entries
then [TimeZone -> Int -> ScoreTable -> Int -> Int -> [AttrLine]
showTable TimeZone
tz Int
pos ScoreTable
h 1 Int
entries]
else [ TimeZone -> Int -> ScoreTable -> Int -> Int -> [AttrLine]
showTable TimeZone
tz Int
pos ScoreTable
h 1 Int
entries
, TimeZone -> Int -> ScoreTable -> Int -> Int -> [AttrLine]
showTable TimeZone
tz Int
pos ScoreTable
h (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
entries Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
entries Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2))
Int
entries ]