-- | Slideshows.
module Game.LambdaHack.Client.UI.Slideshow
  ( FontOverlayMap, maxYofFontOverlayMap
  , KeyOrSlot, ButtonWidth(..)
  , KYX, xytranslateKXY, xtranslateKXY, ytranslateKXY, yrenumberKXY
  , OKX, emptyOKX, xytranslateOKX, sideBySideOKX, labDescOKX
  , Slideshow(slideshow), emptySlideshow, unsnoc, toSlideshow
  , attrLinesToFontMap, menuToSlideshow, wrapOKX, splitOverlay, splitOKX
  , highSlideshow
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , 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

type FontOverlayMap = EM.EnumMap DisplayFont Overlay

maxYofFontOverlayMap :: FontOverlayMap -> Int
maxYofFontOverlayMap :: FontOverlayMap -> Int
maxYofFontOverlayMap FontOverlayMap
ovs = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Overlay -> Int) -> [Overlay] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Overlay -> Int
maxYofOverlay (FontOverlayMap -> [Overlay]
forall k a. EnumMap k a -> [a]
EM.elems FontOverlayMap
ovs))

type KeyOrSlot = Either K.KM SlotChar

-- TODO: probably best merge the PointUI into that and represent
-- the position as characters, too, translating to UI positions as needed.
-- The problem is that then I need to do a lot of reverse translation
-- when creating buttons.
-- | Width of on-screen button text, expressed in characters,
-- and so UI (mono font) width is deduced from the used font.
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)

-- | A key or an item slot label at a given position on the screen.
type KYX = (KeyOrSlot, (PointUI, ButtonWidth))

xytranslateKXY :: Int -> Int -> KYX -> KYX
xytranslateKXY :: Int -> Int -> KYX -> KYX
xytranslateKXY Int
dx Int
dy (KeyOrSlot
km, (PointUI Int
x Int
y, ButtonWidth
len)) =
  (KeyOrSlot
km, (Int -> Int -> PointUI
PointUI (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dx) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dy), ButtonWidth
len))

xtranslateKXY :: Int -> KYX -> KYX
xtranslateKXY :: Int -> KYX -> KYX
xtranslateKXY Int
dx = Int -> Int -> KYX -> KYX
xytranslateKXY Int
dx Int
0

ytranslateKXY :: Int -> KYX -> KYX
ytranslateKXY :: Int -> KYX -> KYX
ytranslateKXY = Int -> Int -> KYX -> KYX
xytranslateKXY Int
0

yrenumberKXY :: Int -> KYX -> KYX
yrenumberKXY :: Int -> KYX -> KYX
yrenumberKXY Int
ynew (KeyOrSlot
km, (PointUI Int
x Int
_, ButtonWidth
len)) = (KeyOrSlot
km, (Int -> Int -> PointUI
PointUI Int
x Int
ynew, ButtonWidth
len))

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

emptyOKX :: OKX
emptyOKX :: OKX
emptyOKX = (FontOverlayMap
forall k a. EnumMap k a
EM.empty, [])

xytranslateOKX ::Int -> Int -> OKX -> OKX
xytranslateOKX :: Int -> Int -> OKX -> OKX
xytranslateOKX Int
dx Int
dy (FontOverlayMap
ovs, [KYX]
kyxs) =
  ( (Overlay -> Overlay) -> FontOverlayMap -> FontOverlayMap
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (Int -> Int -> Overlay -> Overlay
xytranslateOverlay Int
dx Int
dy) FontOverlayMap
ovs
  , (KYX -> KYX) -> [KYX] -> [KYX]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> KYX -> KYX
xytranslateKXY Int
dx Int
dy) [KYX]
kyxs )

