module Game.LambdaHack.Client.UI.Frame
( SingleFrame(..), Frames
, blankSingleFrame, overlayFrame, overlayFrameWithLines
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import Data.Word (Word32)
import Game.LambdaHack.Client.UI.Overlay
import Game.LambdaHack.Common.Color
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
newtype SingleFrame = SingleFrame
{singleFrame :: PointArray.GArray Word32 AttrCharW32}
deriving (Eq, Show)
type Frames = [Maybe FrameForall]
blankSingleFrame :: SingleFrame
blankSingleFrame =
let lxsize = fst normalLevelBound + 1
lysize = snd normalLevelBound + 4
in SingleFrame $ PointArray.replicateA lxsize lysize spaceAttrW32
truncateLines :: Bool -> [AttrLine] -> [AttrLine]
truncateLines onBlank l =
let lxsize = fst normalLevelBound + 1
lysize = snd normalLevelBound + 1
canvasLength = if onBlank then lysize + 3 else lysize + 1
topLayer = if length l <= canvasLength
then l ++ [[] | length l < canvasLength && length l > 3]
else take (canvasLength - 1) l
++ [stringToAL "--a portion of the text trimmed--"]
f lenPrev lenNext layerLine =
truncateAttrLine lxsize layerLine (max lenPrev lenNext)
lens = map (min (lxsize - 1) . length) topLayer
in zipWith3 f (0 : lens) (drop 1 lens ++ [0]) topLayer
truncateAttrLine :: X -> AttrLine -> X -> AttrLine
truncateAttrLine w xs lenMax =
case compare w (length xs) of
LT -> let discarded = drop w xs
in if all (== spaceAttrW32) discarded
then take w xs
else take (w - 1) xs ++ [attrChar2ToW32 BrBlack '$']
EQ -> xs
GT -> let xsSpace = if null xs || last xs == spaceAttrW32
then xs
else xs ++ [spaceAttrW32]
whiteN = max (40 - length xsSpace) (1 + lenMax - length xsSpace)
in xsSpace ++ replicate whiteN spaceAttrW32
overlayFrame :: Overlay -> FrameForall -> FrameForall
overlayFrame ov ff = FrameForall $ \v -> do
unFrameForall ff v
mapM_ (\(offset, l) -> unFrameForall (writeLine offset l) v) ov
overlayFrameWithLines :: Bool -> [AttrLine] -> FrameForall -> FrameForall
overlayFrameWithLines onBlank l msf =
let lxsize = fst normalLevelBound + 1
ov = map (\(y, al) -> (y * lxsize, al))
$ zip [0..] $ truncateLines onBlank l
in overlayFrame ov msf