-- | Slideshows.
module Game.LambdaHack.Client.UI.Slideshow
  ( DisplayFont, isSquareFont, isMonoFont, FontOverlayMap, FontSetup(..)
  , multiFontSetup, monoFontSetup, singleFontSetup, textSize
  , ButtonWidth(..), KYX, OKX, Slideshow(slideshow)
  , emptySlideshow, unsnoc, toSlideshow, attrLinesToFontMap
  , maxYofOverlay, menuToSlideshow, wrapOKX, splitOverlay, splitOKX
  , highSlideshow
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , moreMsg, endMsg, keysOKX, showTable, showNearbyScores
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM
import           Data.Time.LocalTime

import           Game.LambdaHack.Client.UI.ItemSlot
import qualified Game.LambdaHack.Client.UI.Key as K
import           Game.LambdaHack.Client.UI.Msg
import           Game.LambdaHack.Client.UI.Overlay
import           Game.LambdaHack.Client.UI.PointUI
import qualified Game.LambdaHack.Common.HighScore as HighScore
import qualified Game.LambdaHack.Definition.Color as Color

data DisplayFont = SquareFont | MonoFont | PropFont
  deriving (Int -> DisplayFont -> ShowS
[DisplayFont] -> ShowS
DisplayFont -> String
(Int -> DisplayFont -> ShowS)
-> (DisplayFont -> String)
-> ([DisplayFont] -> ShowS)
-> Show DisplayFont
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisplayFont] -> ShowS
$cshowList :: [DisplayFont] -> ShowS
show :: DisplayFont -> String
$cshow :: DisplayFont -> String
showsPrec :: Int -> DisplayFont -> ShowS
$cshowsPrec :: Int -> DisplayFont -> ShowS
Show, DisplayFont -> DisplayFont -> Bool
(DisplayFont -> DisplayFont -> Bool)
-> (DisplayFont -> DisplayFont -> Bool) -> Eq DisplayFont
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayFont -> DisplayFont -> Bool
$c/= :: DisplayFont -> DisplayFont -> Bool
== :: DisplayFont -> DisplayFont -> Bool
$c== :: DisplayFont -> DisplayFont -> Bool
Eq, Int -> DisplayFont
DisplayFont -> Int
DisplayFont -> [DisplayFont]
DisplayFont -> DisplayFont
DisplayFont -> DisplayFont -> [DisplayFont]
DisplayFont -> DisplayFont -> DisplayFont -> [DisplayFont]
(DisplayFont -> DisplayFont)
-> (DisplayFont -> DisplayFont)
-> (Int -> DisplayFont)
-> (DisplayFont -> Int)
-> (DisplayFont -> [DisplayFont])
-> (DisplayFont -> DisplayFont -> [DisplayFont])
-> (DisplayFont -> DisplayFont -> [DisplayFont])
-> (DisplayFont -> DisplayFont -> DisplayFont -> [DisplayFont])
-> Enum DisplayFont
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DisplayFont -> DisplayFont -> DisplayFont -> [DisplayFont]
$cenumFromThenTo :: DisplayFont -> DisplayFont -> DisplayFont -> [DisplayFont]
enumFromTo :: DisplayFont -> DisplayFont -> [DisplayFont]
$cenumFromTo :: DisplayFont -> DisplayFont -> [DisplayFont]
enumFromThen :: DisplayFont -> DisplayFont -> [DisplayFont]
$cenumFromThen :: DisplayFont -> DisplayFont -> [DisplayFont]
enumFrom :: DisplayFont -> [DisplayFont]
$cenumFrom :: DisplayFont -> [DisplayFont]
fromEnum :: DisplayFont -> Int
$cfromEnum :: DisplayFont -> Int
toEnum :: Int -> DisplayFont
$ctoEnum :: Int -> DisplayFont
pred :: DisplayFont -> DisplayFont
$cpred :: DisplayFont -> DisplayFont
succ :: DisplayFont -> DisplayFont
$csucc :: DisplayFont -> DisplayFont
Enum)

isSquareFont :: DisplayFont -> Bool
isSquareFont :: DisplayFont -> Bool
isSquareFont SquareFont = Bool
True
isSquareFont _ = Bool
False

isMonoFont :: DisplayFont -> Bool
isMonoFont :: DisplayFont -> Bool
isMonoFont MonoFont = Bool
True
isMonoFont _ = Bool
False

type FontOverlayMap = EM.EnumMap DisplayFont Overlay

data FontSetup = FontSetup
  { FontSetup -> DisplayFont
squareFont :: DisplayFont
  , FontSetup -> DisplayFont
monoFont   :: DisplayFont
  , FontSetup -> DisplayFont
propFont   :: DisplayFont
  }

multiFontSetup :: FontSetup
multiFontSetup :: FontSetup
multiFontSetup = DisplayFont -> DisplayFont -> DisplayFont -> FontSetup
FontSetup DisplayFont
SquareFont DisplayFont
MonoFont DisplayFont
PropFont

monoFontSetup :: FontSetup
monoFontSetup :: FontSetup
monoFontSetup = DisplayFont -> DisplayFont -> DisplayFont -> FontSetup
FontSetup DisplayFont
SquareFont DisplayFont
MonoFont DisplayFont
MonoFont

singleFontSetup :: FontSetup
singleFontSetup :: FontSetup
singleFontSetup = DisplayFont -> DisplayFont -> DisplayFont -> FontSetup
FontSetup DisplayFont
SquareFont DisplayFont
SquareFont DisplayFont
SquareFont

textSize :: DisplayFont -> [a] -> Int
textSize :: DisplayFont -> [a] -> Int
textSize SquareFont l :: [a]
l = 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [a] -> Int
forall a. [a] -> Int
length [a]
l
textSize MonoFont l :: [a]
l = [a] -> Int
forall a. [a] -> Int
length [a]
l
textSize PropFont _ = String -> Int
forall a. HasCallStack => String -> a
error "size of proportional font texts is not defined"