sideBySideOKX :: Int -> Int -> OKX -> OKX -> OKX
sideBySideOKX :: Int -> Int -> OKX -> OKX -> OKX
sideBySideOKX Int
dx Int
dy (FontOverlayMap
ovs1, [KYX]
kyxs1) (FontOverlayMap
ovs2, [KYX]
kyxs2) =
  let (FontOverlayMap
ovs3, [KYX]
kyxs3) = Int -> Int -> OKX -> OKX
xytranslateOKX Int
dx Int
dy (FontOverlayMap
ovs2, [KYX]
kyxs2)
  in ( (Overlay -> Overlay -> Overlay)
-> FontOverlayMap -> FontOverlayMap -> FontOverlayMap
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) FontOverlayMap
ovs1 FontOverlayMap
ovs3
     , (KYX -> (Int, Int)) -> [KYX] -> [KYX]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(KeyOrSlot
_, (PointUI Int
x Int
y, ButtonWidth
_)) -> (Int
y, Int
x)) ([KYX] -> [KYX]) -> [KYX] -> [KYX]
forall a b. (a -> b) -> a -> b
$ [KYX]
kyxs1 [KYX] -> [KYX] -> [KYX]
forall a. [a] -> [a] -> [a]
++ [KYX]
kyxs3 )

-- The bangs are to free the possibly very long input list ASAP.
labDescOKX :: DisplayFont -> DisplayFont
           -> [(AttrString, AttrString, KeyOrSlot)]
           -> OKX
labDescOKX :: DisplayFont
-> DisplayFont -> [(AttrString, AttrString, KeyOrSlot)] -> OKX
labDescOKX DisplayFont
labFont DisplayFont
descFont [(AttrString, AttrString, KeyOrSlot)]
l =
  let descFontSize :: AttrString -> Int
descFontSize | DisplayFont -> Bool
isPropFont DisplayFont
descFont = AttrString -> Int
forall a. [a] -> Int
length  -- may be less or a bit more
                   | Bool
otherwise = DisplayFont -> AttrString -> Int
forall a. DisplayFont -> [a] -> Int
textSize DisplayFont
descFont
      processRow :: (AttrString, AttrString, KeyOrSlot)
                 -> (AttrLine, (Int, AttrLine), KYX)
      processRow :: (AttrString, AttrString, KeyOrSlot)
-> (AttrLine, (Int, AttrLine), KYX)
processRow (!AttrString
tLab, !AttrString
tDesc, !KeyOrSlot
ekm) =
        let labLen :: Int
labLen = DisplayFont -> AttrString -> Int
forall a. DisplayFont -> [a] -> Int
textSize DisplayFont
labFont AttrString
tLab
            lenButton :: Int
lenButton = Int
labLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AttrString -> Int
descFontSize AttrString
tDesc
        in ( AttrString -> AttrLine
attrStringToAL AttrString
tLab
           , (Int
labLen, AttrString -> AttrLine
attrStringToAL AttrString
tDesc)
           , (KeyOrSlot
ekm, (Int -> Int -> PointUI
PointUI Int
0 Int
0, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
descFont Int
lenButton)) )
      ([AttrLine]
tsLab, [(Int, AttrLine)]
tsDesc, [KYX]
kxs) = [(AttrLine, (Int, AttrLine), KYX)]
-> ([AttrLine], [(Int, AttrLine)], [KYX])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(AttrLine, (Int, AttrLine), KYX)]
 -> ([AttrLine], [(Int, AttrLine)], [KYX]))
-> [(AttrLine, (Int, AttrLine), KYX)]
-> ([AttrLine], [(Int, AttrLine)], [KYX])
forall a b. (a -> b) -> a -> b
$ ((AttrString, AttrString, KeyOrSlot)
 -> (AttrLine, (Int, AttrLine), KYX))
-> [(AttrString, AttrString, KeyOrSlot)]
-> [(AttrLine, (Int, AttrLine), KYX)]
forall a b. (a -> b) -> [a] -> [b]
map (AttrString, AttrString, KeyOrSlot)
-> (AttrLine, (Int, AttrLine), KYX)
processRow [(AttrString, AttrString, KeyOrSlot)]
l
      ovs :: FontOverlayMap
