-- | Slideshows.
module Game.LambdaHack.Client.UI.Slideshow
  ( KYX, OKX, Slideshow(slideshow)
  , emptySlideshow, unsnoc, toSlideshow, menuToSlideshow
  , wrapOKX, splitOverlay, splitOKX, highSlideshow
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , 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

-- | A key or an item slot label at a given position on the screen.
type KYX = (Either [K.KM] SlotChar, (Y, X, X))

-- | An Overlay of text with an associated list of keys or slots
-- that activated when the specified screen position is pointed at.
-- The list should be sorted wrt rows and then columns.
type OKX = (Overlay, [KYX])

-- | A list of active screenfulls to be shown one after another.
-- Each screenful has an independent numbering of rows and columns.
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
menuToSlideshow :: OKX -> Slideshow
menuToSlideshow (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)

-- Note that we only split wrt @White@ space, nothing else.
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
$  -- and kxs0 is sorted
  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)) =
        -- Check whether most space taken by report and keys.
        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 ))
               -- will display "$" (unless has EOLs)
        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)]  -- all fits on one screen
           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

-- | Generate a slideshow with the current and previous scores.
highSlideshow :: X          -- ^ width of the display area
              -> Y          -- ^ height of the display area
              -> HighScore.ScoreTable -- ^ current score table
              -> Int        -- ^ position of the current score in the table
              -> Text       -- ^ the name of the game mode
              -> TimeZone   -- ^ the timezone where the game is run
              -> 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

-- | Show a screenful of the high scores table.
-- Parameter @entries@ is the number of (3-line) scores to be shown.
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)

-- | Produce a couple of renderings of the high scores table.
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]