{-# LANGUAGE RankNTypes, FlexibleContexts #-}
module UI.BrickHelpers where
import Text.Wrap
import Brick
import Brick.Forms
import Brick.Widgets.Border
import Brick.Widgets.Center
import Data.Char (isDigit)
import Data.Maybe
import Data.Text (pack)
import Graphics.Vty (imageWidth, imageHeight, charFill)
import Lens.Micro
import States (Name(SBClick))
import Text.Read (readMaybe)
import UI.Attributes
import qualified Graphics.Vty as V
import qualified Brick.Types as T

hCenteredStrWrap :: String -> Widget n
hCenteredStrWrap :: forall n. String -> Widget n
hCenteredStrWrap = (Widget n -> Widget n) -> String -> Widget n
forall n. (Widget n -> Widget n) -> String -> Widget n
hCenteredStrWrapWithAttr Widget n -> Widget n
forall a. a -> a
id

hCenteredStrWrapWithAttr :: (Widget n -> Widget n) -> String -> Widget n
hCenteredStrWrapWithAttr :: forall n. (Widget n -> Widget n) -> String -> Widget n
hCenteredStrWrapWithAttr Widget n -> Widget n
attr String
p = 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 w :: Int
w = 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
  let result :: Widget n
result = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ (Text -> Widget n) -> [Text] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map (Widget n -> Widget n
forall n. Widget n -> Widget n
hCenter (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget n -> Widget n
attr (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txt) ([Text] -> [Widget n]) -> [Text] -> [Widget n]
forall a b. (a -> b) -> a -> b
$ WrapSettings -> Int -> Text -> [Text]
wrapTextToLines (WrapSettings
defaultWrapSettings {preserveIndentation=False, breakLongWords=True}) Int
w (String -> Text
pack String
p)
  Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
result

-- Somewhat inefficient because rendering is done just to
-- determine the width and height. So don't use this if the
-- rendering is expensive.
centerPopup :: Widget n -> Widget n
centerPopup :: forall n. Widget n -> Widget n
centerPopup Widget n
widget = 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
  Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
widget
  let w :: Int
w = 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
imageWidth
      h :: Int
h = 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
imageHeight
      x :: Int
x = (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
w) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
      y :: Int
y = (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
h) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
  Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Location -> Widget n -> Widget n
forall n. Location -> Widget n -> Widget n
translateBy ((Int, Int) -> Location
Location (Int
x, Int
y)) Widget n
widget

drawException :: Maybe String -> Widget n
drawException :: forall n. Maybe String -> Widget n
drawException Maybe String
Nothing = Widget n
forall n. Widget n
emptyWidget
drawException (Just String
e) =
        Widget n -> Widget n
forall n. Widget n -> Widget n
centerPopup (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ 
        Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (String -> Widget n
forall n. String -> Widget n
str String
"Error") (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
withAttr AttrName
exceptionAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
e

-- | Fill all available space with the specified character. Grows only
-- horizontally.
hFill :: Char -> Widget n
hFill :: forall n. Char -> Widget n
hFill = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Widget n -> Widget n) -> (Char -> Widget n) -> Char -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Widget n
forall n. Char -> Widget n
fill

-- | Fill all available space with the specified character. Grows only
-- vertically.
vFill :: Char -> Widget n
vFill :: forall n. Char -> Widget n
vFill = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
1 (Widget n -> Widget n) -> (Char -> Widget n) -> Char -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Widget n
forall n. Char -> Widget n
fill

atLeastV :: Int -> Widget n -> Widget n
atLeastV :: forall n. Int -> Widget n -> Widget n
atLeastV Int
n Widget n
widget = 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
  Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
widget
  let h :: Int
h  = 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
imageHeight
      dh :: Int
dh = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
h
  if Int
dh Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then 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
n (Widget n
widget Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Char -> Widget n
forall n. Char -> Widget n
vFill Char
' ') else Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
widget

yesnoField :: (Ord n, Show n) => Bool -> Lens' s Bool -> n -> String -> s -> FormFieldState s e n
yesnoField :: forall n s e.
(Ord n, Show n) =>
Bool -> Lens' s Bool -> n -> String -> s -> FormFieldState s e n
yesnoField Bool
rightAlign Lens' s Bool
stLens n
name String
label s
initialState =
  let initVal :: Bool
initVal = s
initialState s -> Getting Bool s Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool s Bool
Lens' s Bool
stLens

      handleEvent :: BrickEvent n e -> m ()
handleEvent (MouseDown n
n Button
_ [Modifier]
_ Location
_) | n
n n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
name = (Bool -> Bool) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify Bool -> Bool
not
      handleEvent (VtyEvent (V.EvKey (V.KChar Char
' ') [])) = (Bool -> Bool) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify Bool -> Bool
not
      handleEvent (VtyEvent (V.EvKey Key
V.KEnter [])) = (Bool -> Bool) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify Bool -> Bool
not
      handleEvent BrickEvent n e
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  
  in FormFieldState { formFieldState :: Bool
formFieldState = Bool
initVal
                    , formFields :: [FormField Bool Bool e n]
formFields = [ n
-> (Bool -> Maybe Bool)
-> Bool
-> (Bool -> Bool -> Widget n)
-> (BrickEvent n e -> EventM n Bool ())
-> FormField Bool Bool e n
forall a b e n.
n
-> (b -> Maybe a)
-> Bool
-> (Bool -> b -> Widget n)
-> (BrickEvent n e -> EventM n b ())
-> FormField a b e n
FormField n
name Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True 
                                       (Bool -> String -> n -> Bool -> Bool -> Widget n
forall n. Ord n => Bool -> String -> n -> Bool -> Bool -> Widget n
renderYesno Bool
rightAlign String
label n
name)
                                       BrickEvent n e -> EventM n Bool ()
forall {m :: * -> *} {e}.
MonadState Bool m =>
BrickEvent n e -> m ()
handleEvent ]
                    , formFieldLens :: Lens' s Bool
formFieldLens = (Bool -> f Bool) -> s -> f s
Lens' s Bool
stLens
                    , formFieldUpdate :: Bool -> Bool -> Bool
formFieldUpdate = Bool -> Bool -> Bool
forall a b. a -> b -> a
const
                    , formFieldRenderHelper :: Widget n -> Widget n
formFieldRenderHelper = Widget n -> Widget n
forall a. a -> a
id
                    , formFieldConcat :: [Widget n] -> Widget n
formFieldConcat = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox
                    , formFieldVisibilityMode :: FormFieldVisibilityMode
formFieldVisibilityMode = FormFieldVisibilityMode
ShowAugmentedField }

renderYesno :: Ord n => Bool -> String -> n -> Bool -> Bool -> Widget n
renderYesno :: forall n. Ord n => Bool -> String -> n -> Bool -> Bool -> Widget n
renderYesno Bool
rightAlign String
label n
n Bool
foc Bool
val =
  let addAttr :: Widget n -> Widget n
addAttr = if Bool
foc then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
focusedFormInputAttr else Widget n -> Widget n
forall a. a -> a
id
  in n -> Widget n -> Widget n
forall n. Ord n => n -> Widget n -> Widget n
clickable n
n (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
    (if Bool
val 
      then Widget n -> Widget n
forall n. Widget n -> Widget n
addAttr (String -> Widget n
forall n. String -> Widget n
str String
"Yes")
      else if Bool
rightAlign 
        then String -> Widget n
forall n. String -> Widget n
str String
" " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n -> Widget n
forall n. Widget n -> Widget n
addAttr (String -> Widget n
forall n. String -> Widget n
str String
"No")
        else Widget n -> Widget n
forall n. Widget n -> Widget n
addAttr (String -> Widget n
forall n. String -> Widget n
str String
"No") Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget n
forall n. String -> Widget n
str String
" ") Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget n
forall n. String -> Widget n
str String
label

naturalNumberField :: (Ord n, Show n) => Int -> Lens' s Int -> n -> String -> s -> FormFieldState s e n
naturalNumberField :: forall n s e.
(Ord n, Show n) =>
Int -> Lens' s Int -> n -> String -> s -> FormFieldState s e n
naturalNumberField Int
bound Lens' s Int
stLens n
name String
postfix s
initialState =
  let initVal :: Int
initVal = s
initialState s -> Getting Int s Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int s Int
Lens' s Int
stLens

      handleEvent :: BrickEvent n e -> m ()
handleEvent (VtyEvent (V.EvKey (V.KChar Char
c) [])) | Char -> Bool
isDigit Char
c =
           do Int
s <- m Int
forall s (m :: * -> *). MonadState s m => m s
get
              let newValue :: Int
newValue = String -> Int
forall a. Read a => String -> a
read (Int -> String
forall a. Show a => a -> String
show Int
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c])
              Int -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
newValue Int
bound
      handleEvent (VtyEvent (V.EvKey Key
V.KBS [])) = 
        do Int
s <- m Int
forall s (m :: * -> *). MonadState s m => m s
get
           Int -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ case Int -> String
forall a. Show a => a -> String
show Int
s of
             String
"" -> Int
0
             String
xs -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> String
forall a. HasCallStack => [a] -> [a]
init String
xs))
      handleEvent BrickEvent n e
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  
  in FormFieldState { formFieldState :: Int
formFieldState = Int
initVal
                    , formFields :: [FormField Int Int e n]
formFields = [ n
-> (Int -> Maybe Int)
-> Bool
-> (Bool -> Int -> Widget n)
-> (BrickEvent n e -> EventM n Int ())
-> FormField Int Int e n
forall a b e n.
n
-> (b -> Maybe a)
-> Bool
-> (Bool -> b -> Widget n)
-> (BrickEvent n e -> EventM n b ())
-> FormField a b e n
FormField n
name Int -> Maybe Int
forall a. a -> Maybe a
Just Bool
True 
                                       (Int -> String -> n -> Bool -> Int -> Widget n
forall n. Int -> String -> n -> Bool -> Int -> Widget n
renderNaturalNumber Int
bound String
postfix n
name)
                                       BrickEvent n e -> EventM n Int ()
forall {m :: * -> *} {n} {e}.
MonadState Int m =>
BrickEvent n e -> m ()
handleEvent ]
                    , formFieldLens :: Lens' s Int
formFieldLens = (Int -> f Int) -> s -> f s
Lens' s Int
stLens
                    , formFieldUpdate :: Int -> Int -> Int
formFieldUpdate = Int -> Int -> Int
forall a b. a -> b -> a
const
                    , formFieldRenderHelper :: Widget n -> Widget n
formFieldRenderHelper = Widget n -> Widget n
forall a. a -> a
id
                    , formFieldConcat :: [Widget n] -> Widget n
formFieldConcat = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox
                    , formFieldVisibilityMode :: FormFieldVisibilityMode
formFieldVisibilityMode = FormFieldVisibilityMode
ShowAugmentedField }

renderNaturalNumber :: Int -> String -> n -> Bool -> Int -> Widget n
renderNaturalNumber :: forall n. Int -> String -> n -> Bool -> Int -> Widget n
renderNaturalNumber Int
bound String
postfix n
n Bool
foc Int
val =
  let addAttr :: Widget n -> Widget n
addAttr = if Bool
foc then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
focusedFormInputAttr else Widget n -> Widget n
forall a. a -> a
id
      val' :: String
val' = Int -> String
forall a. Show a => a -> String
show Int
val
      csr :: Widget n -> Widget n
csr = if Bool
foc then n -> Location -> Widget n -> Widget n
forall n. n -> Location -> Widget n -> Widget n
showCursor n
n ((Int, Int) -> Location
Location (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
val',Int
0)) else Widget n -> Widget n
forall a. a -> a
id
  in if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
postfix
    then Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> String
forall a. Show a => a -> String
show Int
bound)) (Widget n -> Widget n
csr (Widget n -> Widget n
forall n. Widget n -> Widget n
addAttr (String -> Widget n
forall n. String -> Widget n
str String
val')) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Char -> Widget n
forall n. Char -> Widget n
hFill Char
' ') 
    else Widget n -> Widget n
csr (Widget n -> Widget n
forall n. Widget n -> Widget n
addAttr (String -> Widget n
forall n. String -> Widget n
str String
val')) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget n
forall n. String -> Widget n
str String
postfix

-- https://github.com/jtdaugherty/brick/issues/290#issuecomment-699570168
fixedHeightOrViewport :: (Ord n, Show n) => Int -> n -> Widget n -> Widget n
fixedHeightOrViewport :: forall n. (Ord n, Show n) => Int -> n -> Widget n -> Widget n
fixedHeightOrViewport Int
maxHeight n
vpName Widget n
w =
    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
        -- Render the viewport contents in advance
        Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
w
        -- If the contents will fit in the maximum allowed rows,
        -- just return the content without putting it in a viewport.
        if Image -> Int
imageHeight (Result n -> Image
forall n. Result n -> Image
image Result n
result) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxHeight
            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
            -- Otherwise put the contents (pre-rendered) in a viewport
            -- and limit the height to the maximum allowable height.
            else Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
maxHeight (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                         n -> ViewportType -> Widget n -> Widget n
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport n
vpName ViewportType
Vertical (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)

fixedHeightOrViewportPercent :: (Ord n, Show n) => Int -> n -> Widget n -> Widget n
fixedHeightOrViewportPercent :: forall n. (Ord n, Show n) => Int -> n -> Widget n -> Widget n
fixedHeightOrViewportPercent Int
percentage n
vpName Widget n
w =
    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
        Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
w
        Int
available <- Context n -> Int
forall n. Context n -> Int
availHeight (Context n -> Int)
-> ReaderT (Context n) (State (RenderState n)) (Context n)
-> ReaderT (Context n) (State (RenderState n)) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (Context n) (State (RenderState n)) (Context n)
forall n. RenderM n (Context n)
getContext

        if Image -> Int
imageHeight (Result n -> Image
forall n. Result n -> Image
image Result n
result) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
percentage Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
available Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100
            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 (Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimitPercent Int
percentage (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                         n -> ViewportType -> Widget n -> Widget n
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport n
vpName ViewportType
Vertical Widget n
w)

handleClickScroll :: (Int -> EventM n s ()) -> ClickableScrollbarElement -> EventM n s ()
handleClickScroll :: forall n s.
(Int -> EventM n s ())
-> ClickableScrollbarElement -> EventM n s ()
handleClickScroll Int -> EventM n s ()
scroll ClickableScrollbarElement
el =
  case ClickableScrollbarElement
el of
    ClickableScrollbarElement
T.SBHandleBefore -> Int -> EventM n s ()
scroll (-Int
1)
    ClickableScrollbarElement
T.SBHandleAfter  -> Int -> EventM n s ()
scroll Int
1
    ClickableScrollbarElement
T.SBTroughBefore -> Int -> EventM n s ()
scroll (-Int
10)
    ClickableScrollbarElement
T.SBTroughAfter  -> Int -> EventM n s ()
scroll Int
10
    ClickableScrollbarElement
T.SBBar          -> () -> EventM n s ()
forall a. a -> EventM n s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

scrollableViewportPercent :: Int -> Name -> Widget Name -> Widget Name
scrollableViewportPercent :: Int -> Name -> Widget Name -> Widget Name
scrollableViewportPercent Int
percent Name
n =
  (ClickableScrollbarElement -> Name -> Name)
-> Widget Name -> Widget Name
forall n.
(ClickableScrollbarElement -> n -> n) -> Widget n -> Widget n
withClickableVScrollBars ClickableScrollbarElement -> Name -> Name
SBClick (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Widget Name -> Widget Name
forall n. Widget n -> Widget n
withVScrollBarHandles (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  VScrollBarOrientation -> Widget Name -> Widget Name
forall n. VScrollBarOrientation -> Widget n -> Widget n
withVScrollBars VScrollBarOrientation
OnRight (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Int -> Name -> Widget Name -> Widget Name
forall n. (Ord n, Show n) => Int -> n -> Widget n -> Widget n
fixedHeightOrViewportPercent Int
percent Name
n (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1)