git.iko.soy/reflex-vty
on develop help sign in
Zipper: add rightN, leftN. Mouse Events: Fix drag, add MouseDown, MouseUp
commit3bc844e6e0b5d62c8bf5d57daeadd26ff7ccf939 authorAli Abrar <aliabrar@gmail.com> dateSun 4 Nov 2018, 15:17 (8 years ago) parentb31f862
2 files changed+50−15
compare with develop
unifiedsplit
src/Data/Text/Zipper.hs+24−10 src/Reflex/Vty/Widget.hs+26−5
src/Data/Text/Zipper.hs+24−10
@@ -37,19 +37,33 @@ data TextZipper = TextZipper
3737
3838-- | Move the cursor left one character, if possible
3939left :: TextZipper -> TextZipper
40−left z@(TextZipper lb b a la) = case T.unsnoc b of
41− Nothing -> case lb of
42− [] -> z
43− (l:ls) -> TextZipper ls l "" (a : la)
44− Just (b', c) -> TextZipper lb b' (T.cons c a) la
40+left = leftN 1
41+
42+-- | Move the cursor left by the given number of characters, or, if the document
43+-- isn't long enough, to the beginning of the document
44+leftN :: Int -> TextZipper -> TextZipper
45+leftN n z@(TextZipper lb b a la) =
46+ if T.length b >= n
47+ then
48+ let n' = T.length b - n
49+ in TextZipper lb (T.take n' b) (T.drop n' b <> a) la
50+ else case lb of
51+ [] -> home z
52+ (l:ls) -> leftN (n - T.length b - 1) $ TextZipper ls l "" ((b <> a) : la)
4553
4654-- | Move the cursor right one character, if possible
4755right :: TextZipper -> TextZipper
48−right z@(TextZipper lb b a la) = case T.uncons a of
49− Nothing -> case la of
50− [] -> z
51− (l:ls) -> TextZipper (b : lb) "" l ls
52− Just (c, a') -> TextZipper lb (T.snoc b c) a' la
56+right = rightN 1
57+
58+-- | Move the character right by the given number of characters, or, if the document
59+-- isn't long enough, to the end of the document
60+rightN :: Int -> TextZipper -> TextZipper
61+rightN n z@(TextZipper lb b a la) =
62+ if T.length a >= n
63+ then TextZipper lb (b <> T.take n a) (T.drop n a) la
64+ else case la of
65+ [] -> end z
66+ (l:ls) -> rightN (n - T.length a - 1) $ TextZipper ((b <> a) : lb) "" l ls
5367
5468-- | Move the cursor up one logical line, if possible
5569up :: TextZipper -> TextZipper
src/Reflex/Vty/Widget.hs+26−5
@@ -27,7 +27,7 @@ module Reflex.Vty.Widget
2727 , Region(..)
2828 , regionSize
2929 , regionBlankImage
30− , Drag (..)
30+ , Drag(..)
3131 , drag
3232 , mouseDown
3333 , pane
@@ -278,7 +278,11 @@ drag
278278drag btn = do
279279 inp <- input
280280 let f :: Maybe Drag -> V.Event -> Maybe Drag
281− f Nothing = const Nothing
281+ f Nothing = \case
282+ V.EvMouseDown x y btn' mods
283+ | btn == btn' -> Just $ Drag (x,y) (x,y) btn' mods False
284+ | otherwise -> Nothing
285+ _ -> Nothing
282286 f (Just (Drag from _ _ mods end)) = \case
283287 V.EvMouseDown x y btn' mods'
284288 | end -> Just $ Drag (x,y) (x,y) btn' mods' False
@@ -301,13 +305,30 @@ drag btn = do
301305mouseDown
302306 :: (Reflex t, Monad m)
303307 => V.Button
304− -> VtyWidget t m (Event t VtyEvent)
308+ -> VtyWidget t m (Event t MouseDown)
305309mouseDown btn = do
306310 i <- input
307− return $ fforMaybe i $ \x -> case x of
308− V.EvMouseDown _ _ btn' _ -> if btn == btn' then Just x else Nothing
311+ return $ fforMaybe i $ \case
312+ V.EvMouseDown x y btn' mods -> if btn == btn'
313+ then Just $ MouseDown btn' (x, y) mods
314+ else Nothing
309315 _ -> Nothing
310316
317+-- | Information about a mouse down event
318+data MouseDown = MouseDown
319+ { _mouseDown_button :: V.Button
320+ , _mouseDown_coordinates :: (Int, Int)
321+ , _mouseDown_modifiers :: [V.Modifier]
322+ }
323+ deriving (Eq, Ord, Show)
324+
325+-- | Information about a mouse up event
326+data MouseUp = MouseUp
327+ { _mouseUp_button :: Maybe V.Button
328+ , _mouseUp_coordinates :: (Int, Int)
329+ }
330+ deriving (Eq, Ord, Show)
331+
311332-- | A plain split of the available space into vertically stacked panes.
312333-- No visual separator is built in here.
313334splitV :: (Reflex t, Monad m)