-- 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 = (Either [K.KM] SlotChar, (PointUI, ButtonWidth))

-- | 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 = (FontOverlayMap, [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 :: FontSetup -> [OKX] -> Slideshow
toSlideshow :: FontSetup -> [OKX] -> Slideshow
toSlideshow FontSetup{..} okxs :: [OKX]
okxs = [OKX] -> Slideshow
Slideshow ([OKX] -> Slideshow) -> [OKX] -> Slideshow
forall a b. (a -> b) -> a -> b
$ Bool -> [OKX] -> [OKX]
addFooters Bool
False [OKX]
okxsNotNull
 where
  okxFilter :: (a, [(Either [a] b, b)]) -> (a, [(Either [a] b, b)])
okxFilter (ov :: a
ov, kyxs :: [(Either [a] b, b)]
kyxs) =
    (a
ov, ((Either [a] b, b) -> Bool)
-> [(Either [a] b, b)] -> [(Either [a] b, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (([a] -> Bool) -> (b -> Bool) -> Either [a] b -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall a. [a] -> Bool
null) (Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True) (Either [a] b -> Bool)
-> ((Either [a] b, b) -> Either [a] b) -> (Either [a] b, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either [a] b, b) -> Either [a] b
forall a b. (a, b) -> a
fst) [(Either [a] b, b)]
kyxs)
  okxsNotNull :: [OKX]
okxsNotNull = (OKX -> OKX) -> [OKX] -> [OKX]
forall a b. (a -> b) -> [a] -> [b]
map OKX -> OKX
forall a a b b.
(a, [(Either [a] b, b)]) -> (a, [(Either [a] b, b)])
okxFilter [OKX]
okxs
  pofOv :: Overlay -> PointUI
  pofOv :: Overlay -> PointUI
pofOv [] = Int -> Int -> PointUI
PointUI 0 0
  pofOv l :: Overlay
l = let pyAfterLast :: Int
pyAfterLast = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
maxYofOverlay Overlay
l  -- append after last line
            in Int -> Int -> PointUI
PointUI 0 Int
pyAfterLast
  atEnd :: [a] -> [a] -> [a]
atEnd = ([a] -> [a] -> [a]) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)
  appendToFontOverlayMap :: FontOverlayMap -> AttrLine
                         -> (FontOverlayMap, PointUI, DisplayFont)
  appendToFontOverlayMap :: FontOverlayMap
-> AttrLine -> (FontOverlayMap, PointUI, DisplayFont)
appendToFontOverlayMap ovs :: FontOverlayMap
ovs al :: AttrLine
al =
    let maxYminXofOverlay :: [(PointUI, b)] -> (Int, Int)
maxYminXofOverlay ov :: [(PointUI, b)]
ov = let ymxOfOverlay :: (PointUI, b) -> (Int, Int)
ymxOfOverlay (PointUI x :: Int
x y :: Int
y, _) = (- Int
y, Int
x)
                               in [(Int, Int)] -> (Int, Int)
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([(Int, Int)] -> (Int, Int)) -> [(Int, Int)] -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ (0, 0) (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: ((PointUI, b) -> (Int, Int)) -> [(PointUI, b)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (PointUI, b) -> (Int, Int)
forall b. (PointUI, b) -> (Int, Int)
ymxOfOverlay [(PointUI, b)]
ov
        -- @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
        (fontMax :: DisplayFont
fontMax, unique :: Bool
unique) = case [(DisplayFont, (Int, Int))]
assocsYX of
          [] -> (DisplayFont
monoFont, Bool
False)
          (font :: DisplayFont
font, (y :: Int
y, _x :: Int
_x)) : rest :: [(DisplayFont, (Int, Int))]
rest -> (DisplayFont
font, ((DisplayFont, (Int, Int)) -> Bool)
-> [(DisplayFont, (Int, Int))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(_, (y2 :: Int
y2, _)) -> Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
y2) [(DisplayFont, (Int, Int))]
rest)
        insertAl :: Overlay -> (FontOverlayMap, PointUI, DisplayFont)
insertAl ovF :: Overlay
ovF =
          let p :: PointUI
p = Overlay -> PointUI
pofOv Overlay
ovF
              displayFont :: DisplayFont
displayFont = case DisplayFont
fontMax of
                SquareFont | Bool
unique -> DisplayFont
SquareFont
                _ -> DisplayFont
monoFont
          in ((Overlay -> Overlay -> Overlay)
-> DisplayFont -> Overlay -> FontOverlayMap -> FontOverlayMap
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
atEnd DisplayFont
displayFont [(PointUI
p, AttrLine
al)] FontOverlayMap
ovs, PointUI
p, DisplayFont
displayFont)
    in case DisplayFont -> FontOverlayMap -> Maybe Overlay
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup DisplayFont
fontMax FontOverlayMap
ovs of
      Just ovF :: Overlay
ovF -> Overlay -> (FontOverlayMap, PointUI, DisplayFont)
insertAl Overlay
ovF
      Nothing -> Overlay -> (FontOverlayMap, PointUI, DisplayFont)
insertAl []
  addFooters :: Bool -> [OKX] -> [OKX]
  addFooters :: Bool -> [OKX] -> [OKX]
addFooters _ [] = String -> [OKX]
forall a. HasCallStack => String -> a
error (String -> [OKX]) -> String -> [OKX]
forall a b. (a -> b) -> a -> b
$ "" String -> [OKX] -> String
forall v. Show v => String -> v -> String
`showFailure` [OKX]
okxsNotNull
  addFooters _ [(als :: FontOverlayMap
als, [])] =
    let (ovs :: FontOverlayMap
ovs, p :: PointUI
p, font :: DisplayFont
font) = FontOverlayMap
-> AttrLine -> (FontOverlayMap, PointUI, DisplayFont)
appendToFontOverlayMap FontOverlayMap
als (String -> AttrLine
stringToAL String
endMsg)
    in [(FontOverlayMap
ovs, [([KM] -> Either [KM] SlotChar
forall a b. a -> Either a b
Left [KM
K.safeSpaceKM], (PointUI
p, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
font 15))])]
  addFooters False [(als :: FontOverlayMap
als, kxs :: [KYX]
kxs)] = [(FontOverlayMap
als, [KYX]
kxs)]
  addFooters True [(als :: FontOverlayMap
als, kxs :: [KYX]
kxs)] =
    let (ovs :: FontOverlayMap
ovs, p :: PointUI
p, font :: DisplayFont
font) = FontOverlayMap
-> AttrLine -> (FontOverlayMap, PointUI, DisplayFont)
appendToFontOverlayMap FontOverlayMap
als (String -> AttrLine
stringToAL String
endMsg)
    in [(FontOverlayMap
ovs, [KYX]
kxs [KYX] -> [KYX] -> [KYX]
forall a. [a] -> [a] -> [a]
++ [([KM] -> Either [KM] SlotChar
forall a b. a -> Either a b
Left [KM
K.safeSpaceKM], (PointUI
p, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
font 15))])]
  addFooters _ ((als :: FontOverlayMap
als, kxs :: [KYX]
kxs) : rest :: [OKX]
rest) =
    let (ovs :: FontOverlayMap
ovs, p :: PointUI
p, font :: DisplayFont
font) = FontOverlayMap
-> AttrLine -> (FontOverlayMap, PointUI, DisplayFont)
appendToFontOverlayMap FontOverlayMap
als (String -> AttrLine
stringToAL String
moreMsg)
    in (FontOverlayMap
ovs, [KYX]
kxs [KYX] -> [KYX] -> [KYX]
forall a. [a] -> [a] -> [a]
++ [([KM] -> Either [KM] SlotChar
forall a b. a -> Either a b
Left [KM
K.safeSpaceKM], (PointUI
p, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
font 8))])
       OKX -> [OKX] -> [OKX]
forall a. a -> [a] -> [a]
: Bool -> [OKX] -> [OKX]
addFooters Bool
True [OKX]
rest

attrLinesToFontMap :: Int -> [(DisplayFont, [AttrLine])] -> FontOverlayMap
attrLinesToFontMap :: Int -> [(DisplayFont, [AttrLine])] -> FontOverlayMap
attrLinesToFontMap start0 :: Int
start0 blurb :: [(DisplayFont, [AttrLine])]
blurb =
  let zipAttrLines :: Int -> [AttrLine] -> (Overlay, Int)
      zipAttrLines :: Int -> [AttrLine] -> (Overlay, Int)
zipAttrLines start :: Int
start als :: [AttrLine]
als =
        ( ((Int, AttrLine) -> (PointUI, AttrLine))
-> [(Int, AttrLine)] -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> PointUI) -> (Int, AttrLine) -> (PointUI, AttrLine)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Int -> PointUI) -> (Int, AttrLine) -> (PointUI, AttrLine))
-> (Int -> PointUI) -> (Int, AttrLine) -> (PointUI, AttrLine)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> PointUI
PointUI 0) ([(Int, AttrLine)] -> Overlay) -> [(Int, AttrLine)] -> Overlay
forall a b. (a -> b) -> a -> b
$ [Int] -> [AttrLine] -> [(Int, AttrLine)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
start ..] [AttrLine]
als
        , Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [AttrLine] -> Int
forall a. [a] -> Int
length [AttrLine]
als )
      addOverlay :: (FontOverlayMap, Int) -> (DisplayFont, [AttrLine])
                 -> (FontOverlayMap, Int)
      addOverlay :: (FontOverlayMap, Int)
