77 lines
2.2 KiB
Haskell
77 lines
2.2 KiB
Haskell
module Dodge.Prop.Moving (
|
|
-- fallSmallBounceDamage,
|
|
-- fallSmallBounce,
|
|
updateDebrisChunk,
|
|
) where
|
|
|
|
import Linear.Metric
|
|
import Linear.V3
|
|
--import Dodge.Damage
|
|
import Dodge.Base
|
|
import Dodge.Data.World
|
|
import Geometry
|
|
import LensHelp
|
|
import Control.Monad
|
|
|
|
updateDebrisChunk :: World -> Debris -> (World, Maybe Debris)
|
|
updateDebrisChunk w db = (w, mdb)
|
|
where
|
|
cdb'
|
|
| norm sv < 0.5 && abs (sp ^. _z) < 0.5 = db
|
|
| otherwise = cdb
|
|
sv = db ^. dbVel
|
|
sp = _dbPos db
|
|
np = sp + sv
|
|
cdb = case collide3WallsFloor sp np w of
|
|
(p,Nothing) -> db & dbPos .~ p
|
|
& dbVel -~ V3 0 0 0.5
|
|
& dbRot %~ dospin
|
|
(p,Just (n,_)) -> db & dbPos .~ p + (0.0001 * normalize n)
|
|
& dbVel .~ (0.7 * reflectInNormal n sv) - V3 0 0 0.5
|
|
dospin = (_dbSpin db *)
|
|
mdb = do
|
|
guard (np ^. _z > -1000)
|
|
return cdb'
|
|
|
|
--fallSmallBounceDamage :: Prop -> World -> World
|
|
--fallSmallBounceDamage pr w =
|
|
-- w
|
|
-- & dodamage
|
|
-- & cWorld . lWorld . props . ix (_prID pr) %~ fallMovement w
|
|
-- where
|
|
-- p = _prPos pr
|
|
-- v = _prVel pr
|
|
-- dodamage
|
|
-- | _prPosZ pr < 25 = damageInCircle (const thedam) p 5
|
|
-- | otherwise = id
|
|
-- thedam = Crushing (floor . (* 10) . max 0 . subtract 5 . abs $ _prVelZ pr) v
|
|
|
|
--fallSmallBounce :: Prop -> World -> World
|
|
--fallSmallBounce pr w = w & cWorld . lWorld . props . ix (_prID pr) %~ fallMovement w
|
|
|
|
--fallMovement :: World -> Prop -> Prop
|
|
--fallMovement w pr
|
|
-- | newposz < 0 && velz < (-2) =
|
|
-- pr
|
|
-- & prVelZ %~ ((* 0.5) . negate)
|
|
-- & updateWithVel (0.5 *.* vel)
|
|
-- & prVel %~ (0.5 *.*)
|
|
-- | newposz < 0 =
|
|
-- pr & prUpdate .~ PropUpdateId
|
|
-- & prPosZ .~ 0
|
|
-- -- & pjQuat *~ (_pjQuatSpin pr)
|
|
-- | otherwise =
|
|
-- pr
|
|
-- & prVelZ -~ 1
|
|
-- & prPosZ +~ velz
|
|
-- & updateWithVel vel
|
|
-- & prQuat *~ _prQuatSpin pr
|
|
-- where
|
|
-- newposz = _prPosZ pr + velz
|
|
-- velz = _prVelZ pr
|
|
-- vel = _prVel pr
|
|
-- pos = _prPos pr
|
|
-- updateWithVel v = case bouncePoint (const True) 0.5 pos (pos + v) w of
|
|
-- Nothing -> prPos +~ v
|
|
-- Just (p, v') -> (prPos .~ p) . (prVel .~ v')
|