Как заставить игрока прыгать (установить его скорость по оси y)?

Вы должны быть в состоянии применить импульс к скорости Y для прыжка. Из вашего собственного ответа вы придумали способ сделать это, суммируя все импульсы от прыжков и добавляя их к интегралу ускорения.

Ваше ускорение также постоянно. Если вы не хотите, чтобы игрок постоянно падал, вам понадобится что-то вроде:

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

Одна из возможных причин, по которой высота ваших прыжков меняется, заключается в том, что вы не сбрасываете скорость, когда игрок приземляется. Если у вас есть правила, которые удерживают игрока над какой-либо точкой (например, над полом) и каким-то образом останавливают ускорение, когда игрок касается пола, вам также нужно установить скорость на 0, если она направлена ​​в сторону пола. (Если вы также установите его на 0, когда он не в направлении пола, игрок никогда не сможет получить скорость, чтобы оторваться от земли.)

Причина, по которой это может вызвать неравномерную высоту прыжка, заключается в том, что конечная скорость, когда игрок приземлится, будет близка к импульсу, который вы приложили для его взлета. Используя ваши числа, если прыжок начался со скоростью -5000 и закончился со скоростью 4800, следующий прыжок добавит импульс -5000, доводя прыжок до начальной скорости только -200. Это может иметь конечную скорость 300, поэтому следующий прыжок будет почти полным прыжком -4700.

Вот полный рабочий пример. Он использует библиотеку глянца для ввода и отображения. gameDefinition соответствует компонентам, представленным в вашем вопросе. integrateDeltas эквивалентен вашему integralB, но создает события, которые являются импульсами, которые легко генерировать в синхронизированной структуре, такой как gloss, и их легко использовать в сочетании с другими событиями, вызывающими импульсы, такими как прыжки.

{-# 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)

В этом примере bY проверяет наличие столкновения с этажом в 0, накапливая импульсы, но ограничивая накопленное значение выше 0.

Скорость bYVel накапливает все импульсы в воздухе, но только те импульсы, которые направлены от пола, когда он не в воздухе. Если вы измените

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

to

yVelChanges = fmap (+) yVelShifts

он воссоздает ошибку с неустойчивыми прыжками.

Ускорение bYAccel присутствует только в воздухе.

Я использовал систему координат с осью +Y в направлении вверх (противоположно ускорению).

Код в конце представляет собой небольшой фреймворк для подключения reactive-banana к gloss.

Решил! Я чувствую себя немного глупо, потому что не подумал об этом раньше, но я просто увеличиваю счетчик каждый eJump и добавляю этот счетчик в 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

По какой-то причине высота прыжка всегда сильно варьируется, но это, вероятно, не связанная с моим расчетом времени проблема.

Я пока не буду отмечать этот вопрос как ответ, если кто-то захочет поделиться лучшим.