-> (DisplayFont, [AttrLine]) -> (FontOverlayMap, Int)
addOverlay (!FontOverlayMap
em, !Int
start) (font :: DisplayFont
font, als :: [AttrLine]
als) =
        let (als2 :: Overlay
als2, start2 :: Int
start2) = Int -> [AttrLine] -> (Overlay, Int)
zipAttrLines Int
start [AttrLine]
als
        in ( (Overlay -> Overlay -> Overlay)
-> DisplayFont -> Overlay -> FontOverlayMap -> FontOverlayMap
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
font Overlay
als2 FontOverlayMap
em
           , Int
start2 )
      (ov :: FontOverlayMap
ov, _) = ((FontOverlayMap, Int)
 -> (DisplayFont, [AttrLine]) -> (FontOverlayMap, Int))
-> (FontOverlayMap, Int)
-> [(DisplayFont, [AttrLine])]
-> (FontOverlayMap, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (FontOverlayMap, Int)
-> (DisplayFont, [AttrLine]) -> (FontOverlayMap, Int)
addOverlay (FontOverlayMap
forall k a. EnumMap k a
EM.empty, Int
start0) [(DisplayFont, [AttrLine])]
blurb
  in FontOverlayMap
ov

moreMsg :: String
moreMsg :: String
moreMsg = "--more--"

endMsg :: String
endMsg :: String
endMsg = "--back to top--"

maxYofOverlay :: Overlay -> Int
maxYofOverlay :: Overlay -> Int
maxYofOverlay ov :: Overlay
ov = let yOfOverlay :: (PointUI, b) -> Int
yOfOverlay (PointUI _ y :: Int
y, _) = Int
y
                   in [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ 0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ((PointUI, AttrLine) -> Int) -> Overlay -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (PointUI, AttrLine) -> Int
forall b. (PointUI, b) -> Int
yOfOverlay Overlay
ov

menuToSlideshow :: OKX -> Slideshow
menuToSlideshow :: OKX -> Slideshow
menuToSlideshow (als :: FontOverlayMap
als, kxs :: [KYX]
kxs) =
  Bool -> Slideshow -> Slideshow
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (FontOverlayMap -> Bool
forall k a. EnumMap k a -> Bool
EM.null FontOverlayMap
als Bool -> Bool -> Bool
|| [KYX] -> Bool
forall a. [a] -> Bool
null [KYX]
kxs)) (Slideshow -> Slideshow) -> Slideshow -> Slideshow
forall a b. (a -> b) -> a -> b
$ [OKX] -> Slideshow
Slideshow [(FontOverlayMap
als, [KYX]
kxs)]

wrapOKX :: DisplayFont -> Int -> Int -> Int -> [(K.KM, String)]
        -> (Overlay, [KYX])
wrapOKX :: DisplayFont
-> Int -> Int -> Int -> [(KM, String)] -> (Overlay, [KYX])
wrapOKX _ _ _ _ [] = ([], [])
wrapOKX displayFont :: DisplayFont
displayFont ystart :: Int
ystart xstart :: Int
xstart width :: Int
width ks :: [(KM, String)]
ks =
  let overlayLineFromStrings :: Int -> Int -> [String] -> (PointUI, AttrLine)
      overlayLineFromStrings :: Int -> Int -> [String] -> (PointUI, AttrLine)
overlayLineFromStrings xlineStart :: Int
xlineStart y :: Int
y strings :: [String]
strings =
        let p :: PointUI
p = Int -> Int -> PointUI
PointUI Int
xlineStart Int
y
        in (PointUI
p, String -> AttrLine
stringToAL (String -> AttrLine) -> String -> AttrLine
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
strings))
      f :: ((Int, Int), (Int, [String], Overlay, [KYX])) -> (K.KM, String)
        -> ((Int, Int), (Int, [String], Overlay, [KYX]))
      f :: ((Int, Int), (Int, [String], Overlay, [KYX]))
