justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Bounce gibs

Browse Source
This commit is contained in:
justin
2022-06-03 20:43:29 +01:00
parent dd985c6a49
commit fa60ea0028
1 changed files with 23 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Prop/Gib.hs
+23 -7
View File
@@ -1,4 +1,6 @@
module Dodge.Prop.Gib where module Dodge.Prop.Gib where
import Dodge.Zone
import Dodge.Base
import Dodge.Data import Dodge.Data
import ShapePicture import ShapePicture
import Shape import Shape
@@ -20,7 +22,7 @@ aGib = PropZ
,_pjPosZ = 10 ,_pjPosZ = 10
,_pjVelZ = 5 ,_pjVelZ = 5
,_pjTimer = 20 ,_pjTimer = 20
,_pjQuat = Q.axisAngle (V3 1 1 0) 1 ,_pjQuat = Q.axisAngle (V3 1 0 0) 0
,_pjQuatSpin = Q.axisAngle (V3 1 1 0) 0.1 ,_pjQuatSpin = Q.axisAngle (V3 1 1 0) 0.1
} }
drawGib :: Prop -> SPic drawGib :: Prop -> SPic
@@ -29,25 +31,37 @@ drawGib pr = noPic
. uncurryV translateSHf (_pjPos pr) . uncurryV translateSHf (_pjPos pr)
. colorSH red . colorSH red
. overPosSH (Q.rotate (_pjQuat pr)) . overPosSH (Q.rotate (_pjQuat pr))
$ upperPrismPoly 5 $ square 5 . translateSHz (negate 5)
$ upperPrismPoly 10 $ square 5
updateGib :: Prop -> World -> World updateGib :: Prop -> World -> World
updateGib pr = props . ix (_pjID pr) %~ updateGib' updateGib pr w = w & props . ix (_pjID pr) %~ updateGib' w
updateGib' :: Prop -> Prop updateGib' :: World -> Prop -> Prop
updateGib' pr updateGib' w pr
| newposz < 0 && velz < (-2) = pr
& pjVelZ %~ ((*0.5) . negate)
-- & pjPos +~ (0.5*.* vel)
& updateWithVel (0.5 *.* vel)
& pjVel %~ (0.5 *.*)
-- & pjPos +~ (0.5*.* vel)
| newposz < 0 = pr & pjUpdate .~ const id | newposz < 0 = pr & pjUpdate .~ const id
& pjZ .~ 0 & pjZ .~ 0
-- & pjQuat *~ (_pjQuatSpin pr) -- & pjQuat *~ (_pjQuatSpin pr)
| otherwise = pr | otherwise = pr
& pjVelZ -~ 1 & pjVelZ -~ 1
& pjPosZ +~ velz & pjPosZ +~ velz
& pjPos +~ vel & updateWithVel vel
& pjQuat *~ (_pjQuatSpin pr) & pjQuat *~ (_pjQuatSpin pr)
where where
newposz = _pjPosZ pr + velz newposz = _pjPosZ pr + velz
velz = _pjVelZ pr velz = _pjVelZ pr
vel = _pjVel pr vel = _pjVel pr
pos = _pjPos pr
--updateWithVel v = case reflectPointWalls pos (pos + v) $ wallsAlongLine pos (pos +v) w of
updateWithVel v = case collidePointAnyWallsReflect pos (pos + v) $ wallsAlongLine pos (pos +v) w of
Nothing -> pjPos +~ v
Just (p,v') -> (pjPos .~ p) . (pjVel .~ v')
addGibsAt :: Point2 -> World -> World addGibsAt :: Point2 -> World -> World
addGibsAt p w = w & addg (V2 2 2) addGibsAt p w = w & addg (V2 2 2)
@@ -56,5 +70,7 @@ addGibsAt p w = w & addg (V2 2 2)
& addg (V2 (2) (-2)) & addg (V2 (2) (-2))
where where
addg v = plNew props pjID (aGib & pjPos .~ p addg v = plNew props pjID (aGib & pjPos .~ p
& pjVel .~ v) & pjVel .~ v
& pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
)