{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
-- | 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
  , padLeft
  , padRight
  , padTop
  , padBottom
  , padLeftRight
  , padTopBottom
  , padAll

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

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

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

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

  -- * Cursor placement
  , showCursor

  -- * Naming
  , Named(..)

  -- * Translation
  , translateBy

  -- * Cropping
  , cropLeftBy
  , cropRightBy
  , cropTopBy
  , cropBottomBy

  -- * Extent reporting
  , reportExtent
  , clickable

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

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

  -- ** Cropping results
  , cropToContext
  )
where

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

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
import Data.Monoid ((<>), mempty)
#endif

import Lens.Micro ((^.), (.~), (&), (%~), to, _1, _2, each, to, Lens')
import Lens.Micro.Mtl (use, (%=))
import Control.Monad ((>=>),when)
import Control.Monad.Trans.State.Lazy
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Class (lift)
import qualified Data.Foldable as F
import qualified Data.Text as T
import qualified Data.DList as DL
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 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 (String -> Int) -> (Text -> String) -> Text -> Int
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 (String -> Int) -> (f Char -> String) -> f Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f Char -> String
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 :: BorderStyle -> Widget n -> Widget n
withBorderStyle BorderStyle
bs Widget n
p = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ (Context -> Context)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& (BorderStyle -> Identity BorderStyle)
-> Context -> Identity Context
Lens' Context BorderStyle
ctxBorderStyleL ((BorderStyle -> Identity BorderStyle)
 -> Context -> Identity Context)
-> BorderStyle -> Context -> Context
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BorderStyle
bs) (Widget n -> RenderM n (Result n)
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 :: Widget n -> Widget n
joinBorders Widget n
p = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ (Context -> Context)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> Context -> Identity Context
Lens' Context Bool
ctxDynBordersL ((Bool -> Identity Bool) -> Context -> Identity Context)
-> Bool -> Context -> Context
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True) (Widget n -> RenderM n (Result n)
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 :: Widget n -> Widget n
separateBorders Widget n
p = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ (Context -> Context)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
&(Bool -> Identity Bool) -> Context -> Identity Context
Lens' Context Bool
ctxDynBordersL ((Bool -> Identity Bool) -> Context -> Identity Context)
-> Bool -> Context -> Context
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False) (Widget n -> RenderM n (Result n)
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 :: Widget n -> Widget n
freezeBorders Widget n
p = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ ((BorderMap DynBorder -> Identity (BorderMap DynBorder))
-> Result n -> Identity (Result n)
forall n. Lens' (Result n) (BorderMap DynBorder)
bordersL ((BorderMap DynBorder -> Identity (BorderMap DynBorder))
 -> Result n -> Identity (Result n))
-> BorderMap DynBorder -> Result n -> Result n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BorderMap DynBorder
forall a. BorderMap a
BM.empty) (Result n -> Result n)
-> RenderM n (Result n) -> RenderM n (Result n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p

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

-- | Add an offset to all cursor locations, visbility 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 :: Location -> Result n -> Result n
addResultOffset Location
off = Location -> Result n -> Result n
forall n. Location -> Result n -> Result n
addCursorOffset Location
off (Result n -> Result n)
-> (Result n -> Result n) -> Result n -> Result n
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Location -> Result n -> Result n
forall n. Location -> Result n -> Result n
addVisibilityOffset Location
off (Result n -> Result n)
-> (Result n -> Result n) -> Result n -> Result n
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Location -> Result n -> Result n
forall n. Location -> Result n -> Result n
addExtentOffset Location
off (Result n -> Result n)
-> (Result n -> Result n) -> Result n -> Result n
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Location -> Result n -> Result n
forall n. Location -> Result n -> Result n
addDynBorderOffset Location
off

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

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

addDynBorderOffset :: Location -> Result n -> Result n
addDynBorderOffset :: Location -> Result n -> Result n
addDynBorderOffset Location
off Result n
r = Result n
r Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (BorderMap DynBorder -> Identity (BorderMap DynBorder))
-> Result n -> Identity (Result n)
forall n. Lens' (Result n) (BorderMap DynBorder)
bordersL ((BorderMap DynBorder -> Identity (BorderMap DynBorder))
 -> Result n -> Identity (Result n))
-> (BorderMap DynBorder -> BorderMap DynBorder)
-> Result n
-> Result n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Location -> BorderMap DynBorder -> BorderMap DynBorder
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').
reportExtent :: n -> Widget n -> Widget n
reportExtent :: n -> Widget n -> Widget n
reportExtent n
n Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
        Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p
        let ext :: Extent n
ext = n -> Location -> (Int, Int) -> Extent n
forall n. n -> Location -> (Int, Int) -> Extent n
Extent n
n ((Int, Int) -> Location
Location (Int
0, Int
0)) (Int, Int)
sz
            sz :: (Int, Int)
sz = ( Result n
resultResult n -> Getting Int (Result n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result n -> Const Int (Result n)
forall n. Lens' (Result n) Image
imageL((Image -> Const Int Image) -> Result n -> Const Int (Result n))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageWidth
                 , Result n
resultResult n -> Getting Int (Result n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result n -> Const Int (Result n)
forall n. Lens' (Result n) Image
imageL((Image -> Const Int Image) -> Result n -> Const Int (Result n))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageHeight
                 )
        Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Result n
result Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& ([Extent n] -> Identity [Extent n])
-> Result n -> Identity (Result n)
forall n. Lens' (Result n) [Extent n]
extentsL (([Extent n] -> Identity [Extent n])
 -> Result n -> Identity (Result n))
-> ([Extent n] -> [Extent n]) -> Result n -> Result n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Extent n
extExtent n -> [Extent n] -> [Extent n]
forall a. a -> [a] -> [a]
:)

-- | Request mouse click events on the specified widget.
clickable :: n -> Widget n -> Widget n
clickable :: n -> Widget n -> Widget n
clickable n
n Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
        ([n] -> Identity [n]) -> RenderState n -> Identity (RenderState n)
forall n. Lens' (RenderState n) [n]
clickableNamesL (([n] -> Identity [n])
 -> RenderState n -> Identity (RenderState n))
-> ([n] -> [n]) -> ReaderT Context (State (RenderState n)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (n
nn -> [n] -> [n]
forall a. a -> [a] -> [a]
:)
        Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ n -> Widget n -> Widget n
forall n. n -> Widget n -> Widget n
reportExtent n
n Widget n
p

addCursorOffset :: Location -> Result n -> Result n
addCursorOffset :: Location -> Result n -> Result n
addCursorOffset Location
off Result n
r =
    let onlyVisible :: [CursorLocation n] -> [CursorLocation n]
onlyVisible = (CursorLocation n -> Bool)
-> [CursorLocation n] -> [CursorLocation n]
forall a. (a -> Bool) -> [a] -> [a]
filter CursorLocation n -> Bool
forall s. TerminalLocation s => s -> Bool
isVisible
        isVisible :: s -> Bool
isVisible s
l = s
ls -> Getting Int s Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int s Int
forall a. TerminalLocation a => Lens' a Int
locationColumnL Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& s
ls -> Getting Int s Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int s Int
forall a. TerminalLocation a => Lens' a Int
locationRowL Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
    in Result n
r Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& ([CursorLocation n] -> Identity [CursorLocation n])
-> Result n -> Identity (Result n)
forall n. Lens' (Result n) [CursorLocation n]
cursorsL (([CursorLocation n] -> Identity [CursorLocation n])
 -> Result n -> Identity (Result n))
-> ([CursorLocation n] -> [CursorLocation n])
-> Result n
-> Result n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\[CursorLocation n]
cs -> [CursorLocation n] -> [CursorLocation n]
onlyVisible ([CursorLocation n] -> [CursorLocation n])
-> [CursorLocation n] -> [CursorLocation n]
forall a b. (a -> b) -> a -> b
$ (CursorLocation n -> Location -> CursorLocation n
forall n. CursorLocation n -> Location -> CursorLocation n
`clOffset` Location
off) (CursorLocation n -> CursorLocation n)
-> [CursorLocation n] -> [CursorLocation n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CursorLocation n]
cs)

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

-- | Take a substring capable of fitting into the number of specified
-- columns. This function takes character column widths into
-- consideration.
takeColumns :: Int -> String -> String
takeColumns :: Int -> String -> String
takeColumns Int
_ String
"" = String
""
takeColumns Int
numCols (Char
c:String
cs) =
    let w :: Int
w = Char -> Int
V.safeWcwidth Char
c
    in if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
numCols
       then []
       else Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
takeColumns (Int
numCols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w) String
cs

-- | 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 :: String -> Widget n
strWrap = WrapSettings -> String -> Widget n
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 :: WrapSettings -> String -> Widget n
strWrapWith WrapSettings
settings String
t = WrapSettings -> Text -> Widget n
forall n. WrapSettings -> Text -> Widget n
txtWrapWith WrapSettings
settings (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
t

safeTextWidth :: T.Text -> Int
safeTextWidth :: Text -> Int
safeTextWidth = String -> Int
V.safeWcswidth (String -> Int) -> (Text -> String) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

-- | 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 :: Text -> Widget n
txtWrap = WrapSettings -> Text -> Widget n
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 :: WrapSettings -> Text -> Widget n
txtWrapWith WrapSettings
settings Text
s =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
      Context
c <- RenderM n Context
forall n. RenderM n Context
getContext
      let theLines :: [Text]
theLines = Text -> Text
fixEmpty (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WrapSettings -> Int -> Text -> [Text]
wrapTextToLines WrapSettings
settings (Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL) Text
s
          fixEmpty :: Text -> Text
fixEmpty Text
l | Text -> Bool
T.null Text
l = Text
" "
                     | Bool
otherwise = Text
l
      case [Text] -> [Text]
forall a. NFData a => a -> a
force [Text]
theLines of
          [] -> Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
forall n. Result n
emptyResult
          [Text]
multiple ->
              let maxLength :: Int
maxLength = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Int
safeTextWidth (Text -> Int) -> [Text] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
multiple
                  padding :: Image
padding = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill (Context
cContext -> Getting Attr Context Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr Context Attr
forall r. Getting r Context Attr
attrL) Char
' ' (Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxLength) ([Image] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Image]
lineImgs)
                  lineImgs :: [Image]
lineImgs = Text -> Image
lineImg (Text -> Image) -> [Text] -> [Image]
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
cContext -> Getting Attr Context Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr Context Attr
forall r. Getting r Context Attr
attrL)
                                   (Text
lStr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
maxLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
safeTextWidth Text
lStr) Text
" ")
              in Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Result n
forall n. Result n
emptyResult Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result n -> Identity (Result n)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result n -> Identity (Result n))
-> Image -> Result n -> Result n
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'. 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 string should not contain escape sequences or carriage returns.
str :: String -> Widget n
str :: String -> Widget n
str String
s =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
      Context
c <- RenderM n Context
forall n. RenderM n Context
getContext
      let theLines :: [String]
theLines = String -> String
fixEmpty (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([String] -> [String]
dropUnused ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) String
s
          fixEmpty :: String -> String
          fixEmpty :: String -> String
fixEmpty [] = String
" "
          fixEmpty String
l = String
l
          dropUnused :: [String] -> [String]
dropUnused [String]
l = Int -> String -> String
takeColumns (Context -> Int
availWidth Context
c) (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take (Context -> Int
availHeight Context
c) [String]
l
      case [String] -> [String]
forall a. NFData a => a -> a
force [String]
theLines of
          [] -> Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
forall n. Result n
emptyResult
          [String
one] -> Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Result n
forall n. Result n
emptyResult Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result n -> Identity (Result n)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result n -> Identity (Result n))
-> Image -> Result n -> Result n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Attr -> String -> Image
V.string (Context
cContext -> Getting Attr Context Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr Context Attr
forall r. Getting r Context Attr
attrL) String
one)
          [String]
multiple ->
              let maxLength :: Int
maxLength = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ String -> Int
V.safeWcswidth (String -> Int) -> [String] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
multiple
                  lineImgs :: [Image]
lineImgs = String -> Image
lineImg (String -> Image) -> [String] -> [Image]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
multiple
                  lineImg :: String -> Image
lineImg String
lStr = Attr -> String -> Image
V.string (Context
cContext -> Getting Attr Context Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr Context Attr
forall r. Getting r Context Attr
attrL) (String
lStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
maxLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
V.safeWcswidth String
lStr) Char
' ')
              in Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Result n
forall n. Result n
emptyResult Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result n -> Identity (Result n)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result n -> Identity (Result n))
-> Image -> Result n -> Result n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ([Image] -> Image
V.vertCat [Image]
lineImgs)

-- | Build a widget from a 'T.Text' value. Behaves the same as 'str'
-- 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 text should not contain escape sequences or carriage returns.
txt :: T.Text -> Widget n
txt :: Text -> Widget n
txt = String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> (Text -> String) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

-- | 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 :: Text -> Widget n -> Widget n
hyperlink Text
url Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
        Context
c <- RenderM n Context
forall n. RenderM n Context
getContext
        let attr :: Attr
attr = AttrName -> AttrMap -> Attr
attrMapLookup (Context
cContext -> Getting AttrName Context AttrName -> AttrName
forall s a. s -> Getting a s a -> a
^.Getting AttrName Context AttrName
Lens' Context AttrName
ctxAttrNameL) (Context
cContext -> Getting AttrMap Context AttrMap -> AttrMap
forall s a. s -> Getting a s a -> a
^.Getting AttrMap Context AttrMap
Lens' Context AttrMap
ctxAttrMapL) Attr -> Text -> Attr
`V.withURL` Text
url
        (Context -> Context)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& (AttrMap -> Identity AttrMap) -> Context -> Identity Context
Lens' Context AttrMap
ctxAttrMapL ((AttrMap -> Identity AttrMap) -> Context -> Identity Context)
-> (AttrMap -> AttrMap) -> Context -> Context
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Attr -> AttrMap -> AttrMap
setDefaultAttr Attr
attr) (Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

-- | 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 :: 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 -> (Widget n -> Widget n
forall a. a -> a
id, Size
Greedy)
          Pad Int
i -> (Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
i, Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p)
    in Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
sz (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
        Context
c <- RenderM n Context
forall n. RenderM n Context
getContext
        let lim :: Int
lim = case Padding
padding of
              Padding
Max -> Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL
              Pad Int
i -> Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
        Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
lim Widget n
p
        Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ (Widget n -> Widget n
f (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit (Result n
resultResult n -> Getting Int (Result n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result n -> Const Int (Result n)
forall n. Lens' (Result n) Image
imageL((Image -> Const Int Image) -> Result n -> Const Int (Result n))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageHeight) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Char -> Widget n
forall n. Char -> Widget n
fill Char
' ') Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+>
                 (Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ Result n -> RenderM n (Result n)
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 :: 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 -> (Widget n -> Widget n
forall a. a -> a
id, Size
Greedy)
          Pad Int
i -> (Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
i, Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p)
    in Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
sz (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
        Context
c <- RenderM n Context
forall n. RenderM n Context
getContext
        let lim :: Int
lim = case Padding
padding of
              Padding
Max -> Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL
              Pad Int
i -> Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
        Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
lim Widget n
p
        Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ (Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+>
                 (Widget n -> Widget n
f (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit (Result n
resultResult n -> Getting Int (Result n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result n -> Const Int (Result n)
forall n. Lens' (Result n) Image
imageL((Image -> Const Int Image) -> Result n -> Const Int (Result n))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageHeight) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Char -> Widget n
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 :: 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 -> (Widget n -> Widget n
forall a. a -> a
id, Size
Greedy)
          Pad Int
i -> (Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
i, Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p)
    in Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) Size
sz (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
        Context
c <- RenderM n Context
forall n. RenderM n Context
getContext
        let lim :: Int
lim = case Padding
padding of
              Padding
Max -> Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availHeightL
              Pad Int
i -> Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availHeightL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
        Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
lim Widget n
p
        Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ (Widget n -> Widget n
f (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit (Result n
resultResult n -> Getting Int (Result n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result n -> Const Int (Result n)
forall n. Lens' (Result n) Image
imageL((Image -> Const Int Image) -> Result n -> Const Int (Result n))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageWidth) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Char -> Widget n
forall n. Char -> Widget n
fill Char
' ') Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=>
                 (Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ Result n -> RenderM n (Result n)
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 :: 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 -> (Widget n -> Widget n
forall a. a -> a
id, Size
Greedy)
          Pad Int
i -> (Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
i, Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p)
    in Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) Size
sz (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
        Context
c <- RenderM n Context
forall n. RenderM n Context
getContext
        let lim :: Int
lim = case Padding
padding of
              Padding
Max -> Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availHeightL
              Pad Int
i -> Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availHeightL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
        Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
lim Widget n
p
        Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ (Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=>
                 (Widget n -> Widget n
f (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit (Result n
resultResult n -> Getting Int (Result n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result n -> Const Int (Result n)
forall n. Lens' (Result n) Image
imageL((Image -> Const Int Image) -> Result n -> Const Int (Result n))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageWidth) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Char -> Widget n
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 :: Int -> Widget n -> Widget n
padLeftRight Int
c Widget n
w = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
c) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Padding -> Widget n -> Widget n
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 :: Int -> Widget n -> Widget n
padTopBottom Int
r Widget n
w = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
r) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Padding -> Widget n -> Widget n
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 :: Int -> Widget n -> Widget n
padAll Int
v Widget n
w = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
padLeftRight Int
v (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
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 :: Char -> Widget n
fill Char
ch =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
      Context
c <- RenderM n Context
forall n. RenderM n Context
getContext
      Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Result n
forall n. Result n
emptyResult Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result n -> Identity (Result n)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result n -> Identity (Result n))
-> Image -> Result n -> Result n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill (Context
cContext -> Getting Attr Context Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr Context Attr
forall r. Getting r Context Attr
attrL) Char
ch (Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL) (Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context 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).
{-# NOINLINE vBox #-}
vBox :: [Widget n] -> Widget n
vBox :: [Widget n] -> Widget n
vBox [] = Widget n
forall n. Widget n
emptyWidget
vBox [Widget n
a] = Widget n
a
vBox [Widget n]
pairs = BoxRenderer n -> [Widget n] -> Widget n
forall n. BoxRenderer n -> [Widget n] -> Widget n
renderBox BoxRenderer n
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).
{-# NOINLINE hBox #-}
hBox :: [Widget n] -> Widget n
hBox :: [Widget n] -> Widget n
hBox [] = Widget n
forall n. Widget n
emptyWidget
hBox [Widget n
a] = Widget n
a
hBox [Widget n]
pairs = BoxRenderer n -> [Widget n] -> Widget n
forall n. BoxRenderer n -> [Widget n] -> Widget n
renderBox BoxRenderer n
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 { BoxRenderer n -> Lens' Context Int
contextPrimary :: Lens' Context Int
                , BoxRenderer n -> Lens' Context Int
contextSecondary :: Lens' Context Int
                , BoxRenderer n -> Image -> Int
imagePrimary :: V.Image -> Int
                , BoxRenderer n -> Image -> Int
imageSecondary :: V.Image -> Int
                , BoxRenderer n -> Int -> Widget n -> Widget n
limitPrimary :: Int -> Widget n -> Widget n
                , BoxRenderer n -> Int -> Widget n -> Widget n
limitSecondary :: Int -> Widget n -> Widget n
                , BoxRenderer n -> Widget n -> Size
primaryWidgetSize :: Widget n -> Size
                , BoxRenderer n -> [Image] -> Image
concatenatePrimary :: [V.Image] -> V.Image
                , BoxRenderer n -> [Image] -> Image
concatenateSecondary :: [V.Image] -> V.Image
                , BoxRenderer n -> Int -> Location
locationFromOffset :: Int -> Location
                , BoxRenderer n -> Int -> Image -> Attr -> Image
padImageSecondary :: Int -> V.Image -> V.Attr -> V.Image
                , BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges a)
loPrimary :: forall a. Lens' (Edges a) a -- lo: towards smaller coordinates in that dimension
                , BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges a)
hiPrimary :: forall a. Lens' (Edges a) a -- hi: towards larger  coordinates in that dimension
                , BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges a)
loSecondary :: forall a. Lens' (Edges a) a
                , BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges a)
hiSecondary :: forall a. Lens' (Edges a) a
                , BoxRenderer n -> Int -> Int -> Location
locationFromPrimarySecondary :: Int -> Int -> Location
                , BoxRenderer n -> Int -> Image -> Image
splitLoPrimary :: Int -> V.Image -> V.Image
                , BoxRenderer n -> Int -> Image -> Image
splitHiPrimary :: Int -> V.Image -> V.Image
                , BoxRenderer n -> Int -> Image -> Image
splitLoSecondary :: Int -> V.Image -> V.Image
                , BoxRenderer n -> Int -> Image -> Image
splitHiSecondary :: Int -> V.Image -> V.Image
                , BoxRenderer n -> Int -> BorderMap DynBorder -> IMap DynBorder
lookupPrimary :: Int -> BM.BorderMap DynBorder -> I.IMap DynBorder
                , BoxRenderer n
-> Location
-> Run DynBorder
-> BorderMap DynBorder
-> BorderMap DynBorder
insertSecondary :: Location -> I.Run DynBorder -> BM.BorderMap DynBorder -> BM.BorderMap DynBorder
                }

vBoxRenderer :: BoxRenderer n
vBoxRenderer :: BoxRenderer n
vBoxRenderer =
    BoxRenderer :: forall n.
Lens' Context Int
-> Lens' Context Int
-> (Image -> Int)
-> (Image -> Int)
-> (Int -> Widget n -> Widget n)
-> (Int -> Widget n -> Widget n)
-> (Widget n -> Size)
-> ([Image] -> Image)
-> ([Image] -> Image)
-> (Int -> Location)
-> (Int -> Image -> Attr -> Image)
-> (forall a (f :: * -> *).
    Functor f =>
    (a -> f a) -> Edges a -> f (Edges a))
-> (forall a (f :: * -> *).
    Functor f =>
    (a -> f a) -> Edges a -> f (Edges a))
-> (forall a (f :: * -> *).
    Functor f =>
    (a -> f a) -> Edges a -> f (Edges a))
-> (forall a (f :: * -> *).
    Functor f =>
    (a -> f a) -> Edges a -> f (Edges a))
-> (Int -> Int -> Location)
-> (Int -> Image -> Image)
-> (Int -> Image -> Image)
-> (Int -> Image -> Image)
-> (Int -> Image -> Image)
-> (Int -> BorderMap DynBorder -> IMap DynBorder)
-> (Location
    -> Run DynBorder -> BorderMap DynBorder -> BorderMap DynBorder)
-> BoxRenderer n
BoxRenderer { contextPrimary :: Lens' Context Int
contextPrimary = Lens' Context Int
availHeightL
                , contextSecondary :: Lens' Context Int
contextSecondary = Lens' Context 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 = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit
                , limitSecondary :: Int -> Widget n -> Widget n
limitSecondary = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit
                , primaryWidgetSize :: Widget n -> Size
primaryWidgetSize = Widget n -> Size
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 = (Int, Int) -> Location
Location ((Int, Int) -> Location) -> (Int -> (Int, Int)) -> Int -> 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 = Attr -> Char -> Int -> Int -> Image
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 (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
loPrimary = forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
eTopL
                , hiPrimary :: forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
hiPrimary = forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
eBottomL
                , loSecondary :: forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
loSecondary = forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
eLeftL
                , hiSecondary :: forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
hiSecondary = forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
eRightL
                , locationFromPrimarySecondary :: Int -> Int -> Location
locationFromPrimarySecondary = \Int
r Int
c -> (Int, Int) -> 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
imgInt -> Int -> Int
forall 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
imgInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n) Image
img
                , lookupPrimary :: Int -> BorderMap DynBorder -> IMap DynBorder
lookupPrimary = Int -> BorderMap DynBorder -> IMap DynBorder
forall a. Int -> BorderMap a -> IMap a
BM.lookupRow
                , insertSecondary :: Location
-> Run DynBorder -> BorderMap DynBorder -> BorderMap DynBorder
insertSecondary = Location
-> Run DynBorder -> BorderMap DynBorder -> BorderMap DynBorder
forall a. Location -> Run a -> BorderMap a -> BorderMap a
BM.insertH
                }

hBoxRenderer :: BoxRenderer n
hBoxRenderer :: BoxRenderer n
hBoxRenderer =
    BoxRenderer :: forall n.
Lens' Context Int
-> Lens' Context Int
-> (Image -> Int)
-> (Image -> Int)
-> (Int -> Widget n -> Widget n)
-> (Int -> Widget n -> Widget n)
-> (Widget n -> Size)
-> ([Image] -> Image)
-> ([Image] -> Image)
-> (Int -> Location)
-> (Int -> Image -> Attr -> Image)
-> (forall a (f :: * -> *).
    Functor f =>
    (a -> f a) -> Edges a -> f (Edges a))
-> (forall a (f :: * -> *).
    Functor f =>
    (a -> f a) -> Edges a -> f (Edges a))
-> (forall a (f :: * -> *).
    Functor f =>
    (a -> f a) -> Edges a -> f (Edges a))
-> (forall a (f :: * -> *).
    Functor f =>
    (a -> f a) -> Edges a -> f (Edges a))
-> (Int -> Int -> Location)
-> (Int -> Image -> Image)
-> (Int -> Image -> Image)
-> (Int -> Image -> Image)
-> (Int -> Image -> Image)
-> (Int -> BorderMap DynBorder -> IMap DynBorder)
-> (Location
    -> Run DynBorder -> BorderMap DynBorder -> BorderMap DynBorder)
-> BoxRenderer n
BoxRenderer { contextPrimary :: Lens' Context Int
contextPrimary = Lens' Context Int
availWidthL
                , contextSecondary :: Lens' Context Int
contextSecondary = Lens' Context 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 = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit
                , limitSecondary :: Int -> Widget n -> Widget n
limitSecondary = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit
                , primaryWidgetSize :: Widget n -> Size
primaryWidgetSize = Widget n -> Size
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 = (Int, Int) -> Location
Location ((Int, Int) -> Location) -> (Int -> (Int, Int)) -> Int -> 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 = Attr -> Char -> Int -> Int -> Image
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 (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
loPrimary = forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
eLeftL
                , hiPrimary :: forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
hiPrimary = forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
eRightL
                , loSecondary :: forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
loSecondary = forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
eTopL
                , hiSecondary :: forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
hiSecondary = forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
eBottomL
                , locationFromPrimarySecondary :: Int -> Int -> Location
locationFromPrimarySecondary = \Int
c Int
r -> (Int, Int) -> 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
imgInt -> Int -> Int
forall 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
imgInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n) Image
img
                , lookupPrimary :: Int -> BorderMap DynBorder -> IMap DynBorder
lookupPrimary = Int -> BorderMap DynBorder -> IMap DynBorder
forall a. Int -> BorderMap a -> IMap a
BM.lookupCol
                , insertSecondary :: Location
-> Run DynBorder -> BorderMap DynBorder -> BorderMap DynBorder
insertSecondary = Location
-> Run DynBorder -> BorderMap DynBorder -> BorderMap DynBorder
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 :: BoxRenderer n -> [Widget n] -> Widget n
renderBox BoxRenderer n
br [Widget n]
ws =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget ([Size] -> Size
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Size] -> Size) -> [Size] -> Size
forall a b. (a -> b) -> a -> b
$ Widget n -> Size
forall n. Widget n -> Size
hSize (Widget n -> Size) -> [Widget n] -> [Size]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Widget n]
ws) ([Size] -> Size
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Size] -> Size) -> [Size] -> Size
forall a b. (a -> b) -> a -> b
$ Widget n -> Size
forall n. Widget n -> Size
vSize (Widget n -> Size) -> [Widget n] -> [Size]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Widget n]
ws) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
      Context
c <- RenderM n Context
forall n. RenderM n Context
getContext

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

      let availPrimary :: Int
availPrimary = Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.(BoxRenderer n -> Lens' Context Int
forall n. BoxRenderer n -> Lens' Context Int
contextPrimary BoxRenderer n
br)
          availSecondary :: Int
availSecondary = Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.(BoxRenderer n -> Lens' Context Int
forall n. BoxRenderer n -> Lens' Context Int
contextSecondary BoxRenderer n
br)

          renderHis :: Int
-> DList (Int, Result n)
-> [(Int, Widget n)]
-> ReaderT Context (State (RenderState n)) [(Int, Result n)]
renderHis Int
_ DList (Int, Result n)
prev [] = [(Int, Result n)]
-> ReaderT Context (State (RenderState n)) [(Int, Result n)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, Result n)]
 -> ReaderT Context (State (RenderState n)) [(Int, Result n)])
-> [(Int, Result n)]
-> ReaderT Context (State (RenderState n)) [(Int, Result n)]
forall a b. (a -> b) -> a -> b
$ DList (Int, Result n) -> [(Int, Result n)]
forall a. DList a -> [a]
DL.toList DList (Int, Result n)
prev
          renderHis Int
remainingPrimary DList (Int, Result n)
prev ((Int
i, Widget n
prim):[(Int, Widget n)]
rest) = do
              Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ BoxRenderer n -> Int -> Widget n -> Widget n
forall n. BoxRenderer n -> Int -> Widget n -> Widget n
limitPrimary BoxRenderer n
br Int
remainingPrimary
                               (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ BoxRenderer n -> Int -> Widget n -> Widget n
forall n. BoxRenderer n -> Int -> Widget n -> Widget n
limitSecondary BoxRenderer n
br Int
availSecondary
                               (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
forall n. Widget n -> Widget n
cropToContext Widget n
prim
              Int
-> DList (Int, Result n)
-> [(Int, Widget n)]
-> ReaderT Context (State (RenderState n)) [(Int, Result n)]
renderHis (Int
remainingPrimary Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Result n
resultResult n -> Getting Int (Result n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result n -> Const Int (Result n)
forall n. Lens' (Result n) Image
imageL((Image -> Const Int Image) -> Result n -> Const Int (Result n))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to ((Image -> Int) -> SimpleGetter Image Int)
-> (Image -> Int) -> SimpleGetter Image Int
forall a b. (a -> b) -> a -> b
$ BoxRenderer n -> Image -> Int
forall n. BoxRenderer n -> Image -> Int
imagePrimary BoxRenderer n
br)))
                        (DList (Int, Result n) -> (Int, Result n) -> DList (Int, Result n)
forall a. DList a -> a -> DList a
DL.snoc DList (Int, Result n)
prev (Int
i, Result n
result)) [(Int, Widget n)]
rest

      [(Int, Result n)]
renderedHis <- Int
-> DList (Int, Result n)
-> [(Int, Widget n)]
-> ReaderT Context (State (RenderState n)) [(Int, Result n)]
renderHis Int
availPrimary DList (Int, Result n)
forall a. DList a
DL.empty [(Int, Widget n)]
his

      [(Int, Result n)]
renderedLows <- case [(Int, Widget n)]
lows of
          [] -> [(Int, Result n)]
-> ReaderT Context (State (RenderState n)) [(Int, Result n)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
          [(Int, Widget n)]
ls -> do
              let remainingPrimary :: Int
remainingPrimary = Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.(BoxRenderer n -> Lens' Context Int
forall n. BoxRenderer n -> Lens' Context Int
contextPrimary BoxRenderer n
br) Int -> Int -> Int
forall a. Num a => a -> a -> a
-
                                     ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Result n) -> Getting Int (Int, Result n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Result n -> Const Int (Result n))
-> (Int, Result n) -> Const Int (Int, Result n)
forall s t a b. Field2 s t a b => Lens s t a b
_2((Result n -> Const Int (Result n))
 -> (Int, Result n) -> Const Int (Int, Result n))
-> Getting Int (Result n) Int -> Getting Int (Int, Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Const Int Image) -> Result n -> Const Int (Result n)
forall n. Lens' (Result n) Image
imageL((Image -> Const Int Image) -> Result n -> Const Int (Result n))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to ((Image -> Int) -> SimpleGetter Image Int)
-> (Image -> Int) -> SimpleGetter Image Int
forall a b. (a -> b) -> a -> b
$ BoxRenderer n -> Image -> Int
forall n. BoxRenderer n -> Image -> Int
imagePrimary BoxRenderer n
br)) ((Int, Result n) -> Int) -> [(Int, Result n)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Result n)]
renderedHis)
                  primaryPerLow :: Int
primaryPerLow = Int
remainingPrimary Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` [(Int, Widget n)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Widget n)]
ls
                  rest :: Int
rest = Int
remainingPrimary Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
primaryPerLow Int -> Int -> Int
forall a. Num a => a -> a -> a
* [(Int, Widget n)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Widget n)]
ls)
                  secondaryPerLow :: Int
secondaryPerLow = Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.(BoxRenderer n -> Lens' Context Int
forall n. BoxRenderer n -> Lens' Context Int
contextSecondary BoxRenderer n
br)
                  primaries :: [Int]
primaries = Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
rest (Int
primaryPerLow Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<>
                              Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate ([(Int, Widget n)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Widget n)]
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rest) Int
primaryPerLow

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

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

      let rendered :: [(Int, Result n)]
rendered = ((Int, Result n) -> (Int, Result n) -> Ordering)
-> [(Int, Result n)] -> [(Int, Result n)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> ((Int, Result n) -> Int)
-> (Int, Result n)
-> (Int, Result n)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`DF.on` (Int, Result n) -> Int
forall a b. (a, b) -> a
fst) ([(Int, Result n)] -> [(Int, Result n)])
-> [(Int, Result n)] -> [(Int, Result n)]
forall a b. (a -> b) -> a -> b
$ [(Int, Result n)]
renderedHis [(Int, Result n)] -> [(Int, Result n)] -> [(Int, Result n)]
forall a. [a] -> [a] -> [a]
++ [(Int, Result n)]
renderedLows
          allResults :: [Result n]
allResults = (Int, Result n) -> Result n
forall a b. (a, b) -> b
snd ((Int, Result n) -> Result n) -> [(Int, Result n)] -> [Result n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Result n)]
rendered
          allImages :: [Image]
allImages = (Result n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL) (Result n -> Image) -> [Result n] -> [Image]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Result n]
allResults
          allPrimaries :: [Int]
allPrimaries = BoxRenderer n -> Image -> Int
forall n. BoxRenderer n -> Image -> Int
imagePrimary BoxRenderer n
br (Image -> Int) -> [Image] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Image]
allImages
          allTranslatedResults :: [Result n]
allTranslatedResults = ((((Int, Result n) -> Result n) -> [(Int, Result n)] -> [Result n])
-> [(Int, Result n)] -> ((Int, Result n) -> Result n) -> [Result n]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int, Result n) -> Result n) -> [(Int, Result n)] -> [Result n]
forall a b. (a -> b) -> [a] -> [b]
map) ([Int] -> [Result n] -> [(Int, Result n)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Result n]
allResults) (((Int, Result n) -> Result n) -> [Result n])
-> ((Int, Result n) -> Result n) -> [Result n]
forall a b. (a -> b) -> a -> b
$ \(Int
i, Result n
result) ->
              let off :: Location
off = BoxRenderer n -> Int -> Location
forall n. BoxRenderer n -> Int -> Location
locationFromOffset BoxRenderer n
br Int
offPrimary
                  offPrimary :: Int
offPrimary = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
i [Int]
allPrimaries
              in Location -> Result n -> Result n
forall n. Location -> Result n -> Result n
addResultOffset Location
off 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 = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ BoxRenderer n -> Image -> Int
forall n. BoxRenderer n -> Image -> Int
imageSecondary BoxRenderer n
br (Image -> Int) -> [Image] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Image]
allImages
          padImage :: Image -> Image
padImage Image
img = BoxRenderer n -> Int -> Image -> Attr -> Image
forall n. BoxRenderer n -> Int -> Image -> Attr -> Image
padImageSecondary BoxRenderer n
br (Int
maxSecondary Int -> Int -> Int
forall a. Num a => a -> a -> a
- BoxRenderer n -> Image -> Int
forall n. BoxRenderer n -> Image -> Int
imageSecondary BoxRenderer n
br Image
img)
                         Image
img (Context
cContext -> Getting Attr Context Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr Context Attr
forall r. Getting r Context Attr
attrL)
          ([(IMap Image, IMap Image)]
imageRewrites, BorderMap DynBorder
newBorders) = BoxRenderer n
-> [BorderMap DynBorder]
-> ([(IMap Image, IMap Image)], BorderMap DynBorder)
forall n.
BoxRenderer n
-> [BorderMap DynBorder]
-> ([(IMap Image, IMap Image)], BorderMap DynBorder)
catAllBorders BoxRenderer n
br (Result n -> BorderMap DynBorder
forall n. Result n -> BorderMap DynBorder
borders (Result n -> BorderMap DynBorder)
-> [Result n] -> [BorderMap DynBorder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Result n]
allTranslatedResults)
          rewrittenImages :: [Image]
rewrittenImages = ((IMap Image, IMap Image) -> Image -> Image)
-> [(IMap Image, IMap Image)] -> [Image] -> [Image]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (BoxRenderer n -> (IMap Image, IMap Image) -> Image -> Image
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 (Image -> Image) -> [Image] -> [Image]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Image]
rewrittenImages

      Result n -> RenderM n (Result n)
forall n. Result n -> RenderM n (Result n)
cropResultToContext (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Image
-> [CursorLocation n]
-> [VisibilityRequest]
-> [Extent n]
-> BorderMap DynBorder
-> Result n
forall n.
Image
-> [CursorLocation n]
-> [VisibilityRequest]
-> [Extent n]
-> BorderMap DynBorder
-> Result n
Result (BoxRenderer n -> [Image] -> Image
forall n. BoxRenderer n -> [Image] -> Image
concatenatePrimary BoxRenderer n
br [Image]
paddedImages)
                            ([[CursorLocation n]] -> [CursorLocation n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[CursorLocation n]] -> [CursorLocation n])
-> [[CursorLocation n]] -> [CursorLocation n]
forall a b. (a -> b) -> a -> b
$ Result n -> [CursorLocation n]
forall n. Result n -> [CursorLocation n]
cursors (Result n -> [CursorLocation n])
-> [Result n] -> [[CursorLocation n]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Result n]
allTranslatedResults)
                            ([[VisibilityRequest]] -> [VisibilityRequest]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[VisibilityRequest]] -> [VisibilityRequest])
-> [[VisibilityRequest]] -> [VisibilityRequest]
forall a b. (a -> b) -> a -> b
$ Result n -> [VisibilityRequest]
forall n. Result n -> [VisibilityRequest]
visibilityRequests (Result n -> [VisibilityRequest])
-> [Result n] -> [[VisibilityRequest]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Result n]
allTranslatedResults)
                            ([[Extent n]] -> [Extent n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Extent n]] -> [Extent n]) -> [[Extent n]] -> [Extent n]
forall a b. (a -> b) -> a -> b
$ Result n -> [Extent n]
forall n. Result n -> [Extent n]
extents (Result n -> [Extent n]) -> [Result n] -> [[Extent n]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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 BorderStyle -> BorderStyle -> Bool
forall a. Eq a => a -> a -> Bool
== DynBorder -> BorderStyle
dbStyle DynBorder
b
    Bool -> Bool -> Bool
&& DynBorder -> Attr
dbAttr  DynBorder
a Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
== DynBorder -> Attr
dbAttr  DynBorder
b
    Bool -> Bool -> Bool
&& DynBorder
a DynBorder -> Getting Bool DynBorder Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (Edges BorderSegment -> Const Bool (Edges BorderSegment))
-> DynBorder -> Const Bool DynBorder
Lens' DynBorder (Edges BorderSegment)
dbSegmentsL((Edges BorderSegment -> Const Bool (Edges BorderSegment))
 -> DynBorder -> Const Bool DynBorder)
-> ((Bool -> Const Bool Bool)
    -> Edges BorderSegment -> Const Bool (Edges BorderSegment))
-> Getting Bool DynBorder Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BorderSegment -> Const Bool BorderSegment)
-> Edges BorderSegment -> Const Bool (Edges BorderSegment)
Lens' (Edges BorderSegment) BorderSegment
towardsB((BorderSegment -> Const Bool BorderSegment)
 -> Edges BorderSegment -> Const Bool (Edges BorderSegment))
-> ((Bool -> Const Bool Bool)
    -> BorderSegment -> Const Bool BorderSegment)
-> (Bool -> Const Bool Bool)
-> Edges BorderSegment
-> Const Bool (Edges BorderSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool)
-> BorderSegment -> Const Bool BorderSegment
Lens' BorderSegment Bool
bsAcceptL
    Bool -> Bool -> Bool
&& DynBorder
b DynBorder -> Getting Bool DynBorder Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (Edges BorderSegment -> Const Bool (Edges BorderSegment))
-> DynBorder -> Const Bool DynBorder
Lens' DynBorder (Edges BorderSegment)
dbSegmentsL((Edges BorderSegment -> Const Bool (Edges BorderSegment))
 -> DynBorder -> Const Bool DynBorder)
-> ((Bool -> Const Bool Bool)
    -> Edges BorderSegment -> Const Bool (Edges BorderSegment))
-> Getting Bool DynBorder Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BorderSegment -> Const Bool BorderSegment)
-> Edges BorderSegment -> Const Bool (Edges BorderSegment)
Lens' (Edges BorderSegment) BorderSegment
towardsA((BorderSegment -> Const Bool BorderSegment)
 -> Edges BorderSegment -> Const Bool (Edges BorderSegment))
-> ((Bool -> Const Bool Bool)
    -> BorderSegment -> Const Bool BorderSegment)
-> (Bool -> Const Bool Bool)
-> Edges BorderSegment
-> Const Bool (Edges BorderSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool)
-> BorderSegment -> Const Bool BorderSegment
Lens' BorderSegment Bool
bsOfferL
    Bool -> Bool -> Bool
&& Bool -> Bool
not (DynBorder
a DynBorder -> Getting Bool DynBorder Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (Edges BorderSegment -> Const Bool (Edges BorderSegment))
-> DynBorder -> Const Bool DynBorder
Lens' DynBorder (Edges BorderSegment)
dbSegmentsL((Edges BorderSegment -> Const Bool (Edges BorderSegment))
 -> DynBorder -> Const Bool DynBorder)
-> ((Bool -> Const Bool Bool)
    -> Edges BorderSegment -> Const Bool (Edges BorderSegment))
-> Getting Bool DynBorder Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BorderSegment -> Const Bool BorderSegment)
-> Edges BorderSegment -> Const Bool (Edges BorderSegment)
Lens' (Edges BorderSegment) BorderSegment
towardsB((BorderSegment -> Const Bool BorderSegment)
 -> Edges BorderSegment -> Const Bool (Edges BorderSegment))
-> ((Bool -> Const Bool Bool)
    -> BorderSegment -> Const Bool BorderSegment)
-> (Bool -> Const Bool Bool)
-> Edges BorderSegment
-> Const Bool (Edges BorderSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool)
-> BorderSegment -> Const Bool BorderSegment
Lens' BorderSegment Bool
bsDrawL) -- don't bother doing an update if we don't need to
    = DynBorder -> Maybe DynBorder
forall a. a -> Maybe a
Just (DynBorder
a DynBorder -> (DynBorder -> DynBorder) -> DynBorder
forall a b. a -> (a -> b) -> b
& (Edges BorderSegment -> Identity (Edges BorderSegment))
-> DynBorder -> Identity DynBorder
Lens' DynBorder (Edges BorderSegment)
dbSegmentsL((Edges BorderSegment -> Identity (Edges BorderSegment))
 -> DynBorder -> Identity DynBorder)
-> ((Bool -> Identity Bool)
    -> Edges BorderSegment -> Identity (Edges BorderSegment))
-> (Bool -> Identity Bool)
-> DynBorder
-> Identity DynBorder
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BorderSegment -> Identity BorderSegment)
-> Edges BorderSegment -> Identity (Edges BorderSegment)
Lens' (Edges BorderSegment) BorderSegment
towardsB((BorderSegment -> Identity BorderSegment)
 -> Edges BorderSegment -> Identity (Edges BorderSegment))
-> ((Bool -> Identity Bool)
    -> BorderSegment -> Identity BorderSegment)
-> (Bool -> Identity Bool)
-> Edges BorderSegment
-> Identity (Edges BorderSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> BorderSegment -> Identity BorderSegment
Lens' BorderSegment Bool
bsDrawL ((Bool -> Identity Bool) -> DynBorder -> Identity DynBorder)
-> Bool -> DynBorder -> DynBorder
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True)
    | Bool
otherwise = Maybe DynBorder
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 = (Maybe DynBorder -> Maybe DynBorder)
-> IMap (Maybe DynBorder) -> IMap DynBorder
forall a b. (a -> Maybe b) -> IMap a -> IMap b
I.mapMaybe Maybe DynBorder -> Maybe DynBorder
forall a. a -> a
id
    (IMap (Maybe DynBorder) -> IMap DynBorder)
-> IMap (Maybe DynBorder) -> IMap DynBorder
forall a b. (a -> b) -> a -> b
$ (DynBorder -> DynBorder -> Maybe DynBorder)
-> IMap DynBorder -> IMap DynBorder -> IMap (Maybe DynBorder)
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 synch 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 :: BoxRenderer n -> border -> border -> ((rewrite, rewrite), border)
catBorders BoxRenderer n
br border
r border
l = if Int
lCoord Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rCoord
    then ((rewrite
IMap Image
lRe, rewrite
IMap Image
rRe), border
BorderMap DynBorder
lr')
    else ((rewrite
forall a. IMap a
I.empty, rewrite
forall a. IMap a
I.empty), border
BorderMap DynBorder
lr)
    where
    lr :: BorderMap DynBorder
lr     = Edges Int -> BorderMap DynBorder -> BorderMap DynBorder
forall a. Edges Int -> BorderMap a -> BorderMap a
BM.expand (BorderMap DynBorder -> Edges Int
forall a. BorderMap a -> Edges Int
BM.coordinates border
BorderMap DynBorder
r) border
BorderMap DynBorder
l BorderMap DynBorder -> BorderMap DynBorder -> BorderMap DynBorder
forall a. BorderMap a -> BorderMap a -> BorderMap a
`BM.unsafeUnion`
             Edges Int -> BorderMap DynBorder -> BorderMap DynBorder
forall a. Edges Int -> BorderMap a -> BorderMap a
BM.expand (BorderMap DynBorder -> Edges Int
forall a. BorderMap a -> Edges Int
BM.coordinates border
BorderMap DynBorder
l) border
BorderMap DynBorder
r
    lr' :: BorderMap DynBorder
lr'    = BorderMap DynBorder -> BorderMap DynBorder
forall a. a -> a
id
           (BorderMap DynBorder -> BorderMap DynBorder)
-> (BorderMap DynBorder -> BorderMap DynBorder)
-> BorderMap DynBorder
-> BorderMap DynBorder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IMap DynBorder -> BorderMap DynBorder -> BorderMap DynBorder
mergeIMap Int
lCoord IMap DynBorder
lIMap'
           (BorderMap DynBorder -> BorderMap DynBorder)
-> (BorderMap DynBorder -> BorderMap DynBorder)
-> BorderMap DynBorder
-> BorderMap DynBorder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IMap DynBorder -> BorderMap DynBorder -> BorderMap DynBorder
mergeIMap Int
rCoord IMap DynBorder
rIMap'
           (BorderMap DynBorder -> BorderMap DynBorder)
-> BorderMap DynBorder -> BorderMap DynBorder
forall a b. (a -> b) -> a -> b
$ BorderMap DynBorder
lr
    lCoord :: Int
lCoord = BorderMap DynBorder -> Edges Int
forall a. BorderMap a -> Edges Int
BM.coordinates border
BorderMap DynBorder
l Edges Int -> Getting Int (Edges Int) Int -> Int
forall s a. s -> Getting a s a -> a
^. BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges a)
forall n.
BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges a)
hiPrimary BoxRenderer n
br
    rCoord :: Int
rCoord = BorderMap DynBorder -> Edges Int
forall a. BorderMap a -> Edges Int
BM.coordinates border
BorderMap DynBorder
r Edges Int -> Getting Int (Edges Int) Int -> Int
forall s a. s -> Getting a s a -> a
^. BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges a)
forall n.
BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges a)
loPrimary BoxRenderer n
br
    lIMap :: IMap DynBorder
lIMap  = BoxRenderer n -> Int -> BorderMap DynBorder -> IMap DynBorder
forall n.
BoxRenderer n -> Int -> BorderMap DynBorder -> IMap DynBorder
lookupPrimary BoxRenderer n
br Int
lCoord border
BorderMap DynBorder
l
    rIMap :: IMap DynBorder
rIMap  = BoxRenderer n -> Int -> BorderMap DynBorder -> IMap DynBorder
forall n.
BoxRenderer n -> Int -> BorderMap DynBorder -> IMap DynBorder
lookupPrimary BoxRenderer n
br Int
rCoord border
BorderMap DynBorder
r
    lIMap' :: IMap DynBorder
lIMap' = Lens' (Edges BorderSegment) BorderSegment
-> Lens' (Edges BorderSegment) BorderSegment
-> IMap DynBorder
-> IMap DynBorder
-> IMap DynBorder
catDynBorders (BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges a)
forall n.
BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges a)
loPrimary BoxRenderer n
br) (BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges a)
forall n.
BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges 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 (BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges a)
forall n.
BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges a)
hiPrimary BoxRenderer n
br) (BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges a)
forall n.
BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges a)
loPrimary BoxRenderer n
br) IMap DynBorder
rIMap IMap DynBorder
lIMap
    lRe :: IMap Image
lRe    = DynBorder -> Image
renderDynBorder (DynBorder -> Image) -> IMap DynBorder -> IMap Image
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IMap DynBorder
lIMap'
    rRe :: IMap Image
rRe    = DynBorder -> Image
renderDynBorder (DynBorder -> Image) -> IMap DynBorder -> IMap Image
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 = (BorderMap DynBorder
 -> (Int, Run DynBorder) -> BorderMap DynBorder)
-> BorderMap DynBorder
-> [(Int, Run DynBorder)]
-> BorderMap DynBorder
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl'
        (\BorderMap DynBorder
bm' (Int
s,Run DynBorder
v) -> BoxRenderer n
-> Location
-> Run DynBorder
-> BorderMap DynBorder
-> BorderMap DynBorder
forall n.
BoxRenderer n
-> Location
-> Run DynBorder
-> BorderMap DynBorder
-> BorderMap DynBorder
insertSecondary BoxRenderer n
br (BoxRenderer n -> Int -> Int -> Location
forall n. BoxRenderer n -> Int -> Int -> Location
locationFromPrimarySecondary BoxRenderer n
br Int
p Int
s) Run DynBorder
v BorderMap DynBorder
bm')
        BorderMap DynBorder
bm
        (IMap DynBorder -> [(Int, Run DynBorder)]
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 :: BoxRenderer n
-> [BorderMap DynBorder]
-> ([(IMap Image, IMap Image)], BorderMap DynBorder)
catAllBorders BoxRenderer n
_ [] = ([], BorderMap DynBorder
forall a. BorderMap a
BM.empty)
catAllBorders BoxRenderer n
br (BorderMap DynBorder
bm:[BorderMap DynBorder]
bms) = ([IMap Image] -> [IMap Image] -> [(IMap Image, IMap Image)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([IMap Image
forall a. IMap a
I.empty][IMap Image] -> [IMap Image] -> [IMap Image]
forall a. [a] -> [a] -> [a]
++[IMap Image]
los) ([IMap Image]
his[IMap Image] -> [IMap Image] -> [IMap Image]
forall a. [a] -> [a] -> [a]
++[IMap Image
forall a. IMap a
I.empty]), BorderMap DynBorder
bm') where
    ([(IMap Image, IMap Image)]
rewrites, BorderMap DynBorder
bm') = State (BorderMap DynBorder) [(IMap Image, IMap Image)]
-> BorderMap DynBorder
-> ([(IMap Image, IMap Image)], BorderMap DynBorder)
forall s a. State s a -> s -> (a, s)
runState ((BorderMap DynBorder
 -> StateT (BorderMap DynBorder) Identity (IMap Image, IMap Image))
-> [BorderMap DynBorder]
-> State (BorderMap DynBorder) [(IMap Image, IMap Image)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((BorderMap DynBorder
 -> ((IMap Image, IMap Image), BorderMap DynBorder))
-> StateT (BorderMap DynBorder) Identity (IMap Image, IMap Image)
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((BorderMap DynBorder
  -> ((IMap Image, IMap Image), BorderMap DynBorder))
 -> StateT (BorderMap DynBorder) Identity (IMap Image, IMap Image))
-> (BorderMap DynBorder
    -> BorderMap DynBorder
    -> ((IMap Image, IMap Image), BorderMap DynBorder))
-> BorderMap DynBorder
-> StateT (BorderMap DynBorder) Identity (IMap Image, IMap Image)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoxRenderer n
-> BorderMap DynBorder
-> BorderMap DynBorder
-> ((IMap Image, IMap Image), BorderMap DynBorder)
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) = [(IMap Image, IMap Image)] -> ([IMap Image], [IMap Image])
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 ([Image] -> Image) -> (Image -> [Image]) -> Image -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Image -> [Image]) -> Image -> Image)
-> (IMap Image -> Image -> [Image]) -> IMap Image -> Image -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Run Image)] -> Image -> [Image]
go ([(Int, Run Image)] -> Image -> [Image])
-> (IMap Image -> [(Int, Run Image)])
-> IMap Image
-> Image
-> [Image]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Int, Run Image)] -> [(Int, Run Image)]
forall a. Int -> [(Int, Run a)] -> [(Int, Run a)]
offsets Int
0 ([(Int, Run Image)] -> [(Int, Run Image)])
-> (IMap Image -> [(Int, Run Image)])
-> IMap Image
-> [(Int, Run Image)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IMap Image -> [(Int, Run Image)]
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'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n, Run a
r) (Int, Run a) -> [(Int, Run a)] -> [(Int, Run a)]
forall a. a -> [a] -> [a]
: Int -> [(Int, Run a)] -> [(Int, Run a)]
offsets (Int
n'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Run a -> Int
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]
        [Image] -> [Image] -> [Image]
forall a. [a] -> [a] -> [a]
++ Int -> Image -> [Image]
forall a. Int -> a -> [a]
replicate Int
len Image
new
        [Image] -> [Image] -> [Image]
forall a. [a] -> [a] -> [a]
++ [(Int, Run Image)] -> Image -> [Image]
go [(Int, Run Image)]
nrs (Int -> Image -> Image
splitHi (Int
loInt -> Int -> Int
forall 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 :: BoxRenderer n -> (IMap Image, IMap Image) -> Image -> Image
rewriteImage BoxRenderer n
br (IMap Image
loRewrite, IMap Image
hiRewrite) Image
old = Image -> Image
rewriteHi (Image -> Image) -> (Image -> Image) -> Image -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image -> Image
rewriteLo (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$ Image
old where
    size :: Int
size = BoxRenderer n -> Image -> Int
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 (BoxRenderer n -> Int -> Image -> Image
forall n. BoxRenderer n -> Int -> Image -> Image
splitLoSecondary BoxRenderer n
br) (BoxRenderer n -> Int -> Image -> Image
forall n. BoxRenderer n -> Int -> Image -> Image
splitHiSecondary BoxRenderer n
br) (BoxRenderer n -> [Image] -> Image
forall n. BoxRenderer n -> [Image] -> Image
concatenateSecondary BoxRenderer n
br)
    rewriteLo :: Image -> Image
rewriteLo Image
img
        | IMap Image -> Bool
forall a. IMap a -> Bool
I.null IMap Image
loRewrite Bool -> Bool -> Bool
|| Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Image
img
        | Bool
otherwise = BoxRenderer n -> [Image] -> Image
forall n. BoxRenderer n -> [Image] -> Image
concatenatePrimary BoxRenderer n
br
            [ IMap Image -> Image -> Image
go IMap Image
loRewrite (BoxRenderer n -> Int -> Image -> Image
forall n. BoxRenderer n -> Int -> Image -> Image
splitLoPrimary BoxRenderer n
br Int
1 Image
img)
            , BoxRenderer n -> Int -> Image -> Image
forall n. BoxRenderer n -> Int -> Image -> Image
splitHiPrimary BoxRenderer n
br Int
1 Image
img
            ]
    rewriteHi :: Image -> Image
rewriteHi Image
img
        | IMap Image -> Bool
forall a. IMap a -> Bool
I.null IMap Image
hiRewrite Bool -> Bool -> Bool
|| Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Image
img
        | Bool
otherwise = BoxRenderer n -> [Image] -> Image
forall n. BoxRenderer n -> [Image] -> Image
concatenatePrimary BoxRenderer n
br
            [ BoxRenderer n -> Int -> Image -> Image
forall n. BoxRenderer n -> Int -> Image -> Image
splitLoPrimary BoxRenderer n
br (Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Image
img
            , IMap Image -> Image -> Image
go IMap Image
hiRewrite (BoxRenderer n -> Int -> Image -> Image
forall n. BoxRenderer n -> Int -> Image -> Image
splitHiPrimary BoxRenderer n
br (Int
sizeInt -> Int -> Int
forall 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 :: Int -> Widget n -> Widget n
hLimit Int
w Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$
      (Context -> Context)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT ((Int -> Identity Int) -> Context -> Identity Context
Lens' Context Int
availWidthL ((Int -> Identity Int) -> Context -> Identity Context)
-> (Int -> Int) -> Context -> Context
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
w)) (RenderM n (Result n) -> RenderM n (Result n))
-> RenderM n (Result n) -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
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 :: Int -> Widget n -> Widget n
hLimitPercent Int
w' Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
      let w :: Int
w = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 Int
100 Int
w'
      Context
ctx <- RenderM n Context
forall n. RenderM n Context
getContext
      let usableWidth :: Int
usableWidth = Context
ctxContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL
          widgetWidth :: Int
widgetWidth = Rational -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Int -> Rational
forall a. Real a => a -> Rational
toRational Int
usableWidth Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Int -> Rational
forall a. Real a => a -> Rational
toRational Int
w Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
100))
      (Context -> Context)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT ((Int -> Identity Int) -> Context -> Identity Context
Lens' Context Int
availWidthL ((Int -> Identity Int) -> Context -> Identity Context)
-> (Int -> Int) -> Context -> Context
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
widgetWidth)) (RenderM n (Result n) -> RenderM n (Result n))
-> RenderM n (Result n) -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
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 :: Int -> Widget n -> Widget n
vLimit Int
h Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$
      (Context -> Context)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT ((Int -> Identity Int) -> Context -> Identity Context
Lens' Context Int
availHeightL ((Int -> Identity Int) -> Context -> Identity Context)
-> (Int -> Int) -> Context -> Context
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
h)) (RenderM n (Result n) -> RenderM n (Result n))
-> RenderM n (Result n) -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
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 :: Int -> Widget n -> Widget n
vLimitPercent Int
h' Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
      let h :: Int
h = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 Int
100 Int
h'
      Context
ctx <- RenderM n Context
forall n. RenderM n Context
getContext
      let usableHeight :: Int
usableHeight = Context
ctxContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availHeightL
          widgetHeight :: Int
widgetHeight = Rational -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Int -> Rational
forall a. Real a => a -> Rational
toRational Int
usableHeight Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Int -> Rational
forall a. Real a => a -> Rational
toRational Int
h Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
100))
      (Context -> Context)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT ((Int -> Identity Int) -> Context -> Identity Context
Lens' Context Int
availHeightL ((Int -> Identity Int) -> Context -> Identity Context)
-> (Int -> Int) -> Context -> Context
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
widgetHeight)) (RenderM n (Result n) -> RenderM n (Result n))
-> RenderM n (Result n) -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
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 :: (Int, Int) -> Widget n -> Widget n
setAvailableSize (Int
w, Int
h) Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$
      (Context -> Context)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (\Context
c -> Context
c Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Context -> Identity Context
Lens' Context Int
availHeightL ((Int -> Identity Int) -> Context -> Identity Context)
-> Int -> Context -> Context
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
h Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Context -> Identity Context
Lens' Context Int
availWidthL ((Int -> Identity Int) -> Context -> Identity Context)
-> Int -> Context -> Context
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
w) (RenderM n (Result n) -> RenderM n (Result n))
-> RenderM n (Result n) -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$
        Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
forall n. Widget n -> Widget n
cropToContext Widget n
p

-- | When drawing the specified widget, set the current attribute used
-- for drawing to the one with the specified name. Note that the widget
-- may use further calls to 'withAttr' to override this; if you really
-- 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'.
withAttr :: AttrName -> Widget n -> Widget n
withAttr :: AttrName -> Widget n -> Widget n
withAttr AttrName
an Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$
      (Context -> Context)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& (AttrName -> Identity AttrName) -> Context -> Identity Context
Lens' Context AttrName
ctxAttrNameL ((AttrName -> Identity AttrName) -> Context -> Identity Context)
-> AttrName -> Context -> Context
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AttrName
an) (Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

-- | Update the attribute map while rendering the specified widget: set
-- its new default attribute to the one that we get by looking up the
-- specified attribute name in the map and then modifying it with the
-- specified function.
modifyDefAttr :: (V.Attr -> V.Attr) -> Widget n -> Widget n
modifyDefAttr :: (Attr -> Attr) -> Widget n -> Widget n
modifyDefAttr Attr -> Attr
f Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
        Context
c <- RenderM n Context
forall n. RenderM n Context
getContext
        (Context -> Context)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& (AttrMap -> Identity AttrMap) -> Context -> Identity Context
Lens' Context AttrMap
ctxAttrMapL ((AttrMap -> Identity AttrMap) -> Context -> Identity Context)
-> (AttrMap -> AttrMap) -> Context -> Context
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Attr -> AttrMap -> AttrMap
setDefaultAttr (Attr -> Attr
f (Attr -> Attr) -> Attr -> Attr
forall a b. (a -> b) -> a -> b
$ AttrMap -> Attr
getDefaultAttr (Context
cContext -> Getting AttrMap Context AttrMap -> AttrMap
forall s a. s -> Getting a s a -> a
^.Getting AttrMap Context AttrMap
Lens' Context AttrMap
ctxAttrMapL)))) (Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

-- | Update the attribute map while rendering the specified widget: set
-- its new default attribute to the one that we get by looking up the
-- specified attribute name in the map.
withDefAttr :: AttrName -> Widget n -> Widget n
withDefAttr :: AttrName -> Widget n -> Widget n
withDefAttr AttrName
an Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
        Context
c <- RenderM n Context
forall n. RenderM n Context
getContext
        (Context -> Context)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& (AttrMap -> Identity AttrMap) -> Context -> Identity Context
Lens' Context AttrMap
ctxAttrMapL ((AttrMap -> Identity AttrMap) -> Context -> Identity Context)
-> (AttrMap -> AttrMap) -> Context -> Context
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
cContext -> Getting AttrMap Context AttrMap -> AttrMap
forall s a. s -> Getting a s a -> a
^.Getting AttrMap Context AttrMap
Lens' Context AttrMap
ctxAttrMapL)))) (Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

-- | When rendering the specified widget, update the attribute map with
-- the specified transformation.
updateAttrMap :: (AttrMap -> AttrMap) -> Widget n -> Widget n
updateAttrMap :: (AttrMap -> AttrMap) -> Widget n -> Widget n
updateAttrMap AttrMap -> AttrMap
f Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$
        (Context -> Context)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& (AttrMap -> Identity AttrMap) -> Context -> Identity Context
Lens' Context AttrMap
ctxAttrMapL ((AttrMap -> Identity AttrMap) -> Context -> Identity Context)
-> (AttrMap -> AttrMap) -> Context -> Context
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ AttrMap -> AttrMap
f) (Widget n -> RenderM n (Result n)
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'.
forceAttr :: AttrName -> Widget n -> Widget n
forceAttr :: AttrName -> Widget n -> Widget n
forceAttr AttrName
an Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
        Context
c <- RenderM n Context
forall n. RenderM n Context
getContext
        (Context -> Context)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& (AttrMap -> Identity AttrMap) -> Context -> Identity Context
Lens' Context AttrMap
ctxAttrMapL ((AttrMap -> Identity AttrMap) -> Context -> Identity Context)
-> AttrMap -> Context -> Context
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Attr -> AttrMap
forceAttrMap (AttrName -> AttrMap -> Attr
attrMapLookup AttrName
an (Context
cContext -> Getting AttrMap Context AttrMap -> AttrMap
forall s a. s -> Getting a s a -> a
^.Getting AttrMap Context AttrMap
Lens' Context AttrMap
ctxAttrMapL)))) (Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

-- | Override the lookup of 'targetName' to return the attribute value
-- associated with 'fromName' when rendering the specified widget.
-- See also 'mapAttrName'.
overrideAttr :: AttrName -> AttrName -> Widget n -> Widget n
overrideAttr :: AttrName -> AttrName -> Widget n -> Widget n
overrideAttr AttrName
targetName AttrName
fromName =
    (AttrMap -> AttrMap) -> Widget n -> Widget n
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 :: Image -> Widget n
raw Image
img = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Result n
forall n. Result n
emptyResult Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result n -> Identity (Result n)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result n -> Identity (Result n))
-> Image -> Result n -> Result n
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 :: Location -> Widget n -> Widget n
translateBy Location
off Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
      Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p
      Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Location -> Result n -> Result n
forall n. Location -> Result n -> Result n
addResultOffset Location
off
             (Result n -> Result n) -> Result n -> Result n
forall a b. (a -> b) -> a -> b
$ Result n
result Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result n -> Identity (Result n)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result n -> Identity (Result n))
-> (Image -> Image) -> Result n -> Result n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int -> Int -> Image -> Image
V.translate (Location
offLocation -> Getting Int Location Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Location Int
forall a. TerminalLocation a => Lens' a Int
locationColumnL) (Location
offLocation -> Getting Int Location Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Location Int
forall a. TerminalLocation a => Lens' a Int
locationRowL))

-- | 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 :: Int -> Widget n -> Widget n
cropLeftBy Int
cols Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
      Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p
      let amt :: Int
amt = Image -> Int
V.imageWidth (Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cols
          cropped :: Image -> Image
cropped Image
img = if Int
amt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Image
V.emptyImage else Int -> Image -> Image
V.cropLeft Int
amt Image
img
      Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Location -> Result n -> Result n
forall n. Location -> Result n -> Result n
addResultOffset ((Int, Int) -> Location
Location (-Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cols, Int
0))
             (Result n -> Result n) -> Result n -> Result n
forall a b. (a -> b) -> a -> b
$ Result n
result Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result n -> Identity (Result n)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result n -> Identity (Result n))
-> (Image -> Image) -> Result n -> Result n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Image -> Image
cropped

-- | 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 :: Int -> Widget n -> Widget n
cropRightBy Int
cols Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
      Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p
      let amt :: Int
amt = Image -> Int
V.imageWidth (Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cols
          cropped :: Image -> Image
cropped Image
img = if Int
amt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Image
V.emptyImage else Int -> Image -> Image
V.cropRight Int
amt Image
img
      Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Result n
result Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result n -> Identity (Result n)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result n -> Identity (Result n))
-> (Image -> Image) -> Result n -> Result n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Image -> Image
cropped

-- | 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 :: Int -> Widget n -> Widget n
cropTopBy Int
rows Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
      Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p
      let amt :: Int
amt = Image -> Int
V.imageHeight (Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rows
          cropped :: Image -> Image
cropped Image
img = if Int
amt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Image
V.emptyImage else Int -> Image -> Image
V.cropTop Int
amt Image
img
      Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Location -> Result n -> Result n
forall n. Location -> Result n -> Result n
addResultOffset ((Int, Int) -> Location
Location (Int
0, -Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rows))
             (Result n -> Result n) -> Result n -> Result n
forall a b. (a -> b) -> a -> b
$ Result n
result Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result n -> Identity (Result n)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result n -> Identity (Result n))
-> (Image -> Image) -> Result n -> Result n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Image -> Image
cropped

-- | 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 :: Int -> Widget n -> Widget n
cropBottomBy Int
rows Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
      Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p
      let amt :: Int
amt = Image -> Int
V.imageHeight (Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rows
          cropped :: Image -> Image
cropped Image
img = if Int
amt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Image
V.emptyImage else Int -> Image -> Image
V.cropBottom Int
amt Image
img
      Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Result n
result Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result n -> Identity (Result n)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result n -> Identity (Result n))
-> (Image -> Image) -> Result n -> Result n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Image -> Image
cropped

-- | 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 :: n -> Location -> Widget n -> Widget n
showCursor n
n Location
cloc Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
      Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p
      Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Result n
result Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& ([CursorLocation n] -> Identity [CursorLocation n])
-> Result n -> Identity (Result n)
forall n. Lens' (Result n) [CursorLocation n]
cursorsL (([CursorLocation n] -> Identity [CursorLocation n])
 -> Result n -> Identity (Result n))
-> ([CursorLocation n] -> [CursorLocation n])
-> Result n
-> Result n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Location -> Maybe n -> CursorLocation n
forall n. Location -> Maybe n -> CursorLocation n
CursorLocation Location
cloc (n -> Maybe n
forall a. a -> Maybe a
Just n
n)CursorLocation n -> [CursorLocation n] -> [CursorLocation n]
forall a. a -> [a] -> [a]
:)

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

vRelease :: Widget n -> Maybe (Widget n)
vRelease :: Widget n -> Maybe (Widget n)
vRelease Widget n
p =
    case Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p of
        Size
Fixed -> Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) Size
Greedy (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$
                        (Context -> Context)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Context -> Identity Context
Lens' Context Int
availHeightL ((Int -> Identity Int) -> Context -> Identity Context)
-> Int -> Context -> Context
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
unrestricted) (Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p)
        Size
Greedy -> Maybe (Widget n)
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 :: n -> Widget n -> Widget n
cached n
n Widget n
w =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
w) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
w) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
        Maybe ([n], Result n)
result <- n -> RenderM n (Maybe ([n], Result n))
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
                ([n] -> Identity [n]) -> RenderState n -> Identity (RenderState n)
forall n. Lens' (RenderState n) [n]
clickableNamesL (([n] -> Identity [n])
 -> RenderState n -> Identity (RenderState n))
-> ([n] -> [n]) -> ReaderT Context (State (RenderState n)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([n]
clickables [n] -> [n] -> [n]
forall a. [a] -> [a] -> [a]
++)
                Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
prevResult
            Maybe ([n], Result n)
Nothing  -> do
                Result n
wResult <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
w
                [n]
clickables <- Result n -> RenderM n [n]
forall n. Ord n => Result n -> RenderM n [n]
renderedClickables Result n
wResult
                n -> ([n], Result n) -> ReaderT Context (State (RenderState n)) ()
forall n. Ord n => n -> ([n], Result n) -> RenderM n ()
cacheUpdate n
n ([n]
clickables, Result n
wResult)
                Result n -> RenderM n (Result n)
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 :: Result n -> RenderM n [n]
renderedClickables Result n
renderResult = do
            [n]
allClickables <- Getting [n] (RenderState n) [n] -> RenderM n [n]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting [n] (RenderState n) [n]
forall n. Lens' (RenderState n) [n]
clickableNamesL
            [n] -> RenderM n [n]
forall (m :: * -> *) a. Monad m => a -> m a
return [Extent n -> n
forall n. Extent n -> n
extentName Extent n
e | Extent n
e <- Result n
renderResultResult n -> Getting [Extent n] (Result n) [Extent n] -> [Extent n]
forall s a. s -> Getting a s a -> a
^.Getting [Extent n] (Result n) [Extent n]
forall n. Lens' (Result n) [Extent n]
extentsL, Extent n -> n
forall n. Extent n -> n
extentName Extent n
e n -> [n] -> Bool
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 :: n -> RenderM n (Maybe ([n], Result n))
cacheLookup n
n = do
    Map n ([n], Result n)
cache <- StateT (RenderState n) Identity (Map n ([n], Result n))
-> ReaderT
     Context (StateT (RenderState n) Identity) (Map n ([n], Result n))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (RenderState n) Identity (Map n ([n], Result n))
 -> ReaderT
      Context (StateT (RenderState n) Identity) (Map n ([n], Result n)))
-> StateT (RenderState n) Identity (Map n ([n], Result n))
-> ReaderT
     Context (StateT (RenderState n) Identity) (Map n ([n], Result n))
forall a b. (a -> b) -> a -> b
$ (RenderState n -> Map n ([n], Result n))
-> StateT (RenderState n) Identity (Map n ([n], Result n))
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (RenderState n
-> Getting
     (Map n ([n], Result n)) (RenderState n) (Map n ([n], Result n))
-> Map n ([n], Result n)
forall s a. s -> Getting a s a -> a
^.Getting
  (Map n ([n], Result n)) (RenderState n) (Map n ([n], Result n))
forall n. Lens' (RenderState n) (Map n ([n], Result n))
renderCacheL)
    Maybe ([n], Result n) -> RenderM n (Maybe ([n], Result n))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ([n], Result n) -> RenderM n (Maybe ([n], Result n)))
-> Maybe ([n], Result n) -> RenderM n (Maybe ([n], Result n))
forall a b. (a -> b) -> a -> b
$ n -> Map n ([n], Result n) -> Maybe ([n], Result n)
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 :: n -> ([n], Result n) -> RenderM n ()
cacheUpdate n
n ([n], Result n)
r = StateT (RenderState n) Identity () -> RenderM n ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (RenderState n) Identity () -> RenderM n ())
-> StateT (RenderState n) Identity () -> RenderM n ()
forall a b. (a -> b) -> a -> b
$ (RenderState n -> RenderState n)
-> StateT (RenderState n) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (RenderState n -> (RenderState n -> RenderState n) -> RenderState n
forall a b. a -> (a -> b) -> b
& (Map n ([n], Result n) -> Identity (Map n ([n], Result n)))
-> RenderState n -> Identity (RenderState n)
forall n. Lens' (RenderState n) (Map n ([n], Result n))
renderCacheL ((Map n ([n], Result n) -> Identity (Map n ([n], Result n)))
 -> RenderState n -> Identity (RenderState n))
-> (Map n ([n], Result n) -> Map n ([n], Result n))
-> RenderState n
-> RenderState n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ n
-> ([n], Result n)
-> Map n ([n], Result n)
-> Map n ([n], Result n)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert n
n ([n], Result n)
r)

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

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

      -- Update the viewport size.
      Context
c <- RenderM n Context
forall n. RenderM n Context
getContext
      let newVp :: Viewport
newVp = Int -> Int -> (Int, Int) -> Viewport
VP Int
0 Int
0 (Int, Int)
newSize
          newSize :: (Int, Int)
newSize = (Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL, Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availHeightL)
          doInsert :: Maybe Viewport -> Maybe Viewport
doInsert (Just Viewport
vp) = Viewport -> Maybe Viewport
forall a. a -> Maybe a
Just (Viewport -> Maybe Viewport) -> Viewport -> Maybe Viewport
forall a b. (a -> b) -> a -> b
$ Viewport
vp Viewport -> (Viewport -> Viewport) -> Viewport
forall a b. a -> (a -> b) -> b
& ((Int, Int) -> Identity (Int, Int))
-> Viewport -> Identity Viewport
Lens' Viewport (Int, Int)
vpSize (((Int, Int) -> Identity (Int, Int))
 -> Viewport -> Identity Viewport)
-> (Int, Int) -> Viewport -> Viewport
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Int, Int)
newSize
          doInsert Maybe Viewport
Nothing = Viewport -> Maybe Viewport
forall a. a -> Maybe a
Just Viewport
newVp

      StateT (RenderState n) Identity () -> RenderM n ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (RenderState n) Identity () -> RenderM n ())
-> StateT (RenderState n) Identity () -> RenderM n ()
forall a b. (a -> b) -> a -> b
$ (RenderState n -> RenderState n)
-> StateT (RenderState n) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (RenderState n -> (RenderState n -> RenderState n) -> RenderState n
forall a b. a -> (a -> b) -> b
& (Map n Viewport -> Identity (Map n Viewport))
-> RenderState n -> Identity (RenderState n)
forall n. Lens' (RenderState n) (Map n Viewport)
viewportMapL ((Map n Viewport -> Identity (Map n Viewport))
 -> RenderState n -> Identity (RenderState n))
-> (Map n Viewport -> Map n Viewport)
-> RenderState n
-> RenderState n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((Maybe Viewport -> Maybe Viewport)
-> n -> Map n Viewport -> Map n Viewport
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)
      let release :: Widget n -> Maybe (Widget n)
release = case ViewportType
typ of
            ViewportType
Vertical -> Widget n -> Maybe (Widget n)
forall n. Widget n -> Maybe (Widget n)
vRelease
            ViewportType
Horizontal -> Widget n -> Maybe (Widget n)
forall n. Widget n -> Maybe (Widget n)
hRelease
            ViewportType
Both -> Widget n -> Maybe (Widget n)
forall n. Widget n -> Maybe (Widget n)
vRelease (Widget n -> Maybe (Widget n))
-> (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Widget n -> Maybe (Widget n)
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 -> String -> Widget n
forall a. HasCallStack => String -> a
error (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ String
"tried to embed an infinite-height " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                                    String
"widget in vertical viewport " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (n -> String
forall a. Show a => a -> String
show n
vpname)
                ViewportType
Horizontal -> String -> Widget n
forall a. HasCallStack => String -> a
error (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ String
"tried to embed an infinite-width " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                                      String
"widget in horizontal viewport " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (n -> String
forall a. Show a => a -> String
show n
vpname)
                ViewportType
Both -> String -> Widget n
forall a. HasCallStack => String -> a
error (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ String
"tried to embed an infinite-width or " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                                String
"infinite-height widget in 'Both' type " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                                String
"viewport " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (n -> String
forall a. Show a => a -> String
show n
vpname)

      Result n
initialResult <- Widget n -> RenderM n (Result n)
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 <- StateT (RenderState n) Identity [(n, ScrollRequest)]
-> ReaderT
     Context (StateT (RenderState n) Identity) [(n, ScrollRequest)]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (RenderState n) Identity [(n, ScrollRequest)]
 -> ReaderT
      Context (StateT (RenderState n) Identity) [(n, ScrollRequest)])
-> StateT (RenderState n) Identity [(n, ScrollRequest)]
-> ReaderT
     Context (StateT (RenderState n) Identity) [(n, ScrollRequest)]
forall a b. (a -> b) -> a -> b
$ (RenderState n -> [(n, ScrollRequest)])
-> StateT (RenderState n) Identity [(n, ScrollRequest)]
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets ((RenderState n -> [(n, ScrollRequest)])
 -> StateT (RenderState n) Identity [(n, ScrollRequest)])
-> (RenderState n -> [(n, ScrollRequest)])
-> StateT (RenderState n) Identity [(n, ScrollRequest)]
forall a b. (a -> b) -> a -> b
$ (RenderState n
-> Getting
     [(n, ScrollRequest)] (RenderState n) [(n, ScrollRequest)]
-> [(n, ScrollRequest)]
forall s a. s -> Getting a s a -> a
^.Getting [(n, ScrollRequest)] (RenderState n) [(n, ScrollRequest)]
forall n. Lens' (RenderState n) [(n, ScrollRequest)]
rsScrollRequestsL)
      let relevantRequests :: [ScrollRequest]
relevantRequests = (n, ScrollRequest) -> ScrollRequest
forall a b. (a, b) -> b
snd ((n, ScrollRequest) -> ScrollRequest)
-> [(n, ScrollRequest)] -> [ScrollRequest]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((n, ScrollRequest) -> Bool)
-> [(n, ScrollRequest)] -> [(n, ScrollRequest)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(n
n, ScrollRequest
_) -> n
n n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
vpname) [(n, ScrollRequest)]
reqs
      Bool -> RenderM n () -> RenderM n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ScrollRequest] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ScrollRequest]
relevantRequests) (RenderM n () -> RenderM n ()) -> RenderM n () -> RenderM n ()
forall a b. (a -> b) -> a -> b
$ do
          Maybe Viewport
mVp <- StateT (RenderState n) Identity (Maybe Viewport)
-> ReaderT
     Context (StateT (RenderState n) Identity) (Maybe Viewport)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (RenderState n) Identity (Maybe Viewport)
 -> ReaderT
      Context (StateT (RenderState n) Identity) (Maybe Viewport))
-> StateT (RenderState n) Identity (Maybe Viewport)
-> ReaderT
     Context (StateT (RenderState n) Identity) (Maybe Viewport)
forall a b. (a -> b) -> a -> b
$ (RenderState n -> Maybe Viewport)
-> StateT (RenderState n) Identity (Maybe Viewport)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets ((RenderState n -> Maybe Viewport)
 -> StateT (RenderState n) Identity (Maybe Viewport))
-> (RenderState n -> Maybe Viewport)
-> StateT (RenderState n) Identity (Maybe Viewport)
forall a b. (a -> b) -> a -> b
$ (RenderState n
-> Getting (Maybe Viewport) (RenderState n) (Maybe Viewport)
-> Maybe Viewport
forall s a. s -> Getting a s a -> a
^.(Map n Viewport -> Const (Maybe Viewport) (Map n Viewport))
-> RenderState n -> Const (Maybe Viewport) (RenderState n)
forall n. Lens' (RenderState n) (Map n Viewport)
viewportMapL((Map n Viewport -> Const (Maybe Viewport) (Map n Viewport))
 -> RenderState n -> Const (Maybe Viewport) (RenderState n))
-> ((Maybe Viewport -> Const (Maybe Viewport) (Maybe Viewport))
    -> Map n Viewport -> Const (Maybe Viewport) (Map n Viewport))
-> Getting (Maybe Viewport) (RenderState n) (Maybe Viewport)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map n Viewport -> Maybe Viewport)
-> SimpleGetter (Map n Viewport) (Maybe Viewport)
forall s a. (s -> a) -> SimpleGetter s a
to (n -> Map n Viewport -> Maybe Viewport
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup n
vpname))
          case Maybe Viewport
mVp of
              Maybe Viewport
Nothing -> String -> RenderM n ()
forall a. HasCallStack => String -> a
error (String -> RenderM n ()) -> String -> RenderM n ()
forall a b. (a -> b) -> a -> b
$ String
"BUG: viewport: viewport name " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> n -> String
forall a. Show a => a -> String
show n
vpname String -> String -> String
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
initialResultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL) (Viewport -> Viewport) -> Viewport -> Viewport
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
initialResultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL) (Viewport -> Viewport) -> Viewport -> Viewport
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
initialResultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL) (Viewport -> Viewport) -> Viewport -> Viewport
forall a b. (a -> b) -> a -> b
$
                                      ViewportType -> ScrollRequest -> Image -> Viewport -> Viewport
scrollTo ViewportType
Vertical ScrollRequest
rq (Result n
initialResultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL) (Viewport -> Viewport) -> Viewport -> Viewport
forall a b. (a -> b) -> a -> b
$
                                      [ScrollRequest] -> Viewport -> Viewport
applyRequests [ScrollRequest]
rqs Viewport
v
                  StateT (RenderState n) Identity () -> RenderM n ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (RenderState n) Identity () -> RenderM n ())
-> StateT (RenderState n) Identity () -> RenderM n ()
forall a b. (a -> b) -> a -> b
$ (RenderState n -> RenderState n)
-> StateT (RenderState n) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (RenderState n -> (RenderState n -> RenderState n) -> RenderState n
forall a b. a -> (a -> b) -> b
& (Map n Viewport -> Identity (Map n Viewport))
-> RenderState n -> Identity (RenderState n)
forall n. Lens' (RenderState n) (Map n Viewport)
viewportMapL ((Map n Viewport -> Identity (Map n Viewport))
 -> RenderState n -> Identity (RenderState n))
-> (Map n Viewport -> Map n Viewport)
-> RenderState n
-> RenderState n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (n -> Viewport -> Map n Viewport -> Map n Viewport
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
      Bool -> RenderM n () -> RenderM n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [VisibilityRequest] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([VisibilityRequest] -> Bool) -> [VisibilityRequest] -> Bool
forall a b. (a -> b) -> a -> b
$ Result n
initialResultResult n
-> Getting [VisibilityRequest] (Result n) [VisibilityRequest]
-> [VisibilityRequest]
forall s a. s -> Getting a s a -> a
^.Getting [VisibilityRequest] (Result n) [VisibilityRequest]
forall n. Lens' (Result n) [VisibilityRequest]
visibilityRequestsL) (RenderM n () -> RenderM n ()) -> RenderM n () -> RenderM n ()
forall a b. (a -> b) -> a -> b
$ do
          Maybe Viewport
mVp <- StateT (RenderState n) Identity (Maybe Viewport)
-> ReaderT
     Context (StateT (RenderState n) Identity) (Maybe Viewport)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (RenderState n) Identity (Maybe Viewport)
 -> ReaderT
      Context (StateT (RenderState n) Identity) (Maybe Viewport))
-> StateT (RenderState n) Identity (Maybe Viewport)
-> ReaderT
     Context (StateT (RenderState n) Identity) (Maybe Viewport)
forall a b. (a -> b) -> a -> b
$ (RenderState n -> Maybe Viewport)
-> StateT (RenderState n) Identity (Maybe Viewport)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets ((RenderState n -> Maybe Viewport)
 -> StateT (RenderState n) Identity (Maybe Viewport))
-> (RenderState n -> Maybe Viewport)
-> StateT (RenderState n) Identity (Maybe Viewport)
forall a b. (a -> b) -> a -> b
$ (RenderState n
-> Getting (Maybe Viewport) (RenderState n) (Maybe Viewport)
-> Maybe Viewport
forall s a. s -> Getting a s a -> a
^.(Map n Viewport -> Const (Maybe Viewport) (Map n Viewport))
-> RenderState n -> Const (Maybe Viewport) (RenderState n)
forall n. Lens' (RenderState n) (Map n Viewport)
viewportMapL((Map n Viewport -> Const (Maybe Viewport) (Map n Viewport))
 -> RenderState n -> Const (Maybe Viewport) (RenderState n))
-> ((Maybe Viewport -> Const (Maybe Viewport) (Maybe Viewport))
    -> Map n Viewport -> Const (Maybe Viewport) (Map n Viewport))
-> Getting (Maybe Viewport) (RenderState n) (Maybe Viewport)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map n Viewport -> Maybe Viewport)
-> SimpleGetter (Map n Viewport) (Maybe Viewport)
forall s a. (s -> a) -> SimpleGetter s a
to (n -> Map n Viewport -> Maybe Viewport
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup n
vpname))
          case Maybe Viewport
mVp of
              Maybe Viewport
Nothing -> String -> RenderM n ()
forall a. HasCallStack => String -> a
error (String -> RenderM n ()) -> String -> RenderM n ()
forall a b. (a -> b) -> a -> b
$ String
"BUG: viewport: viewport name " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> n -> String
forall a. Show a => a -> String
show n
vpname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" absent from viewport map"
              Just Viewport
vp -> do
                  let rqs :: [VisibilityRequest]
rqs = Result n
initialResultResult n
-> Getting [VisibilityRequest] (Result n) [VisibilityRequest]
-> [VisibilityRequest]
forall s a. s -> Getting a s a -> a
^.Getting [VisibilityRequest] (Result n) [VisibilityRequest]
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 (Viewport -> Viewport) -> Viewport -> Viewport
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'
                  StateT (RenderState n) Identity () -> RenderM n ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (RenderState n) Identity () -> RenderM n ())
-> StateT (RenderState n) Identity () -> RenderM n ()
forall a b. (a -> b) -> a -> b
$ (RenderState n -> RenderState n)
-> StateT (RenderState n) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (RenderState n -> (RenderState n -> RenderState n) -> RenderState n
forall a b. a -> (a -> b) -> b
& (Map n Viewport -> Identity (Map n Viewport))
-> RenderState n -> Identity (RenderState n)
forall n. Lens' (RenderState n) (Map n Viewport)
viewportMapL ((Map n Viewport -> Identity (Map n Viewport))
 -> RenderState n -> Identity (RenderState n))
-> (Map n Viewport -> Map n Viewport)
-> RenderState n
-> RenderState n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (n -> Viewport -> Map n Viewport -> Map n Viewport
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert n
vpname (Viewport -> Map n Viewport -> Map n Viewport)
-> Viewport -> Map n Viewport -> Map n Viewport
forall a b. (a -> b) -> a -> b
$ (Viewport -> VisibilityRequest -> Viewport)
-> Viewport -> [VisibilityRequest] -> Viewport
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 <- StateT (RenderState n) Identity (Maybe Viewport)
-> ReaderT
     Context (StateT (RenderState n) Identity) (Maybe Viewport)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (RenderState n) Identity (Maybe Viewport)
 -> ReaderT
      Context (StateT (RenderState n) Identity) (Maybe Viewport))
-> StateT (RenderState n) Identity (Maybe Viewport)
-> ReaderT
     Context (StateT (RenderState n) Identity) (Maybe Viewport)
forall a b. (a -> b) -> a -> b
$ (RenderState n -> Maybe Viewport)
-> StateT (RenderState n) Identity (Maybe Viewport)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets ((RenderState n -> Maybe Viewport)
 -> StateT (RenderState n) Identity (Maybe Viewport))
-> (RenderState n -> Maybe Viewport)
-> StateT (RenderState n) Identity (Maybe Viewport)
forall a b. (a -> b) -> a -> b
$ (RenderState n
-> Getting (Maybe Viewport) (RenderState n) (Maybe Viewport)
-> Maybe Viewport
forall s a. s -> Getting a s a -> a
^.(Map n Viewport -> Const (Maybe Viewport) (Map n Viewport))
-> RenderState n -> Const (Maybe Viewport) (RenderState n)
forall n. Lens' (RenderState n) (Map n Viewport)
viewportMapL((Map n Viewport -> Const (Maybe Viewport) (Map n Viewport))
 -> RenderState n -> Const (Maybe Viewport) (RenderState n))
-> ((Maybe Viewport -> Const (Maybe Viewport) (Maybe Viewport))
    -> Map n Viewport -> Const (Maybe Viewport) (Map n Viewport))
-> Getting (Maybe Viewport) (RenderState n) (Maybe Viewport)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map n Viewport -> Maybe Viewport)
-> SimpleGetter (Map n Viewport) (Maybe Viewport)
forall s a. (s -> a) -> SimpleGetter s a
to (n -> Map n Viewport -> Maybe Viewport
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 -> String
-> ReaderT Context (StateT (RenderState n) Identity) Viewport
forall a. HasCallStack => String -> a
error (String
 -> ReaderT Context (StateT (RenderState n) Identity) Viewport)
-> String
-> ReaderT Context (StateT (RenderState n) Identity) Viewport
forall a b. (a -> b) -> a -> b
$ String
"BUG: viewport: viewport name " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> n -> String
forall a. Show a => a -> String
show n
vpname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" absent from viewport map"
          Just Viewport
v -> Viewport
-> ReaderT Context (StateT (RenderState n) Identity) Viewport
forall (m :: * -> *) a. Monad m => a -> m a
return Viewport
v

      let img :: Image
img = Result n
initialResultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL
          fixTop :: Viewport -> Viewport
fixTop Viewport
v = if Image -> Int
V.imageHeight Image
img Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Viewport
vViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.((Int, Int) -> Const Int (Int, Int))
-> Viewport -> Const Int Viewport
Lens' Viewport (Int, Int)
vpSize(((Int, Int) -> Const Int (Int, Int))
 -> Viewport -> Const Int Viewport)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2
                   then Viewport
v Viewport -> (Viewport -> Viewport) -> Viewport
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Viewport -> Identity Viewport
Lens' Viewport Int
vpTop ((Int -> Identity Int) -> Viewport -> Identity Viewport)
-> Int -> Viewport -> Viewport
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Viewport
vViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.((Int, Int) -> Const Int (Int, Int))
-> Viewport -> Const Int Viewport
Lens' Viewport (Int, Int)
vpSize(((Int, Int) -> Const Int (Int, Int))
 -> Viewport -> Const Int Viewport)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1
                   then Viewport
v Viewport -> (Viewport -> Viewport) -> Viewport
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Viewport -> Identity Viewport
Lens' Viewport Int
vpLeft ((Int -> Identity Int) -> Viewport -> Identity Viewport)
-> Int -> Viewport -> Viewport
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
0
                   else Viewport
v
          updateVp :: Viewport -> Viewport
updateVp = case ViewportType
typ of
              ViewportType
Both -> Viewport -> Viewport
fixLeft (Viewport -> Viewport)
-> (Viewport -> Viewport) -> Viewport -> Viewport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Viewport -> Viewport
fixTop
              ViewportType
Horizontal -> Viewport -> Viewport
fixLeft
              ViewportType
Vertical -> Viewport -> Viewport
fixTop
      StateT (RenderState n) Identity () -> RenderM n ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (RenderState n) Identity () -> RenderM n ())
-> StateT (RenderState n) Identity () -> RenderM n ()
forall a b. (a -> b) -> a -> b
$ (RenderState n -> RenderState n)
-> StateT (RenderState n) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (RenderState n -> (RenderState n -> RenderState n) -> RenderState n
forall a b. a -> (a -> b) -> b
& (Map n Viewport -> Identity (Map n Viewport))
-> RenderState n -> Identity (RenderState n)
forall n. Lens' (RenderState n) (Map n Viewport)
viewportMapL ((Map n Viewport -> Identity (Map n Viewport))
 -> RenderState n -> Identity (RenderState n))
-> (Map n Viewport -> Map n Viewport)
-> RenderState n
-> RenderState n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (n -> Viewport -> Map n Viewport -> Map n Viewport
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 <- StateT (RenderState n) Identity (Maybe Viewport)
-> ReaderT
     Context (StateT (RenderState n) Identity) (Maybe Viewport)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (RenderState n) Identity (Maybe Viewport)
 -> ReaderT
      Context (StateT (RenderState n) Identity) (Maybe Viewport))
-> StateT (RenderState n) Identity (Maybe Viewport)
-> ReaderT
     Context (StateT (RenderState n) Identity) (Maybe Viewport)
forall a b. (a -> b) -> a -> b
$ (RenderState n -> Maybe Viewport)
-> StateT (RenderState n) Identity (Maybe Viewport)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (n -> Map n Viewport -> Maybe Viewport
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup n
vpname (Map n Viewport -> Maybe Viewport)
-> (RenderState n -> Map n Viewport)
-> RenderState n
-> Maybe Viewport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RenderState n
-> Getting (Map n Viewport) (RenderState n) (Map n Viewport)
-> Map n Viewport
forall s a. s -> Getting a s a -> a
^.Getting (Map n Viewport) (RenderState n) (Map n Viewport)
forall n. Lens' (RenderState n) (Map n Viewport)
viewportMapL))
      Viewport
vpFinal <- case Maybe Viewport
mVpFinal of
          Maybe Viewport
Nothing -> String
-> ReaderT Context (StateT (RenderState n) Identity) Viewport
forall a. HasCallStack => String -> a
error (String
 -> ReaderT Context (StateT (RenderState n) Identity) Viewport)
-> String
-> ReaderT Context (StateT (RenderState n) Identity) Viewport
forall a b. (a -> b) -> a -> b
$ String
"BUG: viewport: viewport name " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> n -> String
forall a. Show a => a -> String
show n
vpname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" absent from viewport map"
          Just Viewport
v -> Viewport
-> ReaderT Context (StateT (RenderState n) Identity) Viewport
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 <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Location -> Widget n -> Widget n
forall n. Location -> Widget n -> Widget n
translateBy ((Int, Int) -> Location
Location (-Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Viewport
vpFinalViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Viewport Int
Lens' Viewport Int
vpLeft, -Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Viewport
vpFinalViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Viewport Int
Lens' Viewport Int
vpTop))
                           (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
initialResult

      -- Return the translated result with the visibility requests
      -- discarded
      let translatedSize :: (Int, Int)
translatedSize = ( Result n
translatedResult n -> Getting Int (Result n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result n -> Const Int (Result n)
forall n. Lens' (Result n) Image
imageL((Image -> Const Int Image) -> Result n -> Const Int (Result n))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageWidth
                           , Result n
translatedResult n -> Getting Int (Result n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result n -> Const Int (Result n)
forall n. Lens' (Result n) Image
imageL((Image -> Const Int Image) -> Result n -> Const Int (Result n))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageHeight
                           )
      case (Int, Int)
translatedSize of
          (Int
0, Int
0) -> do
              let spaceFill :: Image
spaceFill = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill (Context
cContext -> Getting Attr Context Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr Context Attr
forall r. Getting r Context Attr
attrL) Char
' ' (Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL) (Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availHeightL)
              Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Result n
translated Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result n -> Identity (Result n)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result n -> Identity (Result n))
-> Image -> Result n -> Result n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Image
spaceFill
                                  Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& ([VisibilityRequest] -> Identity [VisibilityRequest])
-> Result n -> Identity (Result n)
forall n. Lens' (Result n) [VisibilityRequest]
visibilityRequestsL (([VisibilityRequest] -> Identity [VisibilityRequest])
 -> Result n -> Identity (Result n))
-> [VisibilityRequest] -> Result n -> Result n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [VisibilityRequest]
forall a. Monoid a => a
mempty
                                  Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& ([Extent n] -> Identity [Extent n])
-> Result n -> Identity (Result n)
forall n. Lens' (Result n) [Extent n]
extentsL (([Extent n] -> Identity [Extent n])
 -> Result n -> Identity (Result n))
-> [Extent n] -> Result n -> Result n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Extent n]
forall a. Monoid a => a
mempty
          (Int, Int)
_ -> Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
forall n. Widget n -> Widget n
cropToContext
                      (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max
                      (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max
                      (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed
                      (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Result n
translated Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& ([VisibilityRequest] -> Identity [VisibilityRequest])
-> Result n -> Identity (Result n)
forall n. Lens' (Result n) [VisibilityRequest]
visibilityRequestsL (([VisibilityRequest] -> Identity [VisibilityRequest])
 -> Result n -> Identity (Result n))
-> [VisibilityRequest] -> Result n -> Result n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [VisibilityRequest]
forall a. Monoid a => a
mempty

-- | 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 :: n -> RenderM n (Maybe Viewport)
unsafeLookupViewport n
name = StateT (RenderState n) Identity (Maybe Viewport)
-> RenderM n (Maybe Viewport)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (RenderState n) Identity (Maybe Viewport)
 -> RenderM n (Maybe Viewport))
-> StateT (RenderState n) Identity (Maybe Viewport)
-> RenderM n (Maybe Viewport)
forall a b. (a -> b) -> a -> b
$ (RenderState n -> Maybe Viewport)
-> StateT (RenderState n) Identity (Maybe Viewport)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (n -> Map n Viewport -> Maybe Viewport
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup n
name (Map n Viewport -> Maybe Viewport)
-> (RenderState n -> Map n Viewport)
-> RenderState n
-> Maybe Viewport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RenderState n
-> Getting (Map n Viewport) (RenderState n) (Map n Viewport)
-> Map n Viewport
forall s a. s -> Getting a s a -> a
^.Getting (Map n Viewport) (RenderState n) (Map n Viewport)
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
_ = String -> 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 Viewport -> (Viewport -> Viewport) -> Viewport
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Viewport -> Identity Viewport
Lens' Viewport Int
vpTop ((Int -> Identity Int) -> Viewport -> Identity Viewport)
-> Int -> Viewport -> Viewport
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
newVStart
    where
        newVStart :: Int
newVStart = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Image -> Int
V.imageHeight Image
img Int -> Int -> Int
forall a. Num a => a -> a -> a
- Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.((Int, Int) -> Const Int (Int, Int))
-> Viewport -> Const Int Viewport
Lens' Viewport (Int, Int)
vpSize(((Int, Int) -> Const Int (Int, Int))
 -> Viewport -> Const Int Viewport)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
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
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Viewport Int
Lens' Viewport Int
vpTop Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
amt
            VScrollPage Direction
Up -> Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Viewport Int
Lens' Viewport Int
vpTop Int -> Int -> Int
forall a. Num a => a -> a -> a
- Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.((Int, Int) -> Const Int (Int, Int))
-> Viewport -> Const Int Viewport
Lens' Viewport (Int, Int)
vpSize(((Int, Int) -> Const Int (Int, Int))
 -> Viewport -> Const Int Viewport)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2
            VScrollPage Direction
Down -> Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Viewport Int
Lens' Viewport Int
vpTop Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.((Int, Int) -> Const Int (Int, Int))
-> Viewport -> Const Int Viewport
Lens' Viewport (Int, Int)
vpSize(((Int, Int) -> Const Int (Int, Int))
 -> Viewport -> Const Int Viewport)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.((Int, Int) -> Const Int (Int, Int))
-> Viewport -> Const Int Viewport
Lens' Viewport (Int, Int)
vpSize(((Int, Int) -> Const Int (Int, Int))
 -> Viewport -> Const Int Viewport)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2
            SetTop Int
i -> Int
i
            ScrollRequest
_ -> Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Viewport Int
Lens' Viewport Int
vpTop
scrollTo ViewportType
Horizontal ScrollRequest
req Image
img Viewport
vp = Viewport
vp Viewport -> (Viewport -> Viewport) -> Viewport
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Viewport -> Identity Viewport
Lens' Viewport Int
vpLeft ((Int -> Identity Int) -> Viewport -> Identity Viewport)
-> Int -> Viewport -> Viewport
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
newHStart
    where
        newHStart :: Int
newHStart = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Image -> Int
V.imageWidth Image
img Int -> Int -> Int
forall a. Num a => a -> a -> a
- Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.((Int, Int) -> Const Int (Int, Int))
-> Viewport -> Const Int Viewport
Lens' Viewport (Int, Int)
vpSize(((Int, Int) -> Const Int (Int, Int))
 -> Viewport -> Const Int Viewport)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
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
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Viewport Int
Lens' Viewport Int
vpLeft Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
amt
            HScrollPage Direction
Up -> Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Viewport Int
Lens' Viewport Int
vpLeft Int -> Int -> Int
forall a. Num a => a -> a -> a
- Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.((Int, Int) -> Const Int (Int, Int))
-> Viewport -> Const Int Viewport
Lens' Viewport (Int, Int)
vpSize(((Int, Int) -> Const Int (Int, Int))
 -> Viewport -> Const Int Viewport)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1
            HScrollPage Direction
Down -> Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Viewport Int
Lens' Viewport Int
vpLeft Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.((Int, Int) -> Const Int (Int, Int))
-> Viewport -> Const Int Viewport
Lens' Viewport (Int, Int)
vpSize(((Int, Int) -> Const Int (Int, Int))
 -> Viewport -> Const Int Viewport)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.((Int, Int) -> Const Int (Int, Int))
-> Viewport -> Const Int Viewport
Lens' Viewport (Int, Int)
vpSize(((Int, Int) -> Const Int (Int, Int))
 -> Viewport -> Const Int Viewport)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1
            SetLeft Int
i -> Int
i
            ScrollRequest
_ -> Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Viewport Int
Lens' Viewport Int
vpLeft

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

        reqEnd :: Int
reqEnd = VisibilityRequest
rqVisibilityRequest -> Getting Int VisibilityRequest Int -> Int
forall s a. s -> Getting a s a -> a
^.(Location -> Const Int Location)
-> VisibilityRequest -> Const Int VisibilityRequest
Lens' VisibilityRequest Location
vrPositionL((Location -> Const Int Location)
 -> VisibilityRequest -> Const Int VisibilityRequest)
-> Getting Int Location Int -> Getting Int VisibilityRequest Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int Location Int
forall a. TerminalLocation a => Lens' a Int
locationRowL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ VisibilityRequest
rqVisibilityRequest -> Getting Int VisibilityRequest Int -> Int
forall s a. s -> Getting a s a -> a
^.((Int, Int) -> Const Int (Int, Int))
-> VisibilityRequest -> Const Int VisibilityRequest
Lens' VisibilityRequest (Int, Int)
vrSizeL(((Int, Int) -> Const Int (Int, Int))
 -> VisibilityRequest -> Const Int VisibilityRequest)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int VisibilityRequest Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2
        newVStart :: Int
        newVStart :: Int
newVStart = if Int
reqStart Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
vStartEndVisible
                   then Int
reqStart
                   else Int
vStartEndVisible
        vStartEndVisible :: Int
vStartEndVisible = if Int
reqEnd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
curEnd
                           then Int
curStart
                           else Int
curStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
reqEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
curEnd)
scrollToView ViewportType
Horizontal VisibilityRequest
rq Viewport
vp = Viewport
vp Viewport -> (Viewport -> Viewport) -> Viewport
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Viewport -> Identity Viewport
Lens' Viewport Int
vpLeft ((Int -> Identity Int) -> Viewport -> Identity Viewport)
-> Int -> Viewport -> Viewport
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
newHStart
    where
        curStart :: Int
curStart = Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Viewport Int
Lens' Viewport Int
vpLeft
        curEnd :: Int
curEnd = Int
curStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.((Int, Int) -> Const Int (Int, Int))
-> Viewport -> Const Int Viewport
Lens' Viewport (Int, Int)
vpSize(((Int, Int) -> Const Int (Int, Int))
 -> Viewport -> Const Int Viewport)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1
        reqStart :: Int
reqStart = VisibilityRequest
rqVisibilityRequest -> Getting Int VisibilityRequest Int -> Int
forall s a. s -> Getting a s a -> a
^.(Location -> Const Int Location)
-> VisibilityRequest -> Const Int VisibilityRequest
Lens' VisibilityRequest Location
vrPositionL((Location -> Const Int Location)
 -> VisibilityRequest -> Const Int VisibilityRequest)
-> Getting Int Location Int -> Getting Int VisibilityRequest Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int Location Int
forall a. TerminalLocation a => Lens' a Int
locationColumnL

        reqEnd :: Int
reqEnd = VisibilityRequest
rqVisibilityRequest -> Getting Int VisibilityRequest Int -> Int
forall s a. s -> Getting a s a -> a
^.(Location -> Const Int Location)
-> VisibilityRequest -> Const Int VisibilityRequest
Lens' VisibilityRequest Location
vrPositionL((Location -> Const Int Location)
 -> VisibilityRequest -> Const Int VisibilityRequest)
-> Getting Int Location Int -> Getting Int VisibilityRequest Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int Location Int
forall a. TerminalLocation a => Lens' a Int
locationColumnL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ VisibilityRequest
rqVisibilityRequest -> Getting Int VisibilityRequest Int -> Int
forall s a. s -> Getting a s a -> a
^.((Int, Int) -> Const Int (Int, Int))
-> VisibilityRequest -> Const Int VisibilityRequest
Lens' VisibilityRequest (Int, Int)
vrSizeL(((Int, Int) -> Const Int (Int, Int))
 -> VisibilityRequest -> Const Int VisibilityRequest)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int VisibilityRequest Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1
        newHStart :: Int
        newHStart :: Int
newHStart = if Int
reqStart Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
hStartEndVisible
                   then Int
reqStart
                   else Int
hStartEndVisible
        hStartEndVisible :: Int
hStartEndVisible = if Int
reqEnd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
curEnd
                           then Int
curStart
                           else Int
curStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
reqEnd Int -> Int -> Int
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 :: Widget n -> Widget n
visible Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
      Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p
      let imageSize :: (Int, Int)
imageSize = ( Result n
resultResult n -> Getting Int (Result n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result n -> Const Int (Result n)
forall n. Lens' (Result n) Image
imageL((Image -> Const Int Image) -> Result n -> Const Int (Result n))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
V.imageWidth
                      , Result n
resultResult n -> Getting Int (Result n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result n -> Const Int (Result n)
forall n. Lens' (Result n) Image
imageL((Image -> Const Int Image) -> Result n -> Const Int (Result n))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Int) -> SimpleGetter Image Int
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.
      Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ if (Int, Int)
imageSize(Int, Int)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Int
forall s a. s -> Getting a s a -> a
^.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& (Int, Int)
imageSize(Int, Int)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Int
forall s a. s -> Getting a s a -> a
^.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
               then Result n
result Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& ([VisibilityRequest] -> Identity [VisibilityRequest])
-> Result n -> Identity (Result n)
forall n. Lens' (Result n) [VisibilityRequest]
visibilityRequestsL (([VisibilityRequest] -> Identity [VisibilityRequest])
 -> Result n -> Identity (Result n))
-> ([VisibilityRequest] -> [VisibilityRequest])
-> Result n
-> Result n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Location -> (Int, Int) -> VisibilityRequest
VR ((Int, Int) -> Location
Location (Int
0, Int
0)) (Int, Int)
imageSize VisibilityRequest -> [VisibilityRequest] -> [VisibilityRequest]
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 :: Location -> (Int, Int) -> Widget n -> Widget n
visibleRegion Location
vrloc (Int, Int)
sz Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
p) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
      Result n
result <- Widget n -> RenderM n (Result n)
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.
      Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ if (Int, Int)
sz(Int, Int)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Int
forall s a. s -> Getting a s a -> a
^.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& (Int, Int)
sz(Int, Int)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Int
forall s a. s -> Getting a s a -> a
^.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
               then Result n
result Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& ([VisibilityRequest] -> Identity [VisibilityRequest])
-> Result n -> Identity (Result n)
forall n. Lens' (Result n) [VisibilityRequest]
visibilityRequestsL (([VisibilityRequest] -> Identity [VisibilityRequest])
 -> Result n -> Identity (Result n))
-> ([VisibilityRequest] -> [VisibilityRequest])
-> Result n
-> Result n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Location -> (Int, Int) -> VisibilityRequest
VR Location
vrloc (Int, Int)
sz VisibilityRequest -> [VisibilityRequest] -> [VisibilityRequest]
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
<+> :: Widget n -> Widget n -> Widget n
(<+>) Widget n
a Widget n
b = [Widget n] -> Widget n
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
<=> :: Widget n -> Widget n -> Widget n
(<=>) Widget n
a Widget n
b = [Widget n] -> Widget n
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)
  #-}