diff --git a/src/Dodge/Prop/Create.hs b/src/Dodge/Prop/Create.hs new file mode 100644 index 000000000..6d4dbbbbc --- /dev/null +++ b/src/Dodge/Prop/Create.hs @@ -0,0 +1 @@ +module Dodge.Prop.Create where diff --git a/src/Dodge/Prop/Gib.hs b/src/Dodge/Prop/Gib.hs new file mode 100644 index 000000000..003589366 --- /dev/null +++ b/src/Dodge/Prop/Gib.hs @@ -0,0 +1,60 @@ +module Dodge.Prop.Gib where +import Dodge.Data +import ShapePicture +import Shape +import Geometry +import Color +import LensHelp +import Dodge.Base.NewID + +import qualified Linear.Quaternion as Q + +aGib :: Prop +aGib = PropZ + {_pjPos = 0 + ,_pjStartPos = 0 + ,_pjVel = 0 + ,_prDraw = drawGib + ,_pjID = 0 + ,_pjUpdate = updateGib + ,_pjPosZ = 10 + ,_pjVelZ = 5 + ,_pjTimer = 20 + ,_pjQuat = Q.axisAngle (V3 1 1 0) 1 + ,_pjQuatSpin = Q.axisAngle (V3 1 1 0) 0.1 + } +drawGib :: Prop -> SPic +drawGib pr = noPic + . translateSHz (_pjPosZ pr) + . uncurryV translateSHf (_pjPos pr) + . colorSH red + . overPosSH (Q.rotate (_pjQuat pr)) + $ upperPrismPoly 5 $ square 5 + +updateGib :: Prop -> World -> World +updateGib pr = props . ix (_pjID pr) %~ updateGib' + +updateGib' :: Prop -> Prop +updateGib' pr + | newposz < 0 = pr & pjUpdate .~ const id + & pjZ .~ 0 +-- & pjQuat *~ (_pjQuatSpin pr) + | otherwise = pr + & pjVelZ -~ 1 + & pjPosZ +~ velz + & pjPos +~ vel + & pjQuat *~ (_pjQuatSpin pr) + where + newposz = _pjPosZ pr + velz + velz = _pjVelZ pr + vel = _pjVel pr + +addGibsAt :: Point2 -> World -> World +addGibsAt p w = w & addg (V2 2 2) + & addg (V2 (-2) 2) + & addg (V2 (-2) (-2)) + & addg (V2 (2) (-2)) + where + addg v = plNew props pjID (aGib & pjPos .~ p + & pjVel .~ v) +