<commit_before>-- | 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
  , 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 (Show, Eq, Enum)

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

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

type FontOverlayMap = EM.EnumMap DisplayFont Overlay

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

multiFontSetup :: FontSetup
multiFontSetup = FontSetup SquareFont MonoFont PropFont

monoFontSetup :: FontSetup
monoFontSetup = FontSetup SquareFont MonoFont MonoFont

singleFontSetup :: FontSetup
singleFontSetup = FontSetup SquareFont SquareFont SquareFont

textSize :: DisplayFont -> [a] -> Int
textSize SquareFont l = 2 * length l
textSize MonoFont l = length l
textSize PropFont _ = 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
  { buttonFont  :: DisplayFont
  , buttonWidth :: Int }
  deriving (Show, 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]}
  deriving (Show, Eq)

emptySlideshow :: Slideshow
emptySlideshow = Slideshow []

unsnoc :: Slideshow -> Maybe (Slideshow, OKX)
unsnoc Slideshow{slideshow} =
  case reverse slideshow of
    [] -> Nothing
    okx : rest -> Just (Slideshow $ reverse rest, okx)

toSlideshow :: FontSetup -> [OKX] -> Slideshow
toSlideshow FontSetup{..} okxs = Slideshow $ addFooters False okxsNotNull
 where
  okxFilter (ov, kyxs) =
    (ov, filter (either (not . null) (const True) . fst) kyxs)
  okxsNotNull = map okxFilter okxs
  pofOv :: Overlay -> PointUI
  pofOv [] = PointUI 0 0
  pofOv l = let pyAfterLast = 1 + maxYofOverlay l  -- append after last line
            in PointUI 0 pyAfterLast
  atEnd = flip (++)
  appendToFontOverlayMap :: FontOverlayMap -> String
                         -> (FontOverlayMap, PointUI, DisplayFont, Int)
  appendToFontOverlayMap ovs msg =
    let maxYminXofOverlay ov = let ymxOfOverlay (PointUI x y, _) = (- y, x)
                               in minimum $ maxBound : map ymxOfOverlay ov
        -- @SortOn@ less efficient here, because function cheap.
        assocsYX = sortBy (comparing snd)
                   $ EM.assocs $ EM.map maxYminXofOverlay ovs
        (fontMax, unique) = case assocsYX of
          [] -> (monoFont, False)
          (font, (y, _x)) : rest -> (font, all (\(_, (y2, _)) -> y /= y2) rest)
        insertAl ovF =
          let p = pofOv ovF
              displayFont = case fontMax of
                SquareFont | unique -> SquareFont
                _ -> monoFont
          in ( EM.insertWith atEnd displayFont [(p, stringToAL msg)] ovs
             , p
             , displayFont
             , length msg )
    in case EM.lookup fontMax ovs of
      Just ovF -> insertAl ovF
      Nothing -> insertAl []
  addFooters :: Bool -> [OKX] -> [OKX]
  addFooters _ [] = error $ "" `showFailure` okxsNotNull
  addFooters _ [(als, [])] =
    -- TODO: make sure this case never coincides with the space button
    -- actually returning to top, as opposed to finishing preview.
    let (ovs, p, font, width) = appendToFontOverlayMap als "--end--"
    in [(ovs, [(Left [K.safeSpaceKM], (p, ButtonWidth font width))])]
  addFooters False [(als, kxs)] = [(als, kxs)]
  addFooters True [(als, kxs)] =
    let (ovs, p, font, width) = appendToFontOverlayMap als "--back to top--"
    in [(ovs, kxs ++ [(Left [K.safeSpaceKM], (p, ButtonWidth font width))])]
  addFooters _ ((als, kxs) : rest) =
    let (ovs, p, font, width) = appendToFontOverlayMap als "--more--"
    in (ovs, kxs ++ [(Left [K.safeSpaceKM], (p, ButtonWidth font width))])
       : addFooters True rest

attrLinesToFontMap :: Int -> [(DisplayFont, [AttrLine])] -> FontOverlayMap
attrLinesToFontMap start0 blurb =
  let zipAttrLines :: Int -> [AttrLine] -> (Overlay, Int)
      zipAttrLines start als =
        ( map (first $ PointUI 0) $ zip [start ..] als
        , start + length als )
      addOverlay :: (FontOverlayMap, Int) -> (DisplayFont, [AttrLine])
                 -> (FontOverlayMap, Int)
      addOverlay (!em, !start) (font, als) =
        let (als2, start2) = zipAttrLines start als
        in ( EM.insertWith (++) font als2 em
           , start2 )<commit_msg>Get rid of spaghetti in the code of appendToFontOverlayMap<commit_after>-- | 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
  , 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 (Show, Eq, Enum)

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

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

type FontOverlayMap = EM.EnumMap DisplayFont Overlay

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

multiFontSetup :: FontSetup
multiFontSetup = FontSetup SquareFont MonoFont PropFont

monoFontSetup :: FontSetup
monoFontSetup = FontSetup SquareFont MonoFont MonoFont

singleFontSetup :: FontSetup
singleFontSetup = FontSetup SquareFont SquareFont SquareFont

textSize :: DisplayFont -> [a] -> Int
textSize SquareFont l = 2 * length l
textSize MonoFont l = length l
textSize PropFont _ = 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
  { buttonFont  :: DisplayFont
  , buttonWidth :: Int }
  deriving (Show, 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]}
  deriving (Show, Eq)

emptySlideshow :: Slideshow
emptySlideshow = Slideshow []

unsnoc :: Slideshow -> Maybe (Slideshow, OKX)
unsnoc Slideshow{slideshow} =
  case reverse slideshow of
    [] -> Nothing
    okx : rest -> Just (Slideshow $ reverse rest, okx)

toSlideshow :: FontSetup -> [OKX] -> Slideshow
toSlideshow FontSetup{..} okxs = Slideshow $ addFooters False okxsNotNull
 where
  okxFilter (ov, kyxs) =
    (ov, filter (either (not . null) (const True) . fst) kyxs)
  okxsNotNull = map okxFilter okxs
  atEnd = flip (++)
  appendToFontOverlayMap :: FontOverlayMap -> String
                         -> (FontOverlayMap, PointUI, DisplayFont, Int)
  appendToFontOverlayMap ovs msg =
    let maxYminXofOverlay ov =
          let ymxOfOverlay (PointUI x y, _) = (- y, x)
          in minimum $ maxBound : map ymxOfOverlay ov
        -- @sortOn@ less efficient here, because function cheap.
        assocsYX = sortBy (comparing snd)
                   $ EM.assocs $ EM.map maxYminXofOverlay ovs
        (fontMax, yMax) = case assocsYX of
          [] -> (monoFont, 0)
          (font, (yNeg, _x)) : rest ->
            let unique = all (\(_, (yNeg2, _)) -> yNeg /= yNeg2) rest
            in ( if font == SquareFont && unique
                 then font
                 else monoFont
               , - yNeg )
        pMax = PointUI 0 (yMax + 1)  -- append after last line
    in ( EM.insertWith atEnd fontMax [(pMax, stringToAL msg)] ovs
       , pMax
       , fontMax
       , length msg )
  addFooters :: Bool -> [OKX] -> [OKX]
  addFooters _ [] = error $ "" `showFailure` okxsNotNull
  addFooters _ [(als, [])] =
    -- TODO: make sure this case never coincides with the space button
    -- actually returning to top, as opposed to finishing preview.
    let (ovs, p, font, width) = appendToFontOverlayMap als "--end--"
    in [(ovs, [(Left [K.safeSpaceKM], (p, ButtonWidth font width))])]
  addFooters False [(als, kxs)] = [(als, kxs)]
  addFooters True [(als, kxs)] =
    let (ovs, p, font, width) = appendToFontOverlayMap als "--back to top--"
    in [(ovs, kxs ++ [(Left [K.safeSpaceKM], (p, ButtonWidth font width))])]
  addFooters _ ((als, kxs) : rest) =
    let (ovs, p, font, width) = appendToFontOverlayMap als "--more--"
    in (ovs, kxs ++ [(Left [K.safeSpaceKM], (p, ButtonWidth font width))])
       : addFooters True rest

attrLinesToFontMap :: Int -> [(DisplayFont, [AttrLine])] -> FontOverlayMap
attrLinesToFontMap start0 blurb =
  let zipAttrLines :: Int -> [AttrLine] -> (Overlay, Int)
      zipAttrLines start als =
        ( map (first $ PointUI 0) $ zip [start ..] als
        , start + length als )
      addOverlay :: (FontOverlayMap, Int) -> (DisplayFont, [AttrLine])
                 -> (FontOverlayMap, Int)
      addOverlay (!em, !start) (font, als) =
        let (als2, start2) = zipAttrLines start als
        in ( EM.insertWith (++) font als2 em
           , start2 )
{'fraction_non_alphanumeric': 0.10153769012201237, 'fraction_numerical': 0.0020892528831689787, 'mean_word_length': 3.081514324693042, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 52, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 1, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1555751', 'n_tokens_mistral': 3765, 'n_tokens_neox': 3711, 'n_words': 1242}