Add skin colors

src/Dodge/Creature.hs

@@ -60,14 +60,13 @@ spawnerCrit = defaultCreature
     { --_crUpdate = stateUpdate $ spawnerAI chaseCrit
      _crHP = 300
     , _crPict = basicCrPict
-    , _crSkinColor =  blue
     , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
     }
+    & crSkin . skinUpper .~ light4 blue
 
 miniGunCrit :: Creature
 miniGunCrit = defaultCreature
     { _crPict = basicCrPict
-    , _crSkinColor =  red
     , _crUpdate = defaultImpulsive [sentinelFireType (const shootTillEmpty)]
     , _crActionPlan = ActionPlan
         { _crImpulse    = []
@@ -84,10 +83,10 @@ miniGunCrit = defaultCreature
     , _crHP = 500
     , _crMvType = defaultAimMvType
     }
+    & crSkin . skinUpper .~ light4 red
 longCrit :: Creature
 longCrit = defaultCreature
     { _crPict = basicCrPict
-    , _crSkinColor =  red
 --    , _crUpdate = stateUpdate sniperAI
     , _crUpdate = defaultImpulsive [sentinelFireType $ const shootTillEmpty]
     , _crActionPlan = ActionPlan
@@ -101,10 +100,10 @@ longCrit = defaultCreature
     , _crRad = 10
     , _crHP = 150
     }
+    & crSkin . skinUpper .~ light4 red
 multGunCrit :: Creature
 multGunCrit = defaultCreature
     { _crPict = basicCrPict
-    , _crSkinColor =  red
 --    , _crUpdate = stateUpdate (twitchMissAI 300 350)
     , _crInv = IM.fromList [(0,bangCaneX 4),(1,medkit 100)]
     , _crInvSel = 0
@@ -131,6 +130,7 @@ multGunCrit = defaultCreature
         , _crGoal       = []
         }
     }
+    & crSkin . skinUpper .~ light4 red
   where
     drawwp = DoActionIfElse NoAction (const crIsAiming) (DoActionThen drawWeapon (WaitThen 50 NoAction))
     reloadActions = 
@@ -152,7 +152,6 @@ startCr = defaultCreature
     , _crMvDir  = pi/2
     , _crID = 0
     , _crPict = basicCrPict
-    , _crSkinColor = black
     , _crUpdate = stateUpdate yourControl
     , _crRad = 10
     , _crMass = 10
@@ -164,6 +163,7 @@ startCr = defaultCreature
     , _crFaction = PlayerFaction
     , _crMvType = MvWalking yourDefaultSpeed
     }
+    & crSkin . skinUpper .~ light4 black
 {- | Items you start with.  -}
 startInvList :: [Item]
 startInvList = [ ]
@@ -202,9 +202,7 @@ inventoryX c = case c of
         [ blinkGun
         , unsafeBlinkGun
         , autoDetector WALLDETECTOR
-        , effectGun "GIBBER" 
+        , effectGun "GIBBER" addCrGibs
-            (\cr -> addGibsAt (_crSkinColor cr) (_crPos cr)
-            . addGibsAt (_crSkinColor cr) (_crPos cr))
         ]
     _ -> []
 

src/Dodge/Creature/ArmourChase.hs

@@ -15,7 +15,7 @@ import Dodge.Creature.Picture
 import Dodge.Creature.Action
 import Dodge.Item.Equipment
 import Dodge.Item.Consumable
-import Picture
+--import Picture
 
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
@@ -37,7 +37,6 @@ flockArmourChaseCrit = defaultCreature
     , _crName = "armourChaseCrit"
     , _crHP = 300
     , _crPict = basicCrPict
-    , _crSkinColor =  green
     , _crInv = IM.fromList 
         [(0,frontArmour)
         ,(1,medkit 200)

src/Dodge/Creature/AutoCrit.hs

@@ -18,11 +18,11 @@ import Picture
 --
 --import Data.Maybe
 import qualified Data.IntMap.Strict as IM
+import Control.Lens
 
 autoCrit :: Creature
 autoCrit = defaultCreature
     { _crPict = basicCrPict
-    , _crSkinColor =  red
     , _crUpdate = defaultImpulsive [sentinelAI]
     , _crActionPlan = ActionPlan
         { _crImpulse    = []
@@ -36,3 +36,4 @@ autoCrit = defaultCreature
     , _crHP = 300
     , _crMvType = defaultAimMvType
     }
+    & crSkin . skinUpper .~ light4 red

src/Dodge/Creature/ChaseCrit.hs

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

src/Dodge/Creature/LauncherCrit.hs

@@ -25,7 +25,6 @@ import Control.Lens
 launcherCrit :: Creature
 launcherCrit = defaultCreature
     { _crPict = basicCrPict
-    , _crSkinColor =  red
     , _crUpdate = defaultImpulsive
         [ performActions
         , watchUpdateStrat
@@ -52,6 +51,7 @@ launcherCrit = defaultCreature
     , _crState = defaultState
     , _crHP = 300
     }
+    & crSkin . skinUpper .~ light4 red
 
 retreatFire :: Action
 retreatFire = ImpulsesList ( [ UseItem ] : replicate 20 [ Turn 0.16 ])

src/Dodge/Creature/LtAutoCrit.hs

@@ -23,7 +23,6 @@ import Control.Lens
 ltAutoCrit :: Creature
 ltAutoCrit = defaultCreature
     { _crPict = basicCrPict
-    , _crSkinColor =  red
     , _crUpdate = defaultImpulsive
         [ performActions
         , watchUpdateStrat
@@ -55,6 +54,7 @@ ltAutoCrit = defaultCreature
     , _crRad = 10
     , _crHP = 500
     }
+    & crSkin . skinUpper .~ light4 red
 
 chooseMovement :: Creature -> World -> Action
 chooseMovement cr w 

src/Dodge/Creature/Picture.hs

@@ -36,7 +36,7 @@ basicCrPict :: Creature
 basicCrPict cr cfig w = 
     drawCrEquipment cr
     <>
-    (basicCrShape col cr
+    (basicCrShape cr
     , pictures $
         targetingPic ++
         [ creatureDisplayText cfig w cr
@@ -44,7 +44,6 @@ basicCrPict 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)
 
@@ -58,24 +57,23 @@ shapeAtCrPos sh cr _ _ =
     )
 
 basicCrShape 
-    :: Color    -- ^ Creature color
+    :: Creature 
-    -> Creature 
     -> Shape
-basicCrShape col cr 
+basicCrShape cr 
     | _crCamouflage cr == Invisible = mempty
     | otherwise = tr . scaleSH (V3 crsize crsize crsize) $ mconcat
         [ --rotdir . _spShape $ drawEquipment cr
-         rotdir . dm . translateSHz 20 $ scalp cr
+         rotdir . dm . colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr
-        , rotdir . dm $ upperBody col cr
+        , rotdir . dm $ colorSH (_skinUpper cskin) $ upperBody cr
-        , dm . rotmdir $ feet cr
+        , dm . rotmdir $ colorSH (_skinLower cskin) $ feet cr
         ]
   where 
+    cskin = _crSkin cr
     crsize = 0.1 * _crRad cr
     dm = damageModSH cr
     tr = uncurryV translateSHf (_crPos cr)
     rotdir = rotateSH (_crDir cr)
     rotmdir = rotateSH (_crMvDir cr)
-        . colorSH (greyN 0.3)
 
 creatureDisplayText :: Configuration -> World -> Creature -> Picture
 creatureDisplayText cfig w cr 
@@ -227,10 +225,10 @@ baseShoulder :: Shape
 {-# INLINE baseShoulder #-}
 baseShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalf 10 $ polyCirc 3 1
 
-upperBody :: Color -> Creature -> Shape
+upperBody :: Creature -> Shape
 {-# INLINE upperBody #-}
 --upperBody col cr = colorSH (light4 col) $ mconcat
-upperBody col cr = colorSH (light4 col) $ mconcat
+upperBody cr = mconcat
     [ arms cr
     , shoulderSH $ torso cr
     ]

src/Dodge/Creature/PistolCrit.hs

@@ -27,7 +27,6 @@ import Control.Monad.State
 pistolCrit :: Creature
 pistolCrit = defaultCreature
     { _crPict = basicCrPict
-    , _crSkinColor =  red
     , _crUpdate =  defaultImpulsive
         [ performActions
         , watchUpdateStrat
@@ -54,6 +53,7 @@ pistolCrit = defaultCreature
     , _crRad = 10
     , _crHP = 500
     }
+    & crSkin . skinUpper .~ light4 red
 chooseMovement :: Creature -> World -> Action
 chooseMovement cr w = chooseMovement' cr w
         `DoActionThen`

src/Dodge/Creature/SpreadGunCrit.hs

@@ -25,7 +25,6 @@ import Control.Lens
 spreadGunCrit :: Creature
 spreadGunCrit = defaultCreature
     { _crPict = basicCrPict
-    , _crSkinColor =  red
     , _crUpdate = defaultImpulsive
         [performActions
         ,watchUpdateStrat
@@ -57,6 +56,7 @@ spreadGunCrit = defaultCreature
     , _crRad = 10
     , _crHP = 500
     }
+    & crSkin . skinUpper .~ light4 red
 
 chooseMovement :: Creature -> World -> Action
 chooseMovement cr w 

src/Dodge/Creature/State.hs

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

src/Dodge/Creature/SwarmCrit.hs

@@ -31,11 +31,11 @@ swarmCrit = defaultCreature
     , _crRad = 2
     , _crMass = 2
     , _crPict = basicCrPict
-    , _crSkinColor =  yellow
     , _crCorpse = setDepth 5 $ color (greyN 0.5) $ circleSolid 2
     , _crFaction = ColorFaction yellow
     , _crMeleeCooldown = 0
     }
+    & crSkin . skinUpper .~ light4 yellow
 
 --swarmCritMoveFunc :: Creature -> Point2 -> Creature -> Point2
 --swarmCritMoveFunc tcr cenp cr 

src/Dodge/Data.hs

@@ -323,7 +323,7 @@ data Creature = Creature
     , _crTwist          :: Float
     , _crID             :: Int
     , _crPict           :: Creature -> Configuration -> World -> SPic
-    , _crSkinColor      :: Color
+    , _crSkin           :: CreatureSkin
     , _crUpdate         :: Creature -> World -> World
     , _crRad            :: Float
     , _crMass           :: Float
@@ -355,6 +355,11 @@ data Creature = Creature
     , _crStatistics     :: CreatureStatistics
     , _crCamouflage     :: CamouflageStatus
     }
+data CreatureSkin = CreatureSkin
+    { _skinHead     :: Color
+    , _skinUpper    :: Color
+    , _skinLower    :: Color
+    }
 data CamouflageStatus
     = FullyVisible
     | Invisible
@@ -1590,6 +1595,7 @@ makeLenses ''ActivateEquipment
 makeLenses ''EquipParams
 makeLenses ''TerminalCommand
 makeLenses ''GenParams
+makeLenses ''CreatureSkin
 ----- ROOM LENSES
 
 makeLenses ''Room

src/Dodge/Default.hs

@@ -31,7 +31,7 @@ defaultCreature = Creature
     , _crTwist  = 0
     , _crID     = 1
     , _crPict   = \_ _ _ -> mempty
-    , _crSkinColor = white
+    , _crSkin = defaultCreatureSkin
     , _crUpdate = const id
     , _crRad    = 10
     , _crMass   = 10
@@ -67,6 +67,9 @@ defaultCreature = Creature
     , _crStatistics = CreatureStatistics 10 10 10
     , _crCamouflage = FullyVisible
     }
+defaultCreatureSkin :: CreatureSkin
+defaultCreatureSkin = CreatureSkin (greyN 0.9) (light4 green) (greyN 0.3)
+
 defaultInanimate :: Creature
 defaultInanimate = defaultCreature & crActionPlan .~ Inanimate
 

src/Dodge/Prop/Gib.hs

@@ -40,7 +40,7 @@ drawGib x pr = noPic
     flesh = colorSH (dark $ dark red)
         . translateSHz (negate x)
         $ upperPrismPoly (2*x) $ square x
-    skin = colorSH (light4 $ _pjColor pr)
+    skin = colorSH (_pjColor pr)
         . translateSH (V3 1 1 (1 - x))
         $ upperPrismPoly (2*x) $ square x
 
@@ -72,12 +72,21 @@ updateGib' w pr
         Nothing -> pjPos +~ v
         Just (p,v') -> (pjPos .~ p) . (pjVel .~ v')
 
-addGibsAt :: Color -> Point2 -> World -> World
+addCrGibs :: Creature -> World -> World
-addGibsAt col p w = foldr addg w (zip4 vels zspeeds quats hs)
+addCrGibs cr w = w
+    & addGibAt 25 (_skinHead skin) cpos
+    & addGibsAt 3 7 (_skinLower skin) cpos
+    & addGibsAt 13 20 (_skinUpper skin) cpos
+  where
+    skin = _crSkin cr
+    cpos = _crPos cr
+
+addGibsAt :: Float -> Float -> Color -> Point2 -> World -> World
+addGibsAt minh maxh col p w = foldr addg w (zip4 vels zspeeds quats hs)
     & randGen .~ newg
   where
     (speeds,newg) = replicateM 4 (state (randomR (1,4))) & runState $ _randGen w
-    hs = replicateM 4 (state (randomR (5,15))) & evalState $ _randGen w
+    hs = replicateM 4 (state (randomR (minh,maxh))) & evalState $ _randGen w
     dirs = unitVectorAtAngle <$> (randsOnCirc 4 & evalState $ _randGen w)
     vels = zipWith (*.*) speeds dirs
     zspeeds = replicateM 4 (state (randomR (-8,8))) & evalState $ _randGen w
@@ -92,3 +101,23 @@ addGibsAt col p w = foldr addg w (zip4 vels zspeeds quats hs)
         & pjPosZ .~ h
         )
   
+addGibAt :: Float -> Color -> Point2 -> World -> World
+addGibAt h col p w = w
+    & plNew props pjID gib
+    & randGen .~ newg
+  where
+    (gib,newg) = runState f $ _randGen w
+    f = do
+        s   <- state $ randomR (1,4)
+        dir <- unitVectorAtAngle <$> state (randomR (0,2*pi))
+        zs  <- state $ randomR (-8,8)
+        q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
+        let v = s *.* dir
+        return $ aGib
+            & pjPos .~ p
+            & pjColor .~ col
+            & pjVel .~ v
+            & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
+            & pjQuat .~ q
+            & pjVelZ .~ zs
+            & pjPosZ .~ h