other kind of dragging

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