{-| Description: Widgets that scroll when their contents don't fit
-}
module Reflex.Vty.Widget.Scroll where

import Control.Monad.Fix
import Data.Default
import Data.List (foldl')
import qualified Graphics.Vty as V
import Reflex
import Reflex.Vty.Widget
import Reflex.Vty.Widget.Input.Mouse

-- | Configuration options for automatic scroll-to-bottom behavior
data ScrollToBottom
  = ScrollToBottom_Always
  -- ^ Always scroll to the bottom on new output
  | ScrollToBottom_Maintain
  -- ^ Scroll down with new output only when, prior to the new output being
  -- added, the widget was scrolled all the way to the bottom.
  deriving (ScrollToBottom -> ScrollToBottom -> Bool
(ScrollToBottom -> ScrollToBottom -> Bool)
-> (ScrollToBottom -> ScrollToBottom -> Bool) -> Eq ScrollToBottom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScrollToBottom -> ScrollToBottom -> Bool
$c/= :: ScrollToBottom -> ScrollToBottom -> Bool
== :: ScrollToBottom -> ScrollToBottom -> Bool
$c== :: ScrollToBottom -> ScrollToBottom -> Bool
Eq, Eq ScrollToBottom
Eq ScrollToBottom
-> (ScrollToBottom -> ScrollToBottom -> Ordering)
-> (ScrollToBottom -> ScrollToBottom -> Bool)
-> (ScrollToBottom -> ScrollToBottom -> Bool)
-> (ScrollToBottom -> ScrollToBottom -> Bool)
-> (ScrollToBottom -> ScrollToBottom -> Bool)
-> (ScrollToBottom -> ScrollToBottom -> ScrollToBottom)
-> (ScrollToBottom -> ScrollToBottom -> ScrollToBottom)
-> Ord ScrollToBottom
ScrollToBottom -> ScrollToBottom -> Bool
ScrollToBottom -> ScrollToBottom -> Ordering
ScrollToBottom -> ScrollToBottom -> ScrollToBottom
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScrollToBottom -> ScrollToBottom -> ScrollToBottom
$cmin :: ScrollToBottom -> ScrollToBottom -> ScrollToBottom
max :: ScrollToBottom -> ScrollToBottom -> ScrollToBottom
$cmax :: ScrollToBottom -> ScrollToBottom -> ScrollToBottom
>= :: ScrollToBottom -> ScrollToBottom -> Bool
$c>= :: ScrollToBottom -> ScrollToBottom -> Bool
> :: ScrollToBottom -> ScrollToBottom -> Bool
$c> :: ScrollToBottom -> ScrollToBottom -> Bool
<= :: ScrollToBottom -> ScrollToBottom -> Bool
$c<= :: ScrollToBottom -> ScrollToBottom -> Bool
< :: ScrollToBottom -> ScrollToBottom -> Bool
$c< :: ScrollToBottom -> ScrollToBottom -> Bool
compare :: ScrollToBottom -> ScrollToBottom -> Ordering
$ccompare :: ScrollToBottom -> ScrollToBottom -> Ordering
$cp1Ord :: Eq ScrollToBottom
Ord, Int -> ScrollToBottom -> ShowS
[ScrollToBottom] -> ShowS
ScrollToBottom -> String
(Int -> ScrollToBottom -> ShowS)
-> (ScrollToBottom -> String)
-> ([ScrollToBottom] -> ShowS)
-> Show ScrollToBottom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScrollToBottom] -> ShowS
$cshowList :: [ScrollToBottom] -> ShowS
show :: ScrollToBottom -> String
$cshow :: ScrollToBottom -> String
showsPrec :: Int -> ScrollToBottom -> ShowS
$cshowsPrec :: Int -> ScrollToBottom -> ShowS
Show)

-- | Configuration for the scrollable element. Controls scroll behavior.
data ScrollableConfig t = ScrollableConfig
  { ScrollableConfig t -> Event t Int
_scrollableConfig_scrollBy :: Event t Int
  -- ^ Number of lines to scroll by
  , ScrollableConfig t -> Event t ScrollPos
_scrollableConfig_scrollTo :: Event t ScrollPos
  -- ^ Specific position to scroll to
  , ScrollableConfig t -> ScrollPos
_scrollableConfig_startingPosition :: ScrollPos
  -- ^ The initial scroll position
  , ScrollableConfig t -> Behavior t (Maybe ScrollToBottom)
_scrollableConfig_scrollToBottom :: Behavior t (Maybe ScrollToBottom)
  -- ^ How the scroll position should be adjusted as new content is added
  }

instance Reflex t => Default (ScrollableConfig t) where
  def :: ScrollableConfig t
def = Event t Int
-> Event t ScrollPos
-> ScrollPos
-> Behavior t (Maybe ScrollToBottom)
-> ScrollableConfig t
forall k (t :: k).
Event t Int
-> Event t ScrollPos
-> ScrollPos
-> Behavior t (Maybe ScrollToBottom)
-> ScrollableConfig t
ScrollableConfig Event t Int
forall k (t :: k) a. Reflex t => Event t a
never Event t ScrollPos
forall k (t :: k) a. Reflex t => Event t a
never ScrollPos
ScrollPos_Top (Maybe ScrollToBottom -> Behavior t (Maybe ScrollToBottom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ScrollToBottom
forall a. Maybe a
Nothing)

-- | The scroll position
data ScrollPos = ScrollPos_Top | ScrollPos_Line Int | ScrollPos_Bottom
  deriving (Int -> ScrollPos -> ShowS
[ScrollPos] -> ShowS
ScrollPos -> String
(Int -> ScrollPos -> ShowS)
-> (ScrollPos -> String)
-> ([ScrollPos] -> ShowS)
-> Show ScrollPos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScrollPos] -> ShowS
$cshowList :: [ScrollPos] -> ShowS
show :: ScrollPos -> String
$cshow :: ScrollPos -> String
showsPrec :: Int -> ScrollPos -> ShowS
$cshowsPrec :: Int -> ScrollPos -> ShowS
Show, ScrollPos -> ScrollPos -> Bool
(ScrollPos -> ScrollPos -> Bool)
-> (ScrollPos -> ScrollPos -> Bool) -> Eq ScrollPos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScrollPos -> ScrollPos -> Bool
$c/= :: ScrollPos -> ScrollPos -> Bool
== :: ScrollPos -> ScrollPos -> Bool
$c== :: ScrollPos -> ScrollPos -> Bool
Eq, Eq ScrollPos
Eq ScrollPos
-> (ScrollPos -> ScrollPos -> Ordering)
-> (ScrollPos -> ScrollPos -> Bool)
-> (ScrollPos -> ScrollPos -> Bool)
-> (ScrollPos -> ScrollPos -> Bool)
-> (ScrollPos -> ScrollPos -> Bool)
-> (ScrollPos -> ScrollPos -> ScrollPos)
-> (ScrollPos -> ScrollPos -> ScrollPos)
-> Ord ScrollPos
ScrollPos -> ScrollPos -> Bool
ScrollPos -> ScrollPos -> Ordering
ScrollPos -> ScrollPos -> ScrollPos
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScrollPos -> ScrollPos -> ScrollPos
$cmin :: ScrollPos -> ScrollPos -> ScrollPos
max :: ScrollPos -> ScrollPos -> ScrollPos
$cmax :: ScrollPos -> ScrollPos -> ScrollPos
>= :: ScrollPos -> ScrollPos -> Bool
$c>= :: ScrollPos -> ScrollPos -> Bool
> :: ScrollPos -> ScrollPos -> Bool
$c> :: ScrollPos -> ScrollPos -> Bool
<= :: ScrollPos -> ScrollPos -> Bool
$c<= :: ScrollPos -> ScrollPos -> Bool
< :: ScrollPos -> ScrollPos -> Bool
$c< :: ScrollPos -> ScrollPos -> Bool
compare :: ScrollPos -> ScrollPos -> Ordering
$ccompare :: ScrollPos -> ScrollPos -> Ordering
$cp1Ord :: Eq ScrollPos
Ord)

-- | The output of a 'scrollable', indicating its current scroll position.
data Scrollable t = Scrollable
  { Scrollable t -> Behavior t ScrollPos
_scrollable_scrollPosition :: Behavior t ScrollPos
  , Scrollable t -> Behavior t Int
_scrollable_totalLines :: Behavior t Int
  , Scrollable t -> Behavior t Int
_scrollable_scrollHeight :: Behavior t Int
  }

-- | Scrollable widget. The output exposes the current scroll position and
-- total number of lines (including those that are hidden)
scrollable
  :: forall t m a.
  ( Reflex t, MonadHold t m, MonadFix m
  , HasDisplayRegion t m, HasInput t m, HasImageWriter t m, HasTheme t m)
  => ScrollableConfig t
  -> (m (Event t (), a))
  -> m (Scrollable t, a)
scrollable :: ScrollableConfig t -> m (Event t (), a) -> m (Scrollable t, a)
scrollable (ScrollableConfig Event t Int
scrollBy Event t ScrollPos
scrollTo ScrollPos
startingPos Behavior t (Maybe ScrollToBottom)
onAppend) m (Event t (), a)
mkImg = do
  Dynamic t Int
dh <- m (Dynamic t Int)
forall k (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayHeight
  Event t KeyCombo
kup <- Key -> m (Event t KeyCombo)
forall k (m :: * -> *) (t :: k).
(Monad m, Reflex t, HasInput t m) =>
Key -> m (Event t KeyCombo)
key Key
V.KUp
  Event t KeyCombo
kdown <- Key -> m (Event t KeyCombo)
forall k (m :: * -> *) (t :: k).
(Monad m, Reflex t, HasInput t m) =>
Key -> m (Event t KeyCombo)
key Key
V.KDown
  Event t ScrollDirection
m <- m (Event t ScrollDirection)
forall k (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasInput t m) =>
m (Event t ScrollDirection)
mouseScroll
  let requestedScroll :: Event t Int
      requestedScroll :: Event t Int
requestedScroll = [Event t Int] -> Event t Int
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
        [ Int
1 Int -> Event t KeyCombo -> Event t Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t KeyCombo
kdown
        , (-Int
1) Int -> Event t KeyCombo -> Event t Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t KeyCombo
kup
        , Event t ScrollDirection -> (ScrollDirection -> Int) -> Event t Int
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t ScrollDirection
m ((ScrollDirection -> Int) -> Event t Int)
-> (ScrollDirection -> Int) -> Event t Int
forall a b. (a -> b) -> a -> b
$ \case
            ScrollDirection
ScrollDirection_Up -> (-Int
1)
            ScrollDirection
ScrollDirection_Down -> Int
1
        , Event t Int
scrollBy
        ]
  rec
    ((Event t ()
update, a
a), Behavior t [Image]
imgs) <- m (Event t (), a) -> m ((Event t (), a), Behavior t [Image])
forall t (m :: * -> *) a.
HasImageWriter t m =>
m a -> m (a, Behavior t [Image])
captureImages (m (Event t (), a) -> m ((Event t (), a), Behavior t [Image]))
-> m (Event t (), a) -> m ((Event t (), a), Behavior t [Image])
forall a b. (a -> b) -> a -> b
$ (Event t VtyEvent -> Event t VtyEvent)
-> m (Event t (), a) -> m (Event t (), a)
forall k (t :: k) (m :: * -> *) a.
HasInput t m =>
(Event t VtyEvent -> Event t VtyEvent) -> m a -> m a
localInput (Behavior t Int -> Event t VtyEvent -> Event t VtyEvent
forall k (t :: k).
Reflex t =>
Behavior t Int -> Event t VtyEvent -> Event t VtyEvent
translateMouseEvents Behavior t Int
translation) (m (Event t (), a) -> m (Event t (), a))
-> m (Event t (), a) -> m (Event t (), a)
forall a b. (a -> b) -> a -> b
$ m (Event t (), a)
mkImg
    let sz :: Behavior t Int
sz = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([Int] -> Int) -> ([Image] -> [Int]) -> [Image] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Image -> Int) -> [Image] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Image -> Int
V.imageHeight ([Image] -> Int) -> Behavior t [Image] -> Behavior t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t [Image]
imgs
    Dynamic t ScrollPos
lineIndex <- ((ScrollPos -> Maybe ScrollPos) -> ScrollPos -> Maybe ScrollPos)
-> ScrollPos
-> Event t (ScrollPos -> Maybe ScrollPos)
-> m (Dynamic t ScrollPos)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
foldDynMaybe (ScrollPos -> Maybe ScrollPos) -> ScrollPos -> Maybe ScrollPos
forall a b. (a -> b) -> a -> b
($) ScrollPos
startingPos (Event t (ScrollPos -> Maybe ScrollPos) -> m (Dynamic t ScrollPos))
-> Event t (ScrollPos -> Maybe ScrollPos)
-> m (Dynamic t ScrollPos)
forall a b. (a -> b) -> a -> b
$ [Event t (ScrollPos -> Maybe ScrollPos)]
-> Event t (ScrollPos -> Maybe ScrollPos)
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
      [ (\((Int
totalLines, Int
h), Int
d) ScrollPos
sp -> ScrollPos -> Maybe ScrollPos
forall a. a -> Maybe a
Just (ScrollPos -> Maybe ScrollPos) -> ScrollPos -> Maybe ScrollPos
forall a b. (a -> b) -> a -> b
$ ScrollPos -> Int -> Int -> Int -> ScrollPos
scrollByLines ScrollPos
sp Int
totalLines Int
h Int
d) (((Int, Int), Int) -> ScrollPos -> Maybe ScrollPos)
-> Event t ((Int, Int), Int)
-> Event t (ScrollPos -> Maybe ScrollPos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t (Int, Int) -> Event t Int -> Event t ((Int, Int), Int)
forall k (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach ((,) (Int -> Int -> (Int, Int))
-> Behavior t Int -> Behavior t (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t Int
sz Behavior t (Int -> (Int, Int))
-> Behavior t Int -> Behavior t (Int, Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
dh) Event t Int
requestedScroll
      , (\((Int
totalLines, Int
h), ScrollPos
newScrollPosition) ScrollPos
_ -> ScrollPos -> Maybe ScrollPos
forall a. a -> Maybe a
Just (ScrollPos -> Maybe ScrollPos) -> ScrollPos -> Maybe ScrollPos
forall a b. (a -> b) -> a -> b
$ case ScrollPos
newScrollPosition of
          ScrollPos_Line Int
n -> Int -> Int -> Int -> ScrollPos
scrollToLine Int
totalLines Int
h Int
n
          ScrollPos
ScrollPos_Top -> ScrollPos
ScrollPos_Top
          ScrollPos
ScrollPos_Bottom -> ScrollPos
ScrollPos_Bottom
        ) (((Int, Int), ScrollPos) -> ScrollPos -> Maybe ScrollPos)
-> Event t ((Int, Int), ScrollPos)
-> Event t (ScrollPos -> Maybe ScrollPos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t (Int, Int)
-> Event t ScrollPos -> Event t ((Int, Int), ScrollPos)
forall k (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach ((,) (Int -> Int -> (Int, Int))
-> Behavior t Int -> Behavior t (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t Int
sz Behavior t (Int -> (Int, Int))
-> Behavior t Int -> Behavior t (Int, Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
dh) Event t ScrollPos
scrollTo
      , (\Maybe ScrollToBottom
cfg ScrollPos
sp -> case Maybe ScrollToBottom
cfg of
          Just ScrollToBottom
ScrollToBottom_Always -> case ScrollPos
sp of
            ScrollPos
ScrollPos_Bottom -> Maybe ScrollPos
forall a. Maybe a
Nothing
            ScrollPos
_ -> ScrollPos -> Maybe ScrollPos
forall a. a -> Maybe a
Just ScrollPos
ScrollPos_Bottom
          Maybe ScrollToBottom
_ -> Maybe ScrollPos
forall a. Maybe a
Nothing) (Maybe ScrollToBottom -> ScrollPos -> Maybe ScrollPos)
-> Event t (Maybe ScrollToBottom)
-> Event t (ScrollPos -> Maybe ScrollPos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t (Maybe ScrollToBottom)
-> Event t () -> Event t (Maybe ScrollToBottom)
forall k (t :: k) b a.
Reflex t =>
Behavior t b -> Event t a -> Event t b
tag Behavior t (Maybe ScrollToBottom)
onAppend Event t ()
update
      ]
    let translation :: Behavior t Int
translation = Int -> ScrollPos -> Int -> Int
calculateTranslation
          (Int -> ScrollPos -> Int -> Int)
-> Behavior t Int -> Behavior t (ScrollPos -> Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
dh
          Behavior t (ScrollPos -> Int -> Int)
-> Behavior t ScrollPos -> Behavior t (Int -> Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t ScrollPos -> Behavior t ScrollPos
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t ScrollPos
lineIndex
          Behavior t (Int -> Int) -> Behavior t Int -> Behavior t Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior t Int
sz
  let cropImages :: Int -> f Image -> f Image
cropImages Int
dy f Image
images = Int -> Image -> Image
cropFromTop Int
dy (Image -> Image) -> f Image -> f Image
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Image
images
  Behavior t [Image] -> m ()
forall t (m :: * -> *).
HasImageWriter t m =>
Behavior t [Image] -> m ()
tellImages (Behavior t [Image] -> m ()) -> Behavior t [Image] -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> [Image] -> [Image]
forall (f :: * -> *). Functor f => Int -> f Image -> f Image
cropImages (Int -> [Image] -> [Image])
-> Behavior t Int -> Behavior t ([Image] -> [Image])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t Int
translation Behavior t ([Image] -> [Image])
-> Behavior t [Image] -> Behavior t [Image]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior t [Image]
imgs
  (Scrollable t, a) -> m (Scrollable t, a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Scrollable t, a) -> m (Scrollable t, a))
-> (Scrollable t, a) -> m (Scrollable t, a)
forall a b. (a -> b) -> a -> b
$ (,a
a) (Scrollable t -> (Scrollable t, a))
-> Scrollable t -> (Scrollable t, a)
forall a b. (a -> b) -> a -> b
$ Scrollable :: forall k (t :: k).
Behavior t ScrollPos
-> Behavior t Int -> Behavior t Int -> Scrollable t
Scrollable
    { _scrollable_scrollPosition :: Behavior t ScrollPos
_scrollable_scrollPosition = Dynamic t ScrollPos -> Behavior t ScrollPos
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t ScrollPos
lineIndex
    , _scrollable_totalLines :: Behavior t Int
_scrollable_totalLines = Behavior t Int
sz
    , _scrollable_scrollHeight :: Behavior t Int
_scrollable_scrollHeight = Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
dh
    }
  where
    cropFromTop :: Int -> V.Image -> V.Image
    cropFromTop :: Int -> Image -> Image
cropFromTop Int
rows Image
i =
      Int -> Image -> Image
V.cropTop (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Image -> Int
V.imageHeight Image
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rows) Image
i
    calculateTranslation :: Int -> ScrollPos -> Int -> Int
calculateTranslation Int
height ScrollPos
scrollPos Int
totalLines = case ScrollPos
scrollPos of
      ScrollPos
ScrollPos_Bottom -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
totalLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
height)
      ScrollPos
ScrollPos_Top -> Int
0
      ScrollPos_Line Int
n -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n
    translateMouseEvents :: Behavior t Int -> Event t VtyEvent -> Event t VtyEvent
translateMouseEvents Behavior t Int
translation Event t VtyEvent
vtyEvent =
          let e :: Event t (Int, VtyEvent)
e = Behavior t Int -> Event t VtyEvent -> Event t (Int, VtyEvent)
forall k (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach Behavior t Int
translation Event t VtyEvent
vtyEvent
          in Event t (Int, VtyEvent)
-> ((Int, VtyEvent) -> VtyEvent) -> Event t VtyEvent
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (Int, VtyEvent)
e (((Int, VtyEvent) -> VtyEvent) -> Event t VtyEvent)
-> ((Int, VtyEvent) -> VtyEvent) -> Event t VtyEvent
forall a b. (a -> b) -> a -> b
$ \case
                (Int
dy, V.EvMouseDown Int
x Int
y Button
btn [Modifier]
mods) -> Int -> Int -> Button -> [Modifier] -> VtyEvent
V.EvMouseDown Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dy) Button
btn [Modifier]
mods
                (Int
dy, V.EvMouseUp Int
x Int
y Maybe Button
btn) -> Int -> Int -> Maybe Button -> VtyEvent
V.EvMouseUp Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dy) Maybe Button
btn
                (Int
_, VtyEvent
otherEvent) -> VtyEvent
otherEvent

-- | Modify the scroll position by the given number of lines
scrollByLines :: ScrollPos -> Int -> Int -> Int -> ScrollPos
scrollByLines :: ScrollPos -> Int -> Int -> Int -> ScrollPos
scrollByLines ScrollPos
sp Int
totalLines Int
height Int
delta =
  let newPos :: Int
newPos = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (ScrollPos -> Int
start ScrollPos
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta)) Int
totalLines
  in Int -> Int -> Int -> ScrollPos
scrollToLine Int
totalLines Int
height Int
newPos
  where
    start :: ScrollPos -> Int
start ScrollPos
ScrollPos_Top = Int
0
    start ScrollPos
ScrollPos_Bottom = Int
totalLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
height
    start (ScrollPos_Line Int
n) = Int
n

-- | Scroll to a particular line
scrollToLine :: Int -> Int -> Int -> ScrollPos
scrollToLine :: Int -> Int -> Int -> ScrollPos
scrollToLine Int
totalLines Int
height Int
newPos = if
  | Int
totalLines Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
height -> ScrollPos
ScrollPos_Top
  | Int
newPos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> ScrollPos
ScrollPos_Top
  | Int
newPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
height Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
totalLines -> ScrollPos
ScrollPos_Bottom
  | Bool
otherwise -> Int -> ScrollPos
ScrollPos_Line Int
newPos