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

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

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

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

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

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

  -- * Cursor placement
  , showCursor
  , putCursor

  -- * Naming
  , Named(..)

  -- * Translation and positioning
  , translateBy
  , relativeTo

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

  -- * Extent reporting
  , reportExtent
  , clickable

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

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

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

  -- ** Cropping results
  , cropToContext
  )
where

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

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

import Text.Wrap (wrapTextToLines, WrapSettings, defaultWrapSettings)

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

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

instance TextWidth T.Text where
    textWidth :: Text -> Int
textWidth = String -> Int
V.wcswidth (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 a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

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

-- | When rendering the specified widget, use the specified border style
-- for any border rendering.
withBorderStyle :: BorderStyle -> Widget n -> Widget n
withBorderStyle :: forall n. BorderStyle -> Widget n -> Widget n
withBorderStyle BorderStyle
bs Widget n
p = 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 n -> Context n)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT ((BorderStyle -> Identity BorderStyle)
-> Context n -> Identity (Context n)
forall n (f :: * -> *).
Functor f =>
(BorderStyle -> f BorderStyle) -> Context n -> f (Context n)
ctxBorderStyleL ((BorderStyle -> Identity BorderStyle)
 -> Context n -> Identity (Context n))
-> BorderStyle -> Context n -> Context n
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 :: forall n. 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 n -> Context n)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT ((Bool -> Identity Bool) -> Context n -> Identity (Context n)
forall n (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> Context n -> f (Context n)
ctxDynBordersL ((Bool -> Identity Bool) -> Context n -> Identity (Context n))
-> Bool -> Context n -> Context n
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 :: forall n. 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 n -> Context n)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT ((Bool -> Identity Bool) -> Context n -> Identity (Context n)
forall n (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> Context n -> f (Context n)
ctxDynBordersL ((Bool -> Identity Bool) -> Context n -> Identity (Context n))
-> Bool -> Context n -> Context n
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 :: forall n. 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 (f :: * -> *).
Functor f =>
(BorderMap DynBorder -> f (BorderMap DynBorder))
-> Result n -> f (Result n)
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
%~ BorderMap DynBorder -> BorderMap DynBorder
forall a b. BorderMap a -> BorderMap b
BM.clear) (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 :: forall n. Widget n
emptyWidget = Image -> Widget n
forall n. Image -> Widget n
raw Image
V.emptyImage

-- | Add an offset to all cursor locations, visibility requests, and
-- extents in the specified rendering result. This function is critical
-- for maintaining correctness in the rendering results as they are
-- processed successively by box layouts and other wrapping combinators,
-- since calls to this function result in converting from widget-local
-- coordinates to (ultimately) terminal-global ones so they can be
-- used by other combinators. You should call this any time you render
-- something and then translate it or otherwise offset it from its
-- original origin.
addResultOffset :: Location -> Result n -> Result n
addResultOffset :: forall n. Location -> Result n -> Result n
addResultOffset Location
off = 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 :: forall n. 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 (f :: * -> *).
Functor f =>
([VisibilityRequest] -> f [VisibilityRequest])
-> Result n -> f (Result n)
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
Traversal
  [VisibilityRequest]
  [VisibilityRequest]
  VisibilityRequest
  VisibilityRequest
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 :: forall n. 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 (f :: * -> *).
Functor f =>
([Extent n] -> f [Extent n]) -> Result n -> f (Result 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
Traversal [Extent n] [Extent n] (Extent n) (Extent n)
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 DisplayRegion
sz) -> n -> Location -> DisplayRegion -> Extent n
forall n. n -> Location -> DisplayRegion -> Extent n
Extent n
n (Location
off Location -> Location -> Location
forall a. Semigroup a => a -> a -> a
<> Location
l) DisplayRegion
sz)

addDynBorderOffset :: Location -> Result n -> Result n
addDynBorderOffset :: forall n. Location -> Result n -> Result n
addDynBorderOffset Location
off Result n
r = Result n
r 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 (f :: * -> *).
Functor f =>
(BorderMap DynBorder -> f (BorderMap DynBorder))
-> Result n -> f (Result n)
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').
--
-- This function is the counterpart to 'makeVisible'; any visibility
-- requests made with 'makeVisible' must have a corresponding
-- 'reportExtent' in order to work. The 'clickable' function will also
-- work for this purpose to tell the renderer about the clickable
-- region.
reportExtent :: (Ord n) => n -> Widget n -> Widget n
reportExtent :: forall n. Ord n => n -> Widget n -> Widget n
reportExtent n
n Widget n
p =
    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 -> DisplayRegion -> Extent n
forall n. n -> Location -> DisplayRegion -> Extent n
Extent n
n (DisplayRegion -> Location
Location (Int
0, Int
0)) DisplayRegion
sz
            sz :: DisplayRegion
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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
                 )
        -- If the reported extent also has a visibility request
        -- from EventM via makeVisible, add a visibility request to
        -- the render state so this gets scrolled into view by any
        -- containing viewport.
        Set n
vReqs <- Getting (Set n) (RenderState n) (Set n)
-> ReaderT (Context n) (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 (f :: * -> *).
Functor f =>
(Set n -> f (Set n)) -> RenderState n -> f (RenderState n)
requestedVisibleNames_L
        let addVisReq :: Result n -> Result n
addVisReq = if DisplayRegion
szDisplayRegion -> Getting Int DisplayRegion Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int DisplayRegion Int
forall s t a b. Field1 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& DisplayRegion
szDisplayRegion -> Getting Int DisplayRegion Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int DisplayRegion Int
forall s t a b. Field2 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& n
n n -> Set n -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set n
vReqs
                        then ([VisibilityRequest] -> Identity [VisibilityRequest])
-> Result n -> Identity (Result n)
forall n (f :: * -> *).
Functor f =>
([VisibilityRequest] -> f [VisibilityRequest])
-> Result n -> f (Result n)
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 -> DisplayRegion -> VisibilityRequest
VR (DisplayRegion -> Location
Location (Int
0, Int
0)) DisplayRegion
sz VisibilityRequest -> [VisibilityRequest] -> [VisibilityRequest]
forall a. a -> [a] -> [a]
:)
                        else Result n -> Result n
forall a. a -> a
id
        Result n -> RenderM n (Result n)
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
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 n
addVisReq (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
& ([Extent n] -> Identity [Extent n])
-> Result n -> Identity (Result n)
forall n (f :: * -> *).
Functor f =>
([Extent n] -> f [Extent n]) -> Result n -> f (Result 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.
--
-- Regions used with 'clickable' can be scrolled into view with
-- 'makeVisible'.
clickable :: (Ord n) => n -> Widget n -> Widget n
clickable :: forall n. Ord n => n -> Widget n -> Widget n
clickable n
n Widget n
p =
    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 (f :: * -> *).
Functor f =>
([n] -> f [n]) -> RenderState n -> f (RenderState n)
clickableNamesL (([n] -> Identity [n])
 -> RenderState n -> Identity (RenderState n))
-> ([n] -> [n]) -> ReaderT (Context n) (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. Ord n => n -> Widget n -> Widget n
reportExtent n
n Widget n
p

addCursorOffset :: Location -> Result n -> Result n
addCursorOffset :: forall n. Location -> Result n -> Result n
addCursorOffset Location
off Result n
r =
    let onlyVisible :: [CursorLocation n] -> [CursorLocation n]
onlyVisible = (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
Lens' s 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
Lens' s 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 (f :: * -> *).
Functor f =>
([CursorLocation n] -> f [CursorLocation n])
-> Result n -> f (Result 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

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

-- | Make a widget from text, but wrap the words in the input's lines at
-- the available width using the default wrapping settings. The input
-- text should not contain escape sequences or carriage returns.
--
-- Unlike 'txt', this is greedy horizontally.
txtWrap :: T.Text -> Widget n
txtWrap :: forall n. Text -> Widget n
txtWrap = 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 :: forall n. 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 n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
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 n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
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 a. a -> ReaderT (Context n) (State (RenderState n)) a
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 a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Int
forall a. TextWidth a => a -> Int
textWidth (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 n
cContext n -> Getting Attr (Context n) Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr (Context n) Attr
forall r n. Getting r (Context n) Attr
attrL) Char
' ' (Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxLength) ([Image] -> Int
forall a. [a] -> 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 n
cContext n -> Getting Attr (Context n) Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr (Context n) Attr
forall r n. Getting r (Context n) 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
forall a. TextWidth a => a -> Int
textWidth Text
lStr) Text
" ")
              in Result n -> RenderM n (Result n)
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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'. Behaves the same as 'txt' when the
-- input contains multiple lines.
--
-- The input string must not contain tab characters. If it does,
-- interface corruption will result since the terminal will likely
-- render it as taking up more than a single column. The caller should
-- replace tabs with the appropriate number of spaces as desired. The
-- input string should not contain escape sequences or carriage returns.
str :: String -> Widget n
str :: forall n. String -> Widget n
str = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> (String -> Text) -> String -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

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

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

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

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

-- | Pad the specified widget on the left. If max padding is used, this
-- grows greedily horizontally; otherwise it defers to the padded
-- widget.
padLeft :: Padding -> Widget n -> Widget n
padLeft :: forall n. Padding -> Widget n -> Widget n
padLeft Padding
padding Widget n
p =
    let (Widget n -> Widget n
f, Size
sz) = case Padding
padding of
          Padding
Max -> (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 n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
        let lim :: Int
lim = case Padding
padding of
              Padding
Max -> Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL
              Pad Int
i -> Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result)

-- | Pad the specified widget on the right. If max padding is used,
-- this grows greedily horizontally; otherwise it defers to the padded
-- widget.
padRight :: Padding -> Widget n -> Widget n
padRight :: forall n. Padding -> Widget n -> Widget n
padRight Padding
padding Widget n
p =
    let (Widget n -> Widget n
f, Size
sz) = case Padding
padding of
          Padding
Max -> (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 n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
        let lim :: Int
lim = case Padding
padding of
              Padding
Max -> Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL
              Pad Int
i -> Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
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 a. a -> ReaderT (Context n) (State (RenderState n)) a
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 :: forall n. Padding -> Widget n -> Widget n
padTop Padding
padding Widget n
p =
    let (Widget n -> Widget n
f, Size
sz) = case Padding
padding of
          Padding
Max -> (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 n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
        let lim :: Int
lim = case Padding
padding of
              Padding
Max -> Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availHeightL
              Pad Int
i -> Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result)

-- | Pad the specified widget on the bottom. If max padding is used,
-- this grows greedily vertically; otherwise it defers to the padded
-- widget.
padBottom :: Padding -> Widget n -> Widget n
padBottom :: forall n. Padding -> Widget n -> Widget n
padBottom Padding
padding Widget n
p =
    let (Widget n -> Widget n
f, Size
sz) = case Padding
padding of
          Padding
Max -> (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 n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
        let lim :: Int
lim = case Padding
padding of
              Padding
Max -> Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availHeightL
              Pad Int
i -> Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
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 a. a -> ReaderT (Context n) (State (RenderState n)) a
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 :: forall n. 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 :: forall n. 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 :: forall n. 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 :: forall n. 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 n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
      Result n -> RenderM n (Result n)
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 n
cContext n -> Getting Attr (Context n) Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr (Context n) Attr
forall r n. Getting r (Context n) Attr
attrL) Char
ch (Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL) (Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availHeightL))

-- | Vertical box layout: put the specified widgets one above the other
-- in the specified order (uppermost first). Defers growth policies to
-- the growth policies of the contained widgets (if any are greedy, so
-- is the box).
--
-- Allocates space to 'Fixed' elements first and 'Greedy' elements
-- second. For example, if a 'vBox' contains three elements @A@, @B@,
-- and @C@, and if @A@ and @B@ are 'Fixed', then 'vBox' first renders
-- @A@ and @B@. Suppose those two take up 10 rows total, and the 'vBox'
-- was given 50 rows. This means 'vBox' then allocates the remaining
-- 40 rows to @C@. If, on the other hand, @A@ and @B@ take up 50 rows
-- together, @C@ will not be rendered at all.
--
-- If all elements are 'Greedy', 'vBox' allocates the available height
-- evenly among the elements. So, for example, if a 'vBox' is rendered
-- in 90 rows and has three 'Greedy' elements, each element will be
-- allocated 30 rows.
{-# NOINLINE vBox #-}
vBox :: [Widget n] -> Widget n
vBox :: forall n. [Widget n] -> Widget n
vBox [] = 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).
--
-- Allocates space to 'Fixed' elements first and 'Greedy' elements
-- second. For example, if an 'hBox' contains three elements @A@, @B@,
-- and @C@, and if @A@ and @B@ are 'Fixed', then 'hBox' first renders
-- @A@ and @B@. Suppose those two take up 10 columns total, and the
-- 'hBox' was given 50 columns. This means 'hBox' then allocates the
-- remaining 40 columns to @C@. If, on the other hand, @A@ and @B@ take
-- up 50 columns together, @C@ will not be rendered at all.
--
-- If all elements are 'Greedy', 'hBox' allocates the available width
-- evenly among the elements. So, for example, if an 'hBox' is rendered
-- in 90 columns and has three 'Greedy' elements, each element will be
-- allocated 30 columns.
{-# NOINLINE hBox #-}
hBox :: [Widget n] -> Widget n
hBox :: forall n. [Widget n] -> Widget n
hBox [] = 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 { forall n. BoxRenderer n -> Lens' (Context n) Int
contextPrimary :: Lens' (Context n) Int
                , forall n. BoxRenderer n -> Lens' (Context n) Int
contextSecondary :: Lens' (Context n) Int
                , forall n. BoxRenderer n -> Image -> Int
imagePrimary :: V.Image -> Int
                , forall n. BoxRenderer n -> Image -> Int
imageSecondary :: V.Image -> Int
                , forall n. BoxRenderer n -> Int -> Widget n -> Widget n
limitPrimary :: Int -> Widget n -> Widget n
                , forall n. BoxRenderer n -> Widget n -> Size
primaryWidgetSize :: Widget n -> Size
                , forall n. BoxRenderer n -> [Image] -> Image
concatenatePrimary :: [V.Image] -> V.Image
                , forall n. BoxRenderer n -> [Image] -> Image
concatenateSecondary :: [V.Image] -> V.Image
                , forall n. BoxRenderer n -> Int -> Location
locationFromOffset :: Int -> Location
                , forall n. BoxRenderer n -> Int -> Image -> Attr -> Image
padImageSecondary :: Int -> V.Image -> V.Attr -> V.Image
                , forall n.
BoxRenderer n
-> forall a (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
                , forall n.
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
                , forall n.
BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges a)
loSecondary :: forall a. Lens' (Edges a) a
                , forall n.
BoxRenderer n
-> forall a (f :: * -> *).
   Functor f =>
   (a -> f a) -> Edges a -> f (Edges a)
hiSecondary :: forall a. Lens' (Edges a) a
                , forall n. BoxRenderer n -> Int -> Int -> Location
locationFromPrimarySecondary :: Int -> Int -> Location
                , forall n. BoxRenderer n -> Int -> Image -> Image
splitLoPrimary :: Int -> V.Image -> V.Image
                , forall n. BoxRenderer n -> Int -> Image -> Image
splitHiPrimary :: Int -> V.Image -> V.Image
                , forall n. BoxRenderer n -> Int -> Image -> Image
splitLoSecondary :: Int -> V.Image -> V.Image
                , forall n. BoxRenderer n -> Int -> Image -> Image
splitHiSecondary :: Int -> V.Image -> V.Image
                , forall n.
BoxRenderer n -> Int -> BorderMap DynBorder -> IMap DynBorder
lookupPrimary :: Int -> BM.BorderMap DynBorder -> I.IMap DynBorder
                , forall n.
BoxRenderer n
-> Location
-> Run DynBorder
-> BorderMap DynBorder
-> BorderMap DynBorder
insertSecondary :: Location -> I.Run DynBorder -> BM.BorderMap DynBorder -> BM.BorderMap DynBorder
                }

vBoxRenderer :: BoxRenderer n
vBoxRenderer :: forall n. BoxRenderer n
vBoxRenderer =
    BoxRenderer { contextPrimary :: Lens' (Context n) Int
contextPrimary = (Int -> f Int) -> Context n -> f (Context n)
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
Lens' (Context n) Int
availHeightL
                , contextSecondary :: Lens' (Context n) Int
contextSecondary = (Int -> f Int) -> Context n -> f (Context n)
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
Lens' (Context n) Int
availWidthL
                , imagePrimary :: Image -> Int
imagePrimary = Image -> Int
V.imageHeight
                , imageSecondary :: Image -> Int
imageSecondary = Image -> Int
V.imageWidth
                , limitPrimary :: Int -> Widget n -> Widget n
limitPrimary = 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
vSize
                , concatenatePrimary :: [Image] -> Image
concatenatePrimary = [Image] -> Image
V.vertCat
                , concatenateSecondary :: [Image] -> Image
concatenateSecondary = [Image] -> Image
V.horizCat
                , locationFromOffset :: Int -> Location
locationFromOffset = DisplayRegion -> Location
Location (DisplayRegion -> Location)
-> (Int -> DisplayRegion) -> 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 = (a -> f a) -> Edges a -> f (Edges a)
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 = (a -> f a) -> Edges a -> f (Edges a)
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 = (a -> f a) -> Edges a -> f (Edges a)
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 = (a -> f a) -> Edges a -> f (Edges a)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
eRightL
                , locationFromPrimarySecondary :: Int -> Int -> Location
locationFromPrimarySecondary = \Int
r Int
c -> DisplayRegion -> Location
Location (Int
c, Int
r)
                , splitLoPrimary :: Int -> Image -> Image
splitLoPrimary = Int -> Image -> Image
V.cropBottom
                , splitHiPrimary :: Int -> Image -> Image
splitHiPrimary = \Int
n Image
img -> Int -> Image -> Image
V.cropTop (Image -> Int
V.imageHeight Image
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 :: forall n. BoxRenderer n
hBoxRenderer =
    BoxRenderer { contextPrimary :: Lens' (Context n) Int
contextPrimary = (Int -> f Int) -> Context n -> f (Context n)
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
Lens' (Context n) Int
availWidthL
                , contextSecondary :: Lens' (Context n) Int
contextSecondary = (Int -> f Int) -> Context n -> f (Context n)
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
Lens' (Context n) Int
availHeightL
                , imagePrimary :: Image -> Int
imagePrimary = Image -> Int
V.imageWidth
                , imageSecondary :: Image -> Int
imageSecondary = Image -> Int
V.imageHeight
                , limitPrimary :: Int -> Widget n -> Widget n
limitPrimary = 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
hSize
                , concatenatePrimary :: [Image] -> Image
concatenatePrimary = [Image] -> Image
V.horizCat
                , concatenateSecondary :: [Image] -> Image
concatenateSecondary = [Image] -> Image
V.vertCat
                , locationFromOffset :: Int -> Location
locationFromOffset = DisplayRegion -> Location
Location (DisplayRegion -> Location)
-> (Int -> DisplayRegion) -> 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 = (a -> f a) -> Edges a -> f (Edges a)
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 = (a -> f a) -> Edges a -> f (Edges a)
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 = (a -> f a) -> Edges a -> f (Edges a)
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 = (a -> f a) -> Edges a -> f (Edges a)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Edges a -> f (Edges a)
eBottomL
                , locationFromPrimarySecondary :: Int -> Int -> Location
locationFromPrimarySecondary = \Int
c Int
r -> DisplayRegion -> Location
Location (Int
c, Int
r)
                , splitLoPrimary :: Int -> Image -> Image
splitLoPrimary = Int -> Image -> Image
V.cropRight
                , splitHiPrimary :: Int -> Image -> Image
splitHiPrimary = \Int
n Image
img -> Int -> Image -> Image
V.cropLeft (Image -> Int
V.imageWidth Image
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 :: forall n. 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 a. Ord a => [a] -> a
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 a. Ord a => [a] -> a
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 n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
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

          renderHi :: Widget n
-> StateT
     Int (ReaderT (Context n) (State (RenderState n))) (Result n)
renderHi Widget n
prim = do
            Int
remainingPrimary <- StateT Int (ReaderT (Context n) (State (RenderState n))) Int
forall s (m :: * -> *). MonadState s m => m s
get
            Result n
result <- RenderM n (Result n)
-> StateT
     Int (ReaderT (Context n) (State (RenderState n))) (Result n)
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RenderM n (Result n)
 -> StateT
      Int (ReaderT (Context n) (State (RenderState n))) (Result n))
-> RenderM n (Result n)
-> StateT
     Int (ReaderT (Context n) (State (RenderState 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
$ BoxRenderer n -> Int -> Widget n -> Widget n
forall n. BoxRenderer n -> Int -> Widget n -> Widget n
limitPrimary BoxRenderer n
br Int
remainingPrimary Widget n
prim
            Result n
result Result n
-> StateT Int (ReaderT (Context n) (State (RenderState n))) ()
-> StateT
     Int (ReaderT (Context n) (State (RenderState n))) (Result n)
forall a b.
a
-> StateT Int (ReaderT (Context n) (State (RenderState n))) b
-> StateT Int (ReaderT (Context n) (State (RenderState n))) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Int -> StateT Int (ReaderT (Context n) (State (RenderState n))) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int
 -> StateT Int (ReaderT (Context n) (State (RenderState n))) ())
-> Int
-> StateT Int (ReaderT (Context n) (State (RenderState n))) ()
forall a b. (a -> b) -> a -> b
$! 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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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)]
renderedHis, Int
remainingPrimary) <-
        StateT
  Int (ReaderT (Context n) (State (RenderState n))) [(Int, Result n)]
-> Int
-> ReaderT
     (Context n) (State (RenderState n)) ([(Int, Result n)], Int)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (((Int, Widget n)
 -> StateT
      Int (ReaderT (Context n) (State (RenderState n))) (Int, Result n))
-> [(Int, Widget n)]
-> StateT
     Int (ReaderT (Context n) (State (RenderState n))) [(Int, Result n)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Widget n
 -> StateT
      Int (ReaderT (Context n) (State (RenderState n))) (Result n))
-> (Int, Widget n)
-> StateT
     Int (ReaderT (Context n) (State (RenderState n))) (Int, Result n)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (Int, a) -> f (Int, b)
traverse Widget n
-> StateT
     Int (ReaderT (Context n) (State (RenderState n))) (Result n)
renderHi) [(Int, Widget n)]
his) (Context n
c Context n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^. BoxRenderer n -> Lens' (Context n) Int
forall n. BoxRenderer n -> Lens' (Context n) Int
contextPrimary BoxRenderer n
br)

      [(Int, Result n)]
renderedLows <- case [(Int, Widget n)]
lows of
          [] -> [(Int, Result n)]
-> ReaderT (Context n) (State (RenderState n)) [(Int, Result n)]
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
          [(Int, Widget n)]
ls -> do
              let primaryPerLow :: Int
primaryPerLow = Int
remainingPrimary Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` [(Int, Widget n)] -> Int
forall a. [a] -> 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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Widget n)]
ls)
                  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 a. [a] -> 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 n) (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 n) (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 (BoxRenderer n -> Int -> Widget n -> Widget n
forall n. BoxRenderer n -> Int -> Widget n -> Widget n
limitPrimary BoxRenderer n
br Int
pri 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 n) (State (RenderState n)) (Int, Result n))
-> [((Int, Widget n), Int)]
-> ReaderT (Context n) (State (RenderState n)) [(Int, Result n)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Int, Widget n), Int)
-> ReaderT (Context n) (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 n) (State (RenderState n)) [(Int, Result n)]
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
imageL) (Result n -> Image) -> [Result n] -> [Image]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Result n]
allResults
          allTranslatedResults :: [Result n]
allTranslatedResults = (State Int [Result n] -> Int -> [Result n])
-> Int -> State Int [Result n] -> [Result n]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Int [Result n] -> Int -> [Result n]
forall s a. State s a -> s -> a
evalState Int
0 (State Int [Result n] -> [Result n])
-> State Int [Result n] -> [Result n]
forall a b. (a -> b) -> a -> b
$ [Result n]
-> (Result n -> StateT Int Identity (Result n))
-> State Int [Result n]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Result n]
allResults ((Result n -> StateT Int Identity (Result n))
 -> State Int [Result n])
-> (Result n -> StateT Int Identity (Result n))
-> State Int [Result n]
forall a b. (a -> b) -> a -> b
$ \Result n
result -> do
              Int
offPrimary <- StateT Int Identity Int
forall s (m :: * -> *). MonadState s m => m s
get
              Int -> StateT Int Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> StateT Int Identity ()) -> Int -> StateT Int Identity ()
forall a b. (a -> b) -> a -> b
$ Int
offPrimary Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Result n
result Result 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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 (BoxRenderer n -> Image -> Int
forall n. BoxRenderer n -> Image -> Int
imagePrimary BoxRenderer n
br))
              Result n -> StateT Int Identity (Result n)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result n -> StateT Int Identity (Result n))
-> Result n -> StateT Int Identity (Result n)
forall a b. (a -> b) -> a -> b
$ Location -> Result n -> Result n
forall n. Location -> Result n -> Result n
addResultOffset (BoxRenderer n -> Int -> Location
forall n. BoxRenderer n -> Int -> Location
locationFromOffset BoxRenderer n
br Int
offPrimary) Result n
result
          -- Determine the secondary dimension value to pad to. In a
          -- vertical box we want all images to be the same width to
          -- avoid attribute over-runs or blank spaces with the wrong
          -- attribute. In a horizontal box we want all images to have
          -- the same height for the same reason.
          maxSecondary :: Int
maxSecondary = [Int] -> Int
forall a. Ord a => [a] -> a
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 n
cContext n -> Getting Attr (Context n) Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr (Context n) Attr
forall r n. Getting r (Context n) 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)
                            ((Result n -> [CursorLocation n])
-> [Result n] -> [CursorLocation n]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Result n -> [CursorLocation n]
forall n. Result n -> [CursorLocation n]
cursors [Result n]
allTranslatedResults)
                            ((Result n -> [VisibilityRequest])
-> [Result n] -> [VisibilityRequest]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Result n -> [VisibilityRequest]
forall n. Result n -> [VisibilityRequest]
visibilityRequests [Result n]
allTranslatedResults)
                            ((Result n -> [Extent n]) -> [Result n] -> [Extent n]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Result n -> [Extent n]
forall n. Result n -> [Extent n]
extents [Result n]
allTranslatedResults)
                            BorderMap DynBorder
newBorders

catDynBorder
    :: Lens' (Edges BorderSegment) BorderSegment
    -> Lens' (Edges BorderSegment) BorderSegment
    -> DynBorder
    -> DynBorder
    -> Maybe DynBorder
catDynBorder :: Lens' (Edges BorderSegment) BorderSegment
-> Lens' (Edges BorderSegment) BorderSegment
-> DynBorder
-> DynBorder
-> Maybe DynBorder
catDynBorder Lens' (Edges BorderSegment) BorderSegment
towardsA Lens' (Edges BorderSegment) BorderSegment
towardsB DynBorder
a DynBorder
b
    -- Currently, we check if the 'BorderStyle's are exactly the same. In the
    -- future, it might be nice to relax this restriction. For example, if a
    -- horizontal border is being rewritten to accommodate a neighboring
    -- vertical border, all we care about is that the two 'bsVertical's line up
    -- sanely. After all, if the horizontal border's 'bsVertical' is the same
    -- as the vertical one's, and the horizontal border's 'BorderStyle' is
    -- self-consistent, then it will look "right" to rewrite according to the
    -- horizontal border's 'BorderStyle'.
    |  DynBorder -> BorderStyle
dbStyle DynBorder
a 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 (BorderSegment -> f BorderSegment)
-> Edges BorderSegment -> f (Edges BorderSegment)
Lens' (Edges BorderSegment) BorderSegment
towardsA (BorderSegment -> f BorderSegment)
-> Edges BorderSegment -> f (Edges BorderSegment)
Lens' (Edges BorderSegment) BorderSegment
towardsB) IMap DynBorder
am IMap DynBorder
bm

-- | Given borders that should be placed next to each other (the first argument
-- on the right or bottom, and the second argument on the left or top), compute
-- new borders and the rewrites that should be done along the edges of the two
-- images to keep the image in sync with the border information.
--
-- The input borders are assumed to be disjoint. This property is not checked.
catBorders
    :: (border ~ BM.BorderMap DynBorder, rewrite ~ I.IMap V.Image)
    => BoxRenderer n -> border -> border -> ((rewrite, rewrite), border)
catBorders :: forall border rewrite n.
(border ~ BorderMap DynBorder, rewrite ~ IMap Image) =>
BoxRenderer n -> border -> border -> ((rewrite, rewrite), border)
catBorders BoxRenderer n
br border
r border
l = if Int
lCoord 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
IMap Image
forall a. IMap a
I.empty, rewrite
IMap Image
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 b a. (b -> a -> b) -> b -> [a] -> b
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 :: forall n.
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((BorderMap DynBorder
 -> ((IMap Image, IMap Image), BorderMap DynBorder))
-> StateT (BorderMap DynBorder) Identity (IMap Image, IMap Image)
forall a.
(BorderMap DynBorder -> (a, BorderMap DynBorder))
-> StateT (BorderMap DynBorder) Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, 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 :: forall n.
BoxRenderer n -> (IMap Image, IMap Image) -> Image -> Image
rewriteImage BoxRenderer n
br (IMap Image
loRewrite, IMap Image
hiRewrite) Image
old = Image -> Image
rewriteHi (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 :: forall n. Int -> Widget n -> Widget n
hLimit Int
w Widget n
p
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Widget n
forall n. Widget n
emptyWidget
    | Bool
otherwise =
        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 n -> Context n)
-> 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 n -> Identity (Context n)
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL ((Int -> Identity Int) -> Context n -> Identity (Context n))
-> (Int -> Int) -> Context n -> Context n
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 :: forall n. Int -> Widget n -> Widget n
hLimitPercent Int
w' Widget n
p
    | Int
w' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Widget n
forall n. Widget n
emptyWidget
    | Bool
otherwise =
        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 n
ctx <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
          let usableWidth :: Int
usableWidth = Context n
ctxContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL
              widgetWidth :: Int
widgetWidth = Rational -> Int
forall b. Integral b => Rational -> b
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 n -> Context n)
-> 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 n -> Identity (Context n)
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL ((Int -> Identity Int) -> Context n -> Identity (Context n))
-> (Int -> Int) -> Context n -> Context n
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 :: forall n. Int -> Widget n -> Widget n
vLimit Int
h Widget n
p
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Widget n
forall n. Widget n
emptyWidget
    | Bool
otherwise =
        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 n -> Context n)
-> 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 n -> Identity (Context n)
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availHeightL ((Int -> Identity Int) -> Context n -> Identity (Context n))
-> (Int -> Int) -> Context n -> Context n
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 :: forall n. Int -> Widget n -> Widget n
vLimitPercent Int
h' Widget n
p
    | Int
h' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Widget n
forall n. Widget n
emptyWidget
    | Bool
otherwise =
        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 n
ctx <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
          let usableHeight :: Int
usableHeight = Context n
ctxContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availHeightL
              widgetHeight :: Int
widgetHeight = Rational -> Int
forall b. Integral b => Rational -> b
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 n -> Context n)
-> 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 n -> Identity (Context n)
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availHeightL ((Int -> Identity Int) -> Context n -> Identity (Context n))
-> (Int -> Int) -> Context n -> Context n
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 :: forall n. DisplayRegion -> Widget n -> Widget n
setAvailableSize (Int
w, Int
h) Widget n
p
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
|| Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Widget n
forall n. Widget n
emptyWidget
    | Bool
otherwise =
        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 n -> Context n)
-> 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 n
c -> Context n
c Context n -> (Context n -> Context n) -> Context n
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Context n -> Identity (Context n)
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availHeightL ((Int -> Identity Int) -> Context n -> Identity (Context n))
-> Int -> Context n -> Context n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
h Context n -> (Context n -> Context n) -> Context n
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Context n -> Identity (Context n)
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL ((Int -> Identity Int) -> Context n -> Identity (Context n))
-> Int -> Context n -> Context n
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 attribute used for
-- drawing to the one with the specified name. Note that the widget may
-- make further changes to the active drawing attribute, so this only
-- takes effect if nothing in the specified widget invokes 'withAttr'
-- or otherwise changes the rendering context's attribute setup. If you
-- want to prevent that, use 'forceAttr'. Attributes used this way still
-- get merged hierarchically and still fall back to the attribute map's
-- default attribute. If you want to change the default attribute, use
-- 'withDefAttr'.
--
-- For example:
--
-- @
--    appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow)
--                                           , ("warning", bg magenta)
--                                           ]
--
--    renderA :: (String, String) -> [Widget n]
--    renderA (a,b) = hBox [ str a
--                         , str " is "
--                         , withAttr "highlight" (str b)
--                         ]
--
--    render1 = renderA (\"Brick\", "fun")
--    render2 = withAttr "warning" render1
-- @
--
-- In the example above, @render1@ will show @Brick is fun@ where the
-- first two words are white on a blue background and the last word
-- is yellow on a blue background. However, @render2@ will show the
-- first two words in white on magenta although the last word is still
-- rendered in yellow on blue.
withAttr :: AttrName -> Widget n -> Widget n
withAttr :: forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
an Widget n
p =
    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 n -> Context n)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT ((AttrName -> Identity AttrName)
-> Context n -> Identity (Context n)
forall n (f :: * -> *).
Functor f =>
(AttrName -> f AttrName) -> Context n -> f (Context n)
ctxAttrNameL ((AttrName -> Identity AttrName)
 -> Context n -> Identity (Context n))
-> AttrName -> Context n -> Context n
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
-- the map's default attribute to the one that we get by applying the
-- specified function to the current map's default attribute. This is a
-- variant of 'withDefAttr'; see the latter for more information.
modifyDefAttr :: (V.Attr -> V.Attr) -> Widget n -> Widget n
modifyDefAttr :: forall n. (Attr -> Attr) -> Widget n -> Widget n
modifyDefAttr Attr -> Attr
f Widget n
p =
    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 n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
        (Context n -> Context n)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT ((AttrMap -> Identity AttrMap) -> Context n -> Identity (Context n)
forall n (f :: * -> *).
Functor f =>
(AttrMap -> f AttrMap) -> Context n -> f (Context n)
ctxAttrMapL ((AttrMap -> Identity AttrMap)
 -> Context n -> Identity (Context n))
-> (AttrMap -> AttrMap) -> Context n -> Context n
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 n
cContext n -> Getting AttrMap (Context n) AttrMap -> AttrMap
forall s a. s -> Getting a s a -> a
^.Getting AttrMap (Context n) AttrMap
forall n (f :: * -> *).
Functor f =>
(AttrMap -> f AttrMap) -> Context n -> f (Context n)
ctxAttrMapL)))) (Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

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

-- | While rendering the specified widget, use a transformed version
-- of the current attribute map. This is a very general function with
-- broad capabilities: you probably want a more specific function such
-- as 'withDefAttr' or 'withAttr'.
updateAttrMap :: (AttrMap -> AttrMap) -> Widget n -> Widget n
updateAttrMap :: forall n. (AttrMap -> AttrMap) -> Widget n -> Widget n
updateAttrMap AttrMap -> AttrMap
f Widget n
p =
    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 n -> Context n)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT ((AttrMap -> Identity AttrMap) -> Context n -> Identity (Context n)
forall n (f :: * -> *).
Functor f =>
(AttrMap -> f AttrMap) -> Context n -> f (Context n)
ctxAttrMapL ((AttrMap -> Identity AttrMap)
 -> Context n -> Identity (Context n))
-> (AttrMap -> AttrMap) -> Context n -> Context n
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'.
--
-- For example:
--
-- @
--    ...
--    appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow)
--                                           , ("notice", fg red) ]
--    ...
--
--    renderA :: (String, String) -> [Widget n]
--    renderA (a,b) = hBox [ withAttr "highlight" (str a)
--                         , str " is "
--                         , withAttr "highlight" (str b)
--                         ]
--
--    render1 = renderA ("Brick", "fun")
--    render2 = forceAttr "notice" render1
-- @
--
-- In the above, render1 will show "Brick is fun" where the first and
-- last words are yellow on a blue background and the middle word is
-- white on a blue background.  However, render2 will show all words
-- in red on a blue background.  In both versions, the middle word
-- will be in white on a blue background.
forceAttr :: AttrName -> Widget n -> Widget n
forceAttr :: forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
an Widget n
p =
    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 n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
        (Context n -> Context n)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT ((AttrMap -> Identity AttrMap) -> Context n -> Identity (Context n)
forall n (f :: * -> *).
Functor f =>
(AttrMap -> f AttrMap) -> Context n -> f (Context n)
ctxAttrMapL ((AttrMap -> Identity AttrMap)
 -> Context n -> Identity (Context n))
-> AttrMap -> Context n -> Context n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Attr -> AttrMap
forceAttrMap (AttrName -> AttrMap -> Attr
attrMapLookup AttrName
an (Context n
cContext n -> Getting AttrMap (Context n) AttrMap -> AttrMap
forall s a. s -> Getting a s a -> a
^.Getting AttrMap (Context n) AttrMap
forall n (f :: * -> *).
Functor f =>
(AttrMap -> f AttrMap) -> Context n -> f (Context n)
ctxAttrMapL)))) (Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p)

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

-- | Override the lookup of the attribute name 'targetName' to return
-- the attribute value associated with 'fromName' when rendering the
-- specified widget.
--
-- For example:
--
-- @
--    appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow)
--                                           , ("notice", fg red)
--                                           ]
--
--    renderA :: (String, String) -> [Widget n]
--    renderA (a, b) = str a <+> str " is " <+> withAttr "highlight" (str b)
--
--    render1 = withAttr "notice" $ renderA ("Brick", "fun")
--    render2 = overrideAttr "highlight" "notice" render1
-- @
--
-- In the example above, @render1@ will show @Brick is fun@ where the
-- first two words are red on a blue background, but @fun@ is yellow on
-- a blue background. However, @render2@ will show all three words in
-- red on a blue background.
overrideAttr :: AttrName -> AttrName -> Widget n -> Widget n
overrideAttr :: forall n. AttrName -> AttrName -> Widget n -> Widget n
overrideAttr AttrName
targetName AttrName
fromName =
    (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 :: forall n. 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 a. a -> ReaderT (Context n) (State (RenderState n)) a
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 :: forall n. 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 a. a -> ReaderT (Context n) (State (RenderState n)) a
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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
Lens' Location 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
Lens' Location Int
locationRowL))

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

-- | Crop the specified widget on the left by the specified number of
-- columns. Defers to the cropped widget for growth policy.
cropLeftBy :: Int -> Widget n -> Widget n
cropLeftBy :: forall n. Int -> Widget n -> Widget n
cropLeftBy Int
cols Widget n
p =
    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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 a. a -> ReaderT (Context n) (State (RenderState n)) a
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 (DisplayRegion -> 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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 to the specified size from the left.
-- Defers to the cropped widget for growth policy.
cropLeftTo :: Int -> Widget n -> Widget n
cropLeftTo :: forall n. Int -> Widget n -> Widget n
cropLeftTo Int
cols Widget n
p =
    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 w :: Int
w = Image -> Int
V.imageWidth (Image -> Int) -> Image -> Int
forall a b. (a -> b) -> a -> b
$ 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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
imageL
            amt :: Int
amt = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cols
        if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cols
           then Result n -> RenderM n (Result n)
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result
           else 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
cropLeftBy Int
amt (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 a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result

-- | Crop the specified widget on the right by the specified number of
-- columns. Defers to the cropped widget for growth policy.
cropRightBy :: Int -> Widget n -> Widget n
cropRightBy :: forall n. Int -> Widget n -> Widget n
cropRightBy Int
cols Widget n
p =
    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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 a. a -> ReaderT (Context n) (State (RenderState n)) a
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 to the specified size from the right.
-- Defers to the cropped widget for growth policy.
cropRightTo :: Int -> Widget n -> Widget n
cropRightTo :: forall n. Int -> Widget n -> Widget n
cropRightTo Int
cols Widget n
p =
    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 w :: Int
w = Image -> Int
V.imageWidth (Image -> Int) -> Image -> Int
forall a b. (a -> b) -> a -> b
$ 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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
imageL
            amt :: Int
amt = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cols
        if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cols
           then Result n -> RenderM n (Result n)
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result
           else 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
cropRightBy Int
amt (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 a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result

-- | Crop the specified widget on the top by the specified number of
-- rows. Defers to the cropped widget for growth policy.
cropTopBy :: Int -> Widget n -> Widget n
cropTopBy :: forall n. Int -> Widget n -> Widget n
cropTopBy Int
rows Widget n
p =
    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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 a. a -> ReaderT (Context n) (State (RenderState n)) a
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 (DisplayRegion -> 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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 to the specified size from the top.
-- Defers to the cropped widget for growth policy.
cropTopTo :: Int -> Widget n -> Widget n
cropTopTo :: forall n. Int -> Widget n -> Widget n
cropTopTo Int
rows Widget n
p =
    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 h :: Int
h = Image -> Int
V.imageHeight (Image -> Int) -> Image -> Int
forall a b. (a -> b) -> a -> b
$ 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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
imageL
            amt :: Int
amt = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rows
        if Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rows
           then Result n -> RenderM n (Result n)
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result
           else 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
cropTopBy Int
amt (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 a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result

-- | Crop the specified widget on the bottom by the specified number of
-- rows. Defers to the cropped widget for growth policy.
cropBottomBy :: Int -> Widget n -> Widget n
cropBottomBy :: forall n. Int -> Widget n -> Widget n
cropBottomBy Int
rows Widget n
p =
    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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 a. a -> ReaderT (Context n) (State (RenderState n)) a
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 to the specified size from the bottom.
-- Defers to the cropped widget for growth policy.
cropBottomTo :: Int -> Widget n -> Widget n
cropBottomTo :: forall n. Int -> Widget n -> Widget n
cropBottomTo Int
rows Widget n
p =
    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 h :: Int
h = Image -> Int
V.imageHeight (Image -> Int) -> Image -> Int
forall a b. (a -> b) -> a -> b
$ 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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
imageL
            amt :: Int
amt = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rows
        if Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rows
           then Result n -> RenderM n (Result n)
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result
           else 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
cropBottomBy Int
amt (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 a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result

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

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

hRelease :: Widget n -> Maybe (Widget n)
hRelease :: forall n. 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 n -> Context n)
-> 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 n -> Identity (Context n)
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL ((Int -> Identity Int) -> Context n -> Identity (Context n))
-> Int -> Context n -> Context n
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 :: forall n. 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 n -> Context n)
-> 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 n -> Identity (Context n)
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availHeightL ((Int -> Identity Int) -> Context n -> Identity (Context n))
-> Int -> Context n -> Context n
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 :: forall n. Ord n => 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 (f :: * -> *).
Functor f =>
([n] -> f [n]) -> RenderState n -> f (RenderState n)
clickableNamesL (([n] -> Identity [n])
 -> RenderState n -> Identity (RenderState n))
-> ([n] -> [n]) -> ReaderT (Context n) (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 a. a -> ReaderT (Context n) (State (RenderState n)) a
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 n) (State (RenderState n)) ()
forall n. Ord n => n -> ([n], Result n) -> RenderM n ()
cacheUpdate n
n ([n]
clickables, Result n
wResult 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 (f :: * -> *).
Functor f =>
([VisibilityRequest] -> f [VisibilityRequest])
-> Result n -> f (Result n)
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 -> RenderM n (Result n)
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
wResult
    where
        -- Given the rendered result of a Widget, collect the list of "clickable" names
        -- from the extents that were in the result.
        renderedClickables :: (Ord n) => Result n -> RenderM n [n]
        renderedClickables :: forall n. Ord n => Result n -> RenderM n [n]
renderedClickables Result n
renderResult = do
            [n]
allClickables <- 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 (f :: * -> *).
Functor f =>
([n] -> f [n]) -> RenderState n -> f (RenderState n)
clickableNamesL
            [n] -> RenderM n [n]
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
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 (f :: * -> *).
Functor f =>
([Extent n] -> f [Extent n]) -> Result n -> f (Result n)
extentsL, Extent n -> n
forall n. Extent n -> n
extentName Extent n
e n -> [n] -> Bool
forall a. Eq a => a -> [a] -> 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 :: forall n. Ord n => n -> RenderM n (Maybe ([n], Result n))
cacheLookup n
n = do
    Map n ([n], Result n)
cache <- State (RenderState n) (Map n ([n], Result n))
-> ReaderT
     (Context n) (State (RenderState n)) (Map n ([n], Result n))
forall (m :: * -> *) a. Monad m => m a -> ReaderT (Context n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State (RenderState n) (Map n ([n], Result n))
 -> ReaderT
      (Context n) (State (RenderState n)) (Map n ([n], Result n)))
-> State (RenderState n) (Map n ([n], Result n))
-> ReaderT
     (Context n) (State (RenderState n)) (Map n ([n], Result n))
forall a b. (a -> b) -> a -> b
$ (RenderState n -> Map n ([n], Result n))
-> State (RenderState n) (Map n ([n], Result n))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> 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 (f :: * -> *).
Functor f =>
(Map n ([n], Result n) -> f (Map n ([n], Result n)))
-> RenderState n -> f (RenderState n)
renderCacheL)
    Maybe ([n], Result n) -> RenderM n (Maybe ([n], Result n))
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
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 :: forall n. Ord n => n -> ([n], Result n) -> RenderM n ()
cacheUpdate n
n ([n], Result n)
r = State (RenderState n) ()
-> ReaderT (Context n) (State (RenderState n)) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT (Context n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State (RenderState n) ()
 -> ReaderT (Context n) (State (RenderState n)) ())
-> State (RenderState n) ()
-> ReaderT (Context n) (State (RenderState n)) ()
forall a b. (a -> b) -> a -> b
$ (RenderState n -> RenderState n) -> State (RenderState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map n ([n], Result n) -> Identity (Map n ([n], Result n)))
-> RenderState n -> Identity (RenderState n)
forall n (f :: * -> *).
Functor f =>
(Map n ([n], Result n) -> f (Map n ([n], Result n)))
-> RenderState n -> f (RenderState 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)

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

-- | Enable scroll bar handles on all vertical scroll bars in the
-- specified widget. Handles appear at the ends of the scroll bar,
-- representing the "handles" that are typically clickable in
-- graphical UIs to move the scroll bar incrementally. Vertical
-- scroll bars are also clickable if mouse mode is enabled and if
-- 'withClickableVScrollBars' is used.
--
-- This will only have an effect if 'withVScrollBars' is also called.
withVScrollBarHandles :: Widget n -> Widget n
withVScrollBarHandles :: forall n. Widget n -> Widget n
withVScrollBarHandles Widget n
w =
    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
$
        (Context n -> Context n)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT ((Bool -> Identity Bool) -> Context n -> Identity (Context n)
forall n (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> Context n -> f (Context n)
ctxVScrollBarShowHandlesL ((Bool -> Identity Bool) -> Context n -> Identity (Context n))
-> Bool -> Context n -> Context n
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
w)

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

-- | The default renderer for vertical viewport scroll bars. Override
-- with 'withVScrollBarRenderer'.
verticalScrollbarRenderer :: VScrollbarRenderer n
verticalScrollbarRenderer :: forall n. VScrollbarRenderer n
verticalScrollbarRenderer =
    VScrollbarRenderer { renderVScrollbar :: Widget n
renderVScrollbar = Char -> Widget n
forall n. Char -> Widget n
fill Char
'█'
                       , renderVScrollbarTrough :: Widget n
renderVScrollbarTrough = Char -> Widget n
forall n. Char -> Widget n
fill Char
' '
                       , renderVScrollbarHandleBefore :: Widget n
renderVScrollbarHandleBefore = String -> Widget n
forall n. String -> Widget n
str String
"^"
                       , renderVScrollbarHandleAfter :: Widget n
renderVScrollbarHandleAfter = String -> Widget n
forall n. String -> Widget n
str String
"v"
                       , scrollbarWidthAllocation :: Int
scrollbarWidthAllocation = Int
1
                       }

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

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

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

-- | Enable scroll bar handles on all horizontal scroll bars in
-- the specified widget. Handles appear at the ends of the scroll
-- bar, representing the "handles" that are typically clickable in
-- graphical UIs to move the scroll bar incrementally. Horizontal
-- scroll bars are also clickable if mouse mode is enabled and if
-- 'withClickableHScrollBars' is used.
--
-- This will only have an effect if 'withHScrollBars' is also called.
withHScrollBarHandles :: Widget n -> Widget n
withHScrollBarHandles :: forall n. Widget n -> Widget n
withHScrollBarHandles Widget n
w =
    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
$
        (Context n -> Context n)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT ((Bool -> Identity Bool) -> Context n -> Identity (Context n)
forall n (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> Context n -> f (Context n)
ctxHScrollBarShowHandlesL ((Bool -> Identity Bool) -> Context n -> Identity (Context n))
-> Bool -> Context n -> Context n
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
w)

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

-- | The default renderer for horizontal viewport scroll bars. Override
-- with 'withHScrollBarRenderer'.
horizontalScrollbarRenderer :: HScrollbarRenderer n
horizontalScrollbarRenderer :: forall n. HScrollbarRenderer n
horizontalScrollbarRenderer =
    HScrollbarRenderer { renderHScrollbar :: Widget n
renderHScrollbar = Char -> Widget n
forall n. Char -> Widget n
fill Char
'█'
                       , renderHScrollbarTrough :: Widget n
renderHScrollbarTrough = Char -> Widget n
forall n. Char -> Widget n
fill Char
' '
                       , renderHScrollbarHandleBefore :: Widget n
renderHScrollbarHandleBefore = String -> Widget n
forall n. String -> Widget n
str String
"<"
                       , renderHScrollbarHandleAfter :: Widget n
renderHScrollbarHandleAfter = String -> Widget n
forall n. String -> Widget n
str String
">"
                       , scrollbarHeightAllocation :: Int
scrollbarHeightAllocation = Int
1
                       }

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

      -- Observe the viewport name so we can detect multiple uses of the
      -- name.
      let observeName :: (Ord n, Show n) => n -> RenderM n ()
          observeName :: forall n. (Ord n, Show n) => n -> RenderM n ()
observeName n
n = do
              Set n
observed <- Getting (Set n) (RenderState n) (Set n)
-> ReaderT (Context n) (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 (f :: * -> *).
Functor f =>
(Set n -> f (Set n)) -> RenderState n -> f (RenderState 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 (f :: * -> *).
Functor f =>
(Set n -> f (Set n)) -> RenderState n -> f (RenderState 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.
      let newVp :: Viewport
newVp = Int -> Int -> DisplayRegion -> DisplayRegion -> Viewport
VP Int
0 Int
0 DisplayRegion
newSize (Int
0, Int
0)
          newSize :: DisplayRegion
newSize = (Int
newWidth, Int
newHeight)
          newWidth :: Int
newWidth = Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
vSBWidth
          newHeight :: Int
newHeight = Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availHeightL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hSBHeight
          vSBWidth :: Int
vSBWidth = Int
-> (VScrollBarOrientation -> Int)
-> Maybe VScrollBarOrientation
-> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int -> VScrollBarOrientation -> Int
forall a b. a -> b -> a
const (Int -> VScrollBarOrientation -> Int)
-> Int -> VScrollBarOrientation -> Int
forall a b. (a -> b) -> a -> b
$ VScrollbarRenderer n -> Int
forall n. VScrollbarRenderer n -> Int
scrollbarWidthAllocation VScrollbarRenderer n
vsRenderer) Maybe VScrollBarOrientation
vsOrientation
          hSBHeight :: Int
hSBHeight = Int
-> (HScrollBarOrientation -> Int)
-> Maybe HScrollBarOrientation
-> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int -> HScrollBarOrientation -> Int
forall a b. a -> b -> a
const (Int -> HScrollBarOrientation -> Int)
-> Int -> HScrollBarOrientation -> Int
forall a b. (a -> b) -> a -> b
$ HScrollbarRenderer n -> Int
forall n. HScrollbarRenderer n -> Int
scrollbarHeightAllocation HScrollbarRenderer n
hsRenderer) Maybe HScrollBarOrientation
hsOrientation
          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
& (DisplayRegion -> Identity DisplayRegion)
-> Viewport -> Identity Viewport
Lens' Viewport DisplayRegion
vpSize ((DisplayRegion -> Identity DisplayRegion)
 -> Viewport -> Identity Viewport)
-> DisplayRegion -> Viewport -> Viewport
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DisplayRegion
newSize
          doInsert Maybe Viewport
Nothing = Viewport -> Maybe Viewport
forall a. a -> Maybe a
Just Viewport
newVp

      State (RenderState n) () -> RenderM n ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT (Context n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State (RenderState n) () -> RenderM n ())
-> State (RenderState n) () -> RenderM n ()
forall a b. (a -> b) -> a -> b
$ (RenderState n -> RenderState n) -> State (RenderState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map n Viewport -> Identity (Map n Viewport))
-> RenderState n -> Identity (RenderState n)
forall n (f :: * -> *).
Functor f =>
(Map n Viewport -> f (Map n Viewport))
-> RenderState n -> f (RenderState n)
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). Also note that for viewports that
      -- only scroll in one direction, we apply a constraint in the
      -- non-scrolling direction in case a scroll bar is present.
      let release :: Widget n -> Maybe (Widget n)
release = case ViewportType
typ of
            ViewportType
Vertical -> Widget n -> Maybe (Widget n)
forall n. Widget n -> Maybe (Widget n)
vRelease (Widget n -> Maybe (Widget n))
-> (Widget n -> Widget n) -> Widget n -> Maybe (Widget n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
newWidth
            ViewportType
Horizontal -> Widget n -> Maybe (Widget n)
forall n. Widget n -> Maybe (Widget n)
hRelease (Widget n -> Maybe (Widget n))
-> (Widget n -> Widget n) -> Widget n -> Maybe (Widget n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
newHeight
            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 <- State (RenderState n) [(n, ScrollRequest)]
-> ReaderT (Context n) (State (RenderState n)) [(n, ScrollRequest)]
forall (m :: * -> *) a. Monad m => m a -> ReaderT (Context n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State (RenderState n) [(n, ScrollRequest)]
 -> ReaderT
      (Context n) (State (RenderState n)) [(n, ScrollRequest)])
-> State (RenderState n) [(n, ScrollRequest)]
-> ReaderT (Context n) (State (RenderState n)) [(n, ScrollRequest)]
forall a b. (a -> b) -> a -> b
$ (RenderState n -> [(n, ScrollRequest)])
-> State (RenderState n) [(n, ScrollRequest)]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (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 (f :: * -> *).
Functor f =>
([(n, ScrollRequest)] -> f [(n, ScrollRequest)])
-> RenderState n -> f (RenderState n)
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 a. [a] -> 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 <- State (RenderState n) (Maybe Viewport)
-> ReaderT (Context n) (State (RenderState n)) (Maybe Viewport)
forall (m :: * -> *) a. Monad m => m a -> ReaderT (Context n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State (RenderState n) (Maybe Viewport)
 -> ReaderT (Context n) (State (RenderState n)) (Maybe Viewport))
-> State (RenderState n) (Maybe Viewport)
-> ReaderT (Context n) (State (RenderState n)) (Maybe Viewport)
forall a b. (a -> b) -> a -> b
$ (RenderState n -> Maybe Viewport)
-> State (RenderState n) (Maybe Viewport)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (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 (f :: * -> *).
Functor f =>
(Map n Viewport -> f (Map n Viewport))
-> RenderState n -> f (RenderState n)
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
imageL) (Viewport -> Viewport) -> Viewport -> Viewport
forall a b. (a -> b) -> a -> b
$
                                      [ScrollRequest] -> Viewport -> Viewport
applyRequests [ScrollRequest]
rqs Viewport
v
                  State (RenderState n) () -> RenderM n ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT (Context n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State (RenderState n) () -> RenderM n ())
-> State (RenderState n) () -> RenderM n ()
forall a b. (a -> b) -> a -> b
$ (RenderState n -> RenderState n) -> State (RenderState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map n Viewport -> Identity (Map n Viewport))
-> RenderState n -> Identity (RenderState n)
forall n (f :: * -> *).
Functor f =>
(Map n Viewport -> f (Map n Viewport))
-> RenderState n -> f (RenderState n)
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 a. [a] -> 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 (f :: * -> *).
Functor f =>
([VisibilityRequest] -> f [VisibilityRequest])
-> Result n -> f (Result n)
visibilityRequestsL) (RenderM n () -> RenderM n ()) -> RenderM n () -> RenderM n ()
forall a b. (a -> b) -> a -> b
$ do
          Maybe Viewport
mVp <- State (RenderState n) (Maybe Viewport)
-> ReaderT (Context n) (State (RenderState n)) (Maybe Viewport)
forall (m :: * -> *) a. Monad m => m a -> ReaderT (Context n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State (RenderState n) (Maybe Viewport)
 -> ReaderT (Context n) (State (RenderState n)) (Maybe Viewport))
-> State (RenderState n) (Maybe Viewport)
-> ReaderT (Context n) (State (RenderState n)) (Maybe Viewport)
forall a b. (a -> b) -> a -> b
$ (RenderState n -> Maybe Viewport)
-> State (RenderState n) (Maybe Viewport)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (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 (f :: * -> *).
Functor f =>
(Map n Viewport -> f (Map n Viewport))
-> RenderState n -> f (RenderState n)
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 (f :: * -> *).
Functor f =>
([VisibilityRequest] -> f [VisibilityRequest])
-> Result n -> f (Result n)
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'
                  State (RenderState n) () -> RenderM n ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT (Context n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State (RenderState n) () -> RenderM n ())
-> State (RenderState n) () -> RenderM n ()
forall a b. (a -> b) -> a -> b
$ (RenderState n -> RenderState n) -> State (RenderState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map n Viewport -> Identity (Map n Viewport))
-> RenderState n -> Identity (RenderState n)
forall n (f :: * -> *).
Functor f =>
(Map n Viewport -> f (Map n Viewport))
-> RenderState n -> f (RenderState n)
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 b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Viewport -> VisibilityRequest -> Viewport
updateVp Viewport
vp [VisibilityRequest]
rqs))

      -- If the size of the rendering changes enough to make the
      -- viewport offsets invalid, reset them
      Maybe Viewport
mVp <- State (RenderState n) (Maybe Viewport)
-> ReaderT (Context n) (State (RenderState n)) (Maybe Viewport)
forall (m :: * -> *) a. Monad m => m a -> ReaderT (Context n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State (RenderState n) (Maybe Viewport)
 -> ReaderT (Context n) (State (RenderState n)) (Maybe Viewport))
-> State (RenderState n) (Maybe Viewport)
-> ReaderT (Context n) (State (RenderState n)) (Maybe Viewport)
forall a b. (a -> b) -> a -> b
$ (RenderState n -> Maybe Viewport)
-> State (RenderState n) (Maybe Viewport)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (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 (f :: * -> *).
Functor f =>
(Map n Viewport -> f (Map n Viewport))
-> RenderState n -> f (RenderState n)
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 n) (State (RenderState n)) Viewport
forall a. HasCallStack => String -> a
error (String -> ReaderT (Context n) (State (RenderState n)) Viewport)
-> String -> ReaderT (Context n) (State (RenderState n)) 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 n) (State (RenderState n)) Viewport
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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
^.(DisplayRegion -> Const Int DisplayRegion)
-> Viewport -> Const Int Viewport
Lens' Viewport DisplayRegion
vpSize((DisplayRegion -> Const Int DisplayRegion)
 -> Viewport -> Const Int Viewport)
-> Getting Int DisplayRegion Int -> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int DisplayRegion Int
forall s t a b. Field2 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_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
^.(DisplayRegion -> Const Int DisplayRegion)
-> Viewport -> Const Int Viewport
Lens' Viewport DisplayRegion
vpSize((DisplayRegion -> Const Int DisplayRegion)
 -> Viewport -> Const Int Viewport)
-> Getting Int DisplayRegion Int -> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int DisplayRegion Int
forall s t a b. Field1 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_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
          updateContentSize :: Viewport -> Viewport
updateContentSize Viewport
v = Viewport
v Viewport -> (Viewport -> Viewport) -> Viewport
forall a b. a -> (a -> b) -> b
& (DisplayRegion -> Identity DisplayRegion)
-> Viewport -> Identity Viewport
Lens' Viewport DisplayRegion
vpContentSize ((DisplayRegion -> Identity DisplayRegion)
 -> Viewport -> Identity Viewport)
-> DisplayRegion -> Viewport -> Viewport
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Image -> Int
V.imageWidth Image
img, Image -> Int
V.imageHeight Image
img)
          updateVp :: Viewport -> Viewport
updateVp = Viewport -> Viewport
updateContentSize (Viewport -> Viewport)
-> (Viewport -> Viewport) -> Viewport -> Viewport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
      State (RenderState n) () -> RenderM n ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT (Context n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State (RenderState n) () -> RenderM n ())
-> State (RenderState n) () -> RenderM n ()
forall a b. (a -> b) -> a -> b
$ (RenderState n -> RenderState n) -> State (RenderState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map n Viewport -> Identity (Map n Viewport))
-> RenderState n -> Identity (RenderState n)
forall n (f :: * -> *).
Functor f =>
(Map n Viewport -> f (Map n Viewport))
-> RenderState n -> f (RenderState n)
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 <- State (RenderState n) (Maybe Viewport)
-> ReaderT (Context n) (State (RenderState n)) (Maybe Viewport)
forall (m :: * -> *) a. Monad m => m a -> ReaderT (Context n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State (RenderState n) (Maybe Viewport)
 -> ReaderT (Context n) (State (RenderState n)) (Maybe Viewport))
-> State (RenderState n) (Maybe Viewport)
-> ReaderT (Context n) (State (RenderState n)) (Maybe Viewport)
forall a b. (a -> b) -> a -> b
$ (RenderState n -> Maybe Viewport)
-> State (RenderState n) (Maybe Viewport)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> 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 (f :: * -> *).
Functor f =>
(Map n Viewport -> f (Map n Viewport))
-> RenderState n -> f (RenderState n)
viewportMapL))
      Viewport
vpFinal <- case Maybe Viewport
mVpFinal of
          Maybe Viewport
Nothing -> String -> ReaderT (Context n) (State (RenderState n)) Viewport
forall a. HasCallStack => String -> a
error (String -> ReaderT (Context n) (State (RenderState n)) Viewport)
-> String -> ReaderT (Context n) (State (RenderState n)) 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 n) (State (RenderState n)) Viewport
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
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 (DisplayRegion -> 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 a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
initialResult

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

      -- Return the translated result with the visibility requests
      -- discarded
      let translatedSize :: DisplayRegion
translatedSize = ( Result n
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 DisplayRegion
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 n
cContext n -> Getting Attr (Context n) Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr (Context n) Attr
forall r n. Getting r (Context n) Attr
attrL) Char
' ' (Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL) (Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availHeightL)
              Result n -> RenderM n (Result n)
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 (f :: * -> *).
Functor f =>
([VisibilityRequest] -> f [VisibilityRequest])
-> Result n -> f (Result n)
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 (f :: * -> *).
Functor f =>
([Extent n] -> f [Extent n]) -> Result n -> f (Result 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
          DisplayRegion
_ -> 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
addVScrollbar
                      (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
addHScrollbar
                      (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 (Viewport
vpFinalViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.(DisplayRegion -> Const Int DisplayRegion)
-> Viewport -> Const Int Viewport
Lens' Viewport DisplayRegion
vpSize((DisplayRegion -> Const Int DisplayRegion)
 -> Viewport -> Const Int Viewport)
-> Getting Int DisplayRegion Int -> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int DisplayRegion Int
forall s t a b. Field2 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_2)
                      (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 (Viewport
vpFinalViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.(DisplayRegion -> Const Int DisplayRegion)
-> Viewport -> Const Int Viewport
Lens' Viewport DisplayRegion
vpSize((DisplayRegion -> Const Int DisplayRegion)
 -> Viewport -> Const Int Viewport)
-> Getting Int DisplayRegion Int -> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int DisplayRegion Int
forall s t a b. Field1 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_1)
                      (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 a. a -> ReaderT (Context n) (State (RenderState n)) a
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 (f :: * -> *).
Functor f =>
([VisibilityRequest] -> f [VisibilityRequest])
-> Result n -> f (Result n)
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

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

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

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

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

-- | Build a vertical scroll bar using the specified renderer and
-- settings.
--
-- You probably don't want to use this directly; instead,
-- use @viewport@, @withVScrollBars@, and, if needed,
-- @withVScrollBarRenderer@. This is exposed so that if you want to
-- render a scroll bar of your own, you can do so outside the @viewport@
-- context.
verticalScrollbar :: (Ord n)
                  => VScrollbarRenderer n
                  -- ^ The renderer to use.
                  -> VScrollBarOrientation
                  -- ^ The scroll bar orientation. The orientation
                  -- governs how additional padding is added to
                  -- the scroll bar if it is smaller than it space
                  -- allocation according to 'scrollbarWidthAllocation'.
                  -> n
                  -- ^ The viewport name associated with this scroll
                  -- bar.
                  -> Maybe (ClickableScrollbarElement -> n -> n)
                  -- ^ Constructor for clickable scroll bar element names.
                  -> Bool
                  -- ^ Whether to display handles.
                  -> Int
                  -- ^ The total viewport height in effect.
                  -> Int
                  -- ^ The viewport vertical scrolling offset in effect.
                  -> Int
                  -- ^ The total viewport content height.
                  -> Widget n
verticalScrollbar :: forall n.
Ord n =>
VScrollbarRenderer n
-> VScrollBarOrientation
-> n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> Bool
-> Int
-> Int
-> Int
-> Widget n
verticalScrollbar VScrollbarRenderer n
vsRenderer VScrollBarOrientation
o n
n Maybe (ClickableScrollbarElement -> n -> n)
constr Bool
showHandles Int
vpHeight Int
vOffset Int
contentHeight =
    Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit (VScrollbarRenderer n -> Int
forall n. VScrollbarRenderer n -> Int
scrollbarWidthAllocation VScrollbarRenderer n
vsRenderer) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
    Widget n -> Widget n
applyPadding (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
    if Bool
showHandles
       then [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox [ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                   n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBHandleBefore (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                   AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarHandleAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ VScrollbarRenderer n -> Widget n
forall n. VScrollbarRenderer n -> Widget n
renderVScrollbarHandleBefore VScrollbarRenderer n
vsRenderer
                 , Widget n
sbBody
                 , Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                   n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBHandleAfter (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                   AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarHandleAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ VScrollbarRenderer n -> Widget n
forall n. VScrollbarRenderer n -> Widget n
renderVScrollbarHandleAfter VScrollbarRenderer n
vsRenderer
                 ]
       else Widget n
sbBody
    where
        sbBody :: Widget n
sbBody = VScrollbarRenderer n
-> n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> Int
-> Int
-> Int
-> Widget n
forall n.
Ord n =>
VScrollbarRenderer n
-> n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> Int
-> Int
-> Int
-> Widget n
verticalScrollbar' VScrollbarRenderer n
vsRenderer n
n Maybe (ClickableScrollbarElement -> n -> n)
constr Int
vpHeight Int
vOffset Int
contentHeight
        applyPadding :: Widget n -> Widget n
applyPadding = case VScrollBarOrientation
o of
            VScrollBarOrientation
OnLeft -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max
            VScrollBarOrientation
OnRight -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max

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

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

            ctxHeight :: Int
ctxHeight = Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availHeightL

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

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

            sbAbove :: Widget n
sbAbove = n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBTroughBefore (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                      AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarTroughAttr (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 Int
sbOffset (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                      VScrollbarRenderer n -> Widget n
forall n. VScrollbarRenderer n -> Widget n
renderVScrollbarTrough VScrollbarRenderer n
vsRenderer
            sbBelow :: Widget n
sbBelow = n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBTroughAfter (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                      AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarTroughAttr (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 (Int
ctxHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
sbOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sbSize)) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                      VScrollbarRenderer n -> Widget n
forall n. VScrollbarRenderer n -> Widget n
renderVScrollbarTrough VScrollbarRenderer n
vsRenderer
            sbMiddle :: Widget n
sbMiddle = n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBBar (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                       AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarAttr (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 Int
sbSize (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ VScrollbarRenderer n -> Widget n
forall n. VScrollbarRenderer n -> Widget n
renderVScrollbar VScrollbarRenderer n
vsRenderer

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

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

-- | Build a horizontal scroll bar using the specified renderer and
-- settings.
--
-- You probably don't want to use this directly; instead, use
-- @viewport@, @withHScrollBars@, and, if needed,
-- @withHScrollBarRenderer@. This is exposed so that if you want to
-- render a scroll bar of your own, you can do so outside the @viewport@
-- context.
horizontalScrollbar :: (Ord n)
                    => HScrollbarRenderer n
                    -- ^ The renderer to use.
                    -> HScrollBarOrientation
                    -- ^ The scroll bar orientation. The orientation
                    -- governs how additional padding is added
                    -- to the scroll bar if it is smaller
                    -- than it space allocation according to
                    -- 'scrollbarHeightAllocation'.
                    -> n
                    -- ^ The viewport name associated with this scroll
                    -- bar.
                    -> Maybe (ClickableScrollbarElement -> n -> n)
                    -- ^ Constructor for clickable scroll bar element
                    -- names. Will be given the element name and the
                    -- viewport name.
                    -> Bool
                    -- ^ Whether to show handles.
                    -> Int
                    -- ^ The total viewport width in effect.
                    -> Int
                    -- ^ The viewport horizontal scrolling offset in effect.
                    -> Int
                    -- ^ The total viewport content width.
                    -> Widget n
horizontalScrollbar :: forall n.
Ord n =>
HScrollbarRenderer n
-> HScrollBarOrientation
-> n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> Bool
-> Int
-> Int
-> Int
-> Widget n
horizontalScrollbar HScrollbarRenderer n
hsRenderer HScrollBarOrientation
o n
n Maybe (ClickableScrollbarElement -> n -> n)
constr Bool
showHandles Int
vpWidth Int
hOffset Int
contentWidth =
    Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit (HScrollbarRenderer n -> Int
forall n. HScrollbarRenderer n -> Int
scrollbarHeightAllocation HScrollbarRenderer n
hsRenderer) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
    Widget n -> Widget n
applyPadding (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
    if Bool
showHandles
       then [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
1 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                   n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBHandleBefore (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                   AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarHandleAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ HScrollbarRenderer n -> Widget n
forall n. HScrollbarRenderer n -> Widget n
renderHScrollbarHandleBefore HScrollbarRenderer n
hsRenderer
                 , Widget n
sbBody
                 , Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
1 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                   n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBHandleAfter (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                   AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarHandleAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ HScrollbarRenderer n -> Widget n
forall n. HScrollbarRenderer n -> Widget n
renderHScrollbarHandleAfter HScrollbarRenderer n
hsRenderer
                 ]
       else Widget n
sbBody
    where
        sbBody :: Widget n
sbBody = HScrollbarRenderer n
-> n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> Int
-> Int
-> Int
-> Widget n
forall n.
Ord n =>
HScrollbarRenderer n
-> n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> Int
-> Int
-> Int
-> Widget n
horizontalScrollbar' HScrollbarRenderer n
hsRenderer n
n Maybe (ClickableScrollbarElement -> n -> n)
constr Int
vpWidth Int
hOffset Int
contentWidth
        applyPadding :: Widget n -> Widget n
applyPadding = case HScrollBarOrientation
o of
            HScrollBarOrientation
OnTop -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max
            HScrollBarOrientation
OnBottom -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padTop Padding
Max

horizontalScrollbar' :: (Ord n)
                     => HScrollbarRenderer n
                     -- ^ The renderer to use.
                     -> n
                     -- ^ The viewport name associated with this scroll
                     -- bar.
                     -> Maybe (ClickableScrollbarElement -> n -> n)
                     -- ^ Constructor for clickable scroll bar element
                     -- names.
                     -> Int
                     -- ^ The total viewport width in effect.
                     -> Int
                     -- ^ The viewport horizontal scrolling offset in effect.
                     -> Int
                     -- ^ The total viewport content width.
                     -> Widget n
horizontalScrollbar' :: forall n.
Ord n =>
HScrollbarRenderer n
-> n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> Int
-> Int
-> Int
-> Widget n
horizontalScrollbar' HScrollbarRenderer n
hsRenderer n
_ Maybe (ClickableScrollbarElement -> n -> n)
_ Int
vpWidth Int
_ Int
0 =
    Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
vpWidth (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ HScrollbarRenderer n -> Widget n
forall n. HScrollbarRenderer n -> Widget n
renderHScrollbarTrough HScrollbarRenderer n
hsRenderer
horizontalScrollbar' HScrollbarRenderer n
hsRenderer n
n Maybe (ClickableScrollbarElement -> n -> n)
constr Int
vpWidth Int
hOffset Int
contentWidth =
    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 n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext

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

            ctxWidth :: Int
ctxWidth = Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL

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

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

            sbLeft :: Widget n
sbLeft = n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBTroughBefore (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                     AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarTroughAttr (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 Int
sbOffset (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                     HScrollbarRenderer n -> Widget n
forall n. HScrollbarRenderer n -> Widget n
renderHScrollbarTrough HScrollbarRenderer n
hsRenderer
            sbRight :: Widget n
sbRight = n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBTroughAfter (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                      AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarTroughAttr (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 (Int
ctxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
sbOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sbSize)) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                      HScrollbarRenderer n -> Widget n
forall n. HScrollbarRenderer n -> Widget n
renderHScrollbarTrough HScrollbarRenderer n
hsRenderer
            sbMiddle :: Widget n
sbMiddle = n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
forall n.
Ord n =>
n
-> Maybe (ClickableScrollbarElement -> n -> n)
-> ClickableScrollbarElement
-> Widget n
-> Widget n
maybeClick n
n Maybe (ClickableScrollbarElement -> n -> n)
constr ClickableScrollbarElement
SBBar (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                       AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
scrollbarAttr (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 Int
sbSize (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ HScrollbarRenderer n -> Widget n
forall n. HScrollbarRenderer n -> Widget n
renderHScrollbar HScrollbarRenderer n
hsRenderer

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

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

-- | Given a name, obtain the viewport for that name by consulting the
-- viewport map in the rendering monad. NOTE! Some care must be taken
-- when calling this function, since it only returns useful values
-- after the viewport in question has been rendered. If you call this
-- function during rendering before a viewport has been rendered, you
-- may get nothing or you may get a stale version of the viewport. This
-- is because viewports are updated during rendering and the one you are
-- interested in may not have been rendered yet. So if you want to use
-- this, be sure you know what you are doing.
unsafeLookupViewport :: (Ord n) => n -> RenderM n (Maybe Viewport)
unsafeLookupViewport :: forall n. Ord n => n -> RenderM n (Maybe Viewport)
unsafeLookupViewport n
name = State (RenderState n) (Maybe Viewport)
-> ReaderT (Context n) (State (RenderState n)) (Maybe Viewport)
forall (m :: * -> *) a. Monad m => m a -> ReaderT (Context n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State (RenderState n) (Maybe Viewport)
 -> ReaderT (Context n) (State (RenderState n)) (Maybe Viewport))
-> State (RenderState n) (Maybe Viewport)
-> ReaderT (Context n) (State (RenderState n)) (Maybe Viewport)
forall a b. (a -> b) -> a -> b
$ (RenderState n -> Maybe Viewport)
-> State (RenderState n) (Maybe Viewport)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> 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 (f :: * -> *).
Functor f =>
(Map n Viewport -> f (Map n Viewport))
-> RenderState n -> f (RenderState n)
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
^.(DisplayRegion -> Const Int DisplayRegion)
-> Viewport -> Const Int Viewport
Lens' Viewport DisplayRegion
vpSize((DisplayRegion -> Const Int DisplayRegion)
 -> Viewport -> Const Int Viewport)
-> Getting Int DisplayRegion Int -> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int DisplayRegion Int
forall s t a b. Field2 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_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
^.(DisplayRegion -> Const Int DisplayRegion)
-> Viewport -> Const Int Viewport
Lens' Viewport DisplayRegion
vpSize((DisplayRegion -> Const Int DisplayRegion)
 -> Viewport -> Const Int Viewport)
-> Getting Int DisplayRegion Int -> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int DisplayRegion Int
forall s t a b. Field2 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_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
^.(DisplayRegion -> Const Int DisplayRegion)
-> Viewport -> Const Int Viewport
Lens' Viewport DisplayRegion
vpSize((DisplayRegion -> Const Int DisplayRegion)
 -> Viewport -> Const Int Viewport)
-> Getting Int DisplayRegion Int -> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int DisplayRegion Int
forall s t a b. Field2 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_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
^.(DisplayRegion -> Const Int DisplayRegion)
-> Viewport -> Const Int Viewport
Lens' Viewport DisplayRegion
vpSize((DisplayRegion -> Const Int DisplayRegion)
 -> Viewport -> Const Int Viewport)
-> Getting Int DisplayRegion Int -> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int DisplayRegion Int
forall s t a b. Field2 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_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
^.(DisplayRegion -> Const Int DisplayRegion)
-> Viewport -> Const Int Viewport
Lens' Viewport DisplayRegion
vpSize((DisplayRegion -> Const Int DisplayRegion)
 -> Viewport -> Const Int Viewport)
-> Getting Int DisplayRegion Int -> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int DisplayRegion Int
forall s t a b. Field1 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_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
^.(DisplayRegion -> Const Int DisplayRegion)
-> Viewport -> Const Int Viewport
Lens' Viewport DisplayRegion
vpSize((DisplayRegion -> Const Int DisplayRegion)
 -> Viewport -> Const Int Viewport)
-> Getting Int DisplayRegion Int -> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int DisplayRegion Int
forall s t a b. Field1 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_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
^.(DisplayRegion -> Const Int DisplayRegion)
-> Viewport -> Const Int Viewport
Lens' Viewport DisplayRegion
vpSize((DisplayRegion -> Const Int DisplayRegion)
 -> Viewport -> Const Int Viewport)
-> Getting Int DisplayRegion Int -> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int DisplayRegion Int
forall s t a b. Field1 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_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
^.(DisplayRegion -> Const Int DisplayRegion)
-> Viewport -> Const Int Viewport
Lens' Viewport DisplayRegion
vpSize((DisplayRegion -> Const Int DisplayRegion)
 -> Viewport -> Const Int Viewport)
-> Getting Int DisplayRegion Int -> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int DisplayRegion Int
forall s t a b. Field1 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_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
^.(DisplayRegion -> Const Int DisplayRegion)
-> Viewport -> Const Int Viewport
Lens' Viewport DisplayRegion
vpSize((DisplayRegion -> Const Int DisplayRegion)
 -> Viewport -> Const Int Viewport)
-> Getting Int DisplayRegion Int -> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int DisplayRegion Int
forall s t a b. Field2 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_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
Lens' Location 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
Lens' Location 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
^.(DisplayRegion -> Const Int DisplayRegion)
-> VisibilityRequest -> Const Int VisibilityRequest
Lens' VisibilityRequest DisplayRegion
vrSizeL((DisplayRegion -> Const Int DisplayRegion)
 -> VisibilityRequest -> Const Int VisibilityRequest)
-> Getting Int DisplayRegion Int
-> Getting Int VisibilityRequest Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int DisplayRegion Int
forall s t a b. Field2 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_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
^.(DisplayRegion -> Const Int DisplayRegion)
-> Viewport -> Const Int Viewport
Lens' Viewport DisplayRegion
vpSize((DisplayRegion -> Const Int DisplayRegion)
 -> Viewport -> Const Int Viewport)
-> Getting Int DisplayRegion Int -> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int DisplayRegion Int
forall s t a b. Field1 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_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
Lens' Location 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
Lens' Location 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
^.(DisplayRegion -> Const Int DisplayRegion)
-> VisibilityRequest -> Const Int VisibilityRequest
Lens' VisibilityRequest DisplayRegion
vrSizeL((DisplayRegion -> Const Int DisplayRegion)
 -> VisibilityRequest -> Const Int VisibilityRequest)
-> Getting Int DisplayRegion Int
-> Getting Int VisibilityRequest Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Int DisplayRegion Int
forall s t a b. Field1 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_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 :: forall n. 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 :: DisplayRegion
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 a. a -> ReaderT (Context n) (State (RenderState n)) a
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 DisplayRegion
imageSizeDisplayRegion -> Getting Int DisplayRegion Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int DisplayRegion Int
forall s t a b. Field1 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& DisplayRegion
imageSizeDisplayRegion -> Getting Int DisplayRegion Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int DisplayRegion Int
forall s t a b. Field2 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_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 (f :: * -> *).
Functor f =>
([VisibilityRequest] -> f [VisibilityRequest])
-> Result n -> f (Result n)
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 -> DisplayRegion -> VisibilityRequest
VR (DisplayRegion -> Location
Location (Int
0, Int
0)) DisplayRegion
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 :: forall n. Location -> DisplayRegion -> Widget n -> Widget n
visibleRegion Location
vrloc DisplayRegion
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 a. a -> ReaderT (Context n) (State (RenderState n)) a
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 DisplayRegion
szDisplayRegion -> Getting Int DisplayRegion Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int DisplayRegion Int
forall s t a b. Field1 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& DisplayRegion
szDisplayRegion -> Getting Int DisplayRegion Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int DisplayRegion Int
forall s t a b. Field2 s t a b => Lens s t a b
Lens DisplayRegion DisplayRegion Int Int
_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 (f :: * -> *).
Functor f =>
([VisibilityRequest] -> f [VisibilityRequest])
-> Result n -> f (Result n)
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 -> DisplayRegion -> VisibilityRequest
VR Location
vrloc DisplayRegion
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
<+> :: forall 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
<=> :: forall 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)
  #-}