-> (KM, String) -> ((Int, Int), (Int, [String], Overlay, [KYX]))
f ((y :: Int
y, x :: Int
x), (xlineStart :: Int
xlineStart, kL :: [String]
kL, kV :: Overlay
kV, kX :: [KYX]
kX)) (key :: KM
key, s :: String
s) =
        let len :: Int
len = DisplayFont -> String -> Int
forall a. DisplayFont -> [a] -> Int
textSize DisplayFont
displayFont String
s
            len1 :: Int
len1 = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DisplayFont -> String -> Int
forall a. DisplayFont -> [a] -> Int
textSize DisplayFont
displayFont " "
        in if Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
width
           then let iov :: (PointUI, AttrLine)
iov = Int -> Int -> [String] -> (PointUI, AttrLine)
overlayLineFromStrings Int
xlineStart Int
y [String]
kL
                in ((Int, Int), (Int, [String], Overlay, [KYX]))
-> (KM, String) -> ((Int, Int), (Int, [String], Overlay, [KYX]))
f ((Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1, 0), (0, [], (PointUI, AttrLine)
iov (PointUI, AttrLine) -> Overlay -> Overlay
forall a. a -> [a] -> [a]
: Overlay
kV, [KYX]
kX)) (KM
key, String
s)
           else ( (Int
y, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len1)
                , ( Int
xlineStart
                  , String
s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
kL
                  , Overlay
kV
                  , ([KM] -> Either [KM] SlotChar
forall a b. a -> Either a b
Left [KM
key], ( Int -> Int -> PointUI
PointUI Int
x Int
y
                                 , DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
displayFont (String -> Int
forall a. [a] -> Int
length String
s) ))
                    KYX -> [KYX] -> [KYX]
forall a. a -> [a] -> [a]
: [KYX]
kX ) )
      ((ystop :: Int
ystop, _), (xlineStop :: Int
xlineStop, kL1 :: [String]
kL1, kV1 :: Overlay
kV1, kX1 :: [KYX]
kX1)) =
        (((Int, Int), (Int, [String], Overlay, [KYX]))
 -> (KM, String) -> ((Int, Int), (Int, [String], Overlay, [KYX])))
-> ((Int, Int), (Int, [String], Overlay, [KYX]))
-> [(KM, String)]
-> ((Int, Int), (Int, [String], Overlay, [KYX]))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Int, Int), (Int, [String], Overlay, [KYX]))
-> (KM, String) -> ((Int, Int), (Int, [String], Overlay, [KYX]))
f ((Int
ystart, Int
xstart), (Int
xstart, [], [], [])) [(KM, String)]
ks
      iov1 :: (PointUI, AttrLine)
iov1 = Int -> Int -> [String] -> (PointUI, AttrLine)
overlayLineFromStrings Int
xlineStop Int
ystop [String]
kL1
  in (Overlay -> Overlay
forall a. [a] -> [a]
reverse (Overlay -> Overlay) -> Overlay -> Overlay
forall a b. (a -> b) -> a -> b
$ (PointUI, AttrLine)
iov1 (PointUI, AttrLine) -> Overlay -> Overlay
forall a. a -> [a] -> [a]
: Overlay
kV1, [KYX] -> [KYX]
forall a. [a] -> [a]
reverse [KYX]
kX1)

keysOKX :: DisplayFont -> Int -> Int -> Int -> [K.KM] -> (Overlay, [KYX])
keysOKX :: DisplayFont -> Int -> Int -> Int -> [KM] -> (Overlay, [KYX])
keysOKX displayFont :: DisplayFont
displayFont ystart :: Int
ystart xstart :: Int
xstart width :: Int
width keys :: [KM]
keys =
  let wrapB :: String -> String
      wrapB :: ShowS
wrapB s :: String
s = "[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "]"
      ks :: [(KM, String)]
