git.iko.soy/reflex-vty
on develop help sign in
Add PageUp and PageDown
commitd37db9a5c401eff7a3359c84f7e65d5d0df51a20 authorAli Abrar <aliabrar@gmail.com> dateMon 5 Nov 2018, 01:46 (8 years ago) parent2f08cc7
2 files changed+26−6
compare with develop
unifiedsplit
src/Data/Text/Zipper.hs+12 src/Reflex/Vty/Widget/Input/Text.hs+14−6
src/Data/Text/Zipper.hs+12
@@ -81,6 +81,18 @@ down z@(TextZipper lb b a la) = case la of
8181 let (b', a') = T.splitAt (T.length b) l
8282 in TextZipper ((b <> a) : lb) b' a' ls
8383
84+-- | Move the cursor up by the given number of lines
85+pageUp :: Int -> TextZipper -> TextZipper
86+pageUp pageSize z = if pageSize <= 0
87+ then z
88+ else pageUp (pageSize - 1) $ up z
89+
90+-- | Move the cursor down by the given number of lines
91+pageDown :: Int -> TextZipper -> TextZipper
92+pageDown pageSize z = if pageSize <= 0
93+ then z
94+ else pageDown (pageSize - 1) $ down z
95+
8496-- | Move the cursor to the beginning of the current logical line
8597home :: TextZipper -> TextZipper
8698home (TextZipper lb b a la) = TextZipper lb "" (b <> a) la
src/Reflex/Vty/Widget/Input/Text.hs+14−6
@@ -39,15 +39,15 @@ textInput
3939textInput cfg = do
4040 i <- input
4141 f <- focus
42+ dh <- displayHeight
43+ dw <- displayWidth
4244 rec v <- foldDyn ($) (_textInputConfig_initialValue cfg) $ mergeWith (.)
43− [ updateTextZipper (_textInputConfig_tabWidth cfg) <$> i
45+ [ uncurry (updateTextZipper (_textInputConfig_tabWidth cfg)) <$> attach (current dh) i
4446 , _textInputConfig_modify cfg
4547 , let displayInfo = (,) <$> rows <*> scrollTop
4648 in ffor (attach (current displayInfo) click) $ \((dl, st), MouseDown _ (mx, my) _) ->
4749 goToDisplayLinePosition mx (st + my) dl
4850 ]
49− dw <- displayWidth
50− dh <- displayHeight
5151 click <- mouseDown V.BLeft
5252 let cursorAttrs = ffor f $ \x -> if x then cursorAttributes else V.defAttr
5353 let rows = (\w s c -> displayLines w V.defAttr c s) <$> dw <*> v <*> cursorAttrs
@@ -96,10 +96,16 @@ spanToImage :: Span V.Attr -> V.Image
9696spanToImage (Span attrs t) = V.text' attrs t
9797
9898-- | Default vty event handler for text inputs
99−updateTextZipper :: Int -> V.Event -> TextZipper -> TextZipper
100−updateTextZipper tabWidth ev = case ev of
101− -- Regular characters
99+updateTextZipper
100+ :: Int -- ^ Tab width
101+ -> Int -- ^ Page size
102+ -> V.Event -- ^ The vty event to handle
103+ -> TextZipper -- ^ The zipper to modify
104+ -> TextZipper
105+updateTextZipper tabWidth pageSize ev = case ev of
106+ -- Special characters
102107 V.EvKey (V.KChar '\t') [] -> tab tabWidth
108+ -- Regular characters
103109 V.EvKey (V.KChar k) [] -> insertChar k
104110 -- Deletion buttons
105111 V.EvKey V.KBS [] -> deleteLeft
@@ -114,4 +120,6 @@ updateTextZipper tabWidth ev = case ev of
114120 V.EvKey V.KDown [] -> down
115121 V.EvKey V.KHome [] -> home
116122 V.EvKey V.KEnd [] -> end
123+ V.EvKey V.KPageUp [] -> pageUp pageSize
124+ V.EvKey V.KPageDown [] -> pageDown pageSize
117125 _ -> id