Add file

src/Dodge/Prop/Create.hs

@@ -0,0 +1 @@
+module Dodge.Prop.Create where

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)
+