on develop help sign in
Zipper: add rightN, leftN. Mouse Events: Fix drag, add MouseDown, MouseUp
3bc844eAli Abrar
src/Data/Text/Zipper.hs+24−10
@@ -37,19 +37,33 @@ data TextZipper = TextZipper
37
37
38-- | Move the cursor left one character, if possible
38-- | Move the cursor left one character, if possible
39left :: TextZipper -> TextZipper
39left :: TextZipper -> TextZipper
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
40−left z@(TextZipper lb b a la) = case T.unsnoc b of
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
41− Nothing -> case lb of
50+ else case lb of
42− [] -> z
51+ [] -> home z
43− (l:ls) -> TextZipper ls l "" (a : la)
44− Just (b', c) -> TextZipper lb b' (T.cons c a) la
52+ (l:ls) -> leftN (n - T.length b - 1) $ TextZipper ls l "" ((b <> a) : la)
45
53
46-- | Move the cursor right one character, if possible
54-- | Move the cursor right one character, if possible
47right :: TextZipper -> TextZipper
55right :: TextZipper -> TextZipper
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
48−right z@(TextZipper lb b a la) = case T.uncons a of
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
49− Nothing -> case la of
64+ else case la of
50− [] -> z
65+ [] -> end z
51− (l:ls) -> TextZipper (b : lb) "" l ls
66+ (l:ls) -> rightN (n - T.length a - 1) $ TextZipper ((b <> a) : lb) "" l ls
52− Just (c, a') -> TextZipper lb (T.snoc b c) a' la
53
67
54-- | Move the cursor up one logical line, if possible
68-- | Move the cursor up one logical line, if possible
55up :: TextZipper -> TextZipper
69up :: TextZipper -> TextZipper
src/Reflex/Vty/Widget.hs+26−5
@@ -27,7 +27,7 @@ module Reflex.Vty.Widget
27 , Region(..)
27 , Region(..)
28 , regionSize
28 , regionSize
29 , regionBlankImage
29 , regionBlankImage
30− , Drag (..)
30+ , Drag(..)
31 , drag
31 , drag
32 , mouseDown
32 , mouseDown
33 , pane
33 , pane
@@ -278,7 +278,11 @@ drag
278drag btn = do
278drag btn = do
279 inp <- input
279 inp <- input
280 let f :: Maybe Drag -> V.Event -> Maybe Drag
280 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
282 f (Just (Drag from _ _ mods end)) = \case
286 f (Just (Drag from _ _ mods end)) = \case
283 V.EvMouseDown x y btn' mods'
287 V.EvMouseDown x y btn' mods'
284 | end -> Just $ Drag (x,y) (x,y) btn' mods' False
288 | end -> Just $ Drag (x,y) (x,y) btn' mods' False
@@ -301,13 +305,30 @@ drag btn = do
301mouseDown
305mouseDown
302 :: (Reflex t, Monad m)
306 :: (Reflex t, Monad m)
303 => V.Button
307 => V.Button
304− -> VtyWidget t m (Event t VtyEvent)
308+ -> VtyWidget t m (Event t MouseDown)
305mouseDown btn = do
309mouseDown btn = do
306 i <- input
310 i <- input
307− return $ fforMaybe i $ \x -> case x of
311+ return $ fforMaybe i $ \case
308− V.EvMouseDown _ _ btn' _ -> if btn == btn' then Just x else Nothing
312+ V.EvMouseDown x y btn' mods -> if btn == btn'
313+ then Just $ MouseDown btn' (x, y) mods
314+ else Nothing
309 _ -> Nothing
315 _ -> Nothing
310
316
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+
311-- | A plain split of the available space into vertically stacked panes.
332-- | A plain split of the available space into vertically stacked panes.
312-- No visual separator is built in here.
333-- No visual separator is built in here.
313splitV :: (Reflex t, Monad m)
334splitV :: (Reflex t, Monad m)