{-# 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 aMap :: AttrMap
aMap layerRenders :: [Widget n]
layerRenders sz :: DisplayRegion
sz chooseCursor :: [CursorLocation n] -> Maybe (CursorLocation n)
chooseCursor rs :: 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
(layerResults :: [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
$
(\p :: 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 = AttrName -> Int -> Int -> BorderStyle -> AttrMap -> Bool -> Context
Context AttrName
forall a. Monoid a => a
mempty (DisplayRegion -> Int
forall a b. (a, b) -> a
fst DisplayRegion
sz) (DisplayRegion -> Int
forall a b. (a, b) -> b
snd DisplayRegion
sz) BorderStyle
defaultBorderStyle AttrMap
aMap 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 DisplayRegion
sz (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 :: Picture
picWithBg = Picture
pic { picBackground :: Background
V.picBackground = Char -> Attr -> Background
V.Background ' ' 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
cropToContext :: Widget n -> Widget n
cropToContext :: Widget n -> Widget n
cropToContext p :: 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 :: 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 c :: Context
c = Int -> Int -> Image -> Image
V.crop (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 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 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 ctx :: Context
ctx cs :: [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
cropCursor :: CursorLocation n -> Maybe (CursorLocation n)
cropCursor c :: 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 c :: 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
< 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
< 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 ctx :: Context
ctx es :: [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
cropExtent :: Extent n -> Maybe (Extent n)
cropExtent (Extent n :: n
n (Location (c :: Int
c, r :: Int
r)) (w :: Int
w, h :: Int
h) (Location (oC :: Int
oC, oR :: Int
oR))) =
let c' :: Int
c' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
c 0
r' :: Int
r' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
r 0
dc :: Int
dc = Int
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c
dr :: Int
dr = Int
r' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r
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
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
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 -> Location -> Extent n
forall n. n -> Location -> DisplayRegion -> Location -> Extent n
Extent n
n (DisplayRegion -> Location
Location (Int
c', Int
r')) (Int
w', Int
h') (DisplayRegion -> Location
Location (Int
oC Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dc, Int
oR Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dr))
in if Int
w' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| Int
h' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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 ctx :: 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 = 0
, eBottom :: Int
eBottom = Context -> Int
availHeight Context
ctx Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
, eLeft :: Int
eLeft = 0
, eRight :: Int
eRight = Context -> Int
availWidth Context
ctx Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
}
renderDynBorder :: DynBorder -> V.Image
renderDynBorder :: DynBorder -> Image
renderDynBorder db :: 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
Edges False False False False -> Char -> BorderStyle -> Char
forall a b. a -> b -> a
const ' '
Edges False False _ _ -> BorderStyle -> Char
bsHorizontal
Edges _ _ False False -> BorderStyle -> Char
bsVertical
Edges False True False True -> BorderStyle -> Char
bsCornerTL
Edges False True True False -> BorderStyle -> Char
bsCornerTR
Edges True False False True -> BorderStyle -> Char
bsCornerBL
Edges True False True False -> BorderStyle -> Char
bsCornerBR
Edges False True True True -> BorderStyle -> Char
bsIntersectT
Edges True False True True -> BorderStyle -> Char
bsIntersectB
Edges True True False True -> BorderStyle -> Char
bsIntersectL
Edges True True True False -> BorderStyle -> Char
bsIntersectR
Edges True True True True -> BorderStyle -> Char
bsIntersectFull