{-# 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 :: 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
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
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
cropExtent :: Extent n -> Maybe (Extent n)
cropExtent (Extent n
n (Location (Int
c, Int
r)) (Int
w, Int
h) (Location (Int
oC, Int
oR))) =
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
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
< 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
Edges Bool
False Bool
False Bool
False Bool
False -> Char -> BorderStyle -> Char
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