This commit is contained in:
nek0 2019-10-10 11:06:58 +02:00
parent 1f574a3e40
commit c0af4e7dd8
2 changed files with 41 additions and 22 deletions

View File

@ -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

View File

@ -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
)
(liftA2
(\mPos bPos -> mPos - bPos)
mousePosBehaviour
ballPosBehaviour
)
-- print acc
) $ apply
(liftA2
(\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