{-# LANGUAGE RankNTypes #-}
-- | Screen frames.
--
-- Note that @PointArray.Array@ here represents a screen frame and so
-- screen positions are denoted by @Point@, contrary to the convention
-- that @Point@ refers to game map coordinates, as outlined
-- in description of 'PointSquare' that should normally be used in that role.
module Game.LambdaHack.Client.UI.Frame
  ( ColorMode(..)
  , FrameST, FrameForall(..), FrameBase(..), Frame
  , PreFrame3, PreFrames3, PreFrame, PreFrames
  , SingleFrame(..), OverlaySpace
  , blankSingleFrame, truncateOverlay, overlayFrame
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , truncateAttrLine
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Control.Monad.ST.Strict
import           Data.Function
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as VM
import           Data.Word

import           Game.LambdaHack.Client.UI.Content.Screen
import           Game.LambdaHack.Client.UI.Overlay
import           Game.LambdaHack.Client.UI.PointUI
import qualified Game.LambdaHack.Common.PointArray as PointArray
import qualified Game.LambdaHack.Definition.Color as Color

-- | Color mode for the display.
data ColorMode =
    ColorFull  -- ^ normal, with full colours
  | ColorBW    -- ^ black and white only
  deriving ColorMode -> ColorMode -> Bool
(ColorMode -> ColorMode -> Bool)
-> (ColorMode -> ColorMode -> Bool) -> Eq ColorMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColorMode -> ColorMode -> Bool
== :: ColorMode -> ColorMode -> Bool
$c/= :: ColorMode -> ColorMode -> Bool
/= :: ColorMode -> ColorMode -> Bool
Eq

type FrameST s = G.Mutable U.Vector s Word32 -> ST s ()

-- | Efficiently composable representation of an operation
-- on a frame, that is, on a mutable vector. When the composite operation
-- is eventually performed, the vector is frozen to become a 'SingleFrame'.
newtype FrameForall = FrameForall {FrameForall -> forall s. FrameST s
unFrameForall :: forall s. FrameST s}

-- | Action that results in a base frame, to be modified further.
newtype FrameBase = FrameBase
  {FrameBase -> forall s. ST s (Mutable Vector s Word32)
unFrameBase :: forall s. ST s (G.Mutable U.Vector s Word32)}

-- | A frame, that is, a base frame and all its modifications.
type Frame = ( (FrameBase, FrameForall)
             , (OverlaySpace, OverlaySpace, OverlaySpace) )

-- | Components of a frame, before it's decided if the first can be overwritten
-- in-place or needs to be copied.
type PreFrame3 = (PreFrame, (OverlaySpace, OverlaySpace, OverlaySpace))

-- | Sequence of screen frames, including delays. Potentially based on a single
-- base frame.
type PreFrames3 = [Maybe PreFrame3]

-- | A simpler variant of @PreFrame3@.
type PreFrame = (U.Vector Word32, FrameForall)

-- | A simpler variant of @PreFrames3@.
type PreFrames = [Maybe PreFrame]

-- | Representation of an operation of overwriting a frame with a single line
-- at the given row.
writeLine :: Int -> AttrString -> FrameForall
{-# INLINE writeLine #-}
writeLine :: Int -> AttrString -> FrameForall
writeLine Int
offset AttrString
al = (forall s. FrameST s) -> FrameForall
FrameForall ((forall s. FrameST s) -> FrameForall)
-> (forall s. FrameST s) -> FrameForall
forall a b. (a -> b) -> a -> b
$ \Mutable Vector s Word32
v -> do
  let writeAt :: Int -> AttrString -> ST s ()
writeAt Int
_ [] = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      writeAt Int
off (AttrCharW32
ac32 : AttrString
rest) = do
        MVector (PrimState (ST s)) Word32 -> Int -> Word32 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.write Mutable Vector s Word32
MVector (PrimState (ST s)) Word32
v Int
off (AttrCharW32 -> Word32
Color.attrCharW32 AttrCharW32
ac32)
        Int -> AttrString -> ST s ()
writeAt (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) AttrString
rest
  Int -> AttrString -> ST s ()
writeAt Int
offset AttrString
al

-- | A frame that is padded to fill the whole screen with optional
-- overlays to display in proportional, square and monospace fonts.
--
-- Note that we don't provide a list of color-highlighed box positions
-- to be drawn separately, because overlays need to obscure not only map,
-- but the highlights as well, so highlights need to be included earlier.
--
-- See the description of 'PointSquare' for explanation of why screen
-- coordinates in @singleArray@ are @Point@ even though they should be
-- 'PointSquare'.
data SingleFrame = SingleFrame
  { SingleFrame -> Array AttrCharW32
singleArray         :: PointArray.Array Color.AttrCharW32
  , SingleFrame -> OverlaySpace
singlePropOverlay   :: OverlaySpace
  , SingleFrame -> OverlaySpace
singleSquareOverlay :: OverlaySpace
  , SingleFrame -> OverlaySpace
singleMonoOverlay   :: OverlaySpace }
  deriving (Int -> SingleFrame -> ShowS
[SingleFrame] -> ShowS
SingleFrame -> String
(Int -> SingleFrame -> ShowS)
-> (SingleFrame -> String)
-> ([SingleFrame] -> ShowS)
-> Show SingleFrame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SingleFrame -> ShowS
showsPrec :: Int -> SingleFrame -> ShowS
$cshow :: SingleFrame -> String
show :: SingleFrame -> String
$cshowList :: [SingleFrame] -> ShowS
showList :: [SingleFrame] -> ShowS
Show, SingleFrame -> SingleFrame -> Bool
(SingleFrame -> SingleFrame -> Bool)
-> (SingleFrame -> SingleFrame -> Bool) -> Eq SingleFrame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SingleFrame -> SingleFrame -> Bool
== :: SingleFrame -> SingleFrame -> Bool
$c/= :: SingleFrame -> SingleFrame -> Bool
/= :: SingleFrame -> SingleFrame -> Bool
Eq)

type OverlaySpace = [(PointUI, AttrString)]

blankSingleFrame :: ScreenContent -> SingleFrame
blankSingleFrame :: ScreenContent -> SingleFrame
blankSingleFrame ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth, Int
rheight :: Int
rheight :: ScreenContent -> Int
rheight} =
  Array AttrCharW32
-> OverlaySpace -> OverlaySpace -> OverlaySpace -> SingleFrame
SingleFrame (Int -> Int -> AttrCharW32 -> Array AttrCharW32
forall c. UnboxRepClass c => Int -> Int -> c -> Array c
PointArray.replicateA Int
rwidth Int
rheight AttrCharW32
Color.spaceAttrW32)
              []
              []
              []

-- | Truncate the overlay: for each line, if it's too long, it's truncated
-- and if there are too many lines, excess is dropped and warning is appended.
-- The width, in the second argument, is calculated in characters,
-- not in UI (mono font) coordinates, so that taking and dropping characters
-- is performed correctly.
truncateOverlay :: Bool -> Int -> Int -> Bool -> Int -> Bool -> Overlay
                -> OverlaySpace
truncateOverlay :: Bool
-> Int -> Int -> Bool -> Int -> Bool -> Overlay -> OverlaySpace
truncateOverlay Bool
halveXstart Int
width Int
rheight Bool
wipeAdjacentRaw Int
fillLen Bool
onBlank Overlay
ov =
  let wipeAdjacent :: Bool
wipeAdjacent = Bool
wipeAdjacentRaw Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
onBlank
      canvasLength :: Int
canvasLength = if Bool
onBlank then Int
rheight else Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
      supHeight :: Int
supHeight = Overlay -> Int
maxYofOverlay Overlay
ov
      trimmedY :: Int
trimmedY = Int
canvasLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      -- Sadly, this does not trim the other, concurrent, overlays that may
      -- obscure the last line and so contend with the "trimmed" message.
      -- Tough luck; just avoid overrunning overlays in higher level code.
      ovTopFiltered :: Overlay
ovTopFiltered = ((PointUI, AttrLine) -> Bool) -> Overlay -> Overlay
forall a. (a -> Bool) -> [a] -> [a]
filter (\(PointUI Int
_ Int
y, AttrLine
_) -> Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
trimmedY) Overlay
ov
      trimmedAlert :: (PointUI, AttrLine)
trimmedAlert = ( Int -> Int -> PointUI
PointUI Int
0 Int
trimmedY
                     , String -> AttrLine
stringToAL String
"--a portion of the text trimmed--" )
      extraLine :: Overlay
extraLine | Int
supHeight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3
                  Bool -> Bool -> Bool
|| Int
supHeight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
trimmedY
                  Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
wipeAdjacent = []
                | Bool
otherwise =
        let supHs :: Overlay
supHs = ((PointUI, AttrLine) -> Bool) -> Overlay -> Overlay
forall a. (a -> Bool) -> [a] -> [a]
filter (\(PointUI Int
_ Int
y, AttrLine
_) -> Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
supHeight) Overlay
ov
        in if Overlay -> Bool
forall a. [a] -> Bool
null Overlay
supHs
           then []
           else let (PointUI Int
xLast Int
yLast, AttrLine
_) =
                      ((PointUI, AttrLine) -> (PointUI, AttrLine) -> Ordering)
-> Overlay -> (PointUI, AttrLine)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((PointUI, AttrLine) -> Int)
-> (PointUI, AttrLine) -> (PointUI, AttrLine) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (((PointUI, AttrLine) -> Int)
 -> (PointUI, AttrLine) -> (PointUI, AttrLine) -> Ordering)
-> ((PointUI, AttrLine) -> Int)
-> (PointUI, AttrLine)
-> (PointUI, AttrLine)
-> Ordering
forall a b. (a -> b) -> a -> b
$ \(PointUI Int
x Int
_, AttrLine
_) -> Int
x) Overlay
supHs
                in [(Int -> Int -> PointUI
PointUI Int
xLast (Int
yLast Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1), AttrLine
emptyAttrLine)]
      -- This is crude, because an al at lower x may be longer, but KISS.
      -- This also gives a solid rule which al overwrite others
      -- when merging overlays, independent of the order of merging
      -- (except for duplicate x, for which initial order is retained).
      -- The order functions is cheap, we use @sortBy@, not @sortOn@.
      ovTop :: [Overlay]
ovTop = ((PointUI, AttrLine) -> (PointUI, AttrLine) -> Bool)
-> Overlay -> [Overlay]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> ((PointUI, AttrLine) -> Int)
-> (PointUI, AttrLine)
-> (PointUI, AttrLine)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` \(PointUI Int
_ Int
y, AttrLine
_) -> Int
y)
              (Overlay -> [Overlay]) -> Overlay -> [Overlay]
forall a b. (a -> b) -> a -> b
$ ((PointUI, AttrLine) -> (PointUI, AttrLine) -> Ordering)
-> Overlay -> Overlay
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((PointUI, AttrLine) -> (Int, Int))
-> (PointUI, AttrLine) -> (PointUI, AttrLine) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (((PointUI, AttrLine) -> (Int, Int))
 -> (PointUI, AttrLine) -> (PointUI, AttrLine) -> Ordering)
-> ((PointUI, AttrLine) -> (Int, Int))
-> (PointUI, AttrLine)
-> (PointUI, AttrLine)
-> Ordering
forall a b. (a -> b) -> a -> b
$ \(PointUI Int
x Int
y, AttrLine
_) -> (Int
y, Int
x))
              (Overlay -> Overlay) -> Overlay -> Overlay
forall a b. (a -> b) -> a -> b
$ if Int
supHeight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
canvasLength
                then Overlay
ovTopFiltered Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
++ [(PointUI, AttrLine)
trimmedAlert]
                else Overlay
ov Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
++ Overlay
extraLine
      -- Unlike the trimming above, adding spaces around overlay depends
      -- on there being no gaps and a natural order.
      -- Probably also gives messy results when X offsets are not all the same.
      -- Below we at least mitigate the case of multiple lines per row.
      f :: (Int, Int) -> (Int, Int) -> Overlay -> OverlaySpace
f (Int, Int)
_ (Int, Int)
_ [] = String -> OverlaySpace
forall a. HasCallStack => String -> a
error String
"empty list of overlay lines at the given row"
      f (Int
yPrev, Int
lenPrev) (Int
yNext, Int
lenNext) (minAl :: (PointUI, AttrLine)
minAl@(PointUI Int
_ Int
yCur, AttrLine
_) : Overlay
rest) =
        Int -> Int -> Int -> (PointUI, AttrLine) -> (PointUI, AttrString)
g (if Int
yPrev Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
yCur Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 then Int
lenPrev else Int
0)
          (if Int
yNext Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
yCur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 then Int
lenNext else Int
0)
          Int
fillLen
          (PointUI, AttrLine)
minAl
        (PointUI, AttrString) -> OverlaySpace -> OverlaySpace
forall a. a -> [a] -> [a]
: ((PointUI, AttrLine) -> (PointUI, AttrString))
-> Overlay -> OverlaySpace
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int -> (PointUI, AttrLine) -> (PointUI, AttrString)
g Int
0 Int
0 Int
0) Overlay
rest
      g :: Int -> Int -> Int -> (PointUI, AttrLine) -> (PointUI, AttrString)
g Int
lenPrev Int
lenNext Int
fillL (p :: PointUI
p@(PointUI Int
xstartRaw Int
_), AttrLine
layerLine) =
        let xstart :: Int
xstart = if Bool
halveXstart then Int
xstartRaw Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 else Int
xstartRaw
            -- TODO: lenPrev and lenNext is from the same kind of font;
            -- if fonts are mixed, too few spaces are added.
            -- We'd need to keep a global store of line lengths
            -- for every position on the screen, filled first going
            -- over all texts and only afterwards texts rendered.
            -- And prop font measure would still make this imprecise.
            -- TODO: rewrite ovBackdrop according to this idea,
            -- but then process square font only mode with the same mechanism.
            maxLen :: Int
maxLen = if Bool
wipeAdjacent then Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
lenPrev Int
lenNext else Int
0
            fillFromStart :: Int
fillFromStart = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
fillL (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxLen) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xstart
            available :: Int
available = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xstart
        in (PointUI
p, Bool -> Int -> Int -> AttrLine -> AttrString
truncateAttrLine Bool
wipeAdjacent Int
available Int
fillFromStart AttrLine
layerLine)
      rightExtentOfLine :: (PointUI, AttrLine) -> Int
rightExtentOfLine (PointUI Int
xstartRaw Int
_, AttrLine
al) =
        let xstart :: Int
xstart = if Bool
halveXstart then Int
xstartRaw Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 else Int
xstartRaw
        in Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
xstart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AttrString -> Int
forall a. [a] -> Int
length (AttrLine -> AttrString
attrLine AttrLine
al))
      yAndLen :: Overlay -> (Int, Int)
yAndLen [] = (-Int
99, Int
0)
      yAndLen als :: Overlay
als@((PointUI Int
_ Int
y, AttrLine
_) : Overlay
_) =
        (Int
y, [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((PointUI, AttrLine) -> Int) -> Overlay -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (PointUI, AttrLine) -> Int
rightExtentOfLine Overlay
als)
      lens :: [(Int, Int)]
lens = (Overlay -> (Int, Int)) -> [Overlay] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map Overlay -> (Int, Int)
yAndLen [Overlay]
ovTop
      f2 :: Overlay -> OverlaySpace
f2 = ((PointUI, AttrLine) -> (PointUI, AttrString))
-> Overlay -> OverlaySpace
forall a b. (a -> b) -> [a] -> [b]
map (PointUI, AttrLine) -> (PointUI, AttrString)
g2
      g2 :: (PointUI, AttrLine) -> (PointUI, AttrString)
g2 (p :: PointUI
p@(PointUI Int
xstartRaw Int
_), AttrLine
layerLine) =
        let xstart :: Int
xstart = if Bool
halveXstart then Int
xstartRaw Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 else Int
xstartRaw
            available :: Int
available = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xstart
        in (PointUI
p, Bool -> Int -> Int -> AttrLine -> AttrString
truncateAttrLine Bool
False Int
available Int
0 AttrLine
layerLine)
  in [OverlaySpace] -> OverlaySpace
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([OverlaySpace] -> OverlaySpace) -> [OverlaySpace] -> OverlaySpace
forall a b. (a -> b) -> a -> b
$ if Bool
onBlank
              then (Overlay -> OverlaySpace) -> [Overlay] -> [OverlaySpace]
forall a b. (a -> b) -> [a] -> [b]
map Overlay -> OverlaySpace
f2 [Overlay]
ovTop
              else ((Int, Int) -> (Int, Int) -> Overlay -> OverlaySpace)
-> [(Int, Int)] -> [(Int, Int)] -> [Overlay] -> [OverlaySpace]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (Int, Int) -> (Int, Int) -> Overlay -> OverlaySpace
f ((-Int
9, Int
0) (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: [(Int, Int)]
lens) (Int -> [(Int, Int)] -> [(Int, Int)]
forall a. Int -> [a] -> [a]
drop Int
1 [(Int, Int)]
lens [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int
999, Int
0)]) [Overlay]
ovTop

-- | Add a space at the message end, for display overlayed over the level map.
-- Also trim (do not wrap!) too long lines. Also add many spaces when under
-- longer lines.
truncateAttrLine :: Bool -> Int -> Int -> AttrLine -> AttrString
truncateAttrLine :: Bool -> Int -> Int -> AttrLine -> AttrString
truncateAttrLine Bool
addSpaces Int
available Int
fillFromStart AttrLine
aLine =
  let al :: AttrString
al = AttrLine -> AttrString
attrLine AttrLine
aLine
      len :: Int
len = AttrString -> Int
forall a. [a] -> Int
length AttrString
al
  in if | AttrString -> Bool
forall a. [a] -> Bool
null AttrString
al -> if Bool
addSpaces
                     then Int -> AttrCharW32 -> AttrString
forall a. Int -> a -> [a]
replicate Int
fillFromStart AttrCharW32
Color.spaceAttrW32
                     else AttrString
al
        | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
available Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Bool -> Bool -> Bool
&& Bool
addSpaces -> AttrString
al AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.spaceAttrW32]
        | Bool
otherwise -> case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
available Int
len of
            Ordering
LT -> Int -> AttrString -> AttrString
forall a. Int -> [a] -> [a]
take (Int
available Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) AttrString
al AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.trimmedLineAttrW32]
            Ordering
GT | Bool
addSpaces ->
              let alSpace :: AttrString
alSpace = AttrString
al AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.spaceAttrW32, AttrCharW32
Color.spaceAttrW32]
                  whiteN :: Int
whiteN = Int
fillFromStart Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
              in if Int
whiteN Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
                 then AttrString
alSpace  -- speedup (supposedly) for menus
                 else AttrString
alSpace AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ Int -> AttrCharW32 -> AttrString
forall a. Int -> a -> [a]
replicate Int
whiteN AttrCharW32
Color.spaceAttrW32
            Ordering
_ -> AttrString
al

-- | Overlays either the game map only or the whole empty screen frame.
-- We assume the lines of the overlay are not too long nor too many.
overlayFrame :: Int -> OverlaySpace -> PreFrame -> PreFrame
overlayFrame :: Int -> OverlaySpace -> PreFrame -> PreFrame
overlayFrame Int
width OverlaySpace
ov (Vector Word32
m, FrameForall
ff) =
  ( Vector Word32
m
  , (forall s. FrameST s) -> FrameForall
FrameForall ((forall s. FrameST s) -> FrameForall)
-> (forall s. FrameST s) -> FrameForall
forall a b. (a -> b) -> a -> b
$ \Mutable Vector s Word32
v -> do
      FrameForall -> forall s. FrameST s
unFrameForall FrameForall
ff Mutable Vector s Word32
v
      ((PointUI, AttrString) -> ST s ()) -> OverlaySpace -> ST s ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (\(PointUI Int
px Int
py, AttrString
l) ->
               let offset :: Int
offset = Int
py Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
px Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
               in FrameForall -> forall s. FrameST s
unFrameForall (Int -> AttrString -> FrameForall
writeLine Int
offset AttrString
l) Mutable Vector s Word32
v) OverlaySpace
ov )