ovs = (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
labFont ([AttrLine] -> Overlay
offsetOverlay [AttrLine]
tsLab)
            (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
descFont (Overlay -> FontOverlayMap) -> Overlay -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ [(Int, AttrLine)] -> Overlay
offsetOverlayX [(Int, AttrLine)]
tsDesc
  in (FontOverlayMap
ovs, (Int -> KYX -> KYX) -> [Int] -> [KYX] -> [KYX]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> KYX -> KYX
yrenumberKXY [Int
0..] [KYX]
kxs)

-- | 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 -> (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{DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
..} [OKX]
okxs = [OKX] -> Slideshow
Slideshow ([OKX] -> Slideshow) -> [OKX] -> Slideshow
forall a b. (a -> b) -> a -> b
$ Bool -> [OKX] -> [OKX]
addFooters Bool
False [OKX]
okxs
 where
  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 -> String
                         -> (FontOverlayMap, PointUI, DisplayFont, Int)
  appendToFontOverlayMap :: FontOverlayMap
-> String -> (FontOverlayMap, PointUI, DisplayFont, Int)
appendToFontOverlayMap FontOverlayMap
ovs String
msg =
    let maxYminXofOverlay :: [(PointUI, b)] -> (Int, Int)
maxYminXofOverlay [(PointUI, b)]
ov =
          let ymxOfOverlay :: (PointUI, b) -> (Int, Int)
ymxOfOverlay (PointUI Int
x Int
y, b
_) = (- 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
$ (Int, Int)
forall a. Bounded a => a
maxBound (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
        -- @sortOn@ less efficient here, because function cheap.
        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
        (DisplayFont
fontMax, Int
yMax) = case [(DisplayFont, (Int, Int))]
assocsYX of
          [] -> (DisplayFont
monoFont, Int
0)
          (DisplayFont
font, (Int
yNeg, Int
_x)) : [(DisplayFont, (Int, Int))]
rest ->
            let unique :: Bool
unique = ((DisplayFont, (Int, Int)) -> Bool)
-> [(DisplayFont, (Int, Int))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(DisplayFont
_, (Int
yNeg2, Int
_)) -> Int
yNeg Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
yNeg2) [(DisplayFont, (Int, Int))]
rest
            in ( if DisplayFont -> Bool
isSquareFont DisplayFont
font Bool -> Bool -> Bool
&& Bool
unique
                 then DisplayFont
font
                 else DisplayFont
monoFont
               , - Int
yNeg )
        pMax :: PointUI
pMax = Int -> Int -> PointUI
PointUI Int
0 (Int
yMax Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)  -- append after last line
    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
fontMax [(PointUI
pMax, String -> AttrLine
stringToAL String
msg)] FontOverlayMap
ovs
       , PointUI
pMax
       , DisplayFont
fontMax
       , String -> Int
forall a. [a] -> Int
length String
msg )
  addFooters :: Bool -> [OKX] -> [OKX]
  addFooters :: Bool -> [OKX] -> [OKX]
addFooters Bool
_ [] = String -> [OKX]
forall a. HasCallStack => String -> a
error (String -> [OKX]) -> String -> [OKX]
forall a b. (a -> b) -> a -> b
$ String
"" String -> [OKX] -> String
forall v. Show v => String -> v -> String
`showFailure` [OKX]
okxs
  addFooters Bool
_ [(FontOverlayMap
als, [])] =
    -- TODO: make sure this case never coincides with the space button
    -- actually returning to top, as opposed to finishing preview.
    let (FontOverlayMap
ovs, PointUI
p, DisplayFont
font, Int
width) = FontOverlayMap
-> String -> (FontOverlayMap, PointUI, DisplayFont, Int)
appendToFontOverlayMap FontOverlayMap
als String
"--end--"
    in [(FontOverlayMap
ovs, [(KM -> KeyOrSlot
forall a b. a -> Either a b
Left KM
K.safeSpaceKM, (PointUI
p, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
font Int
width))])]
  addFooters Bool
False [(FontOverlayMap
als, [KYX]
kxs)] = [(FontOverlayMap
als, [KYX]
kxs)]
  addFooters Bool
True [(FontOverlayMap
als, [KYX]
kxs)] =
    let (FontOverlayMap
ovs, PointUI
p, DisplayFont
font, Int
width) = FontOverlayMap
-> String -> (FontOverlayMap, PointUI, DisplayFont, Int)
appendToFontOverlayMap FontOverlayMap
als String
"--back to top--"
    in [(FontOverlayMap
ovs, [KYX]
kxs [KYX] -> [KYX] -> [KYX]
forall a. [a] -> [a] -> [a]
++ [(KM -> KeyOrSlot
forall a b. a -> Either a b
Left KM
K.safeSpaceKM, (PointUI
p, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
font Int
width))])]
  addFooters Bool
_ ((FontOverlayMap
als, [KYX]
kxs) : [OKX]
rest) =
    let (FontOverlayMap
ovs, PointUI
p, DisplayFont
font, Int
width) = FontOverlayMap
-> String -> (FontOverlayMap, PointUI, DisplayFont, Int)
appendToFontOverlayMap FontOverlayMap
als String
"--more--"
    in (FontOverlayMap
ovs, [KYX]
kxs [KYX] -> [KYX] -> [KYX]
forall a. [a] -> [a] -> [a]
++ [(KM -> KeyOrSlot
forall a b. a -> Either a b
Left KM
K.safeSpaceKM, (PointUI
p, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
font Int
width))])
       OKX -> [OKX] -> [OKX]
forall a. a -> [a] -> [a]
: Bool -> [OKX] -> [OKX]
addFooters Bool
True [OKX]
rest

-- | This appends vertically a list of blurbs into a single font overlay map.
-- Not to be used if some blurbs need to be places overlapping vertically,
-- e.g., when the square font symbol needs to be in the same line
-- as the start of the descritpion of the denoted item
-- or when mono font buttons need to be after a prompt.
attrLinesToFontMap :: [(DisplayFont, [AttrLine])] -> FontOverlayMap
attrLinesToFontMap :: [(DisplayFont, [AttrLine])] -> FontOverlayMap
attrLinesToFontMap [(DisplayFont, [AttrLine])]
blurb =
  let zipAttrLines :: Int -> [AttrLine] -> (Overlay, Int)
      zipAttrLines :: Int -> [AttrLine] -> (Overlay, Int)
zipAttrLines Int
start [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 Int
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) (DisplayFont
font, [AttrLine]
als) =
        let (Overlay
als2, 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 )
      (FontOverlayMap
ov, Int
_) = ((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
0) [(DisplayFont, [AttrLine])]
blurb
  in FontOverlayMap
ov

menuToSlideshow :: OKX -> Slideshow
menuToSlideshow :: OKX -> Slideshow
menuToSlideshow (FontOverlayMap
als, [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 DisplayFont
_ Int
_ Int
_ Int
_ [] = ([], [])
wrapOKX DisplayFont
displayFont Int
ystart Int
xstart Int
width [(KM, String)]
ks =
  let overlayLineFromStrings :: Int -> Int -> [String] -> (PointUI, AttrLine)
      overlayLineFromStrings :: Int -> Int -> [String] -> (PointUI, AttrLine)
overlayLineFromStrings Int
xlineStart Int
y [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] -> [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 ((Int
y, Int
x), (Int
xlineStart, [String]
kL, Overlay
kV, [KYX]
kX)) (KM
key, 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 String
" "
        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
+ Int
1, Int
0), (Int
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 -> KeyOrSlot
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 ) )
      ((Int
ystop, Int
_), (Int
xlineStop, [String]
kL1, Overlay
kV1, [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 Int
ystart Int
xstart Int
width [KM]
keys =
  let wrapB :: String -> String
      wrapB :: ShowS
wrapB String
s = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
      ks :: [(KM, String)]
ks = (KM -> (KM, String)) -> [KM] -> [(KM, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\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

-- The font argument is for the report and keys overlay. Others already have
-- assigned fonts.
splitOverlay :: FontSetup -> Int -> Int -> Int -> Report -> [K.KM] -> OKX
             -> Slideshow
splitOverlay :: FontSetup
-> Int -> Int -> Int -> Report -> [KM] -> OKX -> Slideshow
splitOverlay FontSetup
fontSetup Int
width Int
height Int
wrap Report
report [KM]
keys (FontOverlayMap
ls0, [KYX]
kxs0) =
  let renderedReport :: [AttrString]
renderedReport = Bool -> Report -> [AttrString]
renderReport Bool
True Report
report
      reportAS :: AttrString
reportAS = (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
  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
False Int
width Int
height Int
wrap
                                      AttrString
reportAS [KM]
keys (FontOverlayMap
ls0, [KYX]
kxs0)

-- Note that we only split wrt @White@ space, nothing else.
splitOKX :: FontSetup -> Bool -> Int -> Int -> Int -> AttrString -> [K.KM]
         -> OKX
         -> [OKX]
splitOKX :: FontSetup
-> Bool -> Int -> Int -> Int -> AttrString -> [KM] -> OKX -> [OKX]
splitOKX FontSetup{DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
..} Bool
msgLong Int
width Int
height Int
wrap AttrString
reportAS [KM]
keys (FontOverlayMap
ls0, [KYX]
kxs0) =
  Bool -> [OKX] -> [OKX]
forall a. HasCallStack => Bool -> a -> a
assert (Int
height Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2) ([OKX] -> [OKX]) -> [OKX] -> [OKX]
forall a b. (a -> b) -> a -> b
$
  let reportParagraphs :: [AttrLine]
reportParagraphs = AttrString -> [AttrLine]
linesAttr AttrString
reportAS
      -- TODO: until SDL support for measuring prop font text is released,
      -- we have to use MonoFont for the paragraph that ends with buttons.
      ([AttrLine]
repProp, 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)
          AttrLine
l : [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 Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width
                else Int
wrap  -- TODO if with width fits on one screen, use it
      msgWidth :: Int
msgWidth = if Bool
msgLong Bool -> Bool -> Bool
&& Bool -> Bool
not (DisplayFont -> Bool
isSquareFont DisplayFont
propFont)
                 then Int
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
        [] -> []
        AttrLine
r : [AttrLine]
rs ->
          -- Make lines of first paragraph long if it has 2 lines at most.
          -- The first line does not obscure anything and the second line
          -- is often short anyway.
          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
<= Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
msgWidth
                           then Int
msgWidth
                           else Int
msgWrap
          in (DisplayFont -> Int -> AttrString -> [AttrLine]
indentSplitAttrString DisplayFont
propFont Int
firstWidth (AttrString -> [AttrLine])
-> (AttrLine -> AttrString) -> AttrLine -> [AttrLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrLine -> AttrString
attrLine) AttrLine
r
               -- first possibly long
             [AttrLine] -> [AttrLine] -> [AttrLine]
forall a. [a] -> [a] -> [a]
++ (AttrLine -> [AttrLine]) -> [AttrLine] -> [AttrLine]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DisplayFont -> Int -> AttrString -> [AttrLine]
indentSplitAttrString DisplayFont
propFont Int
msgWrap (AttrString -> [AttrLine])
-> (AttrLine -> AttrString) -> AttrLine -> [AttrLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrLine -> AttrString
attrLine) [AttrLine]
rs
      -- TODO: refactor this ugly pile of copy-paste
      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 (DisplayFont -> Int -> AttrString -> [AttrLine]
indentSplitAttrString DisplayFont
propFont Int
width (AttrString -> [AttrLine])
-> (AttrLine -> AttrString) -> AttrLine -> [AttrLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrLine -> AttrString
attrLine)
                             [AttrLine]
repProp
      -- If the mono portion first on the line, let it take half width,
      -- but if previous lines shorter, match them and only buttons
      -- are permitted to stick out.
      monoWidth :: Int
monoWidth = if [AttrLine] -> Bool
forall a. [a] -> Bool
null [AttrLine]
repProp then Int
msgWidth else Int
msgWrap
      repMono0 :: Overlay
repMono0 = Int -> Overlay -> Overlay
ytranslateOverlay (Overlay -> Int
forall a. [a] -> Int
length Overlay
repProp0)
                 (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
$ DisplayFont -> Int -> AttrString -> [AttrLine]
indentSplitAttrString DisplayFont
monoFont Int
monoWidth (AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ AttrLine -> AttrString
attrLine AttrLine
repMono
      repMonoW :: Overlay
repMonoW = Int -> Overlay -> Overlay
ytranslateOverlay (Overlay -> Int
forall a. [a] -> Int
length Overlay
repPropW)
                 (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
$ DisplayFont -> Int -> AttrString -> [AttrLine]
indentSplitAttrString DisplayFont
monoFont 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 (DisplayFont -> Int -> AttrString -> [AttrLine]
indentSplitAttrString DisplayFont
propFont 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 = Int -> Overlay -> Overlay
ytranslateOverlay Int
1 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 Int
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 Int
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 String
"A long report is shown. Press a key:"
                  AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.nbspAttrW32]
      (Overlay
lX0, [KYX]
keysX0) = DisplayFont -> Int -> Int -> Int -> [KM] -> (Overlay, [KYX])
keysOKX DisplayFont
monoFont Int
0 (AttrString -> Int
forall a. [a] -> Int
length AttrString
pressAKey) Int
width [KM]
keys
      (Overlay
lX1, [KYX]
keysX1) = DisplayFont -> Int -> Int -> Int -> [KM] -> (Overlay, [KYX])
keysOKX DisplayFont
monoFont Int
1 Int
0 Int
width [KM]
keys
      (Overlay
lX, [KYX]
keysX) = DisplayFont -> Int -> Int -> Int -> [KM] -> (Overlay, [KYX])
keysOKX DisplayFont
monoFont (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
lenOfRep0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
startOfKeys
                            (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width) [KM]
keys
      (Overlay
lXW, [KYX]
keysXW) = DisplayFont -> Int -> Int -> Int -> [KM] -> (Overlay, [KYX])
keysOKX DisplayFont
monoFont (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
lenOfRepW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
startOfKeysW
                              (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width) [KM]
keys
      splitO :: Int -> (Overlay, Overlay, [KYX]) -> OKX -> [OKX]
      splitO :: Int -> (Overlay, Overlay, [KYX]) -> OKX -> [OKX]
splitO Int
yoffset (Overlay
hdrProp, Overlay
hdrMono, [KYX]
rk) (FontOverlayMap
ls, [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 = Int
0
                   | Bool
otherwise = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
maxYofOverlay Overlay
hdrMono
            keyTranslate :: [KYX] -> [KYX]
keyTranslate = (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
ytranslateKXY (Int
hdrOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
yoffset)
            lineTranslate :: FontOverlayMap -> FontOverlayMap
lineTranslate = (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
ytranslateOverlay (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
- Int
1
            ltOffset :: (PointUI, a) -> Bool
            ltOffset :: (PointUI, a) -> Bool
ltOffset (PointUI Int
_ Int
y, a
_) = Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
yoffsetNew
            (FontOverlayMap
pre, 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  -- all fits on one screen
           then [(FontOverlayMap -> FontOverlayMap
prependHdr (FontOverlayMap -> FontOverlayMap)
-> FontOverlayMap -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ FontOverlayMap -> FontOverlayMap
lineTranslate FontOverlayMap
pre, [KYX]
rk [KYX] -> [KYX] -> [KYX]
forall a. [a] -> [a] -> [a]
++ [KYX] -> [KYX]
keyTranslate [KYX]
kxs)]
           else let ([KYX]
preX, [KYX]
postX) = (KYX -> Bool) -> [KYX] -> ([KYX], [KYX])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\(KeyOrSlot
_, (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
lineTranslate FontOverlayMap
pre, [KYX]
rk [KYX] -> [KYX] -> [KYX]
forall a. [a] -> [a] -> [a]
++ [KYX] -> [KYX]
keyTranslate [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 Int
0 Int
0, AttrLine
firstParaReport)]
                         -- shortened for the main slides; in full beforehand
                     , Int -> Overlay -> Overlay
forall a. Int -> [a] -> [a]
take Int
3 Overlay
lX1  -- 3 lines ought to be enough for everyone
                     , [KYX]
keysX1 )
      ((FontOverlayMap
lsInit, [KYX]
kxsInit), (Overlay
headerProp, Overlay
headerMono, [KYX]
rkxs)) =
        -- Check whether all space taken by report and keys.
        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 ->  -- display normally
             (OKX
emptyOKX, (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 ->  -- display widely
             (OKX
emptyOKX, (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
== Int
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
<= Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width ->
             ( OKX
emptyOKX  -- already shown in full in @hdrShortened@
             , (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, [])
                     -- showing in full in the init slide
                 , (Overlay, Overlay, [KYX])
hdrShortened )
               (PointUI, AttrLine)
lX0first : Overlay
_ ->
                 ( ( (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 Int
0 Int
0, AttrString -> AttrLine
firstParagraph AttrString
pressAKey), (PointUI, AttrLine)
lX0first]
                   , (KYX -> Bool) -> [KYX] -> [KYX]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(KeyOrSlot
_, (PointUI Int
_ Int
y, ButtonWidth
_)) -> Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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 Int
0 ([], [], []) (FontOverlayMap
lsInit, [KYX]
kxsInit)
      -- If @ls0@ is not empty, we still want to display the report,
      -- one way or another.
      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 Int
0 (Overlay
headerProp, Overlay
headerMono, [KYX]
rkxs) (FontOverlayMap
ls0, [KYX]
kxs0)
  in [OKX]
initSlides [OKX] -> [OKX] -> [OKX]
forall a. [a] -> [a] -> [a]
++ [OKX]
mainSlides

-- | Generate a slideshow with the current and previous scores.
highSlideshow :: FontSetup
              -> Int        -- ^ width of the display area
              -> Int        -- ^ 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 :: FontSetup
-> Int -> Int -> ScoreTable -> Int -> Text -> TimeZone -> Slideshow
highSlideshow fontSetup :: FontSetup
fontSetup@FontSetup{DisplayFont
monoFont :: DisplayFont
monoFont :: FontSetup -> DisplayFont
monoFont} Int
width Int
height ScoreTable
table Int
pos
              Text
gameModeName TimeZone
tz =
  let entries :: Int
entries = (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
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 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

-- | 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 TimeZone
tz Int
pos ScoreTable
table Int
start Int
entries =
  let zipped :: [(Int, ScoreRecord)]
zipped    = [Int] -> [ScoreRecord] -> [(Int, ScoreRecord)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
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
- Int
1) ([(Int, ScoreRecord)] -> [(Int, ScoreRecord)])
-> [(Int, ScoreRecord)] -> [(Int, ScoreRecord)]
forall a b. (a -> b) -> a -> b
$ [(Int, ScoreRecord)]
zipped
      renderScore :: (Int, ScoreRecord) -> [AttrLine]
renderScore (Int
pos1, 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)

-- | Produce a couple of renderings of the high scores table.
showNearbyScores :: TimeZone -> Int -> HighScore.ScoreTable -> Int
                 -> [[AttrLine]]
showNearbyScores :: TimeZone -> Int -> ScoreTable -> Int -> [[AttrLine]]
showNearbyScores TimeZone
tz Int
pos ScoreTable
h 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 Int
1 Int
entries]
  else [ TimeZone -> Int -> ScoreTable -> Int -> Int -> [AttrLine]
showTable TimeZone
tz Int
pos ScoreTable
h Int
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
+ Int
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` Int
2))
                   Int
entries ]