module Game.LambdaHack.Client.UI.Slideshow
( KYX, OKX, Slideshow(slideshow)
, emptySlideshow, unsnoc, toSlideshow, menuToSlideshow
, wrapOKX, splitOverlay, splitOKX, highSlideshow
#ifdef EXPOSE_INTERNAL
, moreMsg, endMsg, keysOKX, showTable, showNearbyScores
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
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 qualified Game.LambdaHack.Common.HighScore as HighScore
import qualified Game.LambdaHack.Definition.Color as Color
import Game.LambdaHack.Definition.Defs
type KYX = (Either [K.KM] SlotChar, (Y, X, X))
type OKX = (Overlay, [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 :: [OKX] -> Slideshow
toSlideshow :: [OKX] -> Slideshow
toSlideshow 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
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 :: [AttrLine]
als, [])] =
[( [AttrLine]
als [AttrLine] -> [AttrLine] -> [AttrLine]
forall a. [a] -> [a] -> [a]
++ [String -> AttrLine
stringToAL String
endMsg]
, [([KM] -> Either [KM] SlotChar
forall a b. a -> Either a b
Left [KM
K.safeSpaceKM], ([AttrLine] -> Int
forall a. [a] -> Int
length [AttrLine]
als, 0, 15))] )]
addFooters False [(als :: [AttrLine]
als, kxs :: [(Either [KM] SlotChar, (Int, Int, Int))]
kxs)] = [([AttrLine]
als, [(Either [KM] SlotChar, (Int, Int, Int))]
kxs)]
addFooters True [(als :: [AttrLine]
als, kxs :: [(Either [KM] SlotChar, (Int, Int, Int))]
kxs)] =
[( [AttrLine]
als [AttrLine] -> [AttrLine] -> [AttrLine]
forall a. [a] -> [a] -> [a]
++ [String -> AttrLine
stringToAL String
endMsg]
, [(Either [KM] SlotChar, (Int, Int, Int))]
kxs [(Either [KM] SlotChar, (Int, Int, Int))]
-> [(Either [KM] SlotChar, (Int, Int, Int))]
-> [(Either [KM] SlotChar, (Int, Int, Int))]
forall a. [a] -> [a] -> [a]
++ [([KM] -> Either [KM] SlotChar
forall a b. a -> Either a b
Left [KM
K.safeSpaceKM], ([AttrLine] -> Int
forall a. [a] -> Int
length [AttrLine]
als, 0, 15))] )]
addFooters _ ((als :: [AttrLine]
als, kxs :: [(Either [KM] SlotChar, (Int, Int, Int))]
kxs) : rest :: [OKX]
rest) =
( [AttrLine]
als [AttrLine] -> [AttrLine] -> [AttrLine]
forall a. [a] -> [a] -> [a]
++ [String -> AttrLine
stringToAL String
moreMsg]
, [(Either [KM] SlotChar, (Int, Int, Int))]
kxs [(Either [KM] SlotChar, (Int, Int, Int))]
-> [(Either [KM] SlotChar, (Int, Int, Int))]
-> [(Either [KM] SlotChar, (Int, Int, Int))]
forall a. [a] -> [a] -> [a]
++ [([KM] -> Either [KM] SlotChar
forall a b. a -> Either a b
Left [KM
K.safeSpaceKM], ([AttrLine] -> Int
forall a. [a] -> Int
length [AttrLine]
als, 0, 8))] )
OKX -> [OKX] -> [OKX]
forall a. a -> [a] -> [a]
: Bool -> [OKX] -> [OKX]
addFooters Bool
True [OKX]
rest
moreMsg :: String
moreMsg :: String
moreMsg = "--more-- "
endMsg :: String
endMsg :: String
endMsg = "--back to top-- "
menuToSlideshow :: OKX -> Slideshow
(als :: [AttrLine]
als, kxs :: [(Either [KM] SlotChar, (Int, Int, Int))]
kxs) =
Bool -> Slideshow -> Slideshow
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not ([AttrLine] -> Bool
forall a. [a] -> Bool
null [AttrLine]
als Bool -> Bool -> Bool
|| [(Either [KM] SlotChar, (Int, Int, Int))] -> Bool
forall a. [a] -> Bool
null [(Either [KM] SlotChar, (Int, Int, Int))]
kxs)) (Slideshow -> Slideshow) -> Slideshow -> Slideshow
forall a b. (a -> b) -> a -> b
$ [OKX] -> Slideshow
Slideshow [([AttrLine]
als, [(Either [KM] SlotChar, (Int, Int, Int))]
kxs)]
wrapOKX :: Y -> X -> X -> [(K.KM, String)] -> OKX
wrapOKX :: Int -> Int -> Int -> [(KM, String)] -> OKX
wrapOKX ystart :: Int
ystart xstart :: Int
xstart xBound :: Int
xBound ks :: [(KM, String)]
ks =
let f :: ((Int, Int),
([String], [[String]], [(Either [KM] SlotChar, (Int, Int, Int))]))
-> (KM, String)
-> ((Int, Int),
([String], [[String]], [(Either [KM] SlotChar, (Int, Int, Int))]))
f ((y :: Int
y, x :: Int
x), (kL :: [String]
kL, kV :: [[String]]
kV, kX :: [(Either [KM] SlotChar, (Int, Int, Int))]
kX)) (key :: KM
key, s :: String
s) =
let len :: Int
len = String -> Int
forall a. [a] -> Int
length String
s
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
xBound
then ((Int, Int),
([String], [[String]], [(Either [KM] SlotChar, (Int, Int, Int))]))
-> (KM, String)
-> ((Int, Int),
([String], [[String]], [(Either [KM] SlotChar, (Int, Int, Int))]))
f ((Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1, 0), ([], [String]
kL [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: [[String]]
kV, [(Either [KM] SlotChar, (Int, Int, Int))]
kX)) (KM
key, String
s)
else ( (Int
y, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
, (String
s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
kL, [[String]]
kV, ([KM] -> Either [KM] SlotChar
forall a b. a -> Either a b
Left [KM
key], (Int
y, Int
x, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)) (Either [KM] SlotChar, (Int, Int, Int))
-> [(Either [KM] SlotChar, (Int, Int, Int))]
-> [(Either [KM] SlotChar, (Int, Int, Int))]
forall a. a -> [a] -> [a]
: [(Either [KM] SlotChar, (Int, Int, Int))]
kX) )
(kL1 :: [String]
kL1, kV1 :: [[String]]
kV1, kX1 :: [(Either [KM] SlotChar, (Int, Int, Int))]
kX1) = ((Int, Int),
([String], [[String]], [(Either [KM] SlotChar, (Int, Int, Int))]))
-> ([String], [[String]],
[(Either [KM] SlotChar, (Int, Int, Int))])
forall a b. (a, b) -> b
snd (((Int, Int),
([String], [[String]], [(Either [KM] SlotChar, (Int, Int, Int))]))
-> ([String], [[String]],
[(Either [KM] SlotChar, (Int, Int, Int))]))
-> ((Int, Int),
([String], [[String]], [(Either [KM] SlotChar, (Int, Int, Int))]))
-> ([String], [[String]],
[(Either [KM] SlotChar, (Int, Int, Int))])
forall a b. (a -> b) -> a -> b
$ (((Int, Int),
([String], [[String]], [(Either [KM] SlotChar, (Int, Int, Int))]))
-> (KM, String)
-> ((Int, Int),
([String], [[String]], [(Either [KM] SlotChar, (Int, Int, Int))])))
-> ((Int, Int),
([String], [[String]], [(Either [KM] SlotChar, (Int, Int, Int))]))
-> [(KM, String)]
-> ((Int, Int),
([String], [[String]], [(Either [KM] SlotChar, (Int, Int, Int))]))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Int, Int),
([String], [[String]], [(Either [KM] SlotChar, (Int, Int, Int))]))
-> (KM, String)
-> ((Int, Int),
([String], [[String]], [(Either [KM] SlotChar, (Int, Int, Int))]))
f ((Int
ystart, Int
xstart), ([], [], [])) [(KM, String)]
ks
catL :: [String] -> AttrLine
catL = String -> AttrLine
stringToAL (String -> AttrLine)
-> ([String] -> String) -> [String] -> AttrLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse
in ([AttrLine] -> [AttrLine]
forall a. [a] -> [a]
reverse ([AttrLine] -> [AttrLine]) -> [AttrLine] -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ ([String] -> AttrLine) -> [[String]] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> AttrLine
catL ([[String]] -> [AttrLine]) -> [[String]] -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ [String]
kL1 [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: [[String]]
kV1, [(Either [KM] SlotChar, (Int, Int, Int))]
-> [(Either [KM] SlotChar, (Int, Int, Int))]
forall a. [a] -> [a]
reverse [(Either [KM] SlotChar, (Int, Int, Int))]
kX1)
keysOKX :: Y -> X -> X -> [K.KM] -> OKX
keysOKX :: Int -> Int -> Int -> [KM] -> OKX
keysOKX ystart :: Int
ystart xstart :: Int
xstart xBound :: Int
xBound 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 Int -> Int -> Int -> [(KM, String)] -> OKX
wrapOKX Int
ystart Int
xstart Int
xBound [(KM, String)]
ks
splitOverlay :: X -> Y -> Report -> [K.KM] -> OKX -> Slideshow
splitOverlay :: Int -> Int -> Report -> [KM] -> OKX -> Slideshow
splitOverlay width :: Int
width height :: Int
height report :: Report
report keys :: [KM]
keys (ls0 :: [AttrLine]
ls0, kxs0 :: [(Either [KM] SlotChar, (Int, Int, Int))]
kxs0) =
[OKX] -> Slideshow
toSlideshow ([OKX] -> Slideshow) -> [OKX] -> Slideshow
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AttrLine -> [KM] -> OKX -> [OKX]
splitOKX Int
width Int
height (Report -> AttrLine
renderReport Report
report) [KM]
keys ([AttrLine]
ls0, [(Either [KM] SlotChar, (Int, Int, Int))]
kxs0)
splitOKX :: X -> Y -> AttrLine -> [K.KM] -> OKX -> [OKX]
splitOKX :: Int -> Int -> AttrLine -> [KM] -> OKX -> [OKX]
splitOKX width :: Int
width height :: Int
height rrep :: AttrLine
rrep keys :: [KM]
keys (ls0 :: [AttrLine]
ls0, kxs0 :: [(Either [KM] SlotChar, (Int, Int, Int))]
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 msgRaw :: [AttrLine]
msgRaw = Int -> AttrLine -> [AttrLine]
splitAttrLine Int
width AttrLine
rrep
(lX0 :: [AttrLine]
lX0, keysX0 :: [(Either [KM] SlotChar, (Int, Int, Int))]
keysX0) = Int -> Int -> Int -> [KM] -> OKX
keysOKX 0 0 Int
forall a. Bounded a => a
maxBound [KM]
keys
(lX :: [AttrLine]
lX, keysX :: [(Either [KM] SlotChar, (Int, Int, Int))]
keysX) | [AttrLine] -> Bool
forall a. [a] -> Bool
null [AttrLine]
msgRaw = ([AttrLine]
lX0, [(Either [KM] SlotChar, (Int, Int, Int))]
keysX0)
| Bool
otherwise = Int -> Int -> Int -> [KM] -> OKX
keysOKX ([AttrLine] -> Int
forall a. [a] -> Int
length [AttrLine]
msgRaw Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
(AttrLine -> Int
forall a. [a] -> Int
length ([AttrLine] -> AttrLine
forall a. [a] -> a
last [AttrLine]
msgRaw) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
Int
width [KM]
keys
msgOkx :: OKX
msgOkx = ([AttrLine] -> [AttrLine] -> [AttrLine]
glueLines [AttrLine]
msgRaw [AttrLine]
lX, [(Either [KM] SlotChar, (Int, Int, Int))]
keysX)
((lsInit :: [AttrLine]
lsInit, kxsInit :: [(Either [KM] SlotChar, (Int, Int, Int))]
kxsInit), (header :: [AttrLine]
header, rkxs :: [(Either [KM] SlotChar, (Int, Int, Int))]
rkxs)) =
if [AttrLine] -> Int
forall a. [a] -> Int
length ([AttrLine] -> [AttrLine] -> [AttrLine]
glueLines [AttrLine]
msgRaw [AttrLine]
lX0) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
height
then (OKX
msgOkx, ( [AttrLine -> [AttrLine] -> AttrLine
forall a. [a] -> [[a]] -> [a]
intercalate [AttrCharW32
Color.spaceAttrW32] [AttrLine]
lX0 AttrLine -> AttrLine -> AttrLine
<+:> AttrLine
rrep]
, [(Either [KM] SlotChar, (Int, Int, Int))]
keysX0 ))
else (([], []), OKX
msgOkx)
renumber :: a -> (a, (a, b, c)) -> (a, (a, b, c))
renumber y :: a
y (km :: a
km, (y0 :: a
y0, x1 :: b
x1, x2 :: c
x2)) = (a
km, (a
y0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
y, b
x1, c
x2))
splitO :: Int -> OKX -> OKX -> [OKX]
splitO yoffset :: Int
yoffset (hdr :: [AttrLine]
hdr, rk :: [(Either [KM] SlotChar, (Int, Int, Int))]
rk) (ls :: [AttrLine]
ls, kxs :: [(Either [KM] SlotChar, (Int, Int, Int))]
kxs) =
let zipRenumber :: [(Either [KM] SlotChar, (Int, Int, Int))]
-> [(Either [KM] SlotChar, (Int, Int, Int))]
zipRenumber = ((Either [KM] SlotChar, (Int, Int, Int))
-> (Either [KM] SlotChar, (Int, Int, Int)))
-> [(Either [KM] SlotChar, (Int, Int, Int))]
-> [(Either [KM] SlotChar, (Int, Int, Int))]
forall a b. (a -> b) -> [a] -> [b]
map (((Either [KM] SlotChar, (Int, Int, Int))
-> (Either [KM] SlotChar, (Int, Int, Int)))
-> [(Either [KM] SlotChar, (Int, Int, Int))]
-> [(Either [KM] SlotChar, (Int, Int, Int))])
-> ((Either [KM] SlotChar, (Int, Int, Int))
-> (Either [KM] SlotChar, (Int, Int, Int)))
-> [(Either [KM] SlotChar, (Int, Int, Int))]
-> [(Either [KM] SlotChar, (Int, Int, Int))]
forall a b. (a -> b) -> a -> b
$ Int
-> (Either [KM] SlotChar, (Int, Int, Int))
-> (Either [KM] SlotChar, (Int, Int, Int))
forall a a b c. Num a => a -> (a, (a, b, c)) -> (a, (a, b, c))
renumber (Int
-> (Either [KM] SlotChar, (Int, Int, Int))
-> (Either [KM] SlotChar, (Int, Int, Int)))
-> Int
-> (Either [KM] SlotChar, (Int, Int, Int))
-> (Either [KM] SlotChar, (Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Int
forall a. [a] -> Int
length [AttrLine]
hdr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
yoffset
(pre :: [AttrLine]
pre, post :: [AttrLine]
post) = Int -> [AttrLine] -> ([AttrLine], [AttrLine])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) ([AttrLine] -> ([AttrLine], [AttrLine]))
-> [AttrLine] -> ([AttrLine], [AttrLine])
forall a b. (a -> b) -> a -> b
$ [AttrLine]
hdr [AttrLine] -> [AttrLine] -> [AttrLine]
forall a. [a] -> [a] -> [a]
++ [AttrLine]
ls
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
- [AttrLine] -> Int
forall a. [a] -> Int
length [AttrLine]
hdr Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
in if [AttrLine] -> Bool
forall a. [a] -> Bool
null [AttrLine]
post
then [([AttrLine]
pre, [(Either [KM] SlotChar, (Int, Int, Int))]
rk [(Either [KM] SlotChar, (Int, Int, Int))]
-> [(Either [KM] SlotChar, (Int, Int, Int))]
-> [(Either [KM] SlotChar, (Int, Int, Int))]
forall a. [a] -> [a] -> [a]
++ [(Either [KM] SlotChar, (Int, Int, Int))]
-> [(Either [KM] SlotChar, (Int, Int, Int))]
zipRenumber [(Either [KM] SlotChar, (Int, Int, Int))]
kxs)]
else let (preX :: [(Either [KM] SlotChar, (Int, Int, Int))]
preX, postX :: [(Either [KM] SlotChar, (Int, Int, Int))]
postX) =
((Either [KM] SlotChar, (Int, Int, Int)) -> Bool)
-> [(Either [KM] SlotChar, (Int, Int, Int))]
-> ([(Either [KM] SlotChar, (Int, Int, Int))],
[(Either [KM] SlotChar, (Int, Int, Int))])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\(_, (y1 :: Int
y1, _, _)) -> Int
y1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
yoffsetNew) [(Either [KM] SlotChar, (Int, Int, Int))]
kxs
in ([AttrLine]
pre, [(Either [KM] SlotChar, (Int, Int, Int))]
rk [(Either [KM] SlotChar, (Int, Int, Int))]
-> [(Either [KM] SlotChar, (Int, Int, Int))]
-> [(Either [KM] SlotChar, (Int, Int, Int))]
forall a. [a] -> [a] -> [a]
++ [(Either [KM] SlotChar, (Int, Int, Int))]
-> [(Either [KM] SlotChar, (Int, Int, Int))]
zipRenumber [(Either [KM] SlotChar, (Int, Int, Int))]
preX)
OKX -> [OKX] -> [OKX]
forall a. a -> [a] -> [a]
: Int -> OKX -> OKX -> [OKX]
splitO Int
yoffsetNew ([AttrLine]
hdr, [(Either [KM] SlotChar, (Int, Int, Int))]
rk) ([AttrLine]
post, [(Either [KM] SlotChar, (Int, Int, Int))]
postX)
initSlides :: [OKX]
initSlides = if [AttrLine] -> Bool
forall a. [a] -> Bool
null [AttrLine]
lsInit
then Bool -> [OKX] -> [OKX]
forall a. HasCallStack => Bool -> a -> a
assert ([(Either [KM] SlotChar, (Int, Int, Int))] -> Bool
forall a. [a] -> Bool
null [(Either [KM] SlotChar, (Int, Int, Int))]
kxsInit) []
else Int -> OKX -> OKX -> [OKX]
splitO 0 ([], []) ([AttrLine]
lsInit, [(Either [KM] SlotChar, (Int, Int, Int))]
kxsInit)
mainSlides :: [OKX]
mainSlides = if [AttrLine] -> Bool
forall a. [a] -> Bool
null [AttrLine]
ls0 Bool -> Bool -> Bool
&& Bool -> Bool
not ([AttrLine] -> Bool
forall a. [a] -> Bool
null [AttrLine]
lsInit)
then Bool -> [OKX] -> [OKX]
forall a. HasCallStack => Bool -> a -> a
assert ([(Either [KM] SlotChar, (Int, Int, Int))] -> Bool
forall a. [a] -> Bool
null [(Either [KM] SlotChar, (Int, Int, Int))]
kxs0) []
else Int -> OKX -> OKX -> [OKX]
splitO 0 ([AttrLine]
header, [(Either [KM] SlotChar, (Int, Int, Int))]
rkxs) ([AttrLine]
ls0, [(Either [KM] SlotChar, (Int, Int, Int))]
kxs0)
in [OKX]
initSlides [OKX] -> [OKX] -> [OKX]
forall a. [a] -> [a] -> [a]
++ [OKX]
mainSlides
highSlideshow :: X
-> Y
-> HighScore.ScoreTable
-> Int
-> Text
-> TimeZone
-> Slideshow
highSlideshow :: Int -> Int -> ScoreTable -> Int -> Text -> TimeZone -> Slideshow
highSlideshow 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 :: [[AttrLine]]
tts = TimeZone -> Int -> ScoreTable -> Int -> [[AttrLine]]
showNearbyScores TimeZone
tz Int
pos ScoreTable
table Int
entries
al :: AttrLine
al = Text -> AttrLine
textToAL Text
msg
splitScreen :: [AttrLine] -> [OKX]
splitScreen ts :: [AttrLine]
ts =
Int -> Int -> AttrLine -> [KM] -> OKX -> [OKX]
splitOKX Int
width Int
height AttrLine
al [KM
K.spaceKM, KM
K.escKM] ([AttrLine]
ts, [])
in [OKX] -> Slideshow
toSlideshow ([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
$ ([AttrLine] -> [OKX]) -> [[AttrLine]] -> [[OKX]]
forall a b. (a -> b) -> [a] -> [b]
map [AttrLine] -> [OKX]
splitScreen [[AttrLine]]
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 -> [AttrLine] -> [AttrLine]
forall a. a -> [a] -> [a]
: [AttrLine] -> [[AttrLine]] -> [AttrLine]
forall a. [a] -> [[a]] -> [a]
intercalate [[]] (((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]