{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
-- | This module provides the core widget combinators and rendering
-- routines. Everything this library does is in terms of these basic
-- primitives.
module Brick.Widgets.Core
  ( -- * Basic rendering primitives
    TextWidth(..)
  , emptyWidget
  , raw
  , txt
  , txtWrap
  , txtWrapWith
  , str
  , strWrap
  , strWrapWith
  , fill
  , hyperlink

  -- * Padding
  , Padding(..)
  , padLeft
  , padRight
  , padTop
  , padBottom
  , padLeftRight
  , padTopBottom
  , padAll

  -- * Box layout
  , (<=>)
  , (<+>)
  , hBox
  , vBox

  -- * Limits
  , hLimit
  , hLimitPercent
  , vLimit
  , vLimitPercent
  , setAvailableSize

  -- * Attribute management
  , withDefAttr
  , modifyDefAttr
  , withAttr
  , forceAttr
  , forceAttrAllowStyle
  , overrideAttr
  , updateAttrMap

  -- * Border style management
  , withBorderStyle
  , joinBorders
  , separateBorders
  , freezeBorders

  -- * Cursor placement
  , showCursor
  , putCursor

  -- * Naming
  , Named(..)

  -- * Translation and positioning
  , translateBy
  , relativeTo

  -- * Cropping
  , cropLeftBy
  , cropRightBy
  , cropTopBy
  , cropBottomBy
  , cropLeftTo
  , cropRightTo
  , cropTopTo
  , cropBottomTo

  -- * Extent reporting
  , reportExtent
  , clickable

  -- * Scrollable viewports
  , viewport
  , visible
  , visibleRegion
  , unsafeLookupViewport
  , cached

  -- ** Viewport scroll bars
  , withVScrollBars
  , withHScrollBars
  , withClickableHScrollBars
  , withClickableVScrollBars
  , withVScrollBarHandles
  , withHScrollBarHandles
  , withVScrollBarRenderer
  , withHScrollBarRenderer
  , ScrollbarRenderer(..)
  , verticalScrollbarRenderer
  , horizontalScrollbarRenderer
  , scrollbarAttr
  , scrollbarTroughAttr
  , scrollbarHandleAttr
  , verticalScrollbar
  , horizontalScrollbar

  -- ** Adding offsets to cursor positions and visibility requests
  , addResultOffset

  -- ** Cropping results
  , cropToContext
  )
where

#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif

import Lens.Micro ((^.), (.~), (&), (%~), to, _1, _2, each, to, Lens')
import Lens.Micro.Mtl (use, (%=))
import Control.Monad
import Control.Monad.State.Strict
import Control.Monad.Reader
import qualified Data.Foldable as F
import Data.Traversable (for)
import qualified Data.Text as T
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.IMap as I
import qualified Data.Function as DF
import Data.List (sortBy, partition)
import Data.Maybe (fromMaybe)
import qualified Graphics.Vty as V
import Control.DeepSeq

import Text.Wrap (wrapTextToLines, WrapSettings, defaultWrapSettings)

import Brick.Types
import Brick.Types.Internal
import Brick.Widgets.Border.Style
import Brick.Util (clOffset, clamp)
import Brick.AttrMap
import Brick.Widgets.Internal
import qualified Brick.BorderMap as BM

-- | The class of text types that have widths measured in terminal
-- columns. NEVER use 'length' etc. to measure the length of a string if
-- you need to compute how much screen space it will occupy; always use
-- 'textWidth'.
class TextWidth a where
    textWidth :: a -> Int

instance TextWidth T.Text where
    textWidth :: Text -> Int
textWidth = String -> Int
V.wcswidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

instance (F.Foldable f) => TextWidth (f Char) where
    textWidth :: f Char -> Int
textWidth = String -> Int
V.wcswidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

-- | The class of types that store interface element names.
class Named a n where
    -- | Get the name of the specified value.
    getName :: a -> n

-- | When rendering the specified widget, use the specified border style
-- for any border rendering.
withBorderStyle :: BorderStyle -> Widget n -> Widget n
withBorderStyle :: forall n. BorderStyle -> Widget n -> Widget n
withBorderStyle BorderStyle
bs 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 a b. (a -> b) -> a -> b
$
    forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) BorderStyle
ctxBorderStyleL forall s t a b. ASetter s t a b -> b -> s -> t
.~ BorderStyle
bs) (forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

-- | When rendering the specified widget, create borders that respond
-- dynamically to their neighbors to form seamless connections.
joinBorders :: Widget n -> Widget n
joinBorders :: forall n. Widget n -> Widget n
joinBorders 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 a b. (a -> b) -> a -> b
$
    forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) Bool
ctxDynBordersL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True) (forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

-- | When rendering the specified widget, use static borders. This
-- may be marginally faster, but will introduce a small gap between
-- neighboring orthogonal borders.
--
-- This is the default for backwards compatibility.
separateBorders :: Widget n -> Widget n
separateBorders :: forall n. Widget n -> Widget n
separateBorders 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 a b. (a -> b) -> a -> b
$
    forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) Bool
ctxDynBordersL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False) (forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

-- | After the specified widget has been rendered, freeze its borders. A
-- frozen border will not be affected by neighbors, nor will it affect
-- neighbors. Compared to 'separateBorders', 'freezeBorders' will not
-- affect whether borders connect internally to a widget (whereas
-- 'separateBorders' prevents them from connecting).
--
-- Frozen borders cannot be thawed.
freezeBorders :: Widget n -> Widget n
freezeBorders :: forall n. Widget n -> Widget n
freezeBorders 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 a b. (a -> b) -> a -> b
$ (forall n. Lens' (Result n) (BorderMap DynBorder)
bordersL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a b. BorderMap a -> BorderMap b
BM.clear) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n. Widget n -> RenderM n (Result n)
render Widget n
p

-- | The empty widget.
emptyWidget :: Widget n
emptyWidget :: forall n. Widget n
emptyWidget = forall n. Image -> Widget n
raw Image
V.emptyImage

-- | Add an offset to all cursor locations, visibility requests, and
-- extents in the specified rendering result. This function is critical
-- for maintaining correctness in the rendering results as they are
-- processed successively by box layouts and other wrapping combinators,
-- since calls to this function result in converting from widget-local
-- coordinates to (ultimately) terminal-global ones so they can be
-- used by other combinators. You should call this any time you render
-- something and then translate it or otherwise offset it from its
-- original origin.
addResultOffset :: Location -> Result n -> Result n
addResultOffset :: forall n. Location -> Result n -> Result n
addResultOffset Location
off = forall n. Location -> Result n -> Result n
addCursorOffset Location
off forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      forall n. Location -> Result n -> Result n
addVisibilityOffset Location
off forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      forall n. Location -> Result n -> Result n
addExtentOffset Location
off forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      forall n. Location -> Result n -> Result n
addDynBorderOffset Location
off

addVisibilityOffset :: Location -> Result n -> Result n
addVisibilityOffset :: forall n. Location -> Result n -> Result n
addVisibilityOffset Location
off Result n
r = Result n
r forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) [VisibilityRequest]
visibilityRequestsLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Each s t a b => Traversal s t a b
eachforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' VisibilityRequest Location
vrPositionL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Location
off forall a. Semigroup a => a -> a -> a
<>)

addExtentOffset :: Location -> Result n -> Result n
addExtentOffset :: forall n. Location -> Result n -> Result n
addExtentOffset Location
off Result n
r = Result n
r forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) [Extent n]
extentsLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Each s t a b => Traversal s t a b
each forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\(Extent n
n Location
l DisplayRegion
sz) -> forall n. n -> Location -> DisplayRegion -> Extent n
Extent n
n (Location
off forall a. Semigroup a => a -> a -> a
<> Location
l) DisplayRegion
sz)

addDynBorderOffset :: Location -> Result n -> Result n
addDynBorderOffset :: forall n. Location -> Result n -> Result n
addDynBorderOffset Location
off Result n
r = Result n
r 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 a. Location -> BorderMap a -> BorderMap a
BM.translate Location
off

-- | Render the specified widget and record its rendering extent using
-- the specified name (see also 'lookupExtent').
--
-- This function is the counterpart to 'makeVisible'; any visibility
-- requests made with 'makeVisible' must have a corresponding
-- 'reportExtent' in order to work. The 'clickable' function will also
-- work for this purpose to tell the renderer about the clickable
-- region.
reportExtent :: (Ord n) => n -> Widget n -> Widget n
reportExtent :: forall n. Ord n => n -> Widget n -> Widget n
reportExtent n
n 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 a b. (a -> b) -> a -> b
$ do
        Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
p
        let ext :: Extent n
ext = forall n. n -> Location -> DisplayRegion -> Extent n
Extent n
n (DisplayRegion -> Location
Location (Int
0, Int
0)) DisplayRegion
sz
            sz :: DisplayRegion
sz = ( Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageWidth
                 , Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageHeight
                 )
        -- If the reported extent also has a visibility request
        -- from EventM via makeVisible, add a visibility request to
        -- the render state so this gets scrolled into view by any
        -- containing viewport.
        Set n
vReqs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall n. Lens' (RenderState n) (Set n)
requestedVisibleNames_L
        let addVisReq :: Result n -> Result n
addVisReq = if DisplayRegion
szforall s a. s -> Getting a s a -> a
^.forall s t a b. Field1 s t a b => Lens s t a b
_1 forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& DisplayRegion
szforall s a. s -> Getting a s a -> a
^.forall s t a b. Field2 s t a b => Lens s t a b
_2 forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& n
n forall a. Ord a => a -> Set a -> Bool
`S.member` Set n
vReqs
                        then forall n. Lens' (Result n) [VisibilityRequest]
visibilityRequestsL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Location -> DisplayRegion -> VisibilityRequest
VR (DisplayRegion -> Location
Location (Int
0, Int
0)) DisplayRegion
sz forall a. a -> [a] -> [a]
:)
                        else forall a. a -> a
id
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Result n -> Result n
addVisReq forall a b. (a -> b) -> a -> b
$ Result n
result 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
%~ (Extent n
extforall a. a -> [a] -> [a]
:)

-- | Request mouse click events on the specified widget.
--
-- Regions used with 'clickable' can be scrolled into view with
-- 'makeVisible'.
clickable :: (Ord n) => n -> Widget n -> Widget n
clickable :: forall n. Ord n => n -> Widget n -> Widget n
clickable n
n 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 a b. (a -> b) -> a -> b
$ do
        forall n. Lens' (RenderState n) [n]
clickableNamesL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (n
nforall a. a -> [a] -> [a]
:)
        forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Ord n => n -> Widget n -> Widget n
reportExtent n
n Widget n
p

addCursorOffset :: Location -> Result n -> Result n
addCursorOffset :: forall n. Location -> Result n -> Result n
addCursorOffset Location
off Result n
r =
    let onlyVisible :: [CursorLocation n] -> [CursorLocation n]
onlyVisible = forall a. (a -> Bool) -> [a] -> [a]
filter forall {s}. TerminalLocation s => s -> Bool
isVisible
        isVisible :: s -> Bool
isVisible s
l = s
lforall s a. s -> Getting a s a -> a
^.forall a. TerminalLocation a => Lens' a Int
locationColumnL forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& s
lforall s a. s -> Getting a s a -> a
^.forall a. TerminalLocation a => Lens' a Int
locationRowL forall a. Ord a => a -> a -> Bool
>= Int
0
    in Result n
r 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
%~ (\[CursorLocation n]
cs -> [CursorLocation n] -> [CursorLocation n]
onlyVisible forall a b. (a -> b) -> a -> b
$ (forall n. CursorLocation n -> Location -> CursorLocation n
`clOffset` Location
off) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CursorLocation n]
cs)

unrestricted :: Int
unrestricted :: Int
unrestricted = Int
100000

-- | Make a widget from a string, but wrap the words in the input's
-- lines at the available width using the default wrapping settings. The
-- input string should not contain escape sequences or carriage returns.
--
-- Unlike 'str', this is greedy horizontally.
strWrap :: String -> Widget n
strWrap :: forall n. String -> Widget n
strWrap = forall n. WrapSettings -> String -> Widget n
strWrapWith WrapSettings
defaultWrapSettings

-- | Make a widget from a string, but wrap the words in the input's
-- lines at the available width using the specified wrapping settings.
-- The input string should not contain escape sequences or carriage
-- returns.
--
-- Unlike 'str', this is greedy horizontally.
strWrapWith :: WrapSettings -> String -> Widget n
strWrapWith :: forall n. WrapSettings -> String -> Widget n
strWrapWith WrapSettings
settings String
t = forall n. WrapSettings -> Text -> Widget n
txtWrapWith WrapSettings
settings forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
t

-- | Make a widget from text, but wrap the words in the input's lines at
-- the available width using the default wrapping settings. The input
-- text should not contain escape sequences or carriage returns.
--
-- Unlike 'txt', this is greedy horizontally.
txtWrap :: T.Text -> Widget n
txtWrap :: forall n. Text -> Widget n
txtWrap = forall n. WrapSettings -> Text -> Widget n
txtWrapWith WrapSettings
defaultWrapSettings

-- | Make a widget from text, but wrap the words in the input's lines at
-- the available width using the specified wrapping settings. The input
-- text should not contain escape sequences or carriage returns.
--
-- Unlike 'txt', this is greedy horizontally.
txtWrapWith :: WrapSettings -> T.Text -> Widget n
txtWrapWith :: forall n. WrapSettings -> Text -> Widget n
txtWrapWith WrapSettings
settings Text
s =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed forall a b. (a -> b) -> a -> b
$ do
      Context n
c <- forall n. RenderM n (Context n)
getContext
      let theLines :: [Text]
theLines = Text -> Text
fixEmpty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WrapSettings -> Int -> Text -> [Text]
wrapTextToLines WrapSettings
settings (Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL) Text
s
          fixEmpty :: Text -> Text
fixEmpty Text
l | Text -> Bool
T.null Text
l = Text
" "
                     | Bool
otherwise = Text
l
      case forall a. NFData a => a -> a
force [Text]
theLines of
          [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall n. Result n
emptyResult
          [Text]
multiple ->
              let maxLength :: Int
maxLength = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a. TextWidth a => a -> Int
textWidth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
multiple
                  padding :: Image
padding = forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill (Context n
cforall s a. s -> Getting a s a -> a
^.forall r n. Getting r (Context n) Attr
attrL) Char
' ' (Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL forall a. Num a => a -> a -> a
- Int
maxLength) (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Image]
lineImgs)
                  lineImgs :: [Image]
lineImgs = Text -> Image
lineImg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
multiple
                  lineImg :: Text -> Image
lineImg Text
lStr = Attr -> Text -> Image
V.text' (Context n
cforall s a. s -> Getting a s a -> a
^.forall r n. Getting r (Context n) Attr
attrL)
                                   (Text
lStr forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
maxLength forall a. Num a => a -> a -> a
- forall a. TextWidth a => a -> Int
textWidth Text
lStr) Text
" ")
              in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. Result n
emptyResult forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) Image
imageL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ([Image] -> Image
V.horizCat [[Image] -> Image
V.vertCat [Image]
lineImgs, Image
padding])

-- | Build a widget from a 'String'. Behaves the same as 'txt' when the
-- input contains multiple lines.
--
-- The input string must not contain tab characters. If it does,
-- interface corruption will result since the terminal will likely
-- render it as taking up more than a single column. The caller should
-- replace tabs with the appropriate number of spaces as desired. The
-- input string should not contain escape sequences or carriage returns.
str :: String -> Widget n
str :: forall n. String -> Widget n
str = forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Build a widget from a 'T.Text' value. Breaks newlines up and
-- space-pads short lines out to the length of the longest line.
--
-- The input string must not contain tab characters. If it does,
-- interface corruption will result since the terminal will likely
-- render it as taking up more than a single column. The caller should
-- replace tabs with the appropriate number of spaces as desired. The
-- input text should not contain escape sequences or carriage returns.
txt :: T.Text -> Widget n
txt :: forall n. Text -> Widget n
txt Text
s =
    -- Althoguh vty Image uses lazy Text internally, using lazy text at this
    -- level may not be an improvement.  Indeed it can be much worse, due
    -- the overhead of lazy Text being significant compared to the typically
    -- short string content used to compose UIs.
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ do
        Context n
c <- forall n. RenderM n (Context n)
getContext
        let theLines :: [Text]
theLines = Text -> Text
fixEmpty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text] -> [Text]
dropUnused forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines) Text
s
            fixEmpty :: Text -> Text
fixEmpty Text
l = if Text -> Bool
T.null Text
l then Char -> Text
T.singleton Char
' ' else Text
l
            dropUnused :: [Text] -> [Text]
dropUnused [Text]
l = Int -> Text -> Text
takeColumnsT (forall n. Context n -> Int
availWidth Context n
c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> [a] -> [a]
take (forall n. Context n -> Int
availHeight Context n
c) [Text]
l
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case [Text]
theLines of
            [] -> forall n. Result n
emptyResult
            [Text
one] -> forall n. Result n
emptyResult forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) Image
imageL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Attr -> Text -> Image
V.text' (Context n
cforall s a. s -> Getting a s a -> a
^.forall r n. Getting r (Context n) Attr
attrL) Text
one)
            [Text]
multiple ->
                let maxLength :: Int
maxLength = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ Text -> Int
V.safeWctwidth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
multiple
                    lineImgs :: [Image]
lineImgs = Text -> Image
lineImg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
multiple
                    lineImg :: Text -> Image
lineImg Text
lStr = Attr -> Text -> Image
V.text' (Context n
cforall s a. s -> Getting a s a -> a
^.forall r n. Getting r (Context n) Attr
attrL)
                        (Text
lStr forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
maxLength forall a. Num a => a -> a -> a
- Text -> Int
V.safeWctwidth Text
lStr) (Char -> Text
T.singleton Char
' '))
                in forall n. Result n
emptyResult forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) Image
imageL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ([Image] -> Image
V.vertCat [Image]
lineImgs)

-- | Take up to the given width, having regard to character width.
takeColumnsT :: Int -> T.Text -> T.Text
takeColumnsT :: Int -> Text -> Text
takeColumnsT Int
w Text
s = Int -> Text -> Text
T.take (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' DisplayRegion -> Char -> DisplayRegion
f (Int
0,Int
0) Text
s) Text
s
    where
    -- The accumulator value is (index in Text value, width of Text so far)
    f :: DisplayRegion -> Char -> DisplayRegion
f (Int
i,Int
z) Char
c
        -- Width was previously exceeded; continue with same values.
        | Int