ks = (KM -> (KM, String)) -> [KM] -> [(KM, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\key :: KM
key -> (KM
key, ShowS
wrapB ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ KM -> String
K.showKM KM
key)) [KM]
keys
  in DisplayFont
-> Int -> Int -> Int -> [(KM, String)] -> (Overlay, [KYX])
wrapOKX DisplayFont
displayFont Int
ystart Int
xstart Int
width [(KM, String)]
ks

-- The font argument is for the report and keys overlay. Others already have
-- assigned fonts.
splitOverlay :: FontSetup -> Bool -> Int -> Int -> Int
             -> Report -> [K.KM] -> OKX
             -> Slideshow
splitOverlay :: FontSetup
-> Bool -> Int -> Int -> Int -> Report -> [KM] -> OKX -> Slideshow
splitOverlay fontSetup :: FontSetup
fontSetup uScreen1PerLine :: Bool
uScreen1PerLine width :: Int
width height :: Int
height wrap :: Int
wrap
             report :: Report
report keys :: [KM]
keys (ls0 :: FontOverlayMap
ls0, kxs0 :: [KYX]
kxs0) =
  let renderedReport :: [AttrString]
renderedReport = Bool -> Report -> [AttrString]
renderReport Bool
True Report
report
      reportAS :: AttrString
reportAS = if Bool
uScreen1PerLine
                 then (AttrString -> AttrString -> AttrString)
-> AttrString -> [AttrString] -> AttrString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AttrString -> AttrString -> AttrString
(<\:>) [] [AttrString]
renderedReport
                 else (AttrString -> AttrString -> AttrString)
-> AttrString -> [AttrString] -> AttrString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AttrString -> AttrString -> AttrString
(<+:>) [] [AttrString]
renderedReport
      msgLong :: Bool
msgLong = Bool -> Bool
not Bool
uScreen1PerLine
                Bool -> Bool -> Bool
&& [KM] -> Bool
forall a. [a] -> Bool
null [KM]
keys Bool -> Bool -> Bool
&& FontOverlayMap -> Bool
forall k a. EnumMap k a -> Bool
EM.null FontOverlayMap
ls0 Bool -> Bool -> Bool
&& [KYX] -> Bool
forall a. [a] -> Bool
null [KYX]
kxs0
                Bool -> Bool -> Bool
&& AttrString -> Int
forall a. [a] -> Int
length AttrString
reportAS Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width
                Bool -> Bool -> Bool
&& (AttrCharW32 -> Bool) -> AttrString -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n') (Char -> Bool) -> (AttrCharW32 -> Char) -> AttrCharW32 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrCharW32 -> Char
Color.charFromW32) AttrString
reportAS
                     -- if fits in one long line, don't wrap into short lines
  in FontSetup -> [OKX] -> Slideshow
toSlideshow FontSetup
fontSetup ([OKX] -> Slideshow) -> [OKX] -> Slideshow
forall a b. (a -> b) -> a -> b
$ FontSetup
-> Bool -> Int -> Int -> Int -> AttrString -> [KM] -> OKX -> [OKX]
splitOKX FontSetup
fontSetup Bool
msgLong Int
width Int
height Int
wrap
                                      AttrString
reportAS [KM]
keys (FontOverlayMap
ls0, [KYX]
kxs0)

-- 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{..} msgLong :: Bool
msgLong width :: Int
width height :: Int
height wrap :: Int
wrap reportAS :: AttrString
reportAS keys :: [KM]
keys (ls0 :: FontOverlayMap
ls0, kxs0 :: [KYX]
kxs0) =
  Bool -> [OKX] -> [OKX]
forall a. HasCallStack => Bool -> a -> a
assert (Int
height Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 2) ([OKX] -> [OKX]) -> [OKX] -> [OKX]
forall a b. (a -> b) -> a -> b
$
  let indentSplitSpaces :: Int -> AttrString -> [AttrLine]
indentSplitSpaces = Bool -> Int -> AttrString -> [AttrLine]
indentSplitAttrString2
                            (Bool -> Bool
not (DisplayFont -> Bool
isMonoFont DisplayFont
propFont Bool -> Bool -> Bool
|| DisplayFont -> Bool
isSquareFont DisplayFont
propFont))
      reportParagraphs :: [AttrLine]
reportParagraphs = AttrString -> [AttrLine]
linesAttr AttrString
reportAS
      -- TODO: until SDL support for measuring prop font text is released,
      -- we have to use MonoFont for the paragraph that ends with buttons.
      (repProp :: [AttrLine]
repProp, repMono :: AttrLine
repMono) =
        if [KM] -> Bool
forall a. [a] -> Bool
null [KM]
keys
        then ([AttrLine]
reportParagraphs, AttrLine
emptyAttrLine)
        else case [AttrLine] -> [AttrLine]
forall a. [a] -> [a]
reverse [AttrLine]
reportParagraphs of
          [] -> ([], AttrLine
emptyAttrLine)
          l :: AttrLine
l : rest :: [AttrLine]
rest ->
            ([AttrLine] -> [AttrLine]
forall a. [a] -> [a]
reverse [AttrLine]
rest, AttrString -> AttrLine
attrStringToAL (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ AttrLine -> AttrString
attrLine AttrLine
l AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.nbspAttrW32])
      msgWrap :: Int
msgWrap = if Bool
msgLong Bool -> Bool -> Bool
&& Bool -> Bool
not (DisplayFont -> Bool
isSquareFont DisplayFont
propFont)
                then 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width
                else Int
wrap  -- 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 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width
                 else Int
width
      repProp0 :: Overlay
repProp0 = [AttrLine] -> Overlay
offsetOverlay ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ case [AttrLine]
repProp of
        [] -> []
        r :: AttrLine
r : rs :: [AttrLine]
rs ->
          -- 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
<= 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
msgWidth
                           then Int
msgWidth
                           else Int
