From c060a7f74085333076692e1dbd680a68e8c4b4e8 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 29 Sep 2019 20:02:43 +0200 Subject: [PATCH] other kind of dragging --- src/Main.hs | 59 ++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 43 insertions(+), 16 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 7da50c9..8ac3cfc 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -216,8 +216,8 @@ networkDescription (listenerah, _) rotvar transvar = mdo _ <- changes blistener emouse <- fromAddHandler =<< registerMouseEvent passfire mouseah epass <- fromAddHandler =<< registerPassEvent passah - eClickHold <- fromAddHandler =<< registerClickHoldEvent clickholdah - clickHoldBehaviour <- RBC.stepper False eClickHold + eClickHold <- fromAddHandler =<< registerClickHoldEvent passfire clickholdah + clickHoldBehaviour <- RBC.stepper True eClickHold mouseMoveBehaviour <- RBC.stepper (V2 1 1) epass let moveReaction = fmap (\x -> do let input = (\(V2 xx _) -> @@ -230,10 +230,15 @@ networkDescription (listenerah, _) rotvar transvar = mdo clickReaction = fmap (\x -> do let input = (fmap (\foo -> foo - 1) x) / V2 400 300 void $ atomically $ swapTMVar transvar input - print input) + -- print input) + ) mouseMoveBehaviour + printReaction = fmap print blistener + ecPrint <- changes printReaction + reactimate' ecPrint reactimate moveReaction - reactimate' =<< (whenE clickHoldBehaviour <$> changes clickReaction) + ecReaction <- changes clickReaction + reactimate' $ whenE clickHoldBehaviour ecReaction registerListenerEvent :: (MonadIO m) @@ -245,21 +250,32 @@ registerListenerEvent listenerah mousefire clickholdfire = do void $ liftIO $ register listenerah $ \evs -> do let filteredMoveEvents = filter (\ev -> case SDL.eventPayload ev of - SDL.MouseMotionEvent _ -> True + SDL.MouseMotionEvent + (SDL.MouseMotionEventData _ _ _ _ _) -> + True _ -> False ) evs filteredClickEvents = filter (\ev -> case SDL.eventPayload ev of - SDL.MouseMotionEvent - (SDL.MouseMotionEventData _ _ [SDL.ButtonLeft] _ _) -> + -- SDL.MouseMotionEvent + -- (SDL.MouseMotionEventData _ _ [SDL.ButtonLeft] _ _) -> + -- True + SDL.MouseButtonEvent + (SDL.MouseButtonEventData _ _ _ SDL.ButtonLeft _ _) -> True _ -> False ) evs if null filteredMoveEvents then return () - else mousefire (head $ reverse $ filteredMoveEvents) + else mousefire (head $ filteredMoveEvents) if null filteredClickEvents - then clickholdfire False - else clickholdfire True + then + return () + -- clickholdfire False + else + clickholdfire + (any (\x -> SDL.Pressed == SDL.mouseButtonEventMotion + ((\(SDL.MouseButtonEvent dat) -> dat) $ + SDL.eventPayload x)) filteredClickEvents) return listenerah registerMouseEvent @@ -268,11 +284,16 @@ registerMouseEvent -> AddHandler SDL.Event -> m (AddHandler SDL.Event) registerMouseEvent passFire mouseah = do - void $ liftIO $ register mouseah $ - \(SDL.Event _ (SDL.MouseMotionEvent dat)) -> + void $ liftIO $ register mouseah $ digestEvent + return mouseah + where + digestEvent (SDL.Event _ (SDL.MouseMotionEvent dat)) = passFire (fmap fromIntegral $ (\(SDL.P a) -> a) $ SDL.mouseMotionEventPos dat) - return mouseah + digestEvent (SDL.Event _ (SDL.MouseButtonEvent dat)) = + passFire (fmap fromIntegral $ (\(SDL.P a) -> a) $ + SDL.mouseButtonEventPos dat) + digestEvent _ = return () registerPassEvent :: MonadIO m @@ -284,8 +305,14 @@ registerPassEvent passah = do registerClickHoldEvent :: MonadIO m - => AddHandler Bool + => (V2 Float -> IO ()) + -> AddHandler Bool -> m (AddHandler Bool) -registerClickHoldEvent clickholdah = do - void $ liftIO $ register clickholdah $ \_ -> return () +registerClickHoldEvent passfire clickholdah = do + void $ liftIO $ register clickholdah $ \x -> if x + then do + SDL.P vect <- SDL.getAbsoluteMouseLocation + passfire $ fmap fromIntegral vect + else + return () return clickholdah