diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 15d24917d..0efa202b7 100644 --- a/src/Dodge/Creature.hs +++ b/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" - (\cr -> addGibsAt (_crSkinColor cr) (_crPos cr) - . addGibsAt (_crSkinColor cr) (_crPos cr)) + , effectGun "GIBBER" addCrGibs ] _ -> [] diff --git a/src/Dodge/Creature/ArmourChase.hs b/src/Dodge/Creature/ArmourChase.hs index 3fa1ed0d0..7ace21a17 100644 --- a/src/Dodge/Creature/ArmourChase.hs +++ b/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) diff --git a/src/Dodge/Creature/AutoCrit.hs b/src/Dodge/Creature/AutoCrit.hs index ebe5cd054..9a8eb57a8 100644 --- a/src/Dodge/Creature/AutoCrit.hs +++ b/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 diff --git a/src/Dodge/Creature/ChaseCrit.hs b/src/Dodge/Creature/ChaseCrit.hs index 584d53260..e3b4eab4c 100644 --- a/src/Dodge/Creature/ChaseCrit.hs +++ b/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 diff --git a/src/Dodge/Creature/LauncherCrit.hs b/src/Dodge/Creature/LauncherCrit.hs index 686ec1bdc..685fe9f8c 100644 --- a/src/Dodge/Creature/LauncherCrit.hs +++ b/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 ]) diff --git a/src/Dodge/Creature/LtAutoCrit.hs b/src/Dodge/Creature/LtAutoCrit.hs index 81618dcdf..374230259 100644 --- a/src/Dodge/Creature/LtAutoCrit.hs +++ b/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 diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 0fc8d2ede..7ef44b712 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/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 $ upperBody col cr - , dm . rotmdir $ feet cr + rotdir . dm . colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr + , rotdir . dm $ colorSH (_skinUpper cskin) $ upperBody 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 ] diff --git a/src/Dodge/Creature/PistolCrit.hs b/src/Dodge/Creature/PistolCrit.hs index 289ae9a25..ee0dd4095 100644 --- a/src/Dodge/Creature/PistolCrit.hs +++ b/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` diff --git a/src/Dodge/Creature/SpreadGunCrit.hs b/src/Dodge/Creature/SpreadGunCrit.hs index c8f149fa1..0430fd2d4 100644 --- a/src/Dodge/Creature/SpreadGunCrit.hs +++ b/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 diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 6f17d7c00..e8773c494 100644 --- a/src/Dodge/Creature/State.hs +++ b/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) - . addGibsAt (_crSkinColor cr) (_crPos cr) + . addCrGibs cr | otherwise = creatures . at (_crID cr) .~ Nothing addCorpse = IM.insertNewKey $ uncurryV translate (_crOldPos cr) diff --git a/src/Dodge/Creature/SwarmCrit.hs b/src/Dodge/Creature/SwarmCrit.hs index c761c46ed..f1b89e2fa 100644 --- a/src/Dodge/Creature/SwarmCrit.hs +++ b/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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 6662b4a75..524f1f996 100644 --- a/src/Dodge/Data.hs +++ b/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 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index d7a94e7c4..ce9be3fcf 100644 --- a/src/Dodge/Default.hs +++ b/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 diff --git a/src/Dodge/Prop/Gib.hs b/src/Dodge/Prop/Gib.hs index a910fed2f..c9e27a117 100644 --- a/src/Dodge/Prop/Gib.hs +++ b/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 -addGibsAt col p w = foldr addg w (zip4 vels zspeeds quats hs) +addCrGibs :: Creature -> World -> World +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