Tweak gibs

src/Color.hs

@@ -110,3 +110,6 @@ numColor 10 = toV4 (0.5,1,0,1)
 numColor 11 = toV4 (1,0.5,0,1)  
 numColor 12 = toV4 (1,1,1,1) 
 numColor _  = toV4 (1,1,1,1) 
+
+light4 :: Color -> Color
+light4 = light . light . light . light

src/Dodge/Creature.hs

@@ -59,13 +59,15 @@ spawnerCrit :: Creature
 spawnerCrit = defaultCreature
     { --_crUpdate = stateUpdate $ spawnerAI chaseCrit
      _crHP = 300
-    , _crPict = basicCrPict blue
+    , _crPict = basicCrPict
+    , _crSkinColor =  blue
     , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
     }
 
 miniGunCrit :: Creature
 miniGunCrit = defaultCreature
-    { _crPict = basicCrPict red
+    { _crPict = basicCrPict
+    , _crSkinColor =  red
     , _crUpdate = defaultImpulsive [sentinelFireType (const shootTillEmpty)]
     , _crActionPlan = ActionPlan
         { _crImpulse    = []
@@ -84,7 +86,8 @@ miniGunCrit = defaultCreature
     }
 longCrit :: Creature
 longCrit = defaultCreature
-    { _crPict = basicCrPict red
+    { _crPict = basicCrPict
+    , _crSkinColor =  red
 --    , _crUpdate = stateUpdate sniperAI
     , _crUpdate = defaultImpulsive [sentinelFireType $ const shootTillEmpty]
     , _crActionPlan = ActionPlan
@@ -100,7 +103,8 @@ longCrit = defaultCreature
     }
 multGunCrit :: Creature
 multGunCrit = defaultCreature
-    { _crPict = basicCrPict red
+    { _crPict = basicCrPict
+    , _crSkinColor =  red
 --    , _crUpdate = stateUpdate (twitchMissAI 300 350)
     , _crInv = IM.fromList [(0,bangCaneX 4),(1,medkit 100)]
     , _crInvSel = 0
@@ -147,7 +151,8 @@ startCr = defaultCreature
     , _crDir = pi/2
     , _crMvDir  = pi/2
     , _crID = 0
-    , _crPict = basicCrPict black
+    , _crPict = basicCrPict
+    , _crSkinColor = black
     , _crUpdate = stateUpdate yourControl
     , _crRad = 10
     , _crMass = 10
@@ -197,7 +202,9 @@ inventoryX c = case c of
         [ blinkGun
         , unsafeBlinkGun
         , autoDetector WALLDETECTOR
-        , effectGun "GIBBER" (addGibsAt . _crPos)
+        , effectGun "GIBBER" 
+            (\cr -> addGibsAt (_crSkinColor cr) (_crPos cr)
+            . addGibsAt (_crSkinColor cr) (_crPos cr))
         ]
     _ -> []
 

src/Dodge/Creature/ArmourChase.hs

@@ -36,7 +36,8 @@ flockArmourChaseCrit = defaultCreature
         ]
     , _crName = "armourChaseCrit"
     , _crHP = 300
-    , _crPict = basicCrPict green
+    , _crPict = basicCrPict
+    , _crSkinColor =  green
     , _crInv = IM.fromList 
         [(0,frontArmour)
         ,(1,medkit 200)

src/Dodge/Creature/AutoCrit.hs

@@ -21,7 +21,8 @@ import qualified Data.IntMap.Strict as IM
 
 autoCrit :: Creature
 autoCrit = defaultCreature
-    { _crPict = basicCrPict red
+    { _crPict = basicCrPict
+    , _crSkinColor =  red
     , _crUpdate = defaultImpulsive [sentinelAI]
     , _crActionPlan = ActionPlan
         { _crImpulse    = []

src/Dodge/Creature/ChaseCrit.hs

@@ -26,7 +26,8 @@ smallChaseCrit :: Creature
 smallChaseCrit = chaseCrit
     { _crHP = 1
     , _crRad = 4
-    , _crPict = basicCrPict green
+    , _crPict = basicCrPict
+    , _crSkinColor = green
     , _crInv = IM.fromList [(0,medkit 200)]
     , _crCorpse = setDepth 5 $ color (greyN 0.5) $ circleSolid 4
     }
@@ -52,7 +53,8 @@ chaseCrit = defaultCreature
         ]
     , _crName = "chaseCrit"
     , _crHP = 150
-    , _crPict = basicCrPict green
+    , _crPict = basicCrPict
+    , _crSkinColor =  green
     , _crInv = IM.fromList [(0,medkit 200)]
     , _crMeleeCooldown = 0
     , _crFaction = ColorFaction green

src/Dodge/Creature/LauncherCrit.hs

@@ -24,7 +24,8 @@ import Control.Lens
 
 launcherCrit :: Creature
 launcherCrit = defaultCreature
-    { _crPict = basicCrPict red
+    { _crPict = basicCrPict
+    , _crSkinColor =  red
     , _crUpdate = defaultImpulsive
         [ performActions
         , watchUpdateStrat

src/Dodge/Creature/LtAutoCrit.hs

@@ -22,7 +22,8 @@ import Control.Lens
 
 ltAutoCrit :: Creature
 ltAutoCrit = defaultCreature
-    { _crPict = basicCrPict red
+    { _crPict = basicCrPict
+    , _crSkinColor =  red
     , _crUpdate = defaultImpulsive
         [ performActions
         , watchUpdateStrat

src/Dodge/Creature/Picture.hs

@@ -29,12 +29,11 @@ import ShapePicture
 import Control.Lens
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Vector as V
-basicCrPict :: Color    -- ^ Creature color
+basicCrPict :: Creature 
-    -> Creature 
     -> Configuration
     -> World
     -> SPic
-basicCrPict col cr cfig w = 
+basicCrPict cr cfig w = 
     drawCrEquipment cr
     <>
     (basicCrShape col cr
@@ -45,6 +44,7 @@ basicCrPict col cr cfig w =
         ]
     )
   where 
+    col = _crSkinColor cr
     targetingPic = IM.elems $ IM.mapMaybeWithKey f $ _crInv cr
     f invid it = fmap (\g -> g invid it cr cfig w) (it ^? itTargeting . tgDraw)
 
@@ -240,8 +240,6 @@ shoulderSH = translateSHz 20
 --waistSH :: Shape -> Shape
 --waistSH = translateSHz 10
 
-light4 :: Color -> Color
-light4 = light . light . light . light
 
 --drawAwakeLevel
 --    :: Creature

src/Dodge/Creature/PistolCrit.hs

@@ -26,7 +26,8 @@ import Control.Monad.State
 
 pistolCrit :: Creature
 pistolCrit = defaultCreature
-    { _crPict = basicCrPict red
+    { _crPict = basicCrPict
+    , _crSkinColor =  red
     , _crUpdate =  defaultImpulsive
         [ performActions
         , watchUpdateStrat

src/Dodge/Creature/SpreadGunCrit.hs

@@ -24,7 +24,8 @@ import Control.Lens
 
 spreadGunCrit :: Creature
 spreadGunCrit = defaultCreature
-    { _crPict = basicCrPict red
+    { _crPict = basicCrPict
+    , _crSkinColor =  red
     , _crUpdate = defaultImpulsive
         [performActions
         ,watchUpdateStrat

src/Dodge/Creature/State.hs

@@ -76,7 +76,9 @@ checkDeath cr w
   where
     removecr
         | _crID cr == 0 = (creatures . ix (_crID cr) . crUpdate .~ const id)
-            . addGibsAt (_crPos cr)
+            . (creatures . ix (_crID cr) . crPict .~ const mempty)
+            . addGibsAt (_crSkinColor cr) (_crPos cr)
+            . addGibsAt (_crSkinColor cr) (_crPos cr)
         | otherwise  = creatures . at (_crID cr) .~ Nothing
     addCorpse = IM.insertNewKey 
         $ uncurryV translate (_crOldPos cr) 

src/Dodge/Creature/SwarmCrit.hs

@@ -30,7 +30,8 @@ swarmCrit = defaultCreature
     , _crHP = 1
     , _crRad = 2
     , _crMass = 2
-    , _crPict = basicCrPict yellow
+    , _crPict = basicCrPict
+    , _crSkinColor =  yellow
     , _crCorpse = setDepth 5 $ color (greyN 0.5) $ circleSolid 2
     , _crFaction = ColorFaction yellow
     , _crMeleeCooldown = 0

src/Dodge/Data.hs

@@ -323,6 +323,7 @@ data Creature = Creature
     , _crTwist          :: Float
     , _crID             :: Int
     , _crPict           :: Creature -> Configuration -> World -> SPic
+    , _crSkinColor      :: Color
     , _crUpdate         :: Creature -> World -> World
     , _crRad            :: Float
     , _crMass           :: Float
@@ -849,6 +850,7 @@ data Prop
         , _pjTimer :: Int
         , _pjQuat  :: Q.Quaternion Float
         , _pjQuatSpin  :: Q.Quaternion Float
+        , _pjColor :: Color
         }
     | Drone
         { _pjPos :: Point2

src/Dodge/Default.hs

@@ -31,6 +31,7 @@ defaultCreature = Creature
     , _crTwist  = 0
     , _crID     = 1
     , _crPict   = \_ _ _ -> mempty
+    , _crSkinColor = white
     , _crUpdate = const id
     , _crRad    = 10
     , _crMass   = 10

src/Dodge/Prop/Gib.hs

@@ -12,14 +12,15 @@ import Dodge.RandomHelp
 
 import System.Random
 import Control.Monad.State
-import qualified Linear.Quaternion as Q
+import qualified Quaternion as Q
+import Data.List (zip4)
 
 aGib :: Prop
 aGib = PropZ
     {_pjPos = 0
     ,_pjStartPos = 0
     ,_pjVel = 0
-    ,_prDraw = drawGib
+    ,_prDraw = drawGib 4
     ,_pjID = 0
     ,_pjUpdate = updateGib
     ,_pjPosZ = 10
@@ -27,15 +28,21 @@ aGib = PropZ
     ,_pjTimer = 20
     ,_pjQuat = Q.axisAngle (V3 1 0 0) 0
     ,_pjQuatSpin = Q.axisAngle (V3 1 1 0) 0.1
+    ,_pjColor = white
     }
-drawGib :: Prop -> SPic
+drawGib :: Float -> Prop -> SPic
-drawGib pr = noPic
+drawGib x pr = noPic
     . translateSHz (_pjPosZ pr)
     . uncurryV translateSHf (_pjPos pr) 
-    . colorSH red
     . overPosSH (Q.rotate (_pjQuat pr))
-    . translateSHz (negate 5)
+    $ flesh <> skin
-    $ upperPrismPoly 10 $ square 5
+  where
+    flesh = colorSH (dark $ dark red)
+        . translateSHz (negate x)
+        $ upperPrismPoly (2*x) $ square x
+    skin = colorSH (light4 $ _pjColor pr)
+        . translateSH (V3 1 1 (1 - x))
+        $ upperPrismPoly (2*x) $ square x
 
 updateGib :: Prop -> World -> World
 updateGib pr w = w & props . ix (_pjID pr) %~ updateGib' w
@@ -65,16 +72,23 @@ updateGib' w pr
         Nothing -> pjPos +~ v
         Just (p,v') -> (pjPos .~ p) . (pjVel .~ v')
 
-addGibsAt :: Point2 -> World -> World
+addGibsAt :: Color -> Point2 -> World -> World
-addGibsAt p w = foldr addg w (zip vels zspeeds)
+addGibsAt col p w = foldr addg w (zip4 vels zspeeds quats hs)
+    & randGen .~ newg
   where
-    speeds = replicateM 4 (state (randomR (1,4))) & evalState $ _randGen w
+    (speeds,newg) = replicateM 4 (state (randomR (1,4))) & runState $ _randGen w
+    hs = replicateM 4 (state (randomR (5,15))) & evalState $ _randGen w
     dirs = unitVectorAtAngle <$> (randsOnCirc 4 & evalState $ _randGen w)
     vels = zipWith (*.*) speeds dirs
-    zspeeds = replicateM 4 (state (randomR (1,8))) & evalState $ _randGen w
+    zspeeds = replicateM 4 (state (randomR (-8,8))) & evalState $ _randGen w
-    addg (v,zs) = plNew props pjID (aGib & pjPos .~ p
+    quats :: [Q.Quaternion Float]
+    quats = replicateM 4 (Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere) & evalState $ _randGen w
+    addg (v,zs,q,h) = plNew props pjID (aGib & pjPos .~ p +.+ (5 *.* normalizeV v)
+        & pjColor .~ col
         & pjVel .~ v
         & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
+        & pjQuat .~ q
         & pjVelZ .~ zs
+        & pjPosZ .~ h
         )
   

src/Quaternion.hs

@@ -1,9 +1,12 @@
 module Quaternion
     ( rotateToZ
+    , vToQuat
+    , module Linear.Quaternion
     ) where
 import Geometry.Data
 import Geometry.Vector3D
 import qualified Linear.Quaternion as Q
+import Linear.Quaternion
 
 -- apply a rotation as if the z axis moves to the new point.
 rotateToZ :: Point3 -> Point3 -> Point3
@@ -12,3 +15,10 @@ rotateToZ z1
     | otherwise = Q.rotate $ Q.axisAngle cprod (angleVV3 z1 (V3 0 0 1))
   where
     cprod = crossProd z1 (V3 0 0 1)
+
+vToQuat :: Point3 -> Point3 -> Q.Quaternion Float
+vToQuat a b 
+    | cprod == V3 0 0 0 = Q.axisAngle (V3 0 0 1) 0
+    | otherwise = Q.axisAngle cprod (angleVV3 a b)
+  where
+    cprod = crossProd a b