{-# LANGUAGE BangPatterns #-}
module Brick.Widgets.Internal
  ( renderFinal
  , cropToContext
  , cropResultToContext
  , renderDynBorder
  )
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
import Brick.BorderMap (BorderMap)
import qualified Brick.BorderMap as BM

renderFinal :: AttrMap
            -> [Widget n]
            -> V.DisplayRegion
            -> ([CursorLocation n] -> Maybe (CursorLocation n))
            -> RenderState n
            -> (RenderState n, V.Picture, Maybe (CursorLocation n), [Extent n])
renderFinal :: 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, [[Extent n]] -> [Extent n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Extent n]]
layerExtents)
    where
        ([Result n]
layerResults, !RenderState n
newRS) = (State (RenderState n) [Result n]
 -> RenderState n -> ([Result n], RenderState n))
-> RenderState n
-> State (RenderState n) [Result n]
-> ([Result n], RenderState n)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (RenderState n) [Result n]
-> RenderState n -> ([Result n], RenderState n)
forall s a. State s a -> s -> (a, s)
runState RenderState n
rs (State (RenderState n) [Result n] -> ([Result n], RenderState n))
-> State (RenderState n) [Result n] -> ([Result n], RenderState n)
forall a b. (a -> b) -> a -> b
$ [StateT (RenderState n) Identity (Result n)]
-> State (RenderState n) [Result n]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([StateT (RenderState n) Identity (Result n)]
 -> State (RenderState n) [Result n])
-> [StateT (RenderState n) Identity (Result n)]
-> State (RenderState n) [Result n]
forall a b. (a -> b) -> a -> b
$
            (\ReaderT Context (StateT (RenderState n) Identity) (Result n)
p -> ReaderT Context (StateT (RenderState n) Identity) (Result n)
-> Context -> StateT (RenderState n) Identity (Result n)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Context (StateT (RenderState n) Identity) (Result n)
p Context
ctx) (ReaderT Context (StateT (RenderState n) Identity) (Result n)
 -> StateT (RenderState n) Identity (Result n))
-> [ReaderT Context (StateT (RenderState n) Identity) (Result n)]
-> [StateT (RenderState n) Identity (Result n)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            (Widget n
-> ReaderT Context (StateT (RenderState n) Identity) (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n
 -> ReaderT Context (StateT (RenderState n) Identity) (Result n))
-> (Widget n -> Widget n)
-> Widget n
-> ReaderT Context (StateT (RenderState n) Identity) (Result n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Widget n -> Widget n
forall n. Widget n -> Widget n
cropToContext (Widget n
 -> ReaderT Context (StateT (RenderState n) Identity) (Result n))
-> [Widget n]
-> [ReaderT Context (StateT (RenderState n) Identity) (Result n)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Widget n]
layerRenders)

        ctx :: Context
ctx = Context :: AttrName
-> Int
-> Int
-> Int
-> Int
-> BorderStyle
-> AttrMap
-> Bool
-> Context
Context { ctxAttrName :: AttrName
ctxAttrName = AttrName
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
                      }
        pic :: Picture
pic = [Image] -> Picture
V.picForLayers ([Image] -> Picture) -> [Image] -> Picture
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Image -> Image) -> DisplayRegion -> Image -> Image
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Image -> Image
V.resize (Int
w, Int
h) (Image -> Image) -> (Result n -> Image) -> Result n -> Image
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Result n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL) (Result n -> Image) -> [Result n] -> [Image]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Result n]
layerResults

        -- 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 = (Result n
-> Getting [CursorLocation n] (Result n) [CursorLocation n]
-> [CursorLocation n]
forall s a. s -> Getting a s a -> a
^.Getting [CursorLocation n] (Result n) [CursorLocation n]
forall n. Lens' (Result n) [CursorLocation n]
cursorsL) (Result n -> [CursorLocation n])
-> [Result n] -> [[CursorLocation n]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Result n]
layerResults
        layerExtents :: [[Extent n]]
layerExtents = [[Extent n]] -> [[Extent n]]
forall a. [a] -> [a]
reverse ([[Extent n]] -> [[Extent n]]) -> [[Extent n]] -> [[Extent n]]
forall a b. (a -> b) -> a -> b
$ (Result n -> Getting [Extent n] (Result n) [Extent n] -> [Extent n]
forall s a. s -> Getting a s a -> a
^.Getting [Extent n] (Result n) [Extent n]
forall n. Lens' (Result n) [Extent n]
extentsL) (Result n -> [Extent n]) -> [Result n] -> [[Extent n]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Result n]
layerResults
        theCursor :: Maybe (CursorLocation n)
theCursor = [CursorLocation n] -> Maybe (CursorLocation n)
chooseCursor ([CursorLocation n] -> Maybe (CursorLocation n))
-> [CursorLocation n] -> Maybe (CursorLocation n)
forall a b. (a -> b) -> a -> b
$ [[CursorLocation n]] -> [CursorLocation n]
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 :: Widget n -> Widget n
cropToContext Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p RenderM n (Result n)
-> (Result n -> RenderM n (Result n)) -> RenderM n (Result n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Result n -> RenderM n (Result n)
forall n. Result n -> RenderM n (Result n)
cropResultToContext)

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

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

cropCursors :: Context -> [CursorLocation n] -> [CursorLocation n]
cropCursors :: Context -> [CursorLocation n] -> [CursorLocation n]
cropCursors Context
ctx [CursorLocation n]
cs = [Maybe (CursorLocation n)] -> [CursorLocation n]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (CursorLocation n)] -> [CursorLocation n])
-> [Maybe (CursorLocation n)] -> [CursorLocation n]
forall a b. (a -> b) -> a -> b
$ CursorLocation n -> Maybe (CursorLocation n)
forall n. CursorLocation n -> Maybe (CursorLocation n)
cropCursor (CursorLocation n -> Maybe (CursorLocation n))
-> [CursorLocation n] -> [Maybe (CursorLocation n)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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 | CursorLocation n -> Bool
forall n. CursorLocation n -> Bool
outOfContext CursorLocation n
c = Maybe (CursorLocation n)
forall a. Maybe a
Nothing
                     | Bool
otherwise      = CursorLocation n -> Maybe (CursorLocation n)
forall a. a -> Maybe a
Just CursorLocation n
c
        outOfContext :: CursorLocation n -> Bool
outOfContext CursorLocation n
c =
            [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ CursorLocation n
cCursorLocation n -> Getting Int (CursorLocation n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Location -> Const Int Location)
-> CursorLocation n -> Const Int (CursorLocation n)
forall n. Lens' (CursorLocation n) Location
cursorLocationL((Location -> Const Int Location)
 -> CursorLocation n -> Const Int (CursorLocation n))
-> ((Int -> Const Int Int) -> Location -> Const Int Location)
-> Getting Int (CursorLocation n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> Location -> Const Int Location
forall a. TerminalLocation a => Lens' a Int
locationRowL    Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
               , CursorLocation n
cCursorLocation n -> Getting Int (CursorLocation n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Location -> Const Int Location)
-> CursorLocation n -> Const Int (CursorLocation n)
forall n. Lens' (CursorLocation n) Location
cursorLocationL((Location -> Const Int Location)
 -> CursorLocation n -> Const Int (CursorLocation n))
-> ((Int -> Const Int Int) -> Location -> Const Int Location)
-> Getting Int (CursorLocation n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> Location -> Const Int Location
forall a. TerminalLocation a => Lens' a Int
locationColumnL Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
               , CursorLocation n
cCursorLocation n -> Getting Int (CursorLocation n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Location -> Const Int Location)
-> CursorLocation n -> Const Int (CursorLocation n)
forall n. Lens' (CursorLocation n) Location
cursorLocationL((Location -> Const Int Location)
 -> CursorLocation n -> Const Int (CursorLocation n))
-> ((Int -> Const Int Int) -> Location -> Const Int Location)
-> Getting Int (CursorLocation n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> Location -> Const Int Location
forall a. TerminalLocation a => Lens' a Int
locationRowL    Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Context
ctxContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availHeightL
               , CursorLocation n
cCursorLocation n -> Getting Int (CursorLocation n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Location -> Const Int Location)
-> CursorLocation n -> Const Int (CursorLocation n)
forall n. Lens' (CursorLocation n) Location
cursorLocationL((Location -> Const Int Location)
 -> CursorLocation n -> Const Int (CursorLocation n))
-> ((Int -> Const Int Int) -> Location -> Const Int Location)
-> Getting Int (CursorLocation n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> Location -> Const Int Location
forall a. TerminalLocation a => Lens' a Int
locationColumnL Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Context
ctxContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL
               ]

cropExtents :: Context -> [Extent n] -> [Extent n]
cropExtents :: Context -> [Extent n] -> [Extent n]
cropExtents Context
ctx [Extent n]
es = [Maybe (Extent n)] -> [Extent n]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Extent n)] -> [Extent n])
-> [Maybe (Extent n)] -> [Extent n]
forall a b. (a -> b) -> a -> b
$ Extent n -> Maybe (Extent n)
forall n. Extent n -> Maybe (Extent n)
cropExtent (Extent n -> Maybe (Extent n)) -> [Extent n] -> [Maybe (Extent n)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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 and upper left corner are adjusted so that
        -- they are contained within the context region.
        cropExtent :: Extent n -> Maybe (Extent n)
cropExtent (Extent n
n (Location (Int
c, Int
r)) (Int
w, Int
h)) =
            -- First, clamp the upper-left corner to at least (0, 0).
            let c' :: Int
c' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
c Int
0
                r' :: Int
r' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
r Int
0
                -- Then, determine the new lower-right corner based on
                -- the clamped corner.
                endCol :: Int
endCol = Int
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w
                endRow :: Int
endRow = Int
r' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h
                -- Then clamp the lower-right corner based on the
                -- context
                endCol' :: Int
endCol' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Context
ctxContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL) Int
endCol
                endRow' :: Int
endRow' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Context
ctxContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availHeightL) Int
endRow
                -- Then compute the new width and height from the
                -- clamped lower-right corner.
                w' :: Int
w' = Int
endCol' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c'
                h' :: Int
h' = Int
endRow' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r'
                e :: Extent n
e = n -> Location -> DisplayRegion -> Extent n
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' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
h' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
               then Maybe (Extent n)
forall a. Maybe a
Nothing
               else Extent n -> Maybe (Extent n)
forall a. a -> Maybe a
Just Extent n
e

cropBorders :: Context -> BorderMap DynBorder -> BorderMap DynBorder
cropBorders :: Context -> BorderMap DynBorder -> BorderMap DynBorder
cropBorders Context
ctx = Edges Int -> BorderMap DynBorder -> BorderMap DynBorder
forall a. Edges Int -> BorderMap a -> BorderMap a
BM.crop Edges :: forall a. a -> a -> a -> a -> Edges a
Edges
    { eTop :: Int
eTop = Int
0
    , eBottom :: Int
eBottom = Context -> Int
availHeight Context
ctx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    , eLeft :: Int
eLeft = Int
0
    , eRight :: Int
eRight = Context -> Int
availWidth Context
ctx Int -> Int -> Int
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) (Char -> Image)
-> ((BorderStyle -> Char) -> Char)
-> (BorderStyle -> Char)
-> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((BorderStyle -> Char) -> BorderStyle -> Char
forall a b. (a -> b) -> a -> b
$DynBorder -> BorderStyle
dbStyle DynBorder
db) ((BorderStyle -> Char) -> Image) -> (BorderStyle -> Char) -> Image
forall a b. (a -> b) -> a -> b
$ case BorderSegment -> Bool
bsDraw (BorderSegment -> Bool) -> Edges BorderSegment -> Edges Bool
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 -> Char -> BorderStyle -> Char
forall a b. a -> b -> a
const Char
' ' -- dunno lol (but should never happen, so who cares)
    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