How to make a player jump (set it's y velocity)?

Question

Given the following:

integralB :: Num a => Behavior t a -> Behavior t a -- definite integral of a behaviour
eJump :: Event t a -- tells the player to jump
bYAccel = pure 4000 -- y acceleration
bYVel = integralB bYAccel -- y velocity
bY = integralB bYVel -- y position

How do I make the player jump (probably by setting its y velocity) when a jump event arrives?

Answer 1

You'll need to be able to apply an impulse to the Y velocity for the jump. From your own answer, you've come up with a way to do so by summing all the impulses from the jumps and adding them to the integral of the acceleration.

Your acceleration is also constant. If you don't want the player falling constantly, you'd need something like:

bYAccel = (ifB airborne) 4000 0
airborne = fmap (>0) bY

ifB :: Behavior t Bool -> a -> a -> Behavior t a
ifB boolBehavior yes no = fmap (\bool -> if bool then yes else no) boolBehavior

One possible reason the height of your jumps varies is you aren't resetting the velocity when the player lands. If you have rules that hold the player above some position (like the floor), and are somehow stopping acceleration when the player hits the floor, you will also need to set the velocity to 0 if it is in the direction of the floor. (If you also set it to 0 when it's not in the direction of the floor, the player can never get the velocity to leave the ground.)

The reason this would cause erratic jumping heights is that the final velocity when the player lands will be close to the impulse you applied for them to take off. Using your numbers, if a jump started with a velocity of -5000, and ended with a velocity of 4800, the next jump will add an impulse of -5000, taking the jump to a starting velocity of only -200. That might have an ending velocity of 300, so the next jump will be an almost full -4700 jump.

Here's a complete working example. It uses the gloss library for input and display. The gameDefinition corresponds to the components introduced in your question. integrateDeltas is equivalent to your integralB, but produces events that are impulses, which are easy to generate in a clocked framework like gloss, and easy to use mixed with other events that cause impulses, like jumping.

{-# LANGUAGE RankNTypes #-}
module Main where

import Reactive.Banana
import Reactive.Banana.Frameworks.AddHandler
import Reactive.Banana.Frameworks

import Data.IORef
import qualified Graphics.Gloss.Interface.IO.Game as Gloss

gameDefinition :: GlossGameEvents t -> Behavior t Gloss.Picture
gameDefinition events = renderBehavior
    where        
        bY = accumB 0 (fmap sumIfPositive yShifts)
        yShifts = integrateDeltas bYVel

        bYVel = accumB 0 yVelChanges
        yVelChanges = apply ((ifB airborne) (+) sumIfPositive) yVelShifts
        yVelShifts = union (integrateDeltas bYAccel) (fmap (const 3) eJump)

        bYAccel = (ifB airborne) (-10) 0
        airborne = fmap (>0) bY        

        eJump = filterE isKeyEvent (event events)        

        integrateDeltas = integrateDeltaByTimeStep (timeStep events)

        renderBehavior = (liftA3 render) bY bYVel bYAccel 
        render y yVel yAccel =
            Gloss.Pictures [
                Gloss.Translate 0 (20+y*100) (Gloss.Circle 20),
                Gloss.Translate (-50) (-20) (readableText (show y)),
                Gloss.Translate (-50) (-40) (readableText (show yVel)),
                Gloss.Translate (-50) (-60) (readableText (show yAccel))
            ]
        readableText = (Gloss.Scale 0.1 0.1) . Gloss.Text


-- Utilities
sumIfPositive :: (Ord n, Num n) => n -> n -> n
sumIfPositive x y = max 0 (x + y)

ifB :: Behavior t Bool -> a -> a -> Behavior t a
ifB boolBehavior yes no = fmap (\bool -> if bool then yes else no) boolBehavior

integrateDeltaByTimeStep :: (Num n) => Event t n -> Behavior t n -> Event t n
integrateDeltaByTimeStep timeStep derivative = apply (fmap (*) derivative) timeStep

isKeyEvent :: Gloss.Event -> Bool
isKeyEvent (Gloss.EventKey _ _ _ _) = True
isKeyEvent _ = False

-- Main loop to run it

main :: IO ()
main = do   
    reactiveGame (Gloss.InWindow "Reactive Game Example" (400, 400) (10, 10))
        Gloss.white
        100
        gameDefinition

-- Reactive gloss game
data GlossGameEvents t = GlossGameEvents {
    event :: Event t Gloss.Event,
    timeStep :: Event t Float
}

makeReactiveGameNetwork :: Frameworks t
                        => IORef Gloss.Picture
                        -> AddHandler Gloss.Event
                        -> AddHandler Float
                        -> (forall t. GlossGameEvents t -> Behavior t Gloss.Picture)
                        -> Moment t ()
makeReactiveGameNetwork latestFrame glossEvent glossTime game = do
    eventEvent <- fromAddHandler glossEvent
    timeStepEvent <- fromAddHandler glossTime
    let
        events = GlossGameEvents { event = eventEvent, timeStep = timeStepEvent }
        pictureBehavior = game events 
    pictureChanges <- changes pictureBehavior
    reactimate (fmap (writeIORef latestFrame) pictureChanges)       

reactiveGame :: Gloss.Display
             -> Gloss.Color
             -> Int
             -> (forall t. GlossGameEvents t -> Behavior t Gloss.Picture)
             -> IO ()
reactiveGame display color steps game = do
    latestFrame <- newIORef Gloss.Blank
    (glossEvent, fireGlossEvent) <- newAddHandler
    (glossTime, addGlossTime) <- newAddHandler
    network <- compile (makeReactiveGameNetwork latestFrame glossEvent glossTime game)
    actuate network
    Gloss.playIO
        display
        color
        steps
        ()
        (\world -> readIORef latestFrame)
        (\event world -> fireGlossEvent event)
        (\time world -> addGlossTime time)

In this example, bY checks for collision with a floor at 0 by accumulating the impulses, but constraining the accumulated value to be above 0.

The velocity, bYVel, accumulates all impulses while airborne, but only those impulses that are directed away from the floor while not airborne. If you change

yVelChanges = apply ((ifB airborne) (+) sumIfPositive) yVelShifts

to

yVelChanges = fmap (+) yVelShifts

it recreates the erratic jumping bug.

The acceleration, bYAccel, is only present while airborne.

I used a coordinate system with a +Y axis in the up direction (opposite the acceleration).

The code at the end is a small framework to hook reactive-banana up to gloss.

Answer 2

Solved it! I feel a little silly for not thinking of this earlier, but I just increment a counter every eJump and add that counter on to bYVel.

bJumpVel = sumB $ (-5000) <$ eJump
bYVel = (+) <$> bJumpVel <*> integralB bYAccel

-- gives the sum of the events
sumB :: Num a => Event t a -> Behavior t a
sumB e = accumB 0 $ (+) <$> e

For some reason the height of the jump always varies quite a bit, but that's probably an unrelated problem to do with my timing of things.

I won't mark this question as answered yet in case someone wants to share a better one.