drag ball around per click

src/Main.hs

@@ -19,6 +19,7 @@ import Control.Monad
 import Control.Monad.Trans
 
 import Reactive.Banana.Frameworks as RBF
+import Reactive.Banana.Combinators as RBC
 
 import Data.Maybe (fromMaybe)
 
@@ -112,8 +113,8 @@ main = do
               (V4 0 0 0 1)
           transMatrix (V2 ax ay) =
             V4
-              (V4 1 0 0 ax)
-              (V4 0 1 0 (-ay))
+              (V4 1 0 0 (ax - 1))
+              (V4 0 1 0 ((-ay) + 1))
               (V4 0 0 1 1)
               (V4 0 0 0 1)
       hexFragmentStream <- rasterize
@@ -177,14 +178,14 @@ main = do
     -- SDL.showWindow window
     listen@(_, fire) <- liftIO $ newAddHandler
     uniVar <- liftIO $ newTMVarIO 0 :: ContextT FRPBallCtx os IO (TMVar Float)
-    transUniVar <- liftIO $ newTMVarIO (V2 0 0) ::
+    transUniVar <- liftIO $ newTMVarIO (V2 1 1) ::
       ContextT FRPBallCtx os IO (TMVar (V2 Float))
     network <- liftIO $ compile (networkDescription listen uniVar transUniVar)
     forever $ do
       mrot <- liftIO $ atomically $ tryReadTMVar uniVar
       writeBuffer uniformBuffer 0 [fromMaybe 0 mrot]
       mtrans <- liftIO $ atomically $ tryReadTMVar transUniVar
-      writeBuffer positionUniformBuffer 0 [fromMaybe (V2 0 0) mtrans]
+      writeBuffer positionUniformBuffer 0 [fromMaybe (V2 1 1) mtrans]
       liftIO $ actuate network
       render $ do
         clearWindowColor win (V3 0 0 0)
@@ -206,42 +207,41 @@ networkDescription
   -> MomentIO ()
 networkDescription (listenerah, _) rotvar transvar = mdo
   (mouseah, mousefire) <- liftIO $ newAddHandler
-  (clickah, clickfire) <- liftIO $ newAddHandler
+  (passah, passfire) <- liftIO $ newAddHandler
+  (clickholdah, clickholdfire) <- liftIO $ newAddHandler
   blistener <- fromChanges [] =<< registerListenerEvent
     listenerah
     mousefire
-    clickfire
+    clickholdfire
   _ <- changes blistener
-  emouse <- fromAddHandler =<< registerMouseEvent mouseah
-  eclick <- fromAddHandler =<< registerClickEvent clickah
+  emouse <- fromAddHandler =<< registerMouseEvent passfire mouseah
+  epass <- fromAddHandler =<< registerPassEvent passah
+  eClickHold <- fromAddHandler =<< registerClickHoldEvent clickholdah
+  clickHoldBehaviour <- RBC.stepper False eClickHold
+  mouseMoveBehaviour <- RBC.stepper (V2 1 1) epass
   let moveReaction = fmap (\x -> do
         let input = (\(V2 xx _) ->
               fromIntegral xx / 100 :: Float) $ SDL.mouseMotionEventRelMotion $
-                (\(SDL.MouseMotionEvent dat) -> dat) $ SDL.eventPayload $ head x
+                (\(SDL.MouseMotionEvent dat) -> dat) $ SDL.eventPayload x
         past <- fromMaybe 0 <$> (atomically $ tryReadTMVar rotvar)
         void $ atomically $ swapTMVar rotvar (past + input)
         print input)
         emouse
       clickReaction = fmap (\x -> do
-        let input =
-              (\vect -> fmap (\foo -> foo - 1) (vect / V2 400 300)) $
-              (\(SDL.MouseButtonEvent (SDL.MouseButtonEventData _ _ _ _ _ (SDL.P ps))) ->
-                fmap fromIntegral ps :: V2 Float) $
-              SDL.eventPayload $
-              head x
+        let input = (fmap (\foo -> foo - 1) x) / V2 400 300
         void $ atomically $ swapTMVar transvar input
         print input)
-        eclick
+        mouseMoveBehaviour
   reactimate moveReaction
-  reactimate clickReaction
+  reactimate' =<< (whenE clickHoldBehaviour <$> changes clickReaction)
 
 registerListenerEvent
   :: (MonadIO m)
   => AddHandler ([SDL.Event])
-  -> ([SDL.Event] -> IO ())
-  -> ([SDL.Event] -> IO ())
+  ->(SDL.Event -> IO ())
+  -> (Bool -> IO ())
   -> m (AddHandler [SDL.Event])
-registerListenerEvent listenerah mousefire clickfire = do
+registerListenerEvent listenerah mousefire clickholdfire = do
   void $ liftIO $
     register listenerah $ \evs -> do
       let filteredMoveEvents = filter (\ev -> case SDL.eventPayload ev of
@@ -249,31 +249,43 @@ registerListenerEvent listenerah mousefire clickfire = do
             _ -> False
             ) evs
           filteredClickEvents = filter (\ev -> case SDL.eventPayload ev of
-            SDL.MouseButtonEvent
-              (SDL.MouseButtonEventData _ SDL.Pressed _ SDL.ButtonLeft 1 _) ->
+            SDL.MouseMotionEvent
+              (SDL.MouseMotionEventData _ _ [SDL.ButtonLeft] _ _) ->
                 True
             _ -> False
             ) evs
       if null filteredMoveEvents
       then return ()
-      else mousefire filteredMoveEvents
+      else mousefire (head $ reverse $ filteredMoveEvents)
       if null filteredClickEvents
-      then return ()
-      else clickfire filteredClickEvents
+      then clickholdfire False
+      else clickholdfire True
   return listenerah
 
 registerMouseEvent
   :: MonadIO m
-  => AddHandler [SDL.Event]
-  -> m (AddHandler [SDL.Event])
-registerMouseEvent mouseah = do
-  void $ liftIO $ register mouseah $ \_ -> return ()
+  => (V2 Float -> IO ())
+  -> AddHandler SDL.Event
+  -> m (AddHandler SDL.Event)
+registerMouseEvent passFire mouseah = do
+  void $ liftIO $ register mouseah $
+    \(SDL.Event _ (SDL.MouseMotionEvent dat)) ->
+      passFire (fmap fromIntegral $ (\(SDL.P a) -> a) $
+        SDL.mouseMotionEventPos dat)
   return mouseah
 
-registerClickEvent
+registerPassEvent
   :: MonadIO m
-  => AddHandler [SDL.Event]
-  -> m (AddHandler [SDL.Event])
-registerClickEvent clickah = do
-  void $ liftIO $ register clickah $ \_ -> return ()
-  return clickah
+  => AddHandler (V2 Float)
+  -> m (AddHandler (V2 Float))
+registerPassEvent passah = do
+  void $ liftIO $ register passah $ \_ -> return ()
+  return passah
+
+registerClickHoldEvent
+  :: MonadIO m
+  => AddHandler Bool
+  -> m (AddHandler Bool)
+registerClickHoldEvent clickholdah = do
+  void $ liftIO $ register clickholdah $ \_ -> return ()
+  return clickholdah