um

what.hs

-- | what
applyInputs :: PlayerState -> PlayerState
applyInputs ps =
    foldl' (\ps' inputGroup ->
        -- Calculate accelerations for this frame based on input log.
        let (# v, pressed, _, t_ #) = foldl' (\(# v, pressed, t0', t_ #) inp ->
                let t1 = inp^.timeStamp
                    down = inp^.isDown
                in  (# case t0' of
                           Just t0 -> let thisDt = t1 - t0 in
                               if thisDt > 0 then
                                   let dir = (normalize . sum) pressed
                                   in  v + dir ^* (appForce / mass * thisDt)
                               else
                                   v
                           _ -> v
                    ,  (down ? Set.insert $ Set.delete) (inp^.key) pressed
                    ,  Just t1
                    ,  if down then case t0' of
                           Just _ -> Just t_
                           _      -> Just t1
                       else
                           Just t_
                    #)
                ) (# ps'^.vel, Set.empty, Nothing, Nothing #)
                  (inputGroup^.inputs)
            leftoverDir = (normalize . sum) pressed
            v' = if nullV leftoverDir then
                     v
                 else let thisDt = (inputGroup^.now) - t_ in
                     v + leftoverDir ^* (appForce / mass * thisDt)
            -- Apply frictional forces.
            dt' = inputGroup^.dt
            v'' = let frictionalDvNorm = -friction * dt'
                  in if nullV v' || abs frictionalDvNorm >= norm v' then
                      zero
                  else
                      v' + normalize v' ^* frictionalDvNorm
            -- Update position based on new velocity.
            pos' = (ps'^.pos) + v'' ^* dt'
            -- Collision detection.
            (# v''', pos'' #) =
                let V2 vx vy = v''
                    V2 px py = pos'
                    (# vy', py' #) =
                        if | py <= 0                 -> -vy # 0
                           | py >= mainHeight - side -> -vy # mainHeight - side
                           | otherwise               ->  vy # py
                    (# vx', px' #) =
                        if | px >= mainWidth  - side -> -vx # mainWidth  - side
                           | px <= 0                 -> -vx # 0
                           | otherwise               ->  vx # px
                in  V2 vx' vy' # V2 px' py'
        in  ps' & pos         .~ pos''
                & vel         .~ v'''
                & lastOrdinal %~ (max (inputGroup^.ordinal))
    ) ps (ps^.inputQueue) & inputQueue .~ Seq.empty