diff --git a/src/Dodge/Prop/Gib.hs b/src/Dodge/Prop/Gib.hs index 003589366..793da30df 100644 --- a/src/Dodge/Prop/Gib.hs +++ b/src/Dodge/Prop/Gib.hs @@ -1,4 +1,6 @@ module Dodge.Prop.Gib where +import Dodge.Zone +import Dodge.Base import Dodge.Data import ShapePicture import Shape @@ -20,7 +22,7 @@ aGib = PropZ ,_pjPosZ = 10 ,_pjVelZ = 5 ,_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 } drawGib :: Prop -> SPic @@ -29,25 +31,37 @@ drawGib pr = noPic . uncurryV translateSHf (_pjPos pr) . colorSH red . overPosSH (Q.rotate (_pjQuat pr)) - $ upperPrismPoly 5 $ square 5 + . translateSHz (negate 5) + $ upperPrismPoly 10 $ square 5 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' pr +updateGib' :: World -> Prop -> Prop +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 & pjZ .~ 0 -- & pjQuat *~ (_pjQuatSpin pr) | otherwise = pr & pjVelZ -~ 1 & pjPosZ +~ velz - & pjPos +~ vel + & updateWithVel vel & pjQuat *~ (_pjQuatSpin pr) where newposz = _pjPosZ pr + velz velz = _pjVelZ 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 p w = w & addg (V2 2 2) @@ -56,5 +70,7 @@ addGibsAt p w = w & addg (V2 2 2) & addg (V2 (2) (-2)) where addg v = plNew props pjID (aGib & pjPos .~ p - & pjVel .~ v) + & pjVel .~ v + & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1) + )