msgWrap
          in (Int -> AttrString -> [AttrLine]
indentSplitSpaces Int
firstWidth (AttrString -> [AttrLine])
-> (AttrLine -> AttrString) -> AttrLine -> [AttrLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrLine -> AttrString
attrLine) AttrLine
r  -- 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 (Int -> AttrString -> [AttrLine]
indentSplitSpaces Int
msgWrap (AttrString -> [AttrLine])
-> (AttrLine -> AttrString) -> AttrLine -> [AttrLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrLine -> AttrString
attrLine) [AttrLine]
rs
      -- 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 (Int -> AttrString -> [AttrLine]
indentSplitSpaces Int
width (AttrString -> [AttrLine])
-> (AttrLine -> AttrString) -> AttrLine -> [AttrLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrLine -> AttrString
attrLine) [AttrLine]
repProp
      -- 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 = ((PointUI, AttrLine) -> (PointUI, AttrLine)) -> Overlay -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map (\(PointUI x :: Int
x y :: Int
y, al :: AttrLine
al) ->
                        (Int -> Int -> PointUI
PointUI Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
forall a. [a] -> Int
length Overlay
repProp0), AttrLine
al))
                 (Overlay -> Overlay) -> Overlay -> Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay
                 ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ Int -> AttrString -> [AttrLine]
indentSplitAttrString Int
monoWidth (AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ AttrLine -> AttrString
attrLine AttrLine
repMono
      repMonoW :: Overlay
repMonoW = ((PointUI, AttrLine) -> (PointUI, AttrLine)) -> Overlay -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map (\(PointUI x :: Int
x y :: Int
y, al :: AttrLine
al) ->
                        (Int -> Int -> PointUI
PointUI Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
forall a. [a] -> Int
length Overlay
repPropW), AttrLine
al))
                 (Overlay -> Overlay) -> Overlay -> Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay
                 ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ Int -> AttrString -> [AttrLine]
indentSplitAttrString Int
width (AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ AttrLine -> AttrString
attrLine AttrLine
repMono
      repWhole0 :: Overlay
repWhole0 = [AttrLine] -> Overlay
offsetOverlay
                  ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ (AttrLine -> [AttrLine]) -> [AttrLine] -> [AttrLine]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> AttrString -> [AttrLine]
indentSplitSpaces Int
msgWidth (AttrString -> [AttrLine])
-> (AttrLine -> AttrString) -> AttrLine -> [AttrLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrLine -> AttrString
attrLine)
                              [AttrLine]
reportParagraphs
      repWhole1 :: Overlay
repWhole1 = ((PointUI, AttrLine) -> (PointUI, AttrLine)) -> Overlay -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map (\(PointUI x :: Int
x y :: Int
y, al :: AttrLine
al) -> (Int -> Int -> PointUI
PointUI Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1), AttrLine
al)) Overlay
repWhole0
      lenOfRep0 :: Int
lenOfRep0 = Overlay -> Int
forall a. [a] -> Int
length Overlay
repProp0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
forall a. [a] -> Int
length Overlay
repMono0
      lenOfRepW :: Int
lenOfRepW = Overlay -> Int
forall a. [a] -> Int
length Overlay
repPropW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
forall a. [a] -> Int
length Overlay
repMonoW
      startOfKeys :: Int
startOfKeys = if Overlay -> Bool
forall a. [a] -> Bool
null Overlay
repMono0
                    then 0
                    else DisplayFont -> AttrString -> Int
forall a. DisplayFont -> [a] -> Int
textSize DisplayFont
monoFont (AttrLine -> AttrString
attrLine (AttrLine -> AttrString) -> AttrLine -> AttrString
forall a b. (a -> b) -> a -> b
$ (PointUI, AttrLine) -> AttrLine
forall a b. (a, b) -> b
snd ((PointUI, AttrLine) -> AttrLine)
-> (PointUI, AttrLine) -> AttrLine
forall a b. (a -> b) -> a -> b
$ Overlay -> (PointUI, AttrLine)
forall a. [a] -> a
last Overlay
repMono0)
      startOfKeysW :: Int
startOfKeysW = if Overlay -> Bool
forall a. [a] -> Bool
null Overlay
repMonoW
                     then 0
                     else DisplayFont -> AttrString -> Int
forall a. DisplayFont -> [a] -> Int
textSize DisplayFont
monoFont (AttrLine -> AttrString
attrLine (AttrLine -> AttrString) -> AttrLine -> AttrString
forall a b. (a -> b) -> a -> b
$ (PointUI, AttrLine) -> AttrLine
forall a b. (a, b) -> b
snd ((PointUI, AttrLine) -> AttrLine)
-> (PointUI, AttrLine) -> AttrLine
forall a b. (a -> b) -> a -> b
$ Overlay -> (PointUI, AttrLine)
forall a. [a] -> a
last Overlay
repMonoW)
      pressAKey :: AttrString
pressAKey = String -> AttrString
stringToAS "A long report is shown. Press a key:"
                  AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.nbspAttrW32]
      (lX0 :: Overlay
lX0, keysX0 :: [KYX]
keysX0) = DisplayFont -> Int -> Int -> Int -> [KM] -> (Overlay, [KYX])
keysOKX DisplayFont
monoFont 0 (AttrString -> Int
forall a. [a] -> Int
length AttrString
pressAKey) Int
width [KM]
keys
      (lX1 :: Overlay
lX1, keysX1 :: [KYX]
keysX1) = DisplayFont -> Int -> Int -> Int -> [KM] -> (Overlay, [KYX])
keysOKX DisplayFont
monoFont 1 0 Int
width [KM]
keys
      (lX :: Overlay
lX, keysX :: [KYX]
keysX) = DisplayFont -> Int -> Int -> Int -> [KM] -> (Overlay, [KYX])
keysOKX DisplayFont
monoFont (Int
lenOfRep0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int
startOfKeys
                            (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width) [KM]
keys
      (lXW :: Overlay
lXW, keysXW :: [KYX]
keysXW) = DisplayFont -> Int -> Int -> Int -> [KM] -> (Overlay, [KYX])
keysOKX DisplayFont
monoFont (Int
lenOfRepW Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int
startOfKeysW
                              (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width) [KM]
keys
      renumber :: Int -> (a, (PointUI, b)) -> (a, (PointUI, b))
renumber dy :: Int
dy (km :: a
km, (PointUI x :: Int
x y :: Int
y, len :: b
len)) = (a
km, (Int -> Int -> PointUI
PointUI Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dy), b
len))
      renumberOv :: Int -> [(PointUI, b)] -> [(PointUI, b)]
renumberOv dy :: Int
dy = ((PointUI, b) -> (PointUI, b)) -> [(PointUI, b)] -> [(PointUI, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\(PointUI x :: Int
x y :: Int
y, al :: b
al) -> (Int -> Int -> PointUI
PointUI Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dy), b
al))
      splitO :: Int -> (Overlay, Overlay, [KYX]) -> OKX -> [OKX]
      splitO :: Int -> (Overlay, Overlay, [KYX]) -> OKX -> [OKX]
splitO yoffset :: Int
yoffset (hdrProp :: Overlay
hdrProp, hdrMono :: Overlay
hdrMono, rk :: [KYX]
rk) (ls :: FontOverlayMap
ls, kxs :: [KYX]
kxs) =
        let hdrOff :: Int
hdrOff | Overlay -> Bool
forall a. [a] -> Bool
null Overlay
hdrProp Bool -> Bool -> Bool
&& Overlay -> Bool
forall a. [a] -> Bool
null Overlay
hdrMono = 0
                   | Bool
otherwise = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
maxYofOverlay Overlay
hdrMono
            keyRenumber :: [KYX] -> [KYX]
keyRenumber = (KYX -> KYX) -> [KYX] -> [KYX]
forall a b. (a -> b) -> [a] -> [b]
map ((KYX -> KYX) -> [KYX] -> [KYX]) -> (KYX -> KYX) -> [KYX] -> [KYX]
forall a b. (a -> b) -> a -> b
$ Int -> KYX -> KYX
forall a b. Int -> (a, (PointUI, b)) -> (a, (PointUI, b))
renumber (Int
hdrOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
yoffset)
            lineRenumber :: FontOverlayMap -> FontOverlayMap
lineRenumber = (Overlay -> Overlay) -> FontOverlayMap -> FontOverlayMap
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map ((Overlay -> Overlay) -> FontOverlayMap -> FontOverlayMap)
-> (Overlay -> Overlay) -> FontOverlayMap -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ Int -> Overlay -> Overlay
forall b. Int -> [(PointUI, b)] -> [(PointUI, b)]
renumberOv (Int
hdrOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
yoffset)
            yoffsetNew :: Int
yoffsetNew = Int
yoffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hdrOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
            ltOffset :: (PointUI, a) -> Bool
            ltOffset :: (PointUI, a) -> Bool
ltOffset (PointUI _ y :: Int
y, _) = Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
yoffsetNew
            (pre :: FontOverlayMap
pre, post :: FontOverlayMap
post) = ( ((PointUI, AttrLine) -> Bool) -> Overlay -> Overlay
forall a. (a -> Bool) -> [a] -> [a]
filter (PointUI, AttrLine) -> Bool
forall a. (PointUI, a) -> Bool
ltOffset (Overlay -> Overlay) -> FontOverlayMap -> FontOverlayMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FontOverlayMap
ls
                          , ((PointUI, AttrLine) -> Bool) -> Overlay -> Overlay
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((PointUI, AttrLine) -> Bool) -> (PointUI, AttrLine) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PointUI, AttrLine) -> Bool
forall a. (PointUI, a) -> Bool
ltOffset) (Overlay -> Overlay) -> FontOverlayMap -> FontOverlayMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FontOverlayMap
ls )
            prependHdr :: FontOverlayMap -> FontOverlayMap
prependHdr = (Overlay -> Overlay -> Overlay)
-> DisplayFont -> Overlay -> FontOverlayMap -> FontOverlayMap
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
propFont Overlay
hdrProp
                         (FontOverlayMap -> FontOverlayMap)
-> (FontOverlayMap -> FontOverlayMap)
-> FontOverlayMap
-> FontOverlayMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Overlay -> Overlay -> Overlay)
-> DisplayFont -> Overlay -> FontOverlayMap -> FontOverlayMap
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
monoFont Overlay
hdrMono
        in if (Overlay -> Bool) -> [Overlay] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Overlay -> Bool
forall a. [a] -> Bool
null ([Overlay] -> Bool) -> [Overlay] -> Bool
forall a b. (a -> b) -> a -> b
$ FontOverlayMap -> [Overlay]
forall k a. EnumMap k a -> [a]
EM.elems FontOverlayMap
post  -- all fits on one screen
           then [(FontOverlayMap -> FontOverlayMap
prependHdr (FontOverlayMap -> FontOverlayMap)
-> FontOverlayMap -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ FontOverlayMap -> FontOverlayMap
lineRenumber FontOverlayMap
pre, [KYX]
rk [KYX] -> [KYX] -> [KYX]
forall a. [a] -> [a] -> [a]
++ [KYX] -> [KYX]
keyRenumber [KYX]
kxs)]
           else let (preX :: [KYX]
preX, postX :: [KYX]
postX) = (KYX -> Bool) -> [KYX] -> ([KYX], [KYX])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\(_, pa :: (PointUI, ButtonWidth)
pa) -> (PointUI, ButtonWidth) -> Bool
forall a. (PointUI, a) -> Bool
ltOffset (PointUI, ButtonWidth)
pa) [KYX]
kxs
                in (FontOverlayMap -> FontOverlayMap
prependHdr (FontOverlayMap -> FontOverlayMap)
-> FontOverlayMap -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ FontOverlayMap -> FontOverlayMap
lineRenumber FontOverlayMap
pre, [KYX]
rk [KYX] -> [KYX] -> [KYX]
forall a. [a] -> [a] -> [a]
++ [KYX] -> [KYX]
keyRenumber [KYX]
preX)
                   OKX -> [OKX] -> [OKX]
forall a. a -> [a] -> [a]
: Int -> (Overlay, Overlay, [KYX]) -> OKX -> [OKX]
splitO Int
yoffsetNew (Overlay
hdrProp, Overlay
hdrMono, [KYX]
rk) (FontOverlayMap
post, [KYX]
postX)
      firstParaReport :: AttrLine
firstParaReport = AttrString -> AttrLine
firstParagraph AttrString
reportAS
      hdrShortened :: (Overlay, Overlay, [KYX])
hdrShortened = ( [(Int -> Int -> PointUI
PointUI 0 0, AttrLine
firstParaReport)]
                         -- shortened for the main slides; in full beforehand
                     , Int -> Overlay -> Overlay
forall a. Int -> [a] -> [a]
take 3 Overlay
lX1  -- 3 lines ought to be enough for everyone
                     , [KYX]
keysX1 )
      ((lsInit :: FontOverlayMap
lsInit, kxsInit :: [KYX]
kxsInit), (headerProp :: Overlay
headerProp, headerMono :: Overlay
headerMono, rkxs :: [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
             ((FontOverlayMap
forall k a. EnumMap k a
EM.empty, []), (Overlay
repProp0, Overlay
lX Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
++ Overlay
repMono0, [KYX]
keysX))
           | (Int
lenOfRepW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
forall a. [a] -> Int
length Overlay
lXW) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
height ->  -- display widely
             ((FontOverlayMap
forall k a. EnumMap k a
EM.empty, []), (Overlay
repPropW, Overlay
lXW Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
++ Overlay
repMonoW, [KYX]
keysXW))
           | [AttrLine] -> Int
forall a. [a] -> Int
length [AttrLine]
reportParagraphs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
             Bool -> Bool -> Bool
&& AttrString -> Int
forall a. [a] -> Int
length (AttrLine -> AttrString
attrLine AttrLine
firstParaReport) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width ->
             ( (FontOverlayMap
forall k a. EnumMap k a
EM.empty, [])  -- 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 )
               lX0first :: (PointUI, AttrLine)
lX0first : _ ->
                 ( ( (Overlay -> Overlay -> Overlay)
-> DisplayFont -> Overlay -> FontOverlayMap -> FontOverlayMap
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
propFont Overlay
repWhole1
                     (FontOverlayMap -> FontOverlayMap)
-> FontOverlayMap -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ DisplayFont -> Overlay -> FontOverlayMap
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
monoFont
                         [(Int -> Int -> PointUI
PointUI 0 0, AttrString -> AttrLine
firstParagraph AttrString
pressAKey), (PointUI, AttrLine)
lX0first]
                   , (KYX -> Bool) -> [KYX] -> [KYX]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(_, (PointUI _ y :: Int
y, _)) -> Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) [KYX]
keysX0 )
                 , (Overlay, Overlay, [KYX])
hdrShortened )
      initSlides :: [OKX]
initSlides = if FontOverlayMap -> Bool
forall k a. EnumMap k a -> Bool
EM.null FontOverlayMap
lsInit
                   then Bool -> [OKX] -> [OKX]
forall a. HasCallStack => Bool -> a -> a
assert ([KYX] -> Bool
forall a. [a] -> Bool
null [KYX]
kxsInit) []
                   else Int -> (Overlay, Overlay, [KYX]) -> OKX -> [OKX]
splitO 0 ([], [], []) (FontOverlayMap
lsInit, [KYX]
kxsInit)
      -- 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 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} width :: Int
width height :: Int
height table :: ScoreTable
table pos :: Int
pos
              gameModeName :: Text
gameModeName tz :: TimeZone
tz =
  let entries :: Int
entries = (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 3
      msg :: Text
msg = Int -> ScoreTable -> Int -> Text -> Text
HighScore.showAward Int
entries ScoreTable
table Int
pos Text
gameModeName
      tts :: [Overlay]
tts = ([AttrLine] -> Overlay) -> [[AttrLine]] -> [Overlay]
forall a b. (a -> b) -> [a] -> [b]
map [AttrLine] -> Overlay
offsetOverlay ([[AttrLine]] -> [Overlay]) -> [[AttrLine]] -> [Overlay]
forall a b. (a -> b) -> a -> b
$ TimeZone -> Int -> ScoreTable -> Int -> [[AttrLine]]
showNearbyScores TimeZone
tz Int
pos ScoreTable
table Int
entries
      al :: AttrString
al = Text -> AttrString
textToAS Text
msg
      splitScreen :: Overlay -> [OKX]
splitScreen ts :: Overlay
ts =
        FontSetup
-> Bool -> Int -> Int -> Int -> AttrString -> [KM] -> OKX -> [OKX]
splitOKX FontSetup
fontSetup Bool
False Int
width Int
height Int
width AttrString
al [KM
K.spaceKM, KM
K.escKM]
                 (DisplayFont -> Overlay -> FontOverlayMap
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
monoFont Overlay
ts, [])
  in FontSetup -> [OKX] -> Slideshow
toSlideshow FontSetup
fontSetup ([OKX] -> Slideshow) -> [OKX] -> Slideshow
forall a b. (a -> b) -> a -> b
$ [[OKX]] -> [OKX]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[OKX]] -> [OKX]) -> [[OKX]] -> [OKX]
forall a b. (a -> b) -> a -> b
$ (Overlay -> [OKX]) -> [Overlay] -> [[OKX]]
forall a b. (a -> b) -> [a] -> [b]
map Overlay -> [OKX]
splitScreen [Overlay]
tts

-- | 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
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 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 ]