module Brick.Widgets.Internal
( renderFinal
, cropToContext
, cropResultToContext
)
where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Lens.Micro ((^.), (&), (%~))
import Control.Monad.Trans.State.Lazy
import Control.Monad.Trans.Reader
import Data.Maybe (catMaybes)
import qualified Graphics.Vty as V
import Brick.Types
import Brick.Types.Internal
import Brick.AttrMap
import Brick.Widgets.Border.Style
renderFinal :: AttrMap
-> [Widget n]
-> V.DisplayRegion
-> ([CursorLocation n] -> Maybe (CursorLocation n))
-> RenderState n
-> (RenderState n, V.Picture, Maybe (CursorLocation n), [Extent n])
renderFinal aMap layerRenders sz chooseCursor rs = (newRS, picWithBg, theCursor, concat layerExtents)
where
(layerResults, !newRS) = flip runState rs $ sequence $
(\p -> runReaderT p ctx) <$>
(render <$> cropToContext <$> layerRenders)
ctx = Context mempty (fst sz) (snd sz) defaultBorderStyle aMap
pic = V.picForLayers $ uncurry V.resize sz <$> (^.imageL) <$> layerResults
picWithBg = pic { V.picBackground = V.Background ' ' V.defAttr }
layerCursors = (^.cursorsL) <$> layerResults
layerExtents = reverse $ (^.extentsL) <$> layerResults
theCursor = chooseCursor $ concat layerCursors
cropToContext :: Widget n -> Widget n
cropToContext p =
Widget (hSize p) (vSize p) (render p >>= cropResultToContext)
cropResultToContext :: Result n -> RenderM n (Result n)
cropResultToContext result = do
c <- getContext
return $ result & imageL %~ cropImage c
& cursorsL %~ cropCursors c
& extentsL %~ cropExtents c
cropImage :: Context -> V.Image -> V.Image
cropImage c = V.crop (max 0 $ c^.availWidthL) (max 0 $ c^.availHeightL)
cropCursors :: Context -> [CursorLocation n] -> [CursorLocation n]
cropCursors ctx cs = catMaybes $ cropCursor <$> cs
where
cropCursor c | outOfContext c = Nothing
| otherwise = Just c
outOfContext c =
or [ c^.cursorLocationL.locationRowL < 0
, c^.cursorLocationL.locationColumnL < 0
, c^.cursorLocationL.locationRowL >= ctx^.availHeightL
, c^.cursorLocationL.locationColumnL >= ctx^.availWidthL
]
cropExtents :: Context -> [Extent n] -> [Extent n]
cropExtents ctx es = catMaybes $ cropExtent <$> es
where
cropExtent (Extent n (Location (c, r)) (w, h) (Location (oC, oR))) =
let c' = max c 0
r' = max r 0
dc = c' c
dr = r' r
endCol = c' + w
endRow = r' + h
endCol' = min (ctx^.availWidthL) endCol
endRow' = min (ctx^.availHeightL) endRow
w' = endCol' c'
h' = endRow' r'
e = Extent n (Location (c', r')) (w', h') (Location (oC + dc, oR + dr))
in if w' < 0 || h' < 0
then Nothing
else Just e