z forall a. Ord a => a -> a -> Bool
< Int
0                   = (Int
i, Int
z)
        -- Width exceeded.  Signal this with z = -1.  Index will no longer be
        -- incremented.
        --
        -- Why not short circuit (e.g. using foldlM construction)?
        -- Because in the typical case, the Either allocation costs exceed
        -- any benefits.  The pathological case, string length >> width, is
        -- probably rare.
        | Int
z forall a. Num a => a -> a -> a
+ Char -> Int
V.safeWcwidth Char
c forall a. Ord a => a -> a -> Bool
> Int
w = (Int
i, -Int
1)
        -- Width not yet exceeded.  Increment index and add character width.
        | Bool
otherwise               = (Int
i forall a. Num a => a -> a -> a
+ Int
1, Int
z forall a. Num a => a -> a -> a
+ Char -> Int
V.safeWcwidth Char
c)

-- | Hyperlink the given widget to the specified URL. Not all terminal
-- emulators support this. In those that don't, this should have no
-- discernible effect.
hyperlink :: T.Text -> Widget n -> Widget n
hyperlink :: forall n. Text -> Widget n -> Widget n
hyperlink Text
url 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 a b. (a -> b) -> a -> b
$ do
        Context n
c <- forall n. RenderM n (Context n)
getContext
        let attr :: Attr
attr = (Context n
cforall s a. s -> Getting a s a -> a
^.forall r n. Getting r (Context n) Attr
attrL) Attr -> Text -> Attr
`V.withURL` Text
url
        forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) AttrMap
ctxAttrMapL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Attr -> AttrMap -> AttrMap
setDefaultAttr Attr
attr) (forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

-- | The type of padding.
data Padding = Pad Int
             -- ^ Pad by the specified number of rows or columns.
             | Max
             -- ^ Pad up to the number of available rows or columns.

-- | Pad the specified widget on the left. If max padding is used, this
-- grows greedily horizontally; otherwise it defers to the padded
-- widget.
padLeft :: Padding -> Widget n -> Widget n
padLeft :: forall n. Padding -> Widget n -> Widget n
padLeft Padding
padding Widget n
p =
    let (Widget n -> Widget n
f, Size
sz) = case Padding
padding of
          Padding
Max -> (forall a. a -> a
id, Size
Greedy)
          Pad Int
i -> (forall n. Int -> Widget n -> Widget n
hLimit Int
i, forall n. Widget n -> Size
hSize Widget n
p)
    in forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
sz (forall n. Widget n -> Size
vSize Widget n
p) forall a b. (a -> b) -> a -> b
$ do
        Context n
c <- forall n. RenderM n (Context n)
getContext
        let lim :: Int
lim = case Padding
padding of
              Padding
Max -> Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL
              Pad Int
i -> Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL forall a. Num a => a -> a -> a
- Int
i
        Result n
result <- forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit Int
lim Widget n
p
        forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ (Widget n -> Widget n
f forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit (Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageHeight) forall a b. (a -> b) -> a -> b
$ forall n. Char -> Widget n
fill Char
' ') forall n. Widget n -> Widget n -> Widget n
<+>
                 (forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result)

-- | Pad the specified widget on the right. If max padding is used,
-- this grows greedily horizontally; otherwise it defers to the padded
-- widget.
padRight :: Padding -> Widget n -> Widget n
padRight :: forall n. Padding -> Widget n -> Widget n
padRight Padding
padding Widget n
p =
    let (Widget n -> Widget n
f, Size
sz) = case Padding
padding of
          Padding
Max -> (forall a. a -> a
id, Size
Greedy)
          Pad Int
i -> (forall n. Int -> Widget n -> Widget n
hLimit Int
i, forall n. Widget n -> Size
hSize Widget n
p)
    in forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
sz (forall n. Widget n -> Size
vSize Widget n
p) forall a b. (a -> b) -> a -> b
$ do
        Context n
c <- forall n. RenderM n (Context n)
getContext
        let lim :: Int
lim = case Padding
padding of
              Padding
Max -> Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL
              Pad Int
i -> Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL forall a. Num a => a -> a -> a
- Int
i
        Result n
result <- forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit Int
lim Widget n
p
        forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ (forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result) forall n. Widget n -> Widget n -> Widget n
<+>
                 (Widget n -> Widget n
f forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit (Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageHeight) forall a b. (a -> b) -> a -> b
$ forall n. Char -> Widget n
fill Char
' ')

-- | Pad the specified widget on the top. If max padding is used, this
-- grows greedily vertically; otherwise it defers to the padded widget.
padTop :: Padding -> Widget n -> Widget n
padTop :: forall n. Padding -> Widget n -> Widget n
padTop Padding
padding Widget n
p =
    let (Widget n -> Widget n
f, Size
sz) = case Padding
padding of
          Padding
Max -> (forall a. a -> a
id, Size
Greedy)
          Pad Int
i -> (forall n. Int -> Widget n -> Widget n
vLimit Int
i, forall n. Widget n -> Size
vSize Widget n
p)
    in forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
p) Size
sz forall a b. (a -> b) -> a -> b
$ do
        Context n
c <- forall n. RenderM n (Context n)
getContext
        let lim :: Int
lim = case Padding
padding of
              Padding
Max -> Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL
              Pad Int
i -> Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL forall a. Num a => a -> a -> a
- Int
i
        Result n
result <- forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit Int
lim Widget n
p
        forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ (Widget n -> Widget n
f forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit (Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageWidth) forall a b. (a -> b) -> a -> b
$ forall n. Char -> Widget n
fill Char
' ') forall n. Widget n -> Widget n -> Widget n
<=>
                 (forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result)

-- | Pad the specified widget on the bottom. If max padding is used,
-- this grows greedily vertically; otherwise it defers to the padded
-- widget.
padBottom :: Padding -> Widget n -> Widget n
padBottom :: forall n. Padding -> Widget n -> Widget n
padBottom Padding
padding Widget n
p =
    let (Widget n -> Widget n
f, Size
sz) = case Padding
padding of
          Padding
Max -> (forall a. a -> a
id, Size
Greedy)
          Pad Int
i -> (forall n. Int -> Widget n -> Widget n
vLimit Int
i, forall n. Widget n -> Size
vSize Widget n
p)
    in forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
p) Size
sz forall a b. (a -> b) -> a -> b
$ do
        Context n
c <- forall n. RenderM n (Context n)
getContext
        let lim :: Int
lim = case Padding
padding of
              Padding
Max -> Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL
              Pad Int
i -> Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL forall a. Num a => a -> a -> a
- Int
i
        Result n
result <- forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit Int
lim Widget n
p
        forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ (forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result) forall n. Widget n -> Widget n -> Widget n
<=>
                 (Widget n -> Widget n
f forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit (Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageWidth) forall a b. (a -> b) -> a -> b
$ forall n. Char -> Widget n
fill Char
' ')

-- | Pad a widget on the left and right. Defers to the padded widget for
-- growth policy.
padLeftRight :: Int -> Widget n -> Widget n
padLeftRight :: forall n. Int -> Widget n -> Widget n
padLeftRight Int
c Widget n
w = forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
c) forall a b. (a -> b) -> a -> b
$ forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
c) Widget n
w

-- | Pad a widget on the top and bottom. Defers to the padded widget for
-- growth policy.
padTopBottom :: Int -> Widget n -> Widget n
padTopBottom :: forall n. Int -> Widget n -> Widget n
padTopBottom Int
r Widget n
w = forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
r) forall a b. (a -> b) -> a -> b
$ forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
r) Widget n
w

-- | Pad a widget on all sides. Defers to the padded widget for growth
-- policy.
padAll :: Int -> Widget n -> Widget n
padAll :: forall n. Int -> Widget n -> Widget n
padAll Int
v Widget n
w = forall n. Int -> Widget n -> Widget n
padLeftRight Int
v forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
padTopBottom Int
v Widget n
w

-- | Fill all available space with the specified character. Grows both
-- horizontally and vertically.
fill :: Char -> Widget n
fill :: forall n. Char -> Widget n
fill Char
ch =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy forall a b. (a -> b) -> a -> b
$ 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
$ forall n. Result n
emptyResult forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) Image
imageL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill (Context n
cforall s a. s -> Getting a s a -> a
^.forall r n. Getting r (Context n) Attr
attrL) Char
ch (Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL) (Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL))

-- | Vertical box layout: put the specified widgets one above the other
-- in the specified order (uppermost first). Defers growth policies to
-- the growth policies of the contained widgets (if any are greedy, so
-- is the box).
--
-- Allocates space to 'Fixed' elements first and 'Greedy' elements
-- second. For example, if a 'vBox' contains three elements @A@, @B@,
-- and @C@, and if @A@ and @B@ are 'Fixed', then 'vBox' first renders
-- @A@ and @B@. Suppose those two take up 10 rows total, and the 'vBox'
-- was given 50 rows. This means 'vBox' then allocates the remaining
-- 40 rows to @C@. If, on the other hand, @A@ and @B@ take up 50 rows
-- together, @C@ will not be rendered at all.
--
-- If all elements are 'Greedy', 'vBox' allocates the available height
-- evenly among the elements. So, for example, if a 'vBox' is rendered
-- in 90 rows and has three 'Greedy' elements, each element will be
-- allocated 30 rows.
{-# NOINLINE vBox #-}
vBox :: [Widget n] -> Widget n
vBox :: forall n. [Widget n] -> Widget n
vBox [] = forall n. Widget n
emptyWidget
vBox [Widget n
a] = Widget n
a
vBox [Widget n]
pairs = forall n. BoxRenderer n -> [Widget n] -> Widget n
renderBox forall n. BoxRenderer n
vBoxRenderer [Widget n]
pairs

-- | Horizontal box layout: put the specified widgets next to each other
-- in the specified order (leftmost first). Defers growth policies to
-- the growth policies of the contained widgets (if any are greedy, so
-- is the box).
--
-- Allocates space to 'Fixed' elements first and 'Greedy' elements
-- second. For example, if an 'hBox' contains three elements @A@, @B@,
-- and @C@, and if @A@ and @B@ are 'Fixed', then 'hBox' first renders
-- @A@ and @B@. Suppose those two take up 10 columns total, and the
-- 'hBox' was given 50 columns. This means 'hBox' then allocates the
-- remaining 40 columns to @C@. If, on the other hand, @A@ and @B@ take
-- up 50 columns together, @C@ will not be rendered at all.
--
-- If all elements are 'Greedy', 'hBox' allocates the available width
-- evenly among the elements. So, for example, if an 'hBox' is rendered
-- in 90 columns and has three 'Greedy' elements, each element will be
-- allocated 30 columns.
{-# NOINLINE hBox #-}
hBox :: [Widget n] -> Widget n
hBox :: forall n. [Widget n] -> Widget n
hBox [] = forall n. Widget n
emptyWidget
hBox [Widget n
a] = Widget n
a
hBox [Widget n]
pairs = forall n. BoxRenderer n -> [Widget n] -> Widget n
renderBox forall n. BoxRenderer n
hBoxRenderer [Widget n]
pairs

-- | The process of rendering widgets in a box layout is exactly the
-- same except for the dimension under consideration (width vs. height),
-- in which case all of the same operations that consider one dimension
-- in the layout algorithm need to be switched to consider the other.
-- Because of this we fill a BoxRenderer with all of the functions
-- needed to consider the "primary" dimension (e.g. vertical if the
-- box layout is vertical) as well as the "secondary" dimension (e.g.
-- horizontal if the box layout is vertical). Doing this permits us to
-- have one implementation for box layout and parameterizing on the
-- orientation of all of the operations.
data BoxRenderer n =
    BoxRenderer { forall n. BoxRenderer n -> Lens' (Context n) Int
contextPrimary :: Lens' (Context n) Int
                , forall n. BoxRenderer n -> Lens' (Context n) Int
contextSecondary :: Lens' (Context n) Int
                , forall n. BoxRenderer n -> Image -> Int
imagePrimary :: V.Image -> Int
                , forall n. BoxRenderer n -> Image -> Int
imageSecondary :: V.Image -> Int
                , forall n. BoxRenderer n -> Int -> Widget n -> Widget n
limitPrimary :: Int -> Widget n -> Widget n
                , forall n. BoxRenderer n -> Widget n -> Size
primaryWidgetSize :: Widget n -> Size
                , forall n. BoxRenderer n -> [Image] -> Image
concatenatePrimary :: [V.Image] -> V.Image
                , forall n. BoxRenderer n -> [Image] -> Image
concatenateSecondary :: [V.Image] -> V.Image
                , forall n. BoxRenderer n -> Int -> Location
locationFromOffset :: Int -> Location
                , forall n. BoxRenderer n -> Int -> Image -> Attr -> Image
padImageSecondary :: Int -> V.Image -> V.Attr -> V.Image
                , forall n. BoxRenderer n -> forall a. Lens' (Edges a) a
loPrimary :: forall a. Lens' (Edges a) a -- lo: towards smaller coordinates in that dimension
                , forall n. BoxRenderer n -> forall a. Lens' (Edges a) a
hiPrimary :: forall a. Lens' (Edges a) a -- hi: towards larger  coordinates in that dimension
                , forall n. BoxRenderer n -> forall a. Lens' (Edges a) a
loSecondary :: forall a. Lens' (Edges a) a
                , forall n. BoxRenderer n -> forall a. Lens' (Edges a) a
hiSecondary :: forall a. Lens' (Edges a) a
                , forall n. BoxRenderer n -> Int -> Int -> Location
locationFromPrimarySecondary :: Int -> Int -> Location
                , forall n. BoxRenderer n -> Int -> Image -> Image
splitLoPrimary :: Int -> V.Image -> V.Image
                , forall n. BoxRenderer n -> Int -> Image -> Image
splitHiPrimary :: Int -> V.Image -> V.Image
                , forall n. BoxRenderer n -> Int -> Image -> Image
splitLoSecondary :: Int -> V.Image -> V.Image
                , forall n. BoxRenderer n -> Int -> Image -> Image
splitHiSecondary :: Int -> V.Image -> V.Image
                , forall n.
BoxRenderer n -> Int -> BorderMap DynBorder -> IMap DynBorder
lookupPrimary :: Int -> BM.BorderMap DynBorder -> I.IMap DynBorder
                , forall n.
BoxRenderer n
-> Location
-> Run DynBorder
-> BorderMap DynBorder
-> BorderMap DynBorder
insertSecondary :: Location -> I.Run DynBorder -> BM.BorderMap DynBorder -> BM.BorderMap DynBorder
                }

vBoxRenderer :: BoxRenderer n
vBoxRenderer :: forall n. BoxRenderer n
vBoxRenderer =
    BoxRenderer { contextPrimary :: Lens' (Context n) Int
contextPrimary = forall n. Lens' (Context n) Int
availHeightL
                , contextSecondary :: Lens' (Context n) Int
contextSecondary = forall n. Lens' (Context n) Int
availWidthL
                , imagePrimary :: Image -> Int
imagePrimary = Image -> Int
V.imageHeight
                , imageSecondary :: Image -> Int
imageSecondary = Image -> Int
V.imageWidth
                , limitPrimary :: Int -> Widget n -> Widget n
limitPrimary = forall n. Int -> Widget n -> Widget n
vLimit
                , primaryWidgetSize :: Widget n -> Size
primaryWidgetSize = forall n. Widget n -> Size
vSize
                , concatenatePrimary :: [Image] -> Image
concatenatePrimary = [Image] -> Image
V.vertCat
                , concatenateSecondary :: [Image] -> Image
concatenateSecondary = [Image] -> Image
V.horizCat
                , locationFromOffset :: Int -> Location
locationFromOffset = DisplayRegion -> Location
Location forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0 ,)
                , padImageSecondary :: Int -> Image -> Attr -> Image
padImageSecondary = \Int
amt Image
img Attr
a ->
                    let p :: Image
p = forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill Attr
a Char
' ' Int
amt (Image -> Int
V.imageHeight Image
img)
                    in [Image] -> Image
V.horizCat [Image
img, Image
p]
                , loPrimary :: forall a. Lens' (Edges a) a
loPrimary = forall a. Lens' (Edges a) a
eTopL
                , hiPrimary :: forall a. Lens' (Edges a) a
hiPrimary = forall a. Lens' (Edges a) a
eBottomL
                , loSecondary :: forall a. Lens' (Edges a) a
loSecondary = forall a. Lens' (Edges a) a
eLeftL
                , hiSecondary :: forall a. Lens' (Edges a) a
hiSecondary = forall a. Lens' (Edges a) a
eRightL
                , locationFromPrimarySecondary :: Int -> Int -> Location
locationFromPrimarySecondary = \Int
r Int
c -> DisplayRegion -> Location
Location (Int
c, Int
r)
                , splitLoPrimary :: Int -> Image -> Image
splitLoPrimary = Int -> Image -> Image
V.cropBottom
                , splitHiPrimary :: Int -> Image -> Image
splitHiPrimary = \Int
n Image
img -> Int -> Image -> Image
V.cropTop (Image -> Int
V.imageHeight Image
imgforall a. Num a => a -> a -> a
-Int
n) Image
img
                , splitLoSecondary :: Int -> Image -> Image
splitLoSecondary = Int -> Image -> Image
V.cropRight
                , splitHiSecondary :: Int -> Image -> Image
splitHiSecondary = \Int
n Image
img -> Int -> Image -> Image
V.cropLeft (Image -> Int
V.imageWidth Image
imgforall a. Num a => a -> a -> a
-Int
n) Image
img
                , lookupPrimary :: Int -> BorderMap DynBorder -> IMap DynBorder
lookupPrimary = forall a. Int -> BorderMap a -> IMap a
BM.lookupRow
                , insertSecondary :: Location
-> Run DynBorder -> BorderMap DynBorder -> BorderMap DynBorder
insertSecondary = forall a. Location -> Run a -> BorderMap a -> BorderMap a
BM.insertH
                }

hBoxRenderer :: BoxRenderer n
hBoxRenderer :: forall n. BoxRenderer n
hBoxRenderer =
    BoxRenderer { contextPrimary :: Lens' (Context n) Int
contextPrimary = forall n. Lens' (Context n) Int
availWidthL
                , contextSecondary :: Lens' (Context n) Int
contextSecondary = forall n. Lens' (Context n) Int
availHeightL
                , imagePrimary :: Image -> Int
imagePrimary = Image -> Int
V.imageWidth
                , imageSecondary :: Image -> Int
imageSecondary = Image -> Int
V.imageHeight
                , limitPrimary :: Int -> Widget n -> Widget n
limitPrimary = forall n. Int -> Widget n -> Widget n
hLimit
                , primaryWidgetSize :: Widget n -> Size
primaryWidgetSize = forall n. Widget n -> Size
hSize
                , concatenatePrimary :: [Image] -> Image
concatenatePrimary = [Image] -> Image
V.horizCat
                , concatenateSecondary :: [Image] -> Image
concatenateSecondary = [Image] -> Image
V.vertCat
                , locationFromOffset :: Int -> Location
locationFromOffset = DisplayRegion -> Location
Location forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, Int
0)
                , padImageSecondary :: Int -> Image -> Attr -> Image
padImageSecondary = \Int
amt Image
img Attr
a ->
                    let p :: Image
p = forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill Attr
a Char
' ' (Image -> Int
V.imageWidth Image
img) Int
amt
                    in [Image] -> Image
V.vertCat [Image
img, Image
p]
                , loPrimary :: forall a. Lens' (Edges a) a
loPrimary = forall a. Lens' (Edges a) a
eLeftL
                , hiPrimary :: forall a. Lens' (Edges a) a
hiPrimary = forall a. Lens' (Edges a) a
eRightL
                , loSecondary :: forall a. Lens' (Edges a) a
loSecondary = forall a. Lens' (Edges a) a
eTopL
                , hiSecondary :: forall a. Lens' (Edges a) a
hiSecondary = forall a. Lens' (Edges a) a
eBottomL
                , locationFromPrimarySecondary :: Int -> Int -> Location
locationFromPrimarySecondary = \Int
c Int
r -> DisplayRegion -> Location
Location (Int
c, Int
r)
                , splitLoPrimary :: Int -> Image -> Image
splitLoPrimary = Int -> Image -> Image
V.cropRight
                , splitHiPrimary :: Int -> Image -> Image
splitHiPrimary = \Int
n Image
img -> Int -> Image -> Image
V.cropLeft (Image -> Int
V.imageWidth Image
imgforall a. Num a => a -> a -> a
-Int
n) Image
img
                , splitLoSecondary :: Int -> Image -> Image
splitLoSecondary = Int -> Image -> Image
V.cropBottom
                , splitHiSecondary :: Int -> Image -> Image
splitHiSecondary = \Int
n Image
img -> Int -> Image -> Image
V.cropTop (Image -> Int
V.imageHeight Image
imgforall a. Num a => a -> a -> a
-Int
n) Image
img
                , lookupPrimary :: Int -> BorderMap DynBorder -> IMap DynBorder
lookupPrimary = forall a. Int -> BorderMap a -> IMap a
BM.lookupCol
                , insertSecondary :: Location
-> Run DynBorder -> BorderMap DynBorder -> BorderMap DynBorder
insertSecondary = forall a. Location -> Run a -> BorderMap a -> BorderMap a
BM.insertV
                }

-- | Render a series of widgets in a box layout in the order given.
--
-- The growth policy of a box layout is the most unrestricted of the
-- growth policies of the widgets it contains, so to determine the hSize
-- and vSize of the box we just take the maximum (using the Ord instance
-- for Size) of all of the widgets to be rendered in the box.
--
-- Then the box layout algorithm proceeds as follows. We'll use
-- the vertical case to concretely describe the algorithm, but the
-- horizontal case can be envisioned just by exchanging all
-- "vertical"/"horizontal" and "rows"/"columns", etc., in the
-- description.
--
-- The growth policies of the child widgets determine the order in which
-- they are rendered, i.e., the order in which space in the box is
-- allocated to widgets as the algorithm proceeds. This is because order
-- matters: if we render greedy widgets first, there will be no space
-- left for non-greedy ones.
--
-- So we render all widgets with size 'Fixed' in the vertical dimension
-- first. Each is rendered with as much room as the overall box has, but
-- we assume that they will not be greedy and use it all. If they do,
-- maybe it's because the terminal is small and there just isn't enough
-- room to render everything.
--
-- Then the remaining height is distributed evenly amongst all remaining
-- (greedy) widgets and they are rendered in sub-boxes that are as high
-- as this even slice of rows and as wide as the box is permitted to be.
-- We only do this step at all if rendering the non-greedy widgets left
-- us any space, i.e., if there were any rows left.
--
-- After rendering the non-greedy and then greedy widgets, their images
-- are sorted so that they are stored in the order the original widgets
-- were given. All cursor locations and visibility requests in each
-- sub-widget are translated according to the position of the sub-widget
-- in the box.
--
-- All images are padded to be as wide as the widest sub-widget to
-- prevent attribute over-runs. Without this step the attribute used by
-- a sub-widget may continue on in an undesirable fashion until it hits
-- something with a different attribute. To prevent this and to behave
-- in the least surprising way, we pad the image on the right with
-- whitespace using the context's current attribute.
--
-- Finally, the padded images are concatenated together vertically and
-- returned along with the translated cursor positions and visibility
-- requests.
renderBox :: BoxRenderer n -> [Widget n] -> Widget n
renderBox :: forall n. BoxRenderer n -> [Widget n] -> Widget n
renderBox BoxRenderer n
br [Widget n]
ws =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Size
hSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Widget n]
ws) (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Size
vSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Widget n]
ws) forall a b. (a -> b) -> a -> b
$ do
      Context n
c <- forall n. RenderM n (Context n)
getContext

      let pairsIndexed :: [(Int, Widget n)]
pairsIndexed = forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
0::Int)..] [Widget n]
ws
          ([(Int, Widget n)]
his, [(Int, Widget n)]
lows) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(Int, Widget n)
p -> (forall n. BoxRenderer n -> Widget n -> Size
primaryWidgetSize BoxRenderer n
br forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (Int, Widget n)
p) forall a. Eq a => a -> a -> Bool
== Size
Fixed)
                        [(Int, Widget n)]
pairsIndexed

          renderHi :: Widget n
-> StateT
     Int (ReaderT (Context n) (State (RenderState n))) (Result n)
renderHi Widget n
prim = do
            Int
remainingPrimary <- forall s (m :: * -> *). MonadState s m => m s
get
            Result n
result <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. BoxRenderer n -> Int -> Widget n -> Widget n
limitPrimary BoxRenderer n
br Int
remainingPrimary Widget n
prim
            Result n
result forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$! Int
remainingPrimary forall a. Num a => a -> a -> a
- (Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageLforall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall s a. (s -> a) -> SimpleGetter s a
to forall a b. (a -> b) -> a -> b
$ forall n. BoxRenderer n -> Image -> Int
imagePrimary BoxRenderer n
br)))

      ([(Int, Result n)]
renderedHis, Int
remainingPrimary) <-
        forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Widget n
-> StateT
     Int (ReaderT (Context n) (State (RenderState n))) (Result n)
renderHi) [(Int, Widget n)]
his) (Context n
c forall s a. s -> Getting a s a -> a
^. forall n. BoxRenderer n -> Lens' (Context n) Int
contextPrimary BoxRenderer n
br)

      [(Int, Result n)]
renderedLows <- case [(Int, Widget n)]
lows of
          [] -> forall (m :: * -> *) a. Monad m => a -> m a
return []
          [(Int, Widget n)]
ls -> do
              let primaryPerLow :: Int
primaryPerLow = Int
remainingPrimary forall a. Integral a => a -> a -> a
`div` forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Widget n)]
ls
                  rest :: Int
rest = Int
remainingPrimary forall a. Num a => a -> a -> a
- (Int
primaryPerLow forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Widget n)]
ls)
                  primaries :: [Int]
primaries = forall a. Int -> a -> [a]
replicate Int
rest (Int
primaryPerLow forall a. Num a => a -> a -> a
+ Int
1) forall a. Semigroup a => a -> a -> a
<>
                              forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Widget n)]
ls forall a. Num a => a -> a -> a
- Int
rest) Int
primaryPerLow

              let renderLow :: ((Int, Widget n), Int)
-> ReaderT (Context n) (State (RenderState n)) (Int, Result n)
renderLow ((Int
i, Widget n
prim), Int
pri) = (Int
i,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n. Widget n -> RenderM n (Result n)
render (forall n. BoxRenderer n -> Int -> Widget n -> Widget n
limitPrimary BoxRenderer n
br Int
pri Widget n
prim)

              if Int
remainingPrimary forall a. Ord a => a -> a -> Bool
> Int
0 then forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Int, Widget n), Int)
-> ReaderT (Context n) (State (RenderState n)) (Int, Result n)
renderLow (forall a b. [a] -> [b] -> [(a, b)]
zip [(Int, Widget n)]
ls [Int]
primaries) else forall (m :: * -> *) a. Monad m => a -> m a
return []

      let rendered :: [(Int, Result n)]
rendered = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`DF.on` forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ [(Int, Result n)]
renderedHis forall a. [a] -> [a] -> [a]
++ [(Int, Result n)]
renderedLows
          allResults :: [Result n]
allResults = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Result n)]
rendered
          allImages :: [Image]
allImages = (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]
allResults
          allTranslatedResults :: [Result n]
allTranslatedResults = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState Int
0 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Result n]
allResults forall a b. (a -> b) -> a -> b
$ \Result n
result -> do
              Int
offPrimary <- forall s (m :: * -> *). MonadState s m => m s
get
              forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ Int
offPrimary forall a. Num a => a -> a -> a
+ (Result n
result forall s a. s -> Getting a s a -> a
^. forall n. Lens' (Result n) Image
imageL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. (s -> a) -> SimpleGetter s a
to (forall n. BoxRenderer n -> Image -> Int
imagePrimary BoxRenderer n
br))
              forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall n. Location -> Result n -> Result n
addResultOffset (forall n. BoxRenderer n -> Int -> Location
locationFromOffset BoxRenderer n
br Int
offPrimary) Result n
result
          -- Determine the secondary dimension value to pad to. In a
          -- vertical box we want all images to be the same width to
          -- avoid attribute over-runs or blank spaces with the wrong
          -- attribute. In a horizontal box we want all images to have
          -- the same height for the same reason.
          maxSecondary :: Int
maxSecondary = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall n. BoxRenderer n -> Image -> Int
imageSecondary BoxRenderer n
br forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Image]
allImages
          padImage :: Image -> Image
padImage Image
img = forall n. BoxRenderer n -> Int -> Image -> Attr -> Image
padImageSecondary BoxRenderer n
br (Int
maxSecondary forall a. Num a => a -> a -> a
- forall n. BoxRenderer n -> Image -> Int
imageSecondary BoxRenderer n
br Image
img)
                         Image
img (Context n
cforall s a. s -> Getting a s a -> a
^.forall r n. Getting r (Context n) Attr
attrL)
          ([(IMap Image, IMap Image)]
imageRewrites, BorderMap DynBorder
newBorders) = forall n.
BoxRenderer n
-> [BorderMap DynBorder]
-> ([(IMap Image, IMap Image)], BorderMap DynBorder)
catAllBorders BoxRenderer n
br (forall n. Result n -> BorderMap DynBorder
borders forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Result n]
allTranslatedResults)
          rewrittenImages :: [Image]
rewrittenImages = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall n.
BoxRenderer n -> (IMap Image, IMap Image) -> Image -> Image
rewriteImage BoxRenderer n
br) [(IMap Image, IMap Image)]
imageRewrites [Image]
allImages
          paddedImages :: [Image]
paddedImages = Image -> Image
padImage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Image]
rewrittenImages

      forall n. Result n -> RenderM n (Result n)
cropResultToContext forall a b. (a -> b) -> a -> b
$ forall n.
Image
-> [CursorLocation n]
-> [VisibilityRequest]
-> [Extent n]
-> BorderMap DynBorder
-> Result n
Result (forall n. BoxRenderer n -> [Image] -> Image
concatenatePrimary BoxRenderer n
br [Image]
paddedImages)
                            (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall n. Result n -> [CursorLocation n]
cursors [Result n]
allTranslatedResults)
                            (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall n. Result n -> [VisibilityRequest]
visibilityRequests [Result n]
allTranslatedResults)
                            (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall n. Result n -> [Extent n]
extents [Result n]
allTranslatedResults)
                            BorderMap DynBorder
newBorders

catDynBorder
    :: Lens' (Edges BorderSegment) BorderSegment
    -> Lens' (Edges BorderSegment) BorderSegment
    -> DynBorder
    -> DynBorder
    -> Maybe DynBorder
catDynBorder :: Lens' (Edges BorderSegment) BorderSegment
-> Lens' (Edges BorderSegment) BorderSegment
-> DynBorder
-> DynBorder
-> Maybe DynBorder
catDynBorder Lens' (Edges BorderSegment) BorderSegment
towardsA Lens' (Edges BorderSegment) BorderSegment
towardsB DynBorder
a DynBorder
b
    -- Currently, we check if the 'BorderStyle's are exactly the same. In the
    -- future, it might be nice to relax this restriction. For example, if a
    -- horizontal border is being rewritten to accommodate a neighboring
    -- vertical border, all we care about is that the two 'bsVertical's line up
    -- sanely. After all, if the horizontal border's 'bsVertical' is the same
    -- as the vertical one's, and the horizontal border's 'BorderStyle' is
    -- self-consistent, then it will look "right" to rewrite according to the
    -- horizontal border's 'BorderStyle'.
    |  DynBorder -> BorderStyle
dbStyle DynBorder
a forall a. Eq a => a -> a -> Bool
== DynBorder -> BorderStyle
dbStyle DynBorder
b
    Bool -> Bool -> Bool
&& DynBorder -> Attr
dbAttr  DynBorder
a forall a. Eq a => a -> a -> Bool
== DynBorder -> Attr
dbAttr  DynBorder
b
    Bool -> Bool -> Bool
&& DynBorder
a forall s a. s -> Getting a s a -> a
^. Lens' DynBorder (Edges BorderSegment)
dbSegmentsLforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' (Edges BorderSegment) BorderSegment
towardsBforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' BorderSegment Bool
bsAcceptL
    Bool -> Bool -> Bool
&& DynBorder
b forall s a. s -> Getting a s a -> a
^. Lens' DynBorder (Edges BorderSegment)
dbSegmentsLforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' (Edges BorderSegment) BorderSegment
towardsAforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' BorderSegment Bool
bsOfferL
    Bool -> Bool -> Bool
&& Bool -> Bool
not (DynBorder
a forall s a. s -> Getting a s a -> a
^. Lens' DynBorder (Edges BorderSegment)
dbSegmentsLforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' (Edges BorderSegment) BorderSegment
towardsBforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' BorderSegment Bool
bsDrawL) -- don't bother doing an update if we don't need to
    = forall a. a -> Maybe a
Just (DynBorder
a forall a b. a -> (a -> b) -> b
& Lens' DynBorder (Edges BorderSegment)
dbSegmentsLforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' (Edges BorderSegment) BorderSegment
towardsBforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' BorderSegment Bool
bsDrawL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True)
    | Bool
otherwise = forall a. Maybe a
Nothing

catDynBorders
    :: Lens' (Edges BorderSegment) BorderSegment
    -> Lens' (Edges BorderSegment) BorderSegment
    -> I.IMap DynBorder
    -> I.IMap DynBorder
    -> I.IMap DynBorder
catDynBorders :: Lens' (Edges BorderSegment) BorderSegment
-> Lens' (Edges BorderSegment) BorderSegment
-> IMap DynBorder
-> IMap DynBorder
-> IMap DynBorder
catDynBorders Lens' (Edges BorderSegment) BorderSegment
towardsA Lens' (Edges BorderSegment) BorderSegment
towardsB IMap DynBorder
am IMap DynBorder
bm = forall a b. (a -> Maybe b) -> IMap a -> IMap b
I.mapMaybe forall a. a -> a
id
    forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> IMap a -> IMap b -> IMap c
I.intersectionWith (Lens' (Edges BorderSegment) BorderSegment
-> Lens' (Edges BorderSegment) BorderSegment
-> DynBorder
-> DynBorder
-> Maybe DynBorder
catDynBorder Lens' (Edges BorderSegment) BorderSegment
towardsA Lens' (Edges BorderSegment) BorderSegment
towardsB) IMap DynBorder
am IMap DynBorder
bm

-- | Given borders that should be placed next to each other (the first argument
-- on the right or bottom, and the second argument on the left or top), compute
-- new borders and the rewrites that should be done along the edges of the two
-- images to keep the image in sync with the border information.
--
-- The input borders are assumed to be disjoint. This property is not checked.
catBorders
    :: (border ~ BM.BorderMap DynBorder, rewrite ~ I.IMap V.Image)
    => BoxRenderer n -> border -> border -> ((rewrite, rewrite), border)
catBorders :: forall border rewrite n.
(border ~ BorderMap DynBorder, rewrite ~ IMap Image) =>
BoxRenderer n -> border -> border -> ((rewrite, rewrite), border)
catBorders BoxRenderer n
br border
r border
l = if Int
lCoord forall a. Num a => a -> a -> a
+ Int
1 forall a. Eq a => a -> a -> Bool
== Int
rCoord
    then ((IMap Image
lRe, IMap Image
rRe), BorderMap DynBorder
lr')
    else ((forall a. IMap a
I.empty, forall a. IMap a
I.empty), BorderMap DynBorder
lr)
    where
    lr :: BorderMap DynBorder
lr     = forall a. Edges Int -> BorderMap a -> BorderMap a
BM.expand (forall a. BorderMap a -> Edges Int
BM.coordinates border
r) border
l forall a. BorderMap a -> BorderMap a -> BorderMap a
`BM.unsafeUnion`
             forall a. Edges Int -> BorderMap a -> BorderMap a
BM.expand (forall a. BorderMap a -> Edges Int
BM.coordinates border
l) border
r
    lr' :: BorderMap DynBorder
lr'    = forall a. a -> a
id
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IMap DynBorder -> BorderMap DynBorder -> BorderMap DynBorder
mergeIMap Int
lCoord IMap DynBorder
lIMap'
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IMap DynBorder -> BorderMap DynBorder -> BorderMap DynBorder
mergeIMap Int
rCoord IMap DynBorder
rIMap'
           forall a b. (a -> b) -> a -> b
$ BorderMap DynBorder
lr
    lCoord :: Int
lCoord = forall a. BorderMap a -> Edges Int
BM.coordinates border
l forall s a. s -> Getting a s a -> a
^. forall n. BoxRenderer n -> forall a. Lens' (Edges a) a
hiPrimary BoxRenderer n
br
    rCoord :: Int
rCoord = forall a. BorderMap a -> Edges Int
BM.coordinates border
r forall s a. s -> Getting a s a -> a
^. forall n. BoxRenderer n -> forall a. Lens' (Edges a) a
loPrimary BoxRenderer n
br
    lIMap :: IMap DynBorder
lIMap  = forall n.
BoxRenderer n -> Int -> BorderMap DynBorder -> IMap DynBorder
lookupPrimary BoxRenderer n
br Int
lCoord border
l
    rIMap :: IMap DynBorder
rIMap  = forall n.
BoxRenderer n -> Int -> BorderMap DynBorder -> IMap DynBorder
lookupPrimary BoxRenderer n
br Int
rCoord border
r
    lIMap' :: IMap DynBorder
lIMap' = Lens' (Edges BorderSegment) BorderSegment
-> Lens' (Edges BorderSegment) BorderSegment
-> IMap DynBorder
-> IMap DynBorder
-> IMap DynBorder
catDynBorders (forall n. BoxRenderer n -> forall a. Lens' (Edges a) a
loPrimary BoxRenderer n
br) (forall n. BoxRenderer n -> forall a. Lens' (Edges a) a
hiPrimary BoxRenderer n
br) IMap DynBorder
lIMap IMap DynBorder
rIMap
    rIMap' :: IMap DynBorder
rIMap' = Lens' (Edges BorderSegment) BorderSegment
-> Lens' (Edges BorderSegment) BorderSegment
-> IMap DynBorder
-> IMap DynBorder
-> IMap DynBorder
catDynBorders (forall n. BoxRenderer n -> forall a. Lens' (Edges a) a
hiPrimary BoxRenderer n
br) (forall n. BoxRenderer n -> forall a. Lens' (Edges a) a
loPrimary BoxRenderer n
br) IMap DynBorder
rIMap IMap DynBorder
lIMap
    lRe :: IMap Image
lRe    = DynBorder -> Image
renderDynBorder forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IMap DynBorder
lIMap'
    rRe :: IMap Image
rRe    = DynBorder -> Image
renderDynBorder forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IMap DynBorder
rIMap'
    mergeIMap :: Int -> IMap DynBorder -> BorderMap DynBorder -> BorderMap DynBorder
mergeIMap Int
p IMap DynBorder
imap BorderMap DynBorder
bm = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl'
        (\BorderMap DynBorder
bm' (Int
s,Run DynBorder
v) -> forall n.
BoxRenderer n
-> Location
-> Run DynBorder
-> BorderMap DynBorder
-> BorderMap DynBorder
insertSecondary BoxRenderer n
br (forall n. BoxRenderer n -> Int -> Int -> Location
locationFromPrimarySecondary BoxRenderer n
br Int
p Int
s) Run DynBorder
v BorderMap DynBorder
bm')
        BorderMap DynBorder
bm
        (forall a. IMap a -> [(Int, Run a)]
I.unsafeToAscList IMap DynBorder
imap)

-- | Given a direction to concatenate borders in, and the border information
-- itself (which list is assumed to be already shifted so that borders do not
-- overlap and are strictly increasing in the primary direction), produce: a
-- list of rewrites for the lo and hi directions of each border, respectively,
-- and the borders describing the fully concatenated object.
catAllBorders ::
    BoxRenderer n ->
    [BM.BorderMap DynBorder] ->
    ([(I.IMap V.Image, I.IMap V.Image)], BM.BorderMap DynBorder)
catAllBorders :: forall n.
BoxRenderer n
-> [BorderMap DynBorder]
-> ([(IMap Image, IMap Image)], BorderMap DynBorder)
catAllBorders BoxRenderer n
_ [] = ([], forall a. BorderMap a
BM.empty)
catAllBorders BoxRenderer n
br (BorderMap DynBorder
bm:[BorderMap DynBorder]
bms) = (forall a b. [a] -> [b] -> [(a, b)]
zip ([forall a. IMap a
I.empty]forall a. [a] -> [a] -> [a]
++[IMap Image]
los) ([IMap Image]
hisforall a. [a] -> [a] -> [a]
++[forall a. IMap a
I.empty]), BorderMap DynBorder
bm') where
    ([(IMap Image, IMap Image)]
rewrites, BorderMap DynBorder
bm') = forall s a. State s a -> s -> (a, s)
runState (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall border rewrite n.
(border ~ BorderMap DynBorder, rewrite ~ IMap Image) =>
BoxRenderer n -> border -> border -> ((rewrite, rewrite), border)
catBorders BoxRenderer n
br) [BorderMap DynBorder]
bms) BorderMap DynBorder
bm
    ([IMap Image]
his, [IMap Image]
los) = forall a b. [(a, b)] -> ([a], [b])
unzip [(IMap Image, IMap Image)]
rewrites

rewriteEdge ::
    (Int -> V.Image -> V.Image) ->
    (Int -> V.Image -> V.Image) ->
    ([V.Image] -> V.Image) ->
    I.IMap V.Image -> V.Image -> V.Image
rewriteEdge :: (Int -> Image -> Image)
-> (Int -> Image -> Image)
-> ([Image] -> Image)
-> IMap Image
-> Image
-> Image
rewriteEdge Int -> Image -> Image
splitLo Int -> Image -> Image
splitHi [Image] -> Image
combine = ([Image] -> Image
combine forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Run Image)] -> Image -> [Image]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Int -> [(Int, Run a)] -> [(Int, Run a)]
offsets Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IMap a -> [(Int, Run a)]
I.unsafeToAscList where

    -- convert absolute positions into relative ones
    offsets :: Int -> [(Int, Run a)] -> [(Int, Run a)]
offsets Int
_ [] = []
    offsets Int
n ((Int
n', Run a
r):[(Int, Run a)]
nrs) = (Int
n'forall a. Num a => a -> a -> a
-Int
n, Run a
r) forall a. a -> [a] -> [a]
: Int -> [(Int, Run a)] -> [(Int, Run a)]
offsets (Int
n'forall a. Num a => a -> a -> a
+forall a. Run a -> Int
I.len Run a
r) [(Int, Run a)]
nrs

    go :: [(Int, Run Image)] -> Image -> [Image]
go [] Image
old = [Image
old]
    -- TODO: might be nice to construct this image with fill rather than
    -- replicate+char
    go ((Int
lo, I.Run Int
len Image
new):[(Int, Run Image)]
nrs) Image
old
        =  [Int -> Image -> Image
splitLo Int
lo Image
old]
        forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
len Image
new
        forall a. [a] -> [a] -> [a]
++ [(Int, Run Image)] -> Image -> [Image]
go [(Int, Run Image)]
nrs (Int -> Image -> Image
splitHi (Int
loforall a. Num a => a -> a -> a
+Int
len) Image
old)

rewriteImage :: BoxRenderer n -> (I.IMap V.Image, I.IMap V.Image) -> V.Image -> V.Image
rewriteImage :: forall n.
BoxRenderer n -> (IMap Image, IMap Image) -> Image -> Image
rewriteImage BoxRenderer n
br (IMap Image
loRewrite, IMap Image
hiRewrite) Image
old = Image -> Image
rewriteHi forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image -> Image
rewriteLo forall a b. (a -> b) -> a -> b
$ Image
old where
    size :: Int
size = forall n. BoxRenderer n -> Image -> Int
imagePrimary BoxRenderer n
br Image
old
    go :: IMap Image -> Image -> Image
go = (Int -> Image -> Image)
-> (Int -> Image -> Image)
-> ([Image] -> Image)
-> IMap Image
-> Image
-> Image
rewriteEdge (forall n. BoxRenderer n -> Int -> Image -> Image
splitLoSecondary BoxRenderer n
br) (forall n. BoxRenderer n -> Int -> Image -> Image
splitHiSecondary BoxRenderer n
br) (forall n. BoxRenderer n -> [Image] -> Image
concatenateSecondary BoxRenderer n
br)
    rewriteLo :: Image -> Image
rewriteLo Image
img
        | forall a. IMap a -> Bool
I.null IMap Image
loRewrite Bool -> Bool -> Bool
|| Int
size forall a. Eq a => a -> a -> Bool
== Int
0 = Image
img
        | Bool
otherwise = forall n. BoxRenderer n -> [Image] -> Image
concatenatePrimary BoxRenderer n
br
            [ IMap Image -> Image -> Image
go IMap Image
loRewrite (forall n. BoxRenderer n -> Int -> Image -> Image
splitLoPrimary BoxRenderer n
br Int
1 Image
img)
            , forall n. BoxRenderer n -> Int -> Image -> Image
splitHiPrimary BoxRenderer n
br Int
1 Image
img
            ]
    rewriteHi :: Image -> Image
rewriteHi Image
img
        | forall a. IMap a -> Bool
I.null IMap Image
hiRewrite Bool -> Bool -> Bool
|| Int
size forall a. Eq a => a -> a -> Bool
== Int
0 = Image
img
        | Bool
otherwise = forall n. BoxRenderer n -> [Image] -> Image
concatenatePrimary BoxRenderer n
br
            [ forall n. BoxRenderer n -> Int -> Image -> Image
splitLoPrimary BoxRenderer n
br (Int
sizeforall a. Num a => a -> a -> a
-Int
1) Image
img
            , IMap Image -> Image -> Image
go IMap Image
hiRewrite (forall n. BoxRenderer n -> Int -> Image -> Image
splitHiPrimary BoxRenderer n
br (Int
sizeforall a. Num a => a -> a -> a
-Int
1) Image
img)
            ]

-- | Limit the space available to the specified widget to the specified
-- number of columns. This is important for constraining the horizontal
-- growth of otherwise-greedy widgets. This is non-greedy horizontally
-- and defers to the limited widget vertically.
hLimit :: Int -> Widget n -> Widget n
hLimit :: forall n. Int -> Widget n -> Widget n
hLimit Int
w Widget n
p
    | Int
w forall a. Ord a => a -> a -> Bool
<= Int
0 = forall n. Widget n
emptyWidget
    | Bool
otherwise =
        forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed (forall n. Widget n -> Size
vSize Widget n
p) forall a b. (a -> b) -> a -> b
$
          forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) Int
availWidthL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Ord a => a -> a -> a
min Int
w)) forall a b. (a -> b) -> a -> b
$ 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
p

-- | Limit the space available to the specified widget to the specified
-- percentage of available width, as a value between 0 and 100
-- inclusive. Values outside the valid range will be clamped to the
-- range endpoints. This is important for constraining the horizontal
-- growth of otherwise-greedy widgets. This is non-greedy horizontally
-- and defers to the limited widget vertically.
hLimitPercent :: Int -> Widget n -> Widget n
hLimitPercent :: forall n. Int -> Widget n -> Widget n
hLimitPercent Int
w' Widget n
p
    | Int
w' forall a. Ord a => a -> a -> Bool
<= Int
0 = forall n. Widget n
emptyWidget
    | Bool
otherwise =
        forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed (forall n. Widget n -> Size
vSize Widget n
p) forall a b. (a -> b) -> a -> b
$ do
          let w :: Int
w = forall a. Ord a => a -> a -> a -> a
clamp Int
0 Int
100 Int
w'
          Context n
ctx <- forall n. RenderM n (Context n)
getContext
          let usableWidth :: Int
usableWidth = Context n
ctxforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL
              widgetWidth :: Int
widgetWidth = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a. Real a => a -> Rational
toRational Int
usableWidth forall a. Num a => a -> a -> a
* (forall a. Real a => a -> Rational
toRational Int
w forall a. Fractional a => a -> a -> a
/ Rational
100))
          forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) Int
availWidthL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Ord a => a -> a -> a
min Int
widgetWidth)) forall a b. (a -> b) -> a -> b
$ 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
p

-- | Limit the space available to the specified widget to the specified
-- number of rows. This is important for constraining the vertical
-- growth of otherwise-greedy widgets. This is non-greedy vertically and
-- defers to the limited widget horizontally.
vLimit :: Int -> Widget n -> Widget n
vLimit :: forall n. Int -> Widget n -> Widget n
vLimit Int
h Widget n
p
    | Int
h forall a. Ord a => a -> a -> Bool
<= Int
0 = forall n. Widget n
emptyWidget
    | Bool
otherwise =
        forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
p) Size
Fixed forall a b. (a -> b) -> a -> b
$
          forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) Int
availHeightL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Ord a => a -> a -> a
min Int
h)) forall a b. (a -> b) -> a -> b
$ 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
p

-- | Limit the space available to the specified widget to the specified
-- percentage of available height, as a value between 0 and 100
-- inclusive. Values outside the valid range will be clamped to the
-- range endpoints. This is important for constraining the vertical
-- growth of otherwise-greedy widgets. This is non-greedy vertically and
-- defers to the limited widget horizontally.
vLimitPercent :: Int -> Widget n -> Widget n
vLimitPercent :: forall n. Int -> Widget n -> Widget n
vLimitPercent Int
h' Widget n
p
    | Int
h' forall a. Ord a => a -> a -> Bool
<= Int
0 = forall n. Widget n
emptyWidget
    | Bool
otherwise =
        forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
p) Size
Fixed forall a b. (a -> b) -> a -> b
$ do
          let h :: Int
h = forall a. Ord a => a -> a -> a -> a
clamp Int
0 Int
100 Int
h'
          Context n
ctx <- forall n. RenderM n (Context n)
getContext
          let usableHeight :: Int
usableHeight = Context n
ctxforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL
              widgetHeight :: Int
widgetHeight = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a. Real a => a -> Rational
toRational Int
usableHeight forall a. Num a => a -> a -> a
* (forall a. Real a => a -> Rational
toRational Int
h forall a. Fractional a => a -> a -> a
/ Rational
100))
          forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) Int
availHeightL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Ord a => a -> a -> a
min Int
widgetHeight)) forall a b. (a -> b) -> a -> b
$ 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
p

-- | Set the rendering context height and width for this widget. This
-- is useful for relaxing the rendering size constraints on e.g. layer
-- widgets where cropping to the screen size is undesirable.
setAvailableSize :: (Int, Int) -> Widget n -> Widget n
setAvailableSize :: forall n. DisplayRegion -> Widget n -> Widget n
setAvailableSize (Int
w, Int
h) Widget n
p
    | 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 = forall n. Widget n
emptyWidget
    | Bool
otherwise =
        forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$
          forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (\Context n
c -> Context n
c forall a b. a -> (a -> b) -> b
& forall n. Lens' (Context n) Int
availHeightL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
h forall a b. a -> (a -> b) -> b
& forall n. Lens' (Context n) Int
availWidthL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
w) forall a b. (a -> b) -> a -> b
$
            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
p

-- | When drawing the specified widget, set the attribute used for
-- drawing to the one with the specified name. Note that the widget may
-- make further changes to the active drawing attribute, so this only
-- takes effect if nothing in the specified widget invokes 'withAttr'
-- or otherwise changes the rendering context's attribute setup. If you
-- want to prevent that, use 'forceAttr'. Attributes used this way still
-- get merged hierarchically and still fall back to the attribute map's
-- default attribute. If you want to change the default attribute, use
-- 'withDefAttr'.
--
-- For example:
--
-- @
--    appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow)
--                                           , ("warning", bg magenta)
--                                           ]
--
--    renderA :: (String, String) -> [Widget n]
--    renderA (a,b) = hBox [ str a
--                         , str " is "
--                         , withAttr "highlight" (str b)
--                         ]
--
--    render1 = renderA (\"Brick\", "fun")
--    render2 = withAttr "warning" render1
-- @
--
-- In the example above, @render1@ will show @Brick is fun@ where the
-- first two words are white on a blue background and the last word
-- is yellow on a blue background. However, @render2@ will show the
-- first two words in white on magenta although the last word is still
-- rendered in yellow on blue.
withAttr :: AttrName -> Widget n -> Widget n
withAttr :: forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
an 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 a b. (a -> b) -> a -> b
$
      forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) AttrName
ctxAttrNameL forall s t a b. ASetter s t a b -> b -> s -> t
.~ AttrName
an) (forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

-- | Update the attribute map while rendering the specified widget: set
-- the map's default attribute to the one that we get by applying the
-- specified function to the current map's default attribute. This is a
-- variant of 'withDefAttr'; see the latter for more information.
modifyDefAttr :: (V.Attr -> V.Attr) -> Widget n -> Widget n
modifyDefAttr :: forall n. (Attr -> Attr) -> Widget n -> Widget n
modifyDefAttr Attr -> Attr
f 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 a b. (a -> b) -> a -> b
$ do
        Context n
c <- forall n. RenderM n (Context n)
getContext
        forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) AttrMap
ctxAttrMapL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Attr -> AttrMap -> AttrMap
setDefaultAttr (Attr -> Attr
f forall a b. (a -> b) -> a -> b
$ AttrMap -> Attr
getDefaultAttr (Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) AttrMap
ctxAttrMapL)))) (forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

-- | Update the attribute map used while rendering the specified
-- widget (and any sub-widgets): set its new *default* attribute
-- (i.e. the attribute components that will be applied if not
-- overridden by any more specific attributes) to the one that we get
-- by looking up the specified attribute name in the map.
--
-- For example:
--
-- @
--    ...
--    appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow)
--                                           , ("warning", bg magenta)
--                                           , ("good", white `on` green) ]
--    ...
--
--    renderA :: (String, String) -> [Widget n]
--    renderA (a,b) = hBox [ withAttr "good" (str a)
--                         , str " is "
--                         , withAttr "highlight" (str b) ]
--
--    render1 = renderA (\"Brick\", "fun")
--    render2 = withDefAttr "warning" render1
-- @
--
-- In the above, render1 will show "Brick is fun" where the first word
-- is white on a green background, the middle word is white on a blue
-- background, and the last word is yellow on a blue background.
-- However, render2 will show the first word in the same colors but
-- the middle word will be shown in whatever the terminal's normal
-- foreground is on a magenta background, and the third word will be
-- yellow on a magenta background.
withDefAttr :: AttrName -> Widget n -> Widget n
withDefAttr :: forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
an 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 a b. (a -> b) -> a -> b
$ do
        Context n
c <- forall n. RenderM n (Context n)
getContext
        forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) AttrMap
ctxAttrMapL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Attr -> AttrMap -> AttrMap
setDefaultAttr (AttrName -> AttrMap -> Attr
attrMapLookup AttrName
an (Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) AttrMap
ctxAttrMapL)))) (forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

-- | While rendering the specified widget, use a transformed version
-- of the current attribute map. This is a very general function with
-- broad capabilities: you probably want a more specific function such
-- as 'withDefAttr' or 'withAttr'.
updateAttrMap :: (AttrMap -> AttrMap) -> Widget n -> Widget n
updateAttrMap :: forall n. (AttrMap -> AttrMap) -> Widget n -> Widget n
updateAttrMap AttrMap -> AttrMap
f 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 a b. (a -> b) -> a -> b
$
        forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) AttrMap
ctxAttrMapL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ AttrMap -> AttrMap
f) (forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

-- | When rendering the specified widget, force all attribute lookups
-- in the attribute map to use the value currently assigned to the
-- specified attribute name. This means that the attribute lookups will
-- behave as if they all used the name specified here. That further
-- means that the resolved attribute will still inherit from its parent
-- entry in the attribute map as would normally be the case. If you
-- want to have more control over the resulting attribute, consider
-- 'modifyDefAttr'.
--
-- For example:
--
-- @
--    ...
--    appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow)
--                                           , ("notice", fg red) ]
--    ...
--
--    renderA :: (String, String) -> [Widget n]
--    renderA (a,b) = hBox [ withAttr "highlight" (str a)
--                         , str " is "
--                         , withAttr "highlight" (str b)
--                         ]
--
--    render1 = renderA ("Brick", "fun")
--    render2 = forceAttr "notice" render1
-- @
--
-- In the above, render1 will show "Brick is fun" where the first and
-- last words are yellow on a blue background and the middle word is
-- white on a blue background.  However, render2 will show all words
-- in red on a blue background.  In both versions, the middle word
-- will be in white on a blue background.
forceAttr :: AttrName -> Widget n -> Widget n
forceAttr :: forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
an 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 a b. (a -> b) -> a -> b
$ do
        Context n
c <- forall n. RenderM n (Context n)
getContext
        forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) AttrMap
ctxAttrMapL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Attr -> AttrMap
forceAttrMap (AttrName -> AttrMap -> Attr
attrMapLookup AttrName
an (Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) AttrMap
ctxAttrMapL)))) (forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

-- | Like 'forceAttr', except that the style of attribute lookups in the
-- attribute map is preserved and merged with the forced attribute. This
-- allows for situations where 'forceAttr' would otherwise ignore style
-- information that is important to preserve.
forceAttrAllowStyle :: AttrName -> Widget n -> Widget n
forceAttrAllowStyle :: forall n. AttrName -> Widget n -> Widget n
forceAttrAllowStyle AttrName
an 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 a b. (a -> b) -> a -> b
$ do
        Context n
c <- forall n. RenderM n (Context n)
getContext
        let m :: AttrMap
m = Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) AttrMap
ctxAttrMapL
        forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) AttrMap
ctxAttrMapL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Attr -> AttrMap -> AttrMap
forceAttrMapAllowStyle (AttrName -> AttrMap -> Attr
attrMapLookup AttrName
an AttrMap
m) AttrMap
m)) (forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

-- | Override the lookup of the attribute name 'targetName' to return
-- the attribute value associated with 'fromName' when rendering the
-- specified widget.
--
-- For example:
--
-- @
--    appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow)
--                                           , ("notice", fg red)
--                                           ]
--
--    renderA :: (String, String) -> [Widget n]
--    renderA (a, b) = str a <+> str " is " <+> withAttr "highlight" (str b)
--
--    render1 = withAttr "notice" $ renderA ("Brick", "fun")
--    render2 = overrideAttr "highlight" "notice" render1
-- @
--
-- In the example above, @render1@ will show @Brick is fun@ where the
-- first two words are red on a blue background, but @fun@ is yellow on
-- a blue background. However, @render2@ will show all three words in
-- red on a blue background.
overrideAttr :: AttrName -> AttrName -> Widget n -> Widget n
overrideAttr :: forall n. AttrName -> AttrName -> Widget n -> Widget n
overrideAttr AttrName
targetName AttrName
fromName =
    forall n. (AttrMap -> AttrMap) -> Widget n -> Widget n
updateAttrMap (AttrName -> AttrName -> AttrMap -> AttrMap
mapAttrName AttrName
fromName AttrName
targetName)

-- | Build a widget directly from a raw Vty image.
raw :: V.Image -> Widget n
raw :: forall n. Image -> Widget n
raw Image
img = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. Result n
emptyResult forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) Image
imageL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Image
img

-- | Translate the specified widget by the specified offset amount.
-- Defers to the translated widget for growth policy.
translateBy :: Location -> Widget n -> Widget n
translateBy :: forall n. Location -> Widget n -> Widget n
translateBy Location
off 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 a b. (a -> b) -> a -> b
$ do
      Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
p
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. Location -> Result n -> Result n
addResultOffset Location
off
             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
%~ (Int -> Int -> Image -> Image
V.translate (Location
offforall s a. s -> Getting a s a -> a
^.forall a. TerminalLocation a => Lens' a Int
locationColumnL) (Location
offforall s a. s -> Getting a s a -> a
^.forall a. TerminalLocation a => Lens' a Int
locationRowL))

-- | Given a widget, translate it to position it relative to the
-- upper-left coordinates of a reported extent with the specified
-- positioning offset. If the specified name has no reported extent,
-- this just draws the specified widget with no special positioning.
--
-- This is only useful for positioning something in a higher layer
-- relative to a reported extent in a lower layer. Any other use is
-- likely to result in the specified widget being rendered as-is with
-- no translation. This is because this function relies on information
-- about lower layer renderings in order to work; using it with a
-- resource name that wasn't rendered in a lower layer will result in
-- this being equivalent to @id@.
--
-- For example, if you have two layers @topLayer@ and @bottomLayer@,
-- then a widget drawn in @bottomLayer@ with @reportExtent Foo@ can be
-- used to relatively position a widget in @topLayer@ with @topLayer =
-- relativeTo Foo ...@.
relativeTo :: (Ord n) => n -> Location -> Widget n -> Widget n
relativeTo :: forall n. Ord n => n -> Location -> Widget n -> Widget n
relativeTo n
n Location
off Widget n
w =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
w) (forall n. Widget n -> Size
vSize Widget n
w) forall a b. (a -> b) -> a -> b
$ do
        Maybe (Extent n)
mExt <- forall n. Ord n => n -> RenderM n (Maybe (Extent n))
lookupReportedExtent n
n
        case Maybe (Extent n)
mExt of
            Maybe (Extent n)
Nothing -> forall n. Widget n -> RenderM n (Result n)
render Widget n
w
            Just Extent n
ext -> forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Location -> Widget n -> Widget n
translateBy (forall n. Extent n -> Location
extentUpperLeft Extent n
ext forall a. Semigroup a => a -> a -> a
<> Location
off) Widget n
w

-- | Crop the specified widget on the left by the specified number of
-- columns. Defers to the cropped widget for growth policy.
cropLeftBy :: Int -> Widget n -> Widget n
cropLeftBy :: forall n. Int -> Widget n -> Widget n
cropLeftBy Int
cols 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 a b. (a -> b) -> a -> b
$ do
      Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
p
      let amt :: Int
amt = Image -> Int
V.imageWidth (Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL) forall a. Num a => a -> a -> a
- Int
cols
          cropped :: Image -> Image
cropped Image
img = if Int
amt forall a. Ord a => a -> a -> Bool
< Int
0 then Image
V.emptyImage else Int -> Image -> Image
V.cropLeft Int
amt Image
img
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. Location -> Result n -> Result n
addResultOffset (DisplayRegion -> Location
Location (-Int
1 forall a. Num a => a -> a -> a
* Int
cols, Int
0))
             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
%~ Image -> Image
cropped

-- | Crop the specified widget to the specified size from the left.
-- Defers to the cropped widget for growth policy.
cropLeftTo :: Int -> Widget n -> Widget n
cropLeftTo :: forall n. Int -> Widget n -> Widget n
cropLeftTo Int
cols 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 a b. (a -> b) -> a -> b
$ do
        Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
p
        let w :: Int
w = Image -> Int
V.imageWidth forall a b. (a -> b) -> a -> b
$ Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL
            amt :: Int
amt = Int
w forall a. Num a => a -> a -> a
- Int
cols
        if Int
w forall a. Ord a => a -> a -> Bool
<= Int
cols
           then forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result
           else forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
cropLeftBy Int
amt forall a b. (a -> b) -> a -> b
$ forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result

-- | Crop the specified widget on the right by the specified number of
-- columns. Defers to the cropped widget for growth policy.
cropRightBy :: Int -> Widget n -> Widget n
cropRightBy :: forall n. Int -> Widget n -> Widget n
cropRightBy Int
cols 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 a b. (a -> b) -> a -> b
$ do
      Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
p
      let amt :: Int
amt = Image -> Int
V.imageWidth (Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL) forall a. Num a => a -> a -> a
- Int
cols
          cropped :: Image -> Image
cropped Image
img = if Int
amt forall a. Ord a => a -> a -> Bool
< Int
0 then Image
V.emptyImage else Int -> Image -> Image
V.cropRight Int
amt Image
img
      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
%~ Image -> Image
cropped

-- | Crop the specified widget to the specified size from the right.
-- Defers to the cropped widget for growth policy.
cropRightTo :: Int -> Widget n -> Widget n
cropRightTo :: forall n. Int -> Widget n -> Widget n
cropRightTo Int
cols 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 a b. (a -> b) -> a -> b
$ do
        Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
p
        let w :: Int
w = Image -> Int
V.imageWidth forall a b. (a -> b) -> a -> b
$ Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL
            amt :: Int
amt = Int
w forall a. Num a => a -> a -> a
- Int
cols
        if Int
w forall a. Ord a => a -> a -> Bool
<= Int
cols
           then forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result
           else forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
cropRightBy Int
amt forall a b. (a -> b) -> a -> b
$ forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result

-- | Crop the specified widget on the top by the specified number of
-- rows. Defers to the cropped widget for growth policy.
cropTopBy :: Int -> Widget n -> Widget n
cropTopBy :: forall n. Int -> Widget n -> Widget n
cropTopBy Int
rows 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 a b. (a -> b) -> a -> b
$ do
      Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
p
      let amt :: Int
amt = Image -> Int
V.imageHeight (Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL) forall a. Num a => a -> a -> a
- Int
rows
          cropped :: Image -> Image
cropped Image
img = if Int
amt forall a. Ord a => a -> a -> Bool
< Int
0 then Image
V.emptyImage else Int -> Image -> Image
V.cropTop Int
amt Image
img
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. Location -> Result n -> Result n
addResultOffset (DisplayRegion -> Location
Location (Int
0, -Int
1 forall a. Num a => a -> a -> a
* Int
rows))
             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
%~ Image -> Image
cropped

-- | Crop the specified widget to the specified size from the top.
-- Defers to the cropped widget for growth policy.
cropTopTo :: Int -> Widget n -> Widget n
cropTopTo :: forall n. Int -> Widget n -> Widget n
cropTopTo Int
rows 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 a b. (a -> b) -> a -> b
$ do
        Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
p
        let h :: Int
h = Image -> Int
V.imageHeight forall a b. (a -> b) -> a -> b
$ Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL
            amt :: Int
amt = Int
h forall a. Num a => a -> a -> a
- Int
rows
        if Int
h forall a. Ord a => a -> a -> Bool
<= Int
rows
           then forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result
           else forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
cropTopBy Int
amt forall a b. (a -> b) -> a -> b
$ forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result

-- | Crop the specified widget on the bottom by the specified number of
-- rows. Defers to the cropped widget for growth policy.
cropBottomBy :: Int -> Widget n -> Widget n
cropBottomBy :: forall n. Int -> Widget n -> Widget n
cropBottomBy Int
rows 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 a b. (a -> b) -> a -> b
$ do
      Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
p
      let amt :: Int
amt = Image -> Int
V.imageHeight (Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL) forall a. Num a => a -> a -> a
- Int
rows
          cropped :: Image -> Image
cropped Image
img = if Int
amt forall a. Ord a => a -> a -> Bool
< Int
0 then Image
V.emptyImage else Int -> Image -> Image
V.cropBottom Int
amt Image
img
      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
%~ Image -> Image
cropped

-- | Crop the specified widget to the specified size from the bottom.
-- Defers to the cropped widget for growth policy.
cropBottomTo :: Int -> Widget n -> Widget n
cropBottomTo :: forall n. Int -> Widget n -> Widget n
cropBottomTo Int
rows 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 a b. (a -> b) -> a -> b
$ do
        Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
p
        let h :: Int
h = Image -> Int
V.imageHeight forall a b. (a -> b) -> a -> b
$ Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL
            amt :: Int
amt = Int
h forall a. Num a => a -> a -> a
- Int
rows
        if Int
h forall a. Ord a => a -> a -> Bool
<= Int
rows
           then forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result
           else forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
cropBottomBy Int
amt forall a b. (a -> b) -> a -> b
$ forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result

-- | When rendering the specified widget, also register a cursor
-- positioning request using the specified name and location.
showCursor :: n -> Location -> Widget n -> Widget n
showCursor :: forall n. n -> Location -> Widget n -> Widget n
showCursor n
n Location
cloc 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 a b. (a -> b) -> a -> 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. Location -> Maybe n -> Bool -> CursorLocation n
CursorLocation Location
cloc (forall a. a -> Maybe a
Just n
n) Bool
Trueforall a. a -> [a] -> [a]
:)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

-- | When rendering the specified widget, also register a cursor
-- positioning request using the specified name and location.
-- The cursor will only be positioned but not made visible.
putCursor :: n -> Location -> Widget n -> Widget n
putCursor :: forall n. n -> Location -> Widget n -> Widget n
putCursor n
n Location
cloc 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 a b. (a -> b) -> a -> 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. Location -> Maybe n -> Bool -> CursorLocation n
CursorLocation Location
cloc (forall a. a -> Maybe a
Just n
n) Bool
Falseforall a. a -> [a] -> [a]
:)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

hRelease :: Widget n -> Maybe (Widget n)
hRelease :: forall n. Widget n -> Maybe (Widget n)
hRelease Widget n
p =
    case forall n. Widget n -> Size
hSize Widget n
p of
        Size
Fixed -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy (forall n. Widget n -> Size
vSize Widget n
p) forall a b. (a -> b) -> a -> b
$
                        forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) Int
availWidthL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
unrestricted) (forall n. Widget n -> RenderM n (Result n)
render Widget n
p)
        Size
Greedy -> forall a. Maybe a
Nothing

vRelease :: Widget n -> Maybe (Widget n)
vRelease :: forall n. Widget n -> Maybe (Widget n)
vRelease Widget n
p =
    case forall n. Widget n -> Size
vSize Widget n
p of
        Size
Fixed -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
p) Size
Greedy forall a b. (a -> b) -> a -> b
$
                        forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) Int
availHeightL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
unrestricted) (forall n. Widget n -> RenderM n (Result n)
render Widget n
p)
        Size
Greedy -> forall a. Maybe a
Nothing

-- | If the specified resource name has an entry in the rendering cache,
-- use the rendered version from the cache. If not, render the specified
-- widget and update the cache with the result.
--
-- To ensure that mouse events are emitted correctly for cached widgets,
-- in addition to the rendered widget, we also cache (the names of) any
-- clickable extents that were rendered and restore that when utilizing
-- the cache.
--
-- See also 'invalidateCacheEntry'.
cached :: (Ord n) => n -> Widget n -> Widget n
cached :: forall n. Ord n => n -> Widget n -> Widget n
cached n
n Widget n
w =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
w) (forall n. Widget n -> Size
vSize Widget n
w) forall a b. (a -> b) -> a -> b
$ do
        Maybe ([n], Result n)
result <- forall n. Ord n => n -> RenderM n (Maybe ([n], Result n))
cacheLookup n
n
        case Maybe ([n], Result n)
result of
            Just ([n]
clickables, Result n
prevResult) -> do
                forall n. Lens' (RenderState n) [n]
clickableNamesL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([n]
clickables forall a. [a] -> [a] -> [a]
++)
                forall (m :: * -> *) a. Monad m => a -> m a
return Result n
prevResult
            Maybe ([n], Result n)
Nothing  -> do
                Result n
wResult <- forall n. Widget n -> RenderM n (Result n)
render Widget n
w
                [n]
clickables <- forall n. Ord n => Result n -> RenderM n [n]
renderedClickables Result n
wResult
                forall n. Ord n => n -> ([n], Result n) -> RenderM n ()
cacheUpdate n
n ([n]
clickables, Result n
wResult forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) [VisibilityRequest]
visibilityRequestsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Monoid a => a
mempty)
                forall (m :: * -> *) a. Monad m => a -> m a
return Result n
wResult
    where
        -- Given the rendered result of a Widget, collect the list of "clickable" names
        -- from the extents that were in the result.
        renderedClickables :: (Ord n) => Result n -> RenderM n [n]
        renderedClickables :: forall n. Ord n => Result n -> RenderM n [n]
renderedClickables Result n
renderResult = do
            [n]
allClickables <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall n. Lens' (RenderState n) [n]
clickableNamesL
            forall (m :: * -> *) a. Monad m => a -> m a
return [forall n. Extent n -> n
extentName Extent n
e | Extent n
e <- Result n
renderResultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) [Extent n]
extentsL, forall n. Extent n -> n
extentName Extent n
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [n]
allClickables]


cacheLookup :: (Ord n) => n -> RenderM n (Maybe ([n], Result n))
cacheLookup :: forall n. Ord n => n -> RenderM n (Maybe ([n], Result n))
cacheLookup n
n = do
    Map n ([n], Result n)
cache <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^.forall n. Lens' (RenderState n) (Map n ([n], Result n))
renderCacheL)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup n
n Map n ([n], Result n)
cache

cacheUpdate :: Ord n => n -> ([n], Result n) -> RenderM n ()
cacheUpdate :: forall n. Ord n => n -> ([n], Result n) -> RenderM n ()
cacheUpdate n
n ([n], Result n)
r = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall n. Lens' (RenderState n) (Map n ([n], Result n))
renderCacheL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert n
n ([n], Result n)
r)

-- | Enable vertical scroll bars on all viewports in the specified
-- widget and draw them with the specified orientation.
withVScrollBars :: VScrollBarOrientation -> Widget n -> Widget n
withVScrollBars :: forall n. VScrollBarOrientation -> Widget n -> Widget n
withVScrollBars VScrollBarOrientation
orientation Widget n
w =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
w) (forall n. Widget n -> Size
vSize Widget n
w) forall a b. (a -> b) -> a -> b
$
        forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) (Maybe VScrollBarOrientation)
ctxVScrollBarOrientationL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just VScrollBarOrientation
orientation) (forall n. Widget n -> RenderM n (Result n)
render Widget n
w)

-- | Enable scroll bar handles on all vertical scroll bars in the
-- specified widget. Handles appear at the ends of the scroll bar,
-- representing the "handles" that are typically clickable in
-- graphical UIs to move the scroll bar incrementally. Vertical
-- scroll bars are also clickable if mouse mode is enabled and if
-- 'withClickableVScrollBars' is used.
--
-- This will only have an effect if 'withVScrollBars' is also called.
withVScrollBarHandles :: Widget n -> Widget n
withVScrollBarHandles :: forall n. Widget n -> Widget n
withVScrollBarHandles Widget n
w =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
w) (forall n. Widget n -> Size
vSize Widget n
w) forall a b. (a -> b) -> a -> b
$
        forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) Bool
ctxVScrollBarShowHandlesL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True) (forall n. Widget n -> RenderM n (Result n)
render Widget n
w)

-- | Render vertical viewport scroll bars in the specified widget with
-- the specified renderer. This is only needed if you want to override
-- the use of the default renderer, 'verticalScrollbarRenderer'.
withVScrollBarRenderer :: ScrollbarRenderer n -> Widget n -> Widget n
withVScrollBarRenderer :: forall n. ScrollbarRenderer n -> Widget n -> Widget n
withVScrollBarRenderer ScrollbarRenderer n
r Widget n
w =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
w) (forall n. Widget n -> Size
vSize Widget n
w) forall a b. (a -> b) -> a -> b
$
        forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) (Maybe (ScrollbarRenderer n))
ctxVScrollBarRendererL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just ScrollbarRenderer n
r) (forall n. Widget n -> RenderM n (Result n)
render Widget n
w)

-- | The default renderer for vertical viewport scroll bars. Override
-- with 'withVScrollBarRenderer'.
verticalScrollbarRenderer :: ScrollbarRenderer n
verticalScrollbarRenderer :: forall n. ScrollbarRenderer n
verticalScrollbarRenderer =
    ScrollbarRenderer { renderScrollbar :: Widget n
renderScrollbar = forall n. Char -> Widget n
fill Char
'█'
                      , renderScrollbarTrough :: Widget n
renderScrollbarTrough = forall n. Char -> Widget n
fill Char
' '
                      , renderScrollbarHandleBefore :: Widget n
renderScrollbarHandleBefore = forall n. String -> Widget n
str String
"^"
                      , renderScrollbarHandleAfter :: Widget n
renderScrollbarHandleAfter = forall n. String -> Widget n
str String
"v"
                      }

-- | Enable horizontal scroll bars on all viewports in the specified
-- widget and draw them with the specified orientation.
withHScrollBars :: HScrollBarOrientation -> Widget n -> Widget n
withHScrollBars :: forall n. HScrollBarOrientation -> Widget n -> Widget n
withHScrollBars HScrollBarOrientation
orientation Widget n
w =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
w) (forall n. Widget n -> Size
vSize Widget n
w) forall a b. (a -> b) -> a -> b
$
        forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) (Maybe HScrollBarOrientation)
ctxHScrollBarOrientationL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just HScrollBarOrientation
orientation) (forall n. Widget n -> RenderM n (Result n)
render Widget n
w)

-- | Enable mouse click reporting on horizontal scroll bars in the
-- specified widget. This must be used with 'withHScrollBars'. The
-- provided function is used to build a resource name containing the
-- scroll bar element clicked and the viewport name associated with the
-- scroll bar. It is usually a data constructor of the @n@ type.
withClickableHScrollBars :: (ClickableScrollbarElement -> n -> n) -> Widget n -> Widget n
withClickableHScrollBars :: forall n.
(ClickableScrollbarElement -> n -> n) -> Widget n -> Widget n
withClickableHScrollBars ClickableScrollbarElement -> n -> n
f Widget n
w =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
w) (forall n. Widget n -> Size
vSize Widget n
w) forall a b. (a -> b) -> a -> b
$
        forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n.
Lens' (Context n) (Maybe (ClickableScrollbarElement -> n -> n))
ctxHScrollBarClickableConstrL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just ClickableScrollbarElement -> n -> n
f) (forall n. Widget n -> RenderM n (Result n)
render Widget n
w)

-- | Enable mouse click reporting on vertical scroll bars in the
-- specified widget. This must be used with 'withVScrollBars'. The
-- provided function is used to build a resource name containing the
-- scroll bar element clicked and the viewport name associated with the
-- scroll bar. It is usually a data constructor of the @n@ type.
withClickableVScrollBars :: (ClickableScrollbarElement -> n -> n) -> Widget n -> Widget n
withClickableVScrollBars :: forall n.
(ClickableScrollbarElement -> n -> n) -> Widget n -> Widget n
withClickableVScrollBars ClickableScrollbarElement -> n -> n
f Widget n
w =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
w) (forall n. Widget n -> Size
vSize Widget n
w) forall a b. (a -> b) -> a -> b
$
        forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n.
Lens' (Context n) (Maybe (ClickableScrollbarElement -> n -> n))
ctxVScrollBarClickableConstrL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just ClickableScrollbarElement -> n -> n
f) (forall n. Widget n -> RenderM n (Result n)
render Widget n
w)

-- | Enable scroll bar handles on all horizontal scroll bars in
-- the specified widget. Handles appear at the ends of the scroll
-- bar, representing the "handles" that are typically clickable in
-- graphical UIs to move the scroll bar incrementally. Horizontal
-- scroll bars are also clickable if mouse mode is enabled and if
-- 'withClickableHScrollBars' is used.
--
-- This will only have an effect if 'withHScrollBars' is also called.
withHScrollBarHandles :: Widget n -> Widget n
withHScrollBarHandles :: forall n. Widget n -> Widget n
withHScrollBarHandles Widget n
w =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
w) (forall n. Widget n -> Size
vSize Widget n
w) forall a b. (a -> b) -> a -> b
$
        forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) Bool
ctxHScrollBarShowHandlesL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True) (forall n. Widget n -> RenderM n (Result n)
render Widget n
w)

-- | Render horizontal viewport scroll bars in the specified widget with
-- the specified renderer. This is only needed if you want to override
-- the use of the default renderer, 'horizontalScrollbarRenderer'.
withHScrollBarRenderer :: ScrollbarRenderer n -> Widget n -> Widget n
withHScrollBarRenderer :: forall n. ScrollbarRenderer n -> Widget n -> Widget n
withHScrollBarRenderer ScrollbarRenderer n
r Widget n
w =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
w) (forall n. Widget n -> Size
vSize Widget n
w) forall a b. (a -> b) -> a -> b
$
        forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) (Maybe (ScrollbarRenderer n))
ctxHScrollBarRendererL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just ScrollbarRenderer n
r) (forall n. Widget n -> RenderM n (Result n)
render Widget n
w)

-- | The default renderer for horizontal viewport scroll bars. Override
-- with 'withHScrollBarRenderer'.
horizontalScrollbarRenderer :: ScrollbarRenderer n
horizontalScrollbarRenderer :: forall n. ScrollbarRenderer n
horizontalScrollbarRenderer =
    ScrollbarRenderer { renderScrollbar :: Widget n
renderScrollbar = forall n. Char -> Widget n
fill Char
'█'
                      , renderScrollbarTrough :: Widget n
renderScrollbarTrough = forall n. Char -> Widget n
fill Char
' '
                      , renderScrollbarHandleBefore :: Widget n
renderScrollbarHandleBefore = forall n. String -> Widget n
str String
"<"
                      , renderScrollbarHandleAfter :: Widget n
renderScrollbarHandleAfter = forall n. String -> Widget n
str String
">"
                      }

-- | Render the specified widget in a named viewport with the
-- specified type. This permits widgets to be scrolled without being
-- scrolling-aware. To make the most use of viewports, the specified
-- widget should use the 'visible' combinator to make a "visibility
-- request". This viewport combinator will then translate the resulting
-- rendering to make the requested region visible. In addition, the
-- 'Brick.Main.EventM' monad provides primitives to scroll viewports
-- created by this function if 'visible' is not what you want.
--
-- This function can automatically render vertical and horizontal scroll
-- bars if desired. To enable scroll bars, wrap your call to 'viewport'
-- with a call to 'withVScrollBars' and/or 'withHScrollBars'. If you
-- don't like the appearance of the resulting scroll bars (defaults:
-- 'verticalScrollbarRenderer' and 'horizontalScrollbarRenderer'),
-- you can customize how they are drawn by making your own
-- 'ScrollbarRenderer' and using 'withVScrollBarRenderer' and/or
-- 'withHScrollBarRenderer'. Note that when you enable scrollbars, the
-- content of your viewport will lose one column of available space if
-- vertical scroll bars are enabled and one row of available space if
-- horizontal scroll bars are enabled.
--
-- If a viewport receives more than one visibility request, then the
-- visibility requests are merged with the inner visibility request
-- taking preference. If a viewport receives more than one scrolling
-- request from 'Brick.Main.EventM', all are honored in the order in
-- which they are received.
--
-- Some caution should be advised when using this function. The viewport
-- renders its contents anew each time the viewport is drawn; in many
-- cases this is prohibitively expensive, and viewports should not be
-- used to display large contents for scrolling. This function is best
-- used when the contents are not too large OR when the contents are
-- large and render-cacheable.
--
-- Also, be aware that there is a rich API for accessing viewport
-- information from within the 'EventM' monad; check the docs for
-- @Brick.Main@ to learn more about ways to get information about
-- viewports after they're drawn.
viewport :: (Ord n, Show n)
         => n
         -- ^ The name of the viewport (must be unique and stable for
         -- reliable behavior)
         -> ViewportType
         -- ^ The type of viewport (indicates the permitted scrolling
         -- direction)
         -> Widget n
         -- ^ The widget to be rendered in the scrollable viewport
         -> Widget n
viewport :: forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport n
vpname ViewportType
typ Widget n
p =
    forall n. Ord n => n -> Widget n -> Widget n
clickable n
vpname forall a b. (a -> b) -> a -> b
$ forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy forall a b. (a -> b) -> a -> b
$ do
      -- Obtain the scroll bar configuration.
      Context n
c <- forall n. RenderM n (Context n)
getContext
      let vsOrientation :: Maybe VScrollBarOrientation
vsOrientation = forall n. Context n -> Maybe VScrollBarOrientation
ctxVScrollBarOrientation Context n
c
          hsOrientation :: Maybe HScrollBarOrientation
hsOrientation = forall n. Context n -> Maybe HScrollBarOrientation
ctxHScrollBarOrientation Context n
c
          vsRenderer :: ScrollbarRenderer n
vsRenderer = forall a. a -> Maybe a -> a
fromMaybe forall n. ScrollbarRenderer n
verticalScrollbarRenderer (forall n. Context n -> Maybe (ScrollbarRenderer n)
ctxVScrollBarRenderer Context n
c)
          hsRenderer :: ScrollbarRenderer n
hsRenderer = forall a. a -> Maybe a -> a
fromMaybe forall n. ScrollbarRenderer n
horizontalScrollbarRenderer (forall n. Context n -> Maybe (ScrollbarRenderer n)
ctxHScrollBarRenderer Context n
c)
          showVHandles :: Bool
showVHandles = forall n. Context n -> Bool
ctxVScrollBarShowHandles Context n
c
          showHHandles :: Bool
showHHandles = forall n. Context n -> Bool
ctxHScrollBarShowHandles Context n
c
          vsbClickableConstr :: Maybe (ClickableScrollbarElement -> n -> n)
vsbClickableConstr = forall n. Context n -> Maybe (ClickableScrollbarElement -> n -> n)
ctxVScrollBarClickableConstr Context n
c
          hsbClickableConstr :: Maybe (ClickableScrollbarElement -> n -> n)
hsbClickableConstr = forall n. Context n -> Maybe (ClickableScrollbarElement -> n -> n)
ctxHScrollBarClickableConstr Context n
c

      -- Observe the viewport name so we can detect multiple uses of the
      -- name.
      let observeName :: (Ord n, Show n) => n -> RenderM n ()
          observeName :: forall n. (Ord n, Show n) => n -> RenderM n ()
observeName n
n = do
              Set n
observed <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall n. Lens' (RenderState n) (Set n)
observedNamesL
              case forall a. Ord a => a -> Set a -> Bool
S.member n
n Set n
observed of
                  Bool
False -> forall n. Lens' (RenderState n) (Set n)
observedNamesL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a. Ord a => a -> Set a -> Set a
S.insert n
n
                  Bool
True ->
                      forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Error: while rendering the interface, the name " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show n
n forall a. Semigroup a => a -> a -> a
<>
                              String
" was seen more than once. You should ensure that all of the widgets " forall a. Semigroup a => a -> a -> a
<>
                              String
"in each interface have unique name values. This means either " forall a. Semigroup a => a -> a -> a
<>
                              String
"using a different name type or adding constructors to your " forall a. Semigroup a => a -> a -> a
<>
                              String
"existing one and using those to name your widgets.  For more " forall a. Semigroup a => a -> a -> a
<>
                              String
"information, see the \"Resource Names\" section of the Brick User Guide."

      forall n. (Ord n, Show n) => n -> RenderM n ()
observeName n
vpname

      -- Update the viewport size.
      let newVp :: Viewport
newVp = Int -> Int -> DisplayRegion -> DisplayRegion -> Viewport
VP Int
0 Int
0 DisplayRegion
newSize (Int
0, Int
0)
          newSize :: DisplayRegion
newSize = (Int
newWidth, Int
newHeight)
          newWidth :: Int
newWidth = Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL forall a. Num a => a -> a -> a
- Int
vSBWidth
          newHeight :: Int
newHeight = Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL forall a. Num a => a -> a -> a
- Int
hSBHeight
          vSBWidth :: Int
vSBWidth = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (forall a b. a -> b -> a
const Int
1) Maybe VScrollBarOrientation
vsOrientation
          hSBHeight :: Int
hSBHeight = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (forall a b. a -> b -> a
const Int
1) Maybe HScrollBarOrientation
hsOrientation
          doInsert :: Maybe Viewport -> Maybe Viewport
doInsert (Just Viewport
vp) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Viewport
vp forall a b. a -> (a -> b) -> b
& Lens' Viewport DisplayRegion
vpSize forall s t a b. ASetter s t a b -> b -> s -> t
.~ DisplayRegion
newSize
          doInsert Maybe Viewport
Nothing = forall a. a -> Maybe a
Just Viewport
newVp

      forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall n. Lens' (RenderState n) (Map n Viewport)
viewportMapL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe Viewport -> Maybe Viewport
doInsert n
vpname))

      -- Then render the viewport content widget with the rendering
      -- layout constraint released (but raise an exception if we are
      -- asked to render an infinitely-sized widget in the viewport's
      -- scrolling dimension). Also note that for viewports that
      -- only scroll in one direction, we apply a constraint in the
      -- non-scrolling direction in case a scroll bar is present.
      let release :: Widget n -> Maybe (Widget n)
release = case ViewportType
typ of
            ViewportType
Vertical -> forall n. Widget n -> Maybe (Widget n)
vRelease forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Int -> Widget n -> Widget n
hLimit Int
newWidth
            ViewportType
Horizontal -> forall n. Widget n -> Maybe (Widget n)
hRelease forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Int -> Widget n -> Widget n
vLimit Int
newHeight
            ViewportType
Both -> forall n. Widget n -> Maybe (Widget n)
vRelease forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall n. Widget n -> Maybe (Widget n)
hRelease
          released :: Widget n
released = case Widget n -> Maybe (Widget n)
release Widget n
p of
            Just Widget n
w -> Widget n
w
            Maybe (Widget n)
Nothing -> case ViewportType
typ of
                ViewportType
Vertical -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"tried to embed an infinite-height " forall a. Semigroup a => a -> a -> a
<>
                                    String
"widget in vertical viewport " forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show n
vpname)
                ViewportType
Horizontal -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"tried to embed an infinite-width " forall a. Semigroup a => a -> a -> a
<>
                                      String
"widget in horizontal viewport " forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show n
vpname)
                ViewportType
Both -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"tried to embed an infinite-width or " forall a. Semigroup a => a -> a -> a
<>
                                String
"infinite-height widget in 'Both' type " forall a. Semigroup a => a -> a -> a
<>
                                String
"viewport " forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show n
vpname)

      Result n
initialResult <- forall n. Widget n -> RenderM n (Result n)
render Widget n
released

      -- If the rendering state includes any scrolling requests for this
      -- viewport, apply those
      [(n, ScrollRequest)]
reqs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^.forall n. Lens' (RenderState n) [(n, ScrollRequest)]
rsScrollRequestsL)
      let relevantRequests :: [ScrollRequest]
relevantRequests = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter (\(n
n, ScrollRequest
_) -> n
n forall a. Eq a => a -> a -> Bool
== n
vpname) [(n, ScrollRequest)]
reqs
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ScrollRequest]
relevantRequests) forall a b. (a -> b) -> a -> b
$ do
          Maybe Viewport
mVp <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^.forall n. Lens' (RenderState n) (Map n Viewport)
viewportMapLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup n
vpname))
          case Maybe Viewport
mVp of
              Maybe Viewport
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"BUG: viewport: viewport name " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show n
vpname forall a. Semigroup a => a -> a -> a
<> String
" absent from viewport map"
              Just Viewport
vp -> do
                  let updatedVp :: Viewport
updatedVp = [ScrollRequest] -> Viewport -> Viewport
applyRequests [ScrollRequest]
relevantRequests Viewport
vp
                      applyRequests :: [ScrollRequest] -> Viewport -> Viewport
applyRequests [] Viewport
v = Viewport
v
                      applyRequests (ScrollRequest
rq:[ScrollRequest]
rqs) Viewport
v =
                          case ViewportType
typ of
                              ViewportType
Horizontal -> ViewportType -> ScrollRequest -> Image -> Viewport -> Viewport
scrollTo ViewportType
typ ScrollRequest
rq (Result n
initialResultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL) forall a b. (a -> b) -> a -> b
$ [ScrollRequest] -> Viewport -> Viewport
applyRequests [ScrollRequest]
rqs Viewport
v
                              ViewportType
Vertical -> ViewportType -> ScrollRequest -> Image -> Viewport -> Viewport
scrollTo ViewportType
typ ScrollRequest
rq (Result n
initialResultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL) forall a b. (a -> b) -> a -> b
$ [ScrollRequest] -> Viewport -> Viewport
applyRequests [ScrollRequest]
rqs Viewport
v
                              ViewportType
Both -> ViewportType -> ScrollRequest -> Image -> Viewport -> Viewport
scrollTo ViewportType
Horizontal ScrollRequest
rq (Result n
initialResultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL) forall a b. (a -> b) -> a -> b
$
                                      ViewportType -> ScrollRequest -> Image -> Viewport -> Viewport
scrollTo ViewportType
Vertical ScrollRequest
rq (Result n
initialResultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL) forall a b. (a -> b) -> a -> b
$
                                      [ScrollRequest] -> Viewport -> Viewport
applyRequests [ScrollRequest]
rqs Viewport
v
                  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall n. Lens' (RenderState n) (Map n Viewport)
viewportMapL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert n
vpname Viewport
updatedVp))

      -- If the sub-rendering requested visibility, update the scroll
      -- state accordingly
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ Result n
initialResultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) [VisibilityRequest]
visibilityRequestsL) forall a b. (a -> b) -> a -> b
$ do
          Maybe Viewport
mVp <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^.forall n. Lens' (RenderState n) (Map n Viewport)
viewportMapLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup n
vpname))
          case Maybe Viewport
mVp of
              Maybe Viewport
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"BUG: viewport: viewport name " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show n
vpname forall a. Semigroup a => a -> a -> a
<> String
" absent from viewport map"
              Just Viewport
vp -> do
                  let rqs :: [VisibilityRequest]
rqs = Result n
initialResultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) [VisibilityRequest]
visibilityRequestsL
                      updateVp :: Viewport -> VisibilityRequest -> Viewport
updateVp Viewport
vp' VisibilityRequest
rq = case ViewportType
typ of
                          ViewportType
Both -> ViewportType -> VisibilityRequest -> Viewport -> Viewport
scrollToView ViewportType
Horizontal VisibilityRequest
rq forall a b. (a -> b) -> a -> b
$ ViewportType -> VisibilityRequest -> Viewport -> Viewport
scrollToView ViewportType
Vertical VisibilityRequest
rq Viewport
vp'
                          ViewportType
Horizontal -> ViewportType -> VisibilityRequest -> Viewport -> Viewport
scrollToView ViewportType
typ VisibilityRequest
rq Viewport
vp'
                          ViewportType
Vertical -> ViewportType -> VisibilityRequest -> Viewport -> Viewport
scrollToView ViewportType
typ VisibilityRequest
rq Viewport
vp'
                  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall n. Lens' (RenderState n) (Map n Viewport)
viewportMapL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert n
vpname forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Viewport -> VisibilityRequest -> Viewport
updateVp Viewport
vp [VisibilityRequest]
rqs))

      -- If the size of the rendering changes enough to make the
      -- viewport offsets invalid, reset them
      Maybe Viewport
mVp <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^.forall n. Lens' (RenderState n) (Map n Viewport)
viewportMapLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup n
vpname))
      Viewport
vp <- case Maybe Viewport
mVp of
          Maybe Viewport
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"BUG: viewport: viewport name " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show n
vpname forall a. Semigroup a => a -> a -> a
<> String
" absent from viewport map"
          Just Viewport
v -> forall (m :: * -> *) a. Monad m => a -> m a
return Viewport
v

      let img :: Image
img = Result n
initialResultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL
          fixTop :: Viewport -> Viewport
fixTop Viewport
v = if Image -> Int
V.imageHeight Image
img forall a. Ord a => a -> a -> Bool
< Viewport
vforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field2 s t a b => Lens s t a b
_2
                   then Viewport
v forall a b. a -> (a -> b) -> b
& Lens' Viewport Int
vpTop forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
0
                   else Viewport
v
          fixLeft :: Viewport -> Viewport
fixLeft Viewport
v = if Image -> Int
V.imageWidth Image
img forall a. Ord a => a -> a -> Bool
< Viewport
vforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field1 s t a b => Lens s t a b
_1
                   then Viewport
v forall a b. a -> (a -> b) -> b
& Lens' Viewport Int
vpLeft forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
0
                   else Viewport
v
          updateContentSize :: Viewport -> Viewport
updateContentSize Viewport
v = Viewport
v forall a b. a -> (a -> b) -> b
& Lens' Viewport DisplayRegion
vpContentSize forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Image -> Int
V.imageWidth Image
img, Image -> Int
V.imageHeight Image
img)
          updateVp :: Viewport -> Viewport
updateVp = Viewport -> Viewport
updateContentSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. case ViewportType
typ of
              ViewportType
Both -> Viewport -> Viewport
fixLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
. Viewport -> Viewport
fixTop
              ViewportType
Horizontal -> Viewport -> Viewport
fixLeft
              ViewportType
Vertical -> Viewport -> Viewport
fixTop
      forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall n. Lens' (RenderState n) (Map n Viewport)
viewportMapL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert n
vpname (Viewport -> Viewport
updateVp Viewport
vp)))

      -- Get the viewport state now that it has been updated.
      Maybe Viewport
mVpFinal <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup n
vpname forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^.forall n. Lens' (RenderState n) (Map n Viewport)
viewportMapL))
      Viewport
vpFinal <- case Maybe Viewport
mVpFinal of
          Maybe Viewport
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"BUG: viewport: viewport name " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show n
vpname forall a. Semigroup a => a -> a -> a
<> String
" absent from viewport map"
          Just Viewport
v -> forall (m :: * -> *) a. Monad m => a -> m a
return Viewport
v

      -- Then perform a translation of the sub-rendering to fit into the
      -- viewport
      Result n
translated <- forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Location -> Widget n -> Widget n
translateBy (DisplayRegion -> Location
Location (-Int
1 forall a. Num a => a -> a -> a
* Viewport
vpFinalforall s a. s -> Getting a s a -> a
^.Lens' Viewport Int
vpLeft, -Int
1 forall a. Num a => a -> a -> a
* Viewport
vpFinalforall s a. s -> Getting a s a -> a
^.Lens' Viewport Int
vpTop))
                           forall a b. (a -> b) -> a -> b
$ forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Result n
initialResult

      -- If the vertical scroll bar is enabled, render the scroll bar
      -- area.
      let addVScrollbar :: Widget n -> Widget n
addVScrollbar = case Maybe VScrollBarOrientation
vsOrientation of
              Maybe VScrollBarOrientation
Nothing -> forall a. a -> a
id
              Just VScrollBarOrientation
orientation ->
                  let sb :: Widget n
sb = forall n.
Ord n =>
ScrollbarRenderer n
-> n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> Bool
-> Int
-> Int
-> Int
-> Widget n
verticalScrollbar ScrollbarRenderer n
vsRenderer n
vpname
                                                        Maybe (ClickableScrollbarElement -> n -> n)
vsbClickableConstr
                                                        Bool
showVHandles
                                                        (Viewport
vpFinalforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field2 s t a b => Lens s t a b
_2)
                                                        (Viewport
vpFinalforall s a. s -> Getting a s a -> a
^.Lens' Viewport Int
vpTop)
                                                        (Viewport
vpFinalforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpContentSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field2 s t a b => Lens s t a b
_2)
                      combine :: Widget n -> Widget n -> Widget n
combine = case VScrollBarOrientation
orientation of
                          VScrollBarOrientation
OnLeft -> forall n. Widget n -> Widget n -> Widget n
(<+>)
                          VScrollBarOrientation
OnRight -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall n. Widget n -> Widget n -> Widget n
(<+>)
                  in Widget n -> Widget n -> Widget n
combine Widget n
sb
          addHScrollbar :: Widget n -> Widget n
addHScrollbar = case Maybe HScrollBarOrientation
hsOrientation of
              Maybe HScrollBarOrientation
Nothing -> forall a. a -> a
id
              Just HScrollBarOrientation
orientation ->
                  let sb :: Widget n
sb = forall n.
Ord n =>
ScrollbarRenderer n
-> n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> Bool
-> Int
-> Int
-> Int
-> Widget n
horizontalScrollbar ScrollbarRenderer n
hsRenderer n
vpname
                                                          Maybe (ClickableScrollbarElement -> n -> n)
hsbClickableConstr
                                                          Bool
showHHandles
                                                          (Viewport
vpFinalforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field1 s t a b => Lens s t a b
_1)
                                                          (Viewport
vpFinalforall s a. s -> Getting a s a -> a
^.Lens' Viewport Int
vpLeft)
                                                          (Viewport
vpFinalforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpContentSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field1 s t a b => Lens s t a b
_1)
                      combine :: Widget n -> Widget n -> Widget n
combine = case HScrollBarOrientation
orientation of
                          HScrollBarOrientation
OnTop -> forall n. Widget n -> Widget n -> Widget n
(<=>)
                          HScrollBarOrientation
OnBottom -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall n. Widget n -> Widget n -> Widget n
(<=>)
                  in Widget n -> Widget n -> Widget n
combine Widget n
sb

      -- Return the translated result with the visibility requests
      -- discarded
      let translatedSize :: DisplayRegion
translatedSize = ( Result n
translatedforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageWidth
                           , Result n
translatedforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageHeight
                           )
      case DisplayRegion
translatedSize of
          (Int
0, Int
0) -> do
              let spaceFill :: Image
spaceFill = forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill (Context n
cforall s a. s -> Getting a s a -> a
^.forall r n. Getting r (Context n) Attr
attrL) Char
' ' (Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL) (Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL)
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Result n
translated forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) Image
imageL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Image
spaceFill
                                  forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) [VisibilityRequest]
visibilityRequestsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Monoid a => a
mempty
                                  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 -> b -> s -> t
.~ forall a. Monoid a => a
mempty
          DisplayRegion
_ -> forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
addVScrollbar
                      forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
addHScrollbar
                      forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit (Viewport
vpFinalforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field2 s t a b => Lens s t a b
_2)
                      forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit (Viewport
vpFinalforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field1 s t a b => Lens s t a b
_1)
                      forall a b. (a -> b) -> a -> b
$ forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max
                      forall a b. (a -> b) -> a -> b
$ forall n. Padding -> Widget n -> Widget n
padRight Padding
Max
                      forall a b. (a -> b) -> a -> b
$ forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed
                      forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Result n
translated forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) [VisibilityRequest]
visibilityRequestsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Monoid a => a
mempty

-- | The base attribute for scroll bars.
scrollbarAttr :: AttrName
scrollbarAttr :: AttrName
scrollbarAttr = String -> AttrName
attrName String
"scrollbar"

-- | The attribute for scroll bar troughs. This attribute is a
-- specialization of @scrollbarAttr@.
scrollbarTroughAttr :: AttrName
scrollbarTroughAttr :: AttrName
scrollbarTroughAttr = AttrName
scrollbarAttr forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"trough"

-- | The attribute for scroll bar handles. This attribute is a
-- specialization of @scrollbarAttr@.
scrollbarHandleAttr :: AttrName
scrollbarHandleAttr :: AttrName
scrollbarHandleAttr = AttrName
scrollbarAttr forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"handle"

maybeClick :: (Ord n)
           => n
           -> Maybe (ClickableScrollbarElement -> n -> n)
           -> ClickableScrollbarElement
           -> Widget n
           -> Widget n
maybeClick :: forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
_ Maybe (ClickableScrollbarElement -> n -> n)
Nothing ClickableScrollbarElement
_ Widget n
w = Widget n
w
maybeClick n
n (Just ClickableScrollbarElement -> n -> n
f) ClickableScrollbarElement
el Widget n
w = forall n. Ord n => n -> Widget n -> Widget n
clickable (ClickableScrollbarElement -> n -> n
f ClickableScrollbarElement
el n
n) Widget n
w

-- | Build a vertical scroll bar using the specified render and
-- settings.
--
-- You probably don't want to use this directly; instead,
-- use @viewport@, @withVScrollBars@, and, if needed,
-- @withVScrollBarRenderer@. This is exposed so that if you want to
-- render a scroll bar of your own, you can do so outside the @viewport@
-- context.
verticalScrollbar :: (Ord n)
                  => ScrollbarRenderer n
                  -- ^ The renderer to use.
                  -> n
                  -- ^ The viewport name associated with this scroll
                  -- bar.
                  -> Maybe (ClickableScrollbarElement -> n -> n)
                  -- ^ Constructor for clickable scroll bar element names.
                  -> Bool
                  -- ^ Whether to display handles.
                  -> Int
                  -- ^ The total viewport height in effect.
                  -> Int
                  -- ^ The viewport vertical scrolling offset in effect.
                  -> Int
                  -- ^ The total viewport content height.
                  -> Widget n
verticalScrollbar :: forall n.
Ord n =>
ScrollbarRenderer n
-> n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> Bool
-> Int
-> Int
-> Int
-> Widget n
verticalScrollbar ScrollbarRenderer n
vsRenderer n
n Maybe (ClickableScrollbarElement -> n -> n)
constr Bool
False Int
vpHeight Int
vOffset Int
contentHeight =
    forall n.
Ord n =>
ScrollbarRenderer n
-> n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> Int
-> Int
-> Int
-> Widget n
verticalScrollbar' ScrollbarRenderer n
vsRenderer n
n Maybe (ClickableScrollbarElement -> n -> n)
constr Int
vpHeight Int
vOffset Int
contentHeight
verticalScrollbar ScrollbarRenderer n
vsRenderer n
n Maybe (ClickableScrollbarElement -> n -> n)
constr Bool
True Int
vpHeight Int
vOffset Int
contentHeight =
    forall n. [Widget n] -> Widget n
vBox [ forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBHandleBefore forall a b. (a -> b) -> a -> b
$
           forall n. Int -> Widget n -> Widget n
hLimit Int
1 forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarHandleAttr forall a b. (a -> b) -> a -> b
$ forall n. ScrollbarRenderer n -> Widget n
renderScrollbarHandleBefore ScrollbarRenderer n
vsRenderer
         , forall n.
Ord n =>
ScrollbarRenderer n
-> n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> Int
-> Int
-> Int
-> Widget n
verticalScrollbar' ScrollbarRenderer n
vsRenderer n
n Maybe (ClickableScrollbarElement -> n -> n)
constr Int
vpHeight Int
vOffset Int
contentHeight
         , forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBHandleAfter forall a b. (a -> b) -> a -> b
$
           forall n. Int -> Widget n -> Widget n
hLimit Int
1 forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarHandleAttr forall a b. (a -> b) -> a -> b
$ forall n. ScrollbarRenderer n -> Widget n
renderScrollbarHandleAfter ScrollbarRenderer n
vsRenderer
         ]

verticalScrollbar' :: (Ord n)
                   => ScrollbarRenderer n
                   -- ^ The renderer to use.
                   -> n
                   -- ^ The viewport name associated with this scroll
                   -- bar.
                   -> Maybe (ClickableScrollbarElement -> n -> n)
                   -- ^ Constructor for clickable scroll bar element names.
                   -> Int
                   -- ^ The total viewport height in effect.
                   -> Int
                   -- ^ The viewport vertical scrolling offset in effect.
                   -> Int
                   -- ^ The total viewport content height.
                   -> Widget n
verticalScrollbar' :: forall n.
Ord n =>
ScrollbarRenderer n
-> n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> Int
-> Int
-> Int
-> Widget n
verticalScrollbar' ScrollbarRenderer n
vsRenderer n
_ Maybe (ClickableScrollbarElement -> n -> n)
_ Int
vpHeight Int
_ Int
0 =
    forall n. Int -> Widget n -> Widget n
hLimit Int
1 forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit Int
vpHeight forall a b. (a -> b) -> a -> b
$ forall n. ScrollbarRenderer n -> Widget n
renderScrollbarTrough ScrollbarRenderer n
vsRenderer
verticalScrollbar' ScrollbarRenderer n
vsRenderer n
n Maybe (ClickableScrollbarElement -> n -> n)
constr Int
vpHeight Int
vOffset Int
contentHeight =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Greedy forall a b. (a -> b) -> a -> b
$ do
        Context n
c <- forall n. RenderM n (Context n)
getContext

        -- Get the proportion of the total content that is visible
        let visibleContentPercent :: Double
            visibleContentPercent :: Double
visibleContentPercent = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
vpHeight forall a. Fractional a => a -> a -> a
/
                                    forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
contentHeight

            ctxHeight :: Int
ctxHeight = Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL

            -- Then get the proportion of the scroll bar that
            -- should be filled in
            sbSize :: Int
sbSize = forall a. Ord a => a -> a -> a
min Int
ctxHeight forall a b. (a -> b) -> a -> b
$
                     forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$
                     forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Double
visibleContentPercent forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ctxHeight)

            -- Then get the vertical offset of the scroll bar
            -- itself
            sbOffset :: Int
sbOffset = if Int
vOffset forall a. Eq a => a -> a -> Bool
== Int
0
                       then Int
0
                       else if Int
vOffset forall a. Eq a => a -> a -> Bool
== Int
contentHeight forall a. Num a => a -> a -> a
- Int
vpHeight
                            then Int
ctxHeight forall a. Num a => a -> a -> a
- Int
sbSize
                            else forall a. Ord a => a -> a -> a
min (Int
ctxHeight forall a. Num a => a -> a -> a
- Int
sbSize forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$
                                 forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$
                                 forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ctxHeight forall a. Num a => a -> a -> a
*
                                         (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
vOffset forall a. Fractional a => a -> a -> a
/
                                          forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
contentHeight::Double)

            sbAbove :: Widget n
sbAbove = forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBTroughBefore forall a b. (a -> b) -> a -> b
$
                      forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarTroughAttr forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit Int
sbOffset forall a b. (a -> b) -> a -> b
$
                      forall n. ScrollbarRenderer n -> Widget n
renderScrollbarTrough ScrollbarRenderer n
vsRenderer
            sbBelow :: Widget n
sbBelow = forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBTroughAfter forall a b. (a -> b) -> a -> b
$
                      forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarTroughAttr forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit (Int
ctxHeight forall a. Num a => a -> a -> a
- (Int
sbOffset forall a. Num a => a -> a -> a
+ Int
sbSize)) forall a b. (a -> b) -> a -> b
$
                      forall n. ScrollbarRenderer n -> Widget n
renderScrollbarTrough ScrollbarRenderer n
vsRenderer
            sbMiddle :: Widget n
sbMiddle = forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBBar forall a b. (a -> b) -> a -> b
$
                       forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarAttr forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit Int
sbSize forall a b. (a -> b) -> a -> b
$ forall n. ScrollbarRenderer n -> Widget n
renderScrollbar ScrollbarRenderer n
vsRenderer

            sb :: Widget n
sb = forall n. Int -> Widget n -> Widget n
hLimit Int
1 forall a b. (a -> b) -> a -> b
$
                 if Int
sbSize forall a. Eq a => a -> a -> Bool
== Int
ctxHeight
                 then forall n. Int -> Widget n -> Widget n
vLimit Int
sbSize forall a b. (a -> b) -> a -> b
$
                      forall n. ScrollbarRenderer n -> Widget n
renderScrollbarTrough ScrollbarRenderer n
vsRenderer
                 else forall n. [Widget n] -> Widget n
vBox [Widget n
sbAbove, Widget n
sbMiddle, Widget n
sbBelow]

        forall n. Widget n -> RenderM n (Result n)
render Widget n
sb

-- | Build a horizontal scroll bar using the specified render and
-- settings.
--
-- You probably don't want to use this directly; instead, use
-- @viewport@, @withHScrollBars@, and, if needed,
-- @withHScrollBarRenderer@. This is exposed so that if you want to
-- render a scroll bar of your own, you can do so outside the @viewport@
-- context.
horizontalScrollbar :: (Ord n)
                    => ScrollbarRenderer n
                    -- ^ The renderer to use.
                    -> n
                    -- ^ The viewport name associated with this scroll
                    -- bar.
                    -> Maybe (ClickableScrollbarElement -> n -> n)
                    -- ^ Constructor for clickable scroll bar element
                    -- names.
                    -> Bool
                    -- ^ Whether to show handles.
                    -> Int
                    -- ^ The total viewport width in effect.
                    -> Int
                    -- ^ The viewport horizontal scrolling offset in effect.
                    -> Int
                    -- ^ The total viewport content width.
                    -> Widget n
horizontalScrollbar :: forall n.
Ord n =>
ScrollbarRenderer n
-> n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> Bool
-> Int
-> Int
-> Int
-> Widget n
horizontalScrollbar ScrollbarRenderer n
hsRenderer n
n Maybe (ClickableScrollbarElement -> n -> n)
constr Bool
False Int
vpWidth Int
hOffset Int
contentWidth =
    forall n.
Ord n =>
ScrollbarRenderer n
-> n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> Int
-> Int
-> Int
-> Widget n
horizontalScrollbar' ScrollbarRenderer n
hsRenderer n
n Maybe (ClickableScrollbarElement -> n -> n)
constr Int
vpWidth Int
hOffset Int
contentWidth
horizontalScrollbar ScrollbarRenderer n
hsRenderer n
n Maybe (ClickableScrollbarElement -> n -> n)
constr Bool
True Int
vpWidth Int
hOffset Int
contentWidth =
    forall n. [Widget n] -> Widget n
hBox [ forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBHandleBefore forall a b. (a -> b) -> a -> b
$
           forall n. Int -> Widget n -> Widget n
vLimit Int
1 forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarHandleAttr forall a b. (a -> b) -> a -> b
$ forall n. ScrollbarRenderer n -> Widget n
renderScrollbarHandleBefore ScrollbarRenderer n
hsRenderer
         , forall n.
Ord n =>
ScrollbarRenderer n
-> n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> Int
-> Int
-> Int
-> Widget n
horizontalScrollbar' ScrollbarRenderer n
hsRenderer n
n Maybe (ClickableScrollbarElement -> n -> n)
constr Int
vpWidth Int
hOffset Int
contentWidth
         , forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBHandleAfter forall a b. (a -> b) -> a -> b
$
           forall n. Int -> Widget n -> Widget n
vLimit Int
1 forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarHandleAttr forall a b. (a -> b) -> a -> b
$ forall n. ScrollbarRenderer n -> Widget n
renderScrollbarHandleAfter ScrollbarRenderer n
hsRenderer
         ]

horizontalScrollbar' :: (Ord n)
                     => ScrollbarRenderer n
                     -- ^ The renderer to use.
                     -> n
                     -- ^ The viewport name associated with this scroll
                     -- bar.
                     -> Maybe (ClickableScrollbarElement -> n -> n)
                     -- ^ Constructor for clickable scroll bar element
                     -- names.
                     -> Int
                     -- ^ The total viewport width in effect.
                     -> Int
                     -- ^ The viewport horizontal scrolling offset in effect.
                     -> Int
                     -- ^ The total viewport content width.
                     -> Widget n
horizontalScrollbar' :: forall n.
Ord n =>
ScrollbarRenderer n
-> n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> Int
-> Int
-> Int
-> Widget n
horizontalScrollbar' ScrollbarRenderer n
hsRenderer n
_ Maybe (ClickableScrollbarElement -> n -> n)
_ Int
vpWidth Int
_ Int
0 =
    forall n. Int -> Widget n -> Widget n
vLimit Int
1 forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit Int
vpWidth forall a b. (a -> b) -> a -> b
$ forall n. ScrollbarRenderer n -> Widget n
renderScrollbarTrough ScrollbarRenderer n
hsRenderer
horizontalScrollbar' ScrollbarRenderer n
hsRenderer n
n Maybe (ClickableScrollbarElement -> n -> n)
constr Int
vpWidth Int
hOffset Int
contentWidth =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed forall a b. (a -> b) -> a -> b
$ do
        Context n
c <- forall n. RenderM n (Context n)
getContext

        -- Get the proportion of the total content that is visible
        let visibleContentPercent :: Double
            visibleContentPercent :: Double
visibleContentPercent = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
vpWidth forall a. Fractional a => a -> a -> a
/
                                    forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
contentWidth

            ctxWidth :: Int
ctxWidth = Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL

            -- Then get the proportion of the scroll bar that
            -- should be filled in
            sbSize :: Int
sbSize = forall a. Ord a => a -> a -> a
min Int
ctxWidth forall a b. (a -> b) -> a -> b
$
                     forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$
                     forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Double
visibleContentPercent forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ctxWidth)

            -- Then get the horizontal offset of the scroll bar itself
            sbOffset :: Int
sbOffset = if Int
hOffset forall a. Eq a => a -> a -> Bool
== Int
0
                       then Int
0
                       else if Int
hOffset forall a. Eq a => a -> a -> Bool
== Int
contentWidth forall a. Num a => a -> a -> a
- Int
vpWidth
                            then Int
ctxWidth forall a. Num a => a -> a -> a
- Int
sbSize
                            else forall a. Ord a => a -> a -> a
min (Int
ctxWidth forall a. Num a => a -> a -> a
- Int
sbSize forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$
                                 forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$
                                 forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ctxWidth forall a. Num a => a -> a -> a
*
                                         (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hOffset forall a. Fractional a => a -> a -> a
/
                                          forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
contentWidth::Double)

            sbLeft :: Widget n
sbLeft = forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBTroughBefore forall a b. (a -> b) -> a -> b
$
                     forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarTroughAttr forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit Int
sbOffset forall a b. (a -> b) -> a -> b
$
                     forall n. ScrollbarRenderer n -> Widget n
renderScrollbarTrough ScrollbarRenderer n
hsRenderer
            sbRight :: Widget n
sbRight = forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBTroughAfter forall a b. (a -> b) -> a -> b
$
                      forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarTroughAttr forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit (Int
ctxWidth forall a. Num a => a -> a -> a
- (Int
sbOffset forall a. Num a => a -> a -> a
+ Int
sbSize)) forall a b. (a -> b) -> a -> b
$
                      forall n. ScrollbarRenderer n -> Widget n
renderScrollbarTrough ScrollbarRenderer n
hsRenderer
            sbMiddle :: Widget n
sbMiddle = forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBBar forall a b. (a -> b) -> a -> b
$
                       forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarAttr forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit Int
sbSize forall a b. (a -> b) -> a -> b
$ forall n. ScrollbarRenderer n -> Widget n
renderScrollbar ScrollbarRenderer n
hsRenderer

            sb :: Widget n
sb = forall n. Int -> Widget n -> Widget n
vLimit Int
1 forall a b. (a -> b) -> a -> b
$
                 if Int
sbSize forall a. Eq a => a -> a -> Bool
== Int
ctxWidth
                 then forall n. Int -> Widget n -> Widget n
hLimit Int
sbSize forall a b. (a -> b) -> a -> b
$
                      forall n. ScrollbarRenderer n -> Widget n
renderScrollbarTrough ScrollbarRenderer n
hsRenderer
                 else forall n. [Widget n] -> Widget n
hBox [Widget n
sbLeft, Widget n
sbMiddle, Widget n
sbRight]

        forall n. Widget n -> RenderM n (Result n)
render Widget n
sb

-- | Given a name, obtain the viewport for that name by consulting the
-- viewport map in the rendering monad. NOTE! Some care must be taken
-- when calling this function, since it only returns useful values
-- after the viewport in question has been rendered. If you call this
-- function during rendering before a viewport has been rendered, you
-- may get nothing or you may get a stale version of the viewport. This
-- is because viewports are updated during rendering and the one you are
-- interested in may not have been rendered yet. So if you want to use
-- this, be sure you know what you are doing.
unsafeLookupViewport :: (Ord n) => n -> RenderM n (Maybe Viewport)
unsafeLookupViewport :: forall n. Ord n => n -> RenderM n (Maybe Viewport)
unsafeLookupViewport n
name = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup n
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^.forall n. Lens' (RenderState n) (Map n Viewport)
viewportMapL))

scrollTo :: ViewportType -> ScrollRequest -> V.Image -> Viewport -> Viewport
scrollTo :: ViewportType -> ScrollRequest -> Image -> Viewport -> Viewport
scrollTo ViewportType
Both ScrollRequest
_ Image
_ Viewport
_ = forall a. HasCallStack => String -> a
error String
"BUG: called scrollTo on viewport type 'Both'"
scrollTo ViewportType
Vertical ScrollRequest
req Image
img Viewport
vp = Viewport
vp forall a b. a -> (a -> b) -> b
& Lens' Viewport Int
vpTop forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
newVStart
    where
        newVStart :: Int
newVStart = forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Image -> Int
V.imageHeight Image
img forall a. Num a => a -> a -> a
- Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field2 s t a b => Lens s t a b
_2) Int
adjustedAmt
        adjustedAmt :: Int
adjustedAmt = case ScrollRequest
req of
            VScrollBy Int
amt -> Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport Int
vpTop forall a. Num a => a -> a -> a
+ Int
amt
            VScrollPage Direction
Up -> Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport Int
vpTop forall a. Num a => a -> a -> a
- Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field2 s t a b => Lens s t a b
_2
            VScrollPage Direction
Down -> Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport Int
vpTop forall a. Num a => a -> a -> a
+ Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field2 s t a b => Lens s t a b
_2
            ScrollRequest
VScrollToBeginning -> Int
0
            ScrollRequest
VScrollToEnd -> Image -> Int
V.imageHeight Image
img forall a. Num a => a -> a -> a
- Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field2 s t a b => Lens s t a b
_2
            SetTop Int
i -> Int
i
            ScrollRequest
_ -> Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport Int
vpTop
scrollTo ViewportType
Horizontal ScrollRequest
req Image
img Viewport
vp = Viewport
vp forall a b. a -> (a -> b) -> b
& Lens' Viewport Int
vpLeft forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
newHStart
    where
        newHStart :: Int
newHStart = forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Image -> Int
V.imageWidth Image
img forall a. Num a => a -> a -> a
- Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field1 s t a b => Lens s t a b
_1) Int
adjustedAmt
        adjustedAmt :: Int
adjustedAmt = case ScrollRequest
req of
            HScrollBy Int
amt -> Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport Int
vpLeft forall a. Num a => a -> a -> a
+ Int
amt
            HScrollPage Direction
Up -> Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport Int
vpLeft forall a. Num a => a -> a -> a
- Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field1 s t a b => Lens s t a b
_1
            HScrollPage Direction
Down -> Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport Int
vpLeft forall a. Num a => a -> a -> a
+ Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field1 s t a b => Lens s t a b
_1
            ScrollRequest
HScrollToBeginning -> Int
0
            ScrollRequest
HScrollToEnd -> Image -> Int
V.imageWidth Image
img forall a. Num a => a -> a -> a
- Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field1 s t a b => Lens s t a b
_1
            SetLeft Int
i -> Int
i
            ScrollRequest
_ -> Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport Int
vpLeft

scrollToView :: ViewportType -> VisibilityRequest -> Viewport -> Viewport
scrollToView :: ViewportType -> VisibilityRequest -> Viewport -> Viewport
scrollToView ViewportType
Both VisibilityRequest
_ Viewport
_ = forall a. HasCallStack => String -> a
error String
"BUG: called scrollToView on 'Both' type viewport"
scrollToView ViewportType
Vertical VisibilityRequest
rq Viewport
vp = Viewport
vp forall a b. a -> (a -> b) -> b
& Lens' Viewport Int
vpTop forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
newVStart
    where
        curStart :: Int
curStart = Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport Int
vpTop
        curEnd :: Int
curEnd = Int
curStart forall a. Num a => a -> a -> a
+ Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field2 s t a b => Lens s t a b
_2
        reqStart :: Int
reqStart = VisibilityRequest
rqforall s a. s -> Getting a s a -> a
^.Lens' VisibilityRequest Location
vrPositionLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. TerminalLocation a => Lens' a Int
locationRowL

        reqEnd :: Int
reqEnd = VisibilityRequest
rqforall s a. s -> Getting a s a -> a
^.Lens' VisibilityRequest Location
vrPositionLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. TerminalLocation a => Lens' a Int
locationRowL forall a. Num a => a -> a -> a
+ VisibilityRequest
rqforall s a. s -> Getting a s a -> a
^.Lens' VisibilityRequest DisplayRegion
vrSizeLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field2 s t a b => Lens s t a b
_2
        newVStart :: Int
        newVStart :: Int
newVStart = if Int
reqStart forall a. Ord a => a -> a -> Bool
< Int
vStartEndVisible
                   then Int
reqStart
                   else Int
vStartEndVisible
        vStartEndVisible :: Int
vStartEndVisible = if Int
reqEnd forall a. Ord a => a -> a -> Bool
< Int
curEnd
                           then Int
curStart
                           else Int
curStart forall a. Num a => a -> a -> a
+ (Int
reqEnd forall a. Num a => a -> a -> a
- Int
curEnd)
scrollToView ViewportType
Horizontal VisibilityRequest
rq Viewport
vp = Viewport
vp forall a b. a -> (a -> b) -> b
& Lens' Viewport Int
vpLeft forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
newHStart
    where
        curStart :: Int
curStart = Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport Int
vpLeft
        curEnd :: Int
curEnd = Int
curStart forall a. Num a => a -> a -> a
+ Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport DisplayRegion
vpSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field1 s t a b => Lens s t a b
_1
        reqStart :: Int
reqStart = VisibilityRequest
rqforall s a. s -> Getting a s a -> a
^.Lens' VisibilityRequest Location
vrPositionLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. TerminalLocation a => Lens' a Int
locationColumnL

        reqEnd :: Int
reqEnd = VisibilityRequest
rqforall s a. s -> Getting a s a -> a
^.Lens' VisibilityRequest Location
vrPositionLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. TerminalLocation a => Lens' a Int
locationColumnL forall a. Num a => a -> a -> a
+ VisibilityRequest
rqforall s a. s -> Getting a s a -> a
^.Lens' VisibilityRequest DisplayRegion
vrSizeLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field1 s t a b => Lens s t a b
_1
        newHStart :: Int
        newHStart :: Int
newHStart = if Int
reqStart forall a. Ord a => a -> a -> Bool
< Int
hStartEndVisible
                   then Int
reqStart
                   else Int
hStartEndVisible
        hStartEndVisible :: Int
hStartEndVisible = if Int
reqEnd forall a. Ord a => a -> a -> Bool
< Int
curEnd
                           then Int
curStart
                           else Int
curStart forall a. Num a => a -> a -> a
+ (Int
reqEnd forall a. Num a => a -> a -> a
- Int
curEnd)

-- | Request that the specified widget be made visible when it is
-- rendered inside a viewport. This permits widgets (whose sizes and
-- positions cannot be known due to being embedded in arbitrary layouts)
-- to make a request for a parent viewport to locate them and scroll
-- enough to put them in view. This, together with 'viewport', is what
-- makes the text editor and list widgets possible without making them
-- deal with the details of scrolling state management.
--
-- This does nothing if not rendered in a viewport.
visible :: Widget n -> Widget n
visible :: forall n. Widget n -> Widget n
visible 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 a b. (a -> b) -> a -> b
$ do
      Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
p
      let imageSize :: DisplayRegion
imageSize = ( Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageWidth
                      , Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageHeight
                      )
      -- The size of the image to be made visible in a viewport must have
      -- non-zero size in both dimensions.
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if DisplayRegion
imageSizeforall s a. s -> Getting a s a -> a
^.forall s t a b. Field1 s t a b => Lens s t a b
_1 forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& DisplayRegion
imageSizeforall s a. s -> Getting a s a -> a
^.forall s t a b. Field2 s t a b => Lens s t a b
_2 forall a. Ord a => a -> a -> Bool
> Int
0
               then Result n
result forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) [VisibilityRequest]
visibilityRequestsL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Location -> DisplayRegion -> VisibilityRequest
VR (DisplayRegion -> Location
Location (Int
0, Int
0)) DisplayRegion
imageSize forall a. a -> [a] -> [a]
:)
               else Result n
result

-- | Similar to 'visible', request that a region (with the specified
-- 'Location' as its origin and 'V.DisplayRegion' as its size) be made
-- visible when it is rendered inside a viewport. The 'Location' is
-- relative to the specified widget's upper-left corner of (0, 0).
--
-- This does nothing if not rendered in a viewport.
visibleRegion :: Location -> V.DisplayRegion -> Widget n -> Widget n
visibleRegion :: forall n. Location -> DisplayRegion -> Widget n -> Widget n
visibleRegion Location
vrloc DisplayRegion
sz 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 a b. (a -> b) -> a -> b
$ do
      Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
p
      -- The size of the image to be made visible in a viewport must have
      -- non-zero size in both dimensions.
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if DisplayRegion
szforall s a. s -> Getting a s a -> a
^.forall s t a b. Field1 s t a b => Lens s t a b
_1 forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& DisplayRegion
szforall s a. s -> Getting a s a -> a
^.forall s t a b. Field2 s t a b => Lens s t a b
_2 forall a. Ord a => a -> a -> Bool
> Int
0
               then Result n
result forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) [VisibilityRequest]
visibilityRequestsL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Location -> DisplayRegion -> VisibilityRequest
VR Location
vrloc DisplayRegion
sz forall a. a -> [a] -> [a]
:)
               else Result n
result

-- | Horizontal box layout: put the specified widgets next to each other
-- in the specified order. Defers growth policies to the growth policies
-- of both widgets.  This operator is a binary version of 'hBox'.
{-# NOINLINE (<+>) #-}
(<+>) :: Widget n
      -- ^ Left
      -> Widget n
      -- ^ Right
      -> Widget n
<+> :: forall n. Widget n -> Widget n -> Widget n
(<+>) Widget n
a Widget n
b = forall n. [Widget n] -> Widget n
hBox [Widget n
a, Widget n
b]

-- | Vertical box layout: put the specified widgets one above the other
-- in the specified order. Defers growth policies to the growth policies
-- of both widgets.  This operator is a binary version of 'vBox'.
{-# NOINLINE (<=>) #-}
(<=>) :: Widget n
      -- ^ Top
      -> Widget n
      -- ^ Bottom
      -> Widget n
<=> :: forall n. Widget n -> Widget n -> Widget n
(<=>) Widget n
a Widget n
b = forall n. [Widget n] -> Widget n
vBox [Widget n
a, Widget n
b]

{-# RULES
"baseHbox" forall a b   . a <+> b                 = hBox [a, b]
"hBox2"    forall as bs . hBox [hBox as, hBox bs] = hBox (as ++ bs)
"hboxL"    forall as b  . hBox [hBox as, b]       = hBox (as ++ [b])
"hboxR"    forall a bs  . hBox [a, hBox bs]       = hBox (a : bs)
"baseVbox" forall a b   . a <=> b                 = vBox [a, b]
"vBox2"    forall as bs . vBox [vBox as, vBox bs] = vBox (as ++ bs)
"vboxL"    forall as b  . vBox [vBox as, b]       = vBox (as ++ [b])
"vboxR"    forall a bs  . vBox [a, vBox bs]       = vBox (a : bs)
  #-}