{-# LANGUAGE BangPatterns #-}
module Brick.Widgets.Internal
  ( renderFinal
  , cropToContext
  , cropResultToContext
  , renderDynBorder
  , renderWidget
  )
where

import Lens.Micro ((^.), (&), (%~))
import Lens.Micro.Mtl ((%=))
import Control.Monad
import Control.Monad.State.Strict
import Control.Monad.Reader
import Data.Maybe (fromMaybe, mapMaybe)
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Graphics.Vty as V

import Brick.Types
import Brick.Types.Internal
import Brick.AttrMap
import Brick.Widgets.Border.Style
import Brick.BorderMap (BorderMap)
import qualified Brick.BorderMap as BM

renderFinal :: (Ord n)
            => AttrMap
            -> [Widget n]
            -> V.DisplayRegion
            -> ([CursorLocation n] -> Maybe (CursorLocation n))
            -> RenderState n
            -> (RenderState n, V.Picture, Maybe (CursorLocation n), [Extent n])
renderFinal :: forall n.
Ord n =>
AttrMap
-> [Widget n]
-> DisplayRegion
-> ([CursorLocation n] -> Maybe (CursorLocation n))
-> RenderState n
-> (RenderState n, Picture, Maybe (CursorLocation n), [Extent n])
renderFinal AttrMap
aMap [Widget n]
layerRenders (Int
w, Int
h) [CursorLocation n] -> Maybe (CursorLocation n)
chooseCursor RenderState n
rs =
    (RenderState n
newRS, Picture
picWithBg, Maybe (CursorLocation n)
theCursor, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Extent n]]
layerExtents)
    where
        ([Result n]
layerResults, !RenderState n
newRS) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> (a, s)
runState RenderState n
rs forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$
            (\ReaderT (Context n) (StateT (RenderState n) Identity) (Result n)
p -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Context n) (StateT (RenderState n) Identity) (Result n)
p forall {n}. Context n
ctx) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            (\Widget n
layerWidget -> do
                Result n
result <- forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n
cropToContext Widget n
layerWidget
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) [Extent n]
extentsL) forall a b. (a -> b) -> a -> b
$ \Extent n
e ->
                    forall n. Lens' (RenderState n) (Map n (Extent n))
reportedExtentsL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall n. Extent n -> n
extentName Extent n
e) Extent n
e
                forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result
                ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> [a]
reverse [Widget n]
layerRenders

        ctx :: Context n
ctx = Context { ctxAttrName :: AttrName
ctxAttrName = forall a. Monoid a => a
mempty
                      , availWidth :: Int
availWidth = Int
w
                      , availHeight :: Int
availHeight = Int
h
                      , windowWidth :: Int
windowWidth = Int
w
                      , windowHeight :: Int
windowHeight = Int
h
                      , ctxBorderStyle :: BorderStyle
ctxBorderStyle = BorderStyle
defaultBorderStyle
                      , ctxAttrMap :: AttrMap
ctxAttrMap = AttrMap
aMap
                      , ctxDynBorders :: Bool
ctxDynBorders = Bool
False
                      , ctxVScrollBarOrientation :: Maybe VScrollBarOrientation
ctxVScrollBarOrientation = forall a. Maybe a
Nothing
                      , ctxVScrollBarRenderer :: Maybe (ScrollbarRenderer n)
ctxVScrollBarRenderer = forall a. Maybe a
Nothing
                      , ctxHScrollBarOrientation :: Maybe HScrollBarOrientation
ctxHScrollBarOrientation = forall a. Maybe a
Nothing
                      , ctxHScrollBarRenderer :: Maybe (ScrollbarRenderer n)
ctxHScrollBarRenderer = forall a. Maybe a
Nothing
                      , ctxHScrollBarShowHandles :: Bool
ctxHScrollBarShowHandles = Bool
False
                      , ctxVScrollBarShowHandles :: Bool
ctxVScrollBarShowHandles = Bool
False
                      , ctxHScrollBarClickableConstr :: Maybe (ClickableScrollbarElement -> n -> n)
ctxHScrollBarClickableConstr = forall a. Maybe a
Nothing
                      , ctxVScrollBarClickableConstr :: Maybe (ClickableScrollbarElement -> n -> n)
ctxVScrollBarClickableConstr = forall a. Maybe a
Nothing
                      }

        layersTopmostFirst :: [Result n]
layersTopmostFirst = forall a. [a] -> [a]
reverse [Result n]
layerResults
        pic :: Picture
pic = [Image] -> Picture
V.picForLayers forall a b. (a -> b) -> a -> b
$ Int -> Int -> Image -> Image
V.resize Int
w Int
h forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Result n]
layersTopmostFirst

        -- picWithBg is a workaround for runaway attributes.
        -- See https://github.com/coreyoconnor/vty/issues/95
        picWithBg :: Picture
picWithBg = Picture
pic { picBackground :: Background
V.picBackground = Char -> Attr -> Background
V.Background Char
' ' Attr
V.defAttr }

        layerCursors :: [[CursorLocation n]]
layerCursors = (forall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) [CursorLocation n]
cursorsL) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Result n]
layersTopmostFirst
        layerExtents :: [[Extent n]]
layerExtents = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ (forall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) [Extent n]
extentsL) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Result n]
layersTopmostFirst
        theCursor :: Maybe (CursorLocation n)
theCursor = [CursorLocation n] -> Maybe (CursorLocation n)
chooseCursor forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[CursorLocation n]]
layerCursors

-- | After rendering the specified widget, crop its result image to the
-- dimensions in the rendering context.
cropToContext :: Widget n -> Widget n
cropToContext :: forall n. Widget n -> Widget n
cropToContext Widget n
p =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
p) (forall n. Widget n -> Size
vSize Widget n
p) (forall n. Widget n -> RenderM n (Result n)
render Widget n
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall n. Result n -> RenderM n (Result n)
cropResultToContext)

cropResultToContext :: Result n -> RenderM n (Result n)
cropResultToContext :: forall n. Result n -> RenderM n (Result n)
cropResultToContext Result n
result = do
    Context n
c <- forall n. RenderM n (Context n)
getContext
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Result n
result forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) Image
imageL   forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall n. Context n -> Image -> Image
cropImage   Context n
c
                    forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) [CursorLocation n]
cursorsL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall n. Context n -> [CursorLocation n] -> [CursorLocation n]
cropCursors Context n
c
                    forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) [Extent n]
extentsL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall n. Context n -> [Extent n] -> [Extent n]
cropExtents Context n
c
                    forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) (BorderMap DynBorder)
bordersL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall n. Context n -> BorderMap DynBorder -> BorderMap DynBorder
cropBorders Context n
c

cropImage :: Context n -> V.Image -> V.Image
cropImage :: forall n. Context n -> Image -> Image
cropImage Context n
c = Int -> Int -> Image -> Image
V.crop (forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL) (forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL)

cropCursors :: Context n -> [CursorLocation n] -> [CursorLocation n]
cropCursors :: forall n. Context n -> [CursorLocation n] -> [CursorLocation n]
cropCursors Context n
ctx [CursorLocation n]
cs = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {n}. CursorLocation n -> Maybe (CursorLocation n)
cropCursor [CursorLocation n]
cs
    where
        -- A cursor location is removed if it is not within the region
        -- described by the context.
        cropCursor :: CursorLocation n -> Maybe (CursorLocation n)
cropCursor CursorLocation n
c | forall {n}. CursorLocation n -> Bool
outOfContext CursorLocation n
c = forall a. Maybe a
Nothing
                     | Bool
otherwise      = forall a. a -> Maybe a
Just CursorLocation n
c
        outOfContext :: CursorLocation n -> Bool
outOfContext CursorLocation n
c =
            forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ CursorLocation n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (CursorLocation n) Location
cursorLocationLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. TerminalLocation a => Lens' a Int
locationRowL    forall a. Ord a => a -> a -> Bool
< Int
0
               , CursorLocation n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (CursorLocation n) Location
cursorLocationLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. TerminalLocation a => Lens' a Int
locationColumnL forall a. Ord a => a -> a -> Bool
< Int
0
               , CursorLocation n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (CursorLocation n) Location
cursorLocationLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. TerminalLocation a => Lens' a Int
locationRowL    forall a. Ord a => a -> a -> Bool
>= Context n
ctxforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL
               , CursorLocation n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (CursorLocation n) Location
cursorLocationLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. TerminalLocation a => Lens' a Int
locationColumnL forall a. Ord a => a -> a -> Bool
>= Context n
ctxforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL
               ]

cropExtents :: Context n -> [Extent n] -> [Extent n]
cropExtents :: forall n. Context n -> [Extent n] -> [Extent n]
cropExtents Context n
ctx [Extent n]
es = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {n}. Extent n -> Maybe (Extent n)
cropExtent [Extent n]
es
    where
        -- An extent is cropped in places where it is not within the
        -- region described by the context.
        --
        -- If its entirety is outside the context region, it is dropped.
        --
        -- Otherwise its size is adjusted so that it is contained within
        -- the context region.
        cropExtent :: Extent n -> Maybe (Extent n)
cropExtent (Extent n
n (Location (Int
c, Int
r)) (Int
w, Int
h)) =
            -- Determine the new lower-right corner
            let endCol :: Int
endCol = Int
c forall a. Num a => a -> a -> a
+ Int
w
                endRow :: Int
endRow = Int
r forall a. Num a => a -> a -> a
+ Int
h
                -- Then clamp the lower-right corner based on the
                -- context
                endCol' :: Int
endCol' = forall a. Ord a => a -> a -> a
min (Context n
ctxforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL) Int
endCol
                endRow' :: Int
endRow' = forall a. Ord a => a -> a -> a
min (Context n
ctxforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL) Int
endRow
                -- Then compute the new width and height from the
                -- clamped lower-right corner.
                w' :: Int
w' = Int
endCol' forall a. Num a => a -> a -> a
- Int
c
                h' :: Int
h' = Int
endRow' forall a. Num a => a -> a -> a
- Int
r
                e :: Extent n
e = forall n. n -> Location -> DisplayRegion -> Extent n
Extent n
n (DisplayRegion -> Location
Location (Int
c, Int
r)) (Int
w', Int
h')
            in if Int
w' forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
h' forall a. Ord a => a -> a -> Bool
< Int
0
               then forall a. Maybe a
Nothing
               else forall a. a -> Maybe a
Just Extent n
e

cropBorders :: Context n -> BorderMap DynBorder -> BorderMap DynBorder
cropBorders :: forall n. Context n -> BorderMap DynBorder -> BorderMap DynBorder
cropBorders Context n
ctx = forall a. Edges Int -> BorderMap a -> BorderMap a
BM.crop Edges
    { eTop :: Int
eTop = Int
0
    , eBottom :: Int
eBottom = forall n. Context n -> Int
availHeight Context n
ctx forall a. Num a => a -> a -> a
- Int
1
    , eLeft :: Int
eLeft = Int
0
    , eRight :: Int
eRight = forall n. Context n -> Int
availWidth Context n
ctx forall a. Num a => a -> a -> a
- Int
1
    }

renderDynBorder :: DynBorder -> V.Image
renderDynBorder :: DynBorder -> Image
renderDynBorder DynBorder
db = Attr -> Char -> Image
V.char (DynBorder -> Attr
dbAttr DynBorder
db) forall a b. (a -> b) -> a -> b
$ BorderStyle -> Char
getBorderChar forall a b. (a -> b) -> a -> b
$ DynBorder -> BorderStyle
dbStyle DynBorder
db
    where
        getBorderChar :: BorderStyle -> Char
getBorderChar = case BorderSegment -> Bool
bsDraw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynBorder -> Edges BorderSegment
dbSegments DynBorder
db of
            --    top   bot   left  right
            Edges Bool
False Bool
False Bool
False Bool
False -> forall a b. a -> b -> a
const Char
' '
            Edges Bool
False Bool
False Bool
_     Bool
_     -> BorderStyle -> Char
bsHorizontal
            Edges Bool
_     Bool
_     Bool
False Bool
False -> BorderStyle -> Char
bsVertical
            Edges Bool
False Bool
True  Bool
False Bool
True  -> BorderStyle -> Char
bsCornerTL
            Edges Bool
False Bool
True  Bool
True  Bool
False -> BorderStyle -> Char
bsCornerTR
            Edges Bool
True  Bool
False Bool
False Bool
True  -> BorderStyle -> Char
bsCornerBL
            Edges Bool
True  Bool
False Bool
True  Bool
False -> BorderStyle -> Char
bsCornerBR
            Edges Bool
False Bool
True  Bool
True  Bool
True  -> BorderStyle -> Char
bsIntersectT
            Edges Bool
True  Bool
False Bool
True  Bool
True  -> BorderStyle -> Char
bsIntersectB
            Edges Bool
True  Bool
True  Bool
False Bool
True  -> BorderStyle -> Char
bsIntersectL
            Edges Bool
True  Bool
True  Bool
True  Bool
False -> BorderStyle -> Char
bsIntersectR
            Edges Bool
True  Bool
True  Bool
True  Bool
True  -> BorderStyle -> Char
bsIntersectFull

-- | This function provides a simplified interface to rendering a list
-- of 'Widget's as a 'V.Picture' outside of the context of an 'App'.
-- This can be useful in a testing setting but isn't intended to be used
-- for normal application rendering. The API is deliberately narrower
-- than the main interactive API and is not yet stable. Use at your own
-- risk.
--
-- Consult the [Vty library documentation](https://hackage.haskell.org/package/vty)
-- for details on how to output the resulting 'V.Picture'.
renderWidget :: (Ord n)
             => Maybe AttrMap
             -- ^ Optional attribute map used to render. If omitted,
             -- an empty attribute map with the terminal's default
             -- attribute will be used.
             -> [Widget n]
             -- ^ The widget layers to render, topmost first.
             -> V.DisplayRegion
             -- ^ The size of the display region in which to render the
             -- layers.
             -> V.Picture
renderWidget :: forall n.
Ord n =>
Maybe AttrMap -> [Widget n] -> DisplayRegion -> Picture
renderWidget Maybe AttrMap
mAttrMap [Widget n]
layerRenders DisplayRegion
region = Picture
pic
    where
        initialRS :: RenderState n
initialRS = RS { viewportMap :: Map n Viewport
viewportMap = forall k a. Map k a
M.empty
                       , rsScrollRequests :: [(n, ScrollRequest)]
rsScrollRequests = []
                       , observedNames :: Set n
observedNames = forall a. Set a
S.empty
                       , renderCache :: Map n ([n], Result n)
renderCache = forall a. Monoid a => a
mempty
                       , clickableNames :: [n]
clickableNames = []
                       , requestedVisibleNames_ :: Set n
requestedVisibleNames_ = forall a. Set a
S.empty
                       , reportedExtents :: Map n (Extent n)
reportedExtents = forall a. Monoid a => a
mempty
                       }
        am :: AttrMap
am = forall a. a -> Maybe a -> a
fromMaybe (Attr -> [(AttrName, Attr)] -> AttrMap
attrMap Attr
V.defAttr []) Maybe AttrMap
mAttrMap
        (RenderState n
_, Picture
pic, Maybe (CursorLocation n)
_, [Extent n]
_) = forall n.
Ord n =>
AttrMap
-> [Widget n]
-> DisplayRegion
-> ([CursorLocation n] -> Maybe (CursorLocation n))
-> RenderState n
-> (RenderState n, Picture, Maybe (CursorLocation n), [Extent n])
renderFinal AttrMap
am [Widget n]
layerRenders DisplayRegion
region (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) RenderState n
initialRS