yay!

frpball.cabal

@@ -20,10 +20,10 @@ executable frpball
   other-modules:       Types
   default-extensions:  OverloadedStrings
   -- other-extensions:
-  build-depends:       base ^>=4.12.0.0
+  build-depends:       base >=4.12.0.0 && <5
                      , reactive-banana
-                     , sdl2 ^>=2.5.0.0
-                     , GPipe ^>=2.2.4
+                     , sdl2 >=2.5.0.0 && <2.6
+                     , GPipe >=2.2.4
                      , linear
                      , gl
                      , text

src/Main.hs

@@ -204,7 +204,7 @@ main = do
         oldTime <- fromMaybe (currentTime - 0.1) <$>
           (atomically $ tryReadTMVar deltaVar)
         eventFire evs
-        deltaFire (currentTime - oldTime)
+        deltaFire (5 * (currentTime - oldTime))
         atomically $ swapTMVar deltaVar currentTime
 
 networkDescription
@@ -271,16 +271,21 @@ networkDescription (listenerAH, _) (deltaAH, _) rotvar transvar = mdo
     return deltaAH
     )
 
-  let mouseClickPos :: Event (V2 Float) = whenE mouseClickBehaviour mousePos
+  let mouseClickPos :: Event (Maybe (V2 Float)) = apply
+        (pure (\click -> (\pos -> if click then Just pos else Nothing)
+          ) <*>
+          mouseClickBehaviour
+          )
+        mousePos
 
   ballPosBehaviour <- stepper (V2 400 300) ballPos
   ballVelBehaviour <- stepper (V2 0 0) ballVel
   ballAccBehaviour <- stepper (V2 0 0) ballAcc
-  mousePosBehaviour <- stepper (V2 0 0) mousePos
+  mousePosBehaviour <- stepper (V2 400 300) mousePos
   mouseMotionBehaviour <- stepper (V2 0 0) mouseMotion
   mouseClickBehaviour <- stepper False mouseClick
   mouseReleaseBehaviour <- stepper True mouseRelease
-  mouseClickPosBehaviour <- stepper (V2 0 0) mouseClickPos
+  mouseClickPosBehaviour <- stepper Nothing mouseClickPos
 
   ball :: V2 Float <- valueB ballPosBehaviour
 
@@ -297,37 +302,51 @@ networkDescription (listenerAH, _) (deltaAH, _) rotvar transvar = mdo
         -- print input
         )
         ballPosBehaviour
-      ballAccReaction = fmap (\acc ->
+      ballAccReaction = fmap (\acc -> do
         ballAccFire acc
-        )
+        -- print acc
+        ) $ apply
           (liftA2
-          (\mPos bPos -> mPos - bPos)
-          mousePosBehaviour
+            (\mmPos bPos -> (\delta -> case mmPos of
+              Just mPos -> fmap (* 0.99) (mPos - bPos)
+              Nothing -> V2 0 0
+              ))
+            mouseClickPosBehaviour
             ballPosBehaviour
             )
+          delta
       ballVelReaction = fmap (\vel ->
         ballVelFire vel
-        ) $
-        apply
-          (pure (\acc -> (\dtime -> fmap (/ dtime) acc)) <*> ballAccBehaviour)
+        ) $ apply
+          (liftA2
+            (\acc vel -> (\dtime -> fmap (* dtime) acc + vel))
+            ballAccBehaviour
+            ballVelBehaviour
+            )
           delta
       ballMoveReaction = fmap (\x -> do
         ballPosFire x
-        print x
+        -- print x
         ) $ apply
-          (liftA2
-            (\bPos bVel ->
-              (\dtime -> bPos + (fmap (dtime *) bVel))
+          (liftA3
+            (\bPos bVel bAcc ->
+              (\dtime -> (fmap (* (dtime * 0.5)) bAcc) +
+                (fmap (* dtime) bVel) +
+                bPos
+                )
               )
               ballPosBehaviour
               ballVelBehaviour
+              ballAccBehaviour
             )
           delta
 
   reactimate' =<< changes triangleReaction
   reactimate' =<< changes ballReaction
   reactimate ballVelReaction
-  reactimate $ whenE mouseClickBehaviour ballMoveReaction
+  reactimate ballAccReaction
+  -- reactimate $ whenE mouseClickBehaviour ballMoveReaction
+  reactimate ballMoveReaction
   -- reactimate' =<< changes clickReaction
   -- reactimate ballReaction