Data-ify creature drawing (partially)

This commit is contained in:
2022-07-10 23:24:25 +01:00
parent 646942d20c
commit 75cd15c240
20 changed files with 52 additions and 76 deletions
+8 -15
View File
@@ -59,15 +59,13 @@ spawnerCrit :: Creature
spawnerCrit = defaultCreature
{ --_crUpdate = stateUpdate $ spawnerAI chaseCrit
_crHP = 300
, _crPict = basicCrPict
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
}
& crSkin . skinUpper .~ light4 blue
& crType . skinUpper .~ light4 blue
miniGunCrit :: Creature
miniGunCrit = defaultCreature
{ _crPict = basicCrPict
, _crUpdate = defaultImpulsive [sentinelFireType (const shootTillEmpty)]
{ _crUpdate = defaultImpulsive [sentinelFireType (const shootTillEmpty)]
-- , _crInv = IM.fromList [(0,autoRifle & itConsumption . ammoLoaded .~ 1000)]
, _crInv = IM.fromList [(0,miniGunX 3)]
-- , _crInv = IM.fromList [(0,autoRifle)]
@@ -76,12 +74,10 @@ miniGunCrit = defaultCreature
, _crHP = 500
, _crMvType = defaultAimMvType
}
& crSkin . skinUpper .~ light4 red
& crType . skinUpper .~ light4 red
longCrit :: Creature
longCrit = defaultCreature
{ _crPict = basicCrPict
-- , _crUpdate = stateUpdate sniperAI
, _crUpdate = defaultImpulsive [sentinelFireType $ const shootTillEmpty]
{ _crUpdate = defaultImpulsive [sentinelFireType $ const shootTillEmpty]
, _crActionPlan = ActionPlan
{ _apImpulse = []
, _apAction = []
@@ -92,12 +88,10 @@ longCrit = defaultCreature
, _crRad = 10
, _crHP = 150
}
& crSkin . skinUpper .~ light4 red
& crType . skinUpper .~ light4 red
multGunCrit :: Creature
multGunCrit = defaultCreature
{ _crPict = basicCrPict
-- , _crUpdate = stateUpdate (twitchMissAI 300 350)
, _crInv = IM.fromList [(0,volleyGun 4),(1,medkit 100)]
{ _crInv = IM.fromList [(0,volleyGun 4),(1,medkit 100)]
, _crRad = 10
, _crHP = 300
, _crUpdate = defaultImpulsive [sentinelExtraWatchUpdate
@@ -115,7 +109,7 @@ multGunCrit = defaultCreature
]
]
}
& crSkin . skinUpper .~ light4 red
& crType . skinUpper .~ light4 red
where
drawwp = DoActionIfElse NoAction (const crIsAiming) (DoActionThen drawWeapon (WaitThen 50 NoAction))
reloadActions =
@@ -136,7 +130,6 @@ startCr = defaultCreature
, _crDir = pi/2
, _crMvDir = pi/2
, _crID = 0
, _crPict = basicCrPict
, _crUpdate = stateUpdate yourControl
, _crRad = 10
, _crMass = 10
@@ -147,7 +140,7 @@ startCr = defaultCreature
, _crFaction = PlayerFaction
, _crMvType = MvWalking yourDefaultSpeed
}
& crSkin . skinUpper .~ light4 black
& crType . skinUpper .~ light4 black
{- | Items you start with. -}
startInvList :: [Item]
startInvList = [ ]
-2
View File
@@ -10,7 +10,6 @@ import Dodge.Creature.ChaseCrit
--import Dodge.Creature.ChainUpdates
import Dodge.Creature.ReaderUpdate
import Dodge.Creature.Perception
import Dodge.Creature.Picture
--import Dodge.Creature.Impulse
import Dodge.Creature.Action
import Dodge.Item.Equipment
@@ -36,7 +35,6 @@ flockArmourChaseCrit = defaultCreature
]
, _crName = "armourChaseCrit"
, _crHP = 300
, _crPict = basicCrPict
, _crInv = IM.fromList
[(0,frontArmour)
,(1,medkit 200)
+2 -4
View File
@@ -3,7 +3,6 @@ module Dodge.Creature.AutoCrit
) where
import Dodge.Data
import Dodge.Default
import Dodge.Creature.Picture
import Dodge.Creature.Update
import Dodge.Creature.SentinelAI
--import Dodge.Creature.ChooseTarget
@@ -22,11 +21,10 @@ import Control.Lens
autoCrit :: Creature
autoCrit = defaultCreature
{ _crPict = basicCrPict
, _crUpdate = defaultImpulsive [sentinelAI]
{ _crUpdate = defaultImpulsive [sentinelAI]
, _crInv = IM.fromList [(0,autoGun),(1,medkit 100)]
, _crRad = 10
, _crHP = 300
, _crMvType = defaultAimMvType
}
& crSkin . skinUpper .~ light4 red
& crType . skinUpper .~ light4 red
-2
View File
@@ -26,7 +26,6 @@ smallChaseCrit :: Creature
smallChaseCrit = chaseCrit
{ _crHP = 1
, _crRad = 4
, _crPict = basicCrPict
, _crInv = IM.fromList [(0,medkit 200)]
, _crCorpse = basicCrCorpse
}
@@ -52,7 +51,6 @@ chaseCrit = defaultCreature
]
, _crName = "chaseCrit"
, _crHP = 150
, _crPict = basicCrPict
, _crInv = IM.fromList [(0,medkit 200)]
, _crMeleeCooldown = 0
, _crFaction = ColorFaction green
+2 -2
View File
@@ -31,7 +31,7 @@ barrel :: Creature
barrel = defaultInanimate
{ _crUpdate = updateBarrel
, _crHP = 500
, _crPict = picAtCrPos $ setDepth 20 $ pictures
, _crType = DrawnCreature $ picAtCrPos $ setDepth 20 $ pictures
[ color orange $ circleSolid 10
, setDepth 0.049 . color (greyN 0.5) $ circleSolid 8
, color (greyN 0.5) $ circleSolid 8
@@ -46,7 +46,7 @@ explosiveBarrel :: Creature
explosiveBarrel = defaultInanimate
{ _crUpdate = updateExpBarrel
, _crHP = 400
, _crPict = shapeAtCrPos
, _crType = DrawnCreature $ shapeAtCrPos
. colorSH orange
. upperPrismPoly 20
$ polyCirc 4 10
+3 -11
View File
@@ -25,19 +25,14 @@ colorLamp
colorLamp col h = defaultInanimate
{ _crUpdate = initialiseColorLamp col h
, _crHP = 100
, _crPict = picAtCrPosNoRot (lampCrPic h)
, _crType = DrawnCreature $ picAtCrPosNoRot (lampCrPic h)
, _crRad = 3
, _crMass = 3
}
lamp :: Float -> Creature
lamp h = defaultInanimate
{ _crUpdate = initialiseLamp h
, _crHP = 100
, _crPict = picAtCrPosNoRot (lampCrPic h)
, _crRad = 3
, _crMass = 3
}
lamp = colorLamp 0.75
lampCrPic :: Float -> Picture
lampCrPic h = pictures
[ setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
@@ -46,9 +41,6 @@ lampCrPic h = pictures
where
f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] BottomLayer polyNum
initialiseLamp :: Float -> Creature -> World -> World
initialiseLamp = initialiseColorLamp 0.75
initialiseColorLamp :: Point3 -> Float -> Creature -> World -> World
initialiseColorLamp col h cr w = w
& lightSources . at lsid ?~ lsColPosID col (addZ h $ _crPos cr) lsid
+2 -4
View File
@@ -4,7 +4,6 @@ module Dodge.Creature.LauncherCrit
where
import Dodge.Data
import Dodge.Default
import Dodge.Creature.Picture
--import Dodge.Creature.ChainUpdates
import Dodge.Creature.Test
import Dodge.Creature.Volition
@@ -24,8 +23,7 @@ import Control.Lens
launcherCrit :: Creature
launcherCrit = defaultCreature
{ _crPict = basicCrPict
, _crUpdate = defaultImpulsive
{ _crUpdate = defaultImpulsive
[ performActions
, watchUpdateStrat
[ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [retreatFire])
@@ -44,7 +42,7 @@ launcherCrit = defaultCreature
, _crState = defaultState
, _crHP = 300
}
& crSkin . skinUpper .~ light4 red
& crType . skinUpper .~ light4 red
retreatFire :: Action
retreatFire = ImpulsesList ( [ UseItem ] : replicate 20 [ Turn 0.16 ])
+2 -4
View File
@@ -3,7 +3,6 @@ module Dodge.Creature.LtAutoCrit
) where
import Dodge.Data
import Dodge.Default
import Dodge.Creature.Picture
import Dodge.Creature.Update
import Dodge.Creature.Action
import Dodge.Creature.Test
@@ -22,8 +21,7 @@ import Control.Lens
ltAutoCrit :: Creature
ltAutoCrit = defaultCreature
{ _crPict = basicCrPict
, _crUpdate = defaultImpulsive
{ _crUpdate = defaultImpulsive
[ performActions
, watchUpdateStrat
[ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0)
@@ -47,7 +45,7 @@ ltAutoCrit = defaultCreature
, _crRad = 10
, _crHP = 500
}
& crSkin . skinUpper .~ light4 red
& crType . skinUpper .~ light4 red
chooseMovement :: Creature -> World -> Action
chooseMovement cr w
+2 -2
View File
@@ -47,7 +47,7 @@ basicCrShape cr
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
]
where
cskin = _crSkin cr
cskin = _crType cr
crsize = 0.1 * _crRad cr
tr = uncurryV translateSHf (_crPos cr)
rotdir = rotateSH (_crDir cr)
@@ -235,7 +235,7 @@ basicCrCorpse cr cp = noPic . tr . scaleSH (V3 crsize crsize crsize) $ mconcat
, rotdir . rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
]
where
cskin = _crSkin cr
cskin = _crType cr -- this should be fixed
crsize = 0.1 * _crRad cr
tr = uncurryV translateSHf (_cpPos cp)
rotdir = rotateSH (_cpDir cp)
+2 -4
View File
@@ -3,7 +3,6 @@ module Dodge.Creature.PistolCrit
) where
import Dodge.Data
import Dodge.Default
import Dodge.Creature.Picture
import Dodge.Creature.Update
import Dodge.Creature.Test
import Dodge.Creature.Action
@@ -24,8 +23,7 @@ import Control.Lens
pistolCrit :: Creature
pistolCrit = defaultCreature
{ _crPict = basicCrPict
, _crUpdate = defaultImpulsive
{ _crUpdate = defaultImpulsive
[ performActions
, watchUpdateStrat
[ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0)
@@ -44,7 +42,7 @@ pistolCrit = defaultCreature
, _crRad = 10
, _crHP = 500
}
& crSkin . skinUpper .~ light4 red
& crType . skinUpper .~ light4 red
chooseMovement :: Creature -> World -> Action
chooseMovement cr w = chooseMovement' cr w
`DoActionThen`
+2 -4
View File
@@ -3,7 +3,6 @@ module Dodge.Creature.SpreadGunCrit
) where
import Dodge.Data
import Dodge.Default
import Dodge.Creature.Picture
import Dodge.Creature.Update
import Dodge.Creature.Test
import Dodge.Creature.Action
@@ -24,8 +23,7 @@ import Control.Lens
spreadGunCrit :: Creature
spreadGunCrit = defaultCreature
{ _crPict = basicCrPict
, _crUpdate = defaultImpulsive
{ _crUpdate = defaultImpulsive
[performActions
,watchUpdateStrat
[ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0)
@@ -49,7 +47,7 @@ spreadGunCrit = defaultCreature
, _crRad = 10
, _crHP = 500
}
& crSkin . skinUpper .~ light4 red
& crType . skinUpper .~ light4 red
chooseMovement :: Creature -> World -> Action
chooseMovement cr w
+1 -1
View File
@@ -80,7 +80,7 @@ checkDeath cr w
where
removecr
| _crID cr == 0 = (creatures . ix (_crID cr) . crUpdate .~ const id)
. (creatures . ix (_crID cr) . crPict .~ const mempty)
. (creatures . ix (_crID cr) . crType .~ DrawnCreature (const mempty))
. (creatures . ix (_crID cr) . crHP .~ 0)
-- hack to get around player creature being killed but left with more than 0 hp
| otherwise = creatures . at (_crID cr) .~ Nothing
+1 -2
View File
@@ -30,12 +30,11 @@ swarmCrit = defaultCreature
, _crHP = 1
, _crRad = 2
, _crMass = 2
, _crPict = basicCrPict
, _crCorpse = basicCrCorpse
, _crFaction = ColorFaction yellow
, _crMeleeCooldown = 0
}
& crSkin . skinUpper .~ light4 yellow
& crType . skinUpper .~ light4 yellow
--swarmCritMoveFunc :: Creature -> Point2 -> Creature -> Point2
--swarmCritMoveFunc tcr cenp cr
+9 -8
View File
@@ -356,6 +356,13 @@ data TempLightSource = TLS
, _tlsUpdate :: World -> TempLightSource -> Maybe TempLightSource
, _tlsTime :: !Int
}
data CreatureType
= Humanoid
{ _skinHead :: Color
, _skinUpper :: Color
, _skinLower :: Color
}
| DrawnCreature { _cdDraw :: Creature -> SPic }
data Creature = Creature
{ _crPos :: Point2
, _crOldPos :: Point2
@@ -364,9 +371,8 @@ data Creature = Creature
, _crOldDir :: Float
, _crMvDir :: Float
, _crTwist :: Float
, _crType :: CreatureType
, _crID :: Int
, _crPict :: Creature -> SPic
, _crSkin :: CreatureSkin
, _crUpdate :: Creature -> World -> World
, _crRad :: Float
, _crMass :: Float
@@ -398,11 +404,6 @@ data Creature = Creature
, _crStatistics :: CreatureStatistics
, _crCamouflage :: CamouflageStatus
}
data CreatureSkin = CreatureSkin
{ _skinHead :: Color
, _skinUpper :: Color
, _skinLower :: Color
}
data CamouflageStatus
= FullyVisible
| Invisible
@@ -1597,7 +1598,7 @@ makeLenses ''EquipParams
makeLenses ''TerminalCommand
makeLenses ''TerminalInput
makeLenses ''GenParams
makeLenses ''CreatureSkin
makeLenses ''CreatureType
makeLenses ''Corpse
----- ROOM LENSES
+4 -4
View File
@@ -38,8 +38,8 @@ defaultCreature = Creature
, _crMvDir = 0
, _crTwist = 0
, _crID = 1
, _crPict = basicCrPict
, _crSkin = defaultCreatureSkin
-- , _crPict = basicCrPict
, _crType = defaultCreatureSkin
, _crUpdate = const id
, _crRad = 10
, _crMass = 10
@@ -75,8 +75,8 @@ defaultCreature = Creature
, _crStatistics = CreatureStatistics 10 10 10
, _crCamouflage = FullyVisible
}
defaultCreatureSkin :: CreatureSkin
defaultCreatureSkin = CreatureSkin (greyN 0.9) (light4 green) (greyN 0.3)
defaultCreatureSkin :: CreatureType
defaultCreatureSkin = Humanoid (greyN 0.9) (light4 green) (greyN 0.3)
defaultInanimate :: Creature
defaultInanimate = defaultCreature & crActionPlan .~ Inanimate
+2 -1
View File
@@ -120,7 +120,8 @@ defaultWeapon = defaultItem
]
defaultBulletWeapon :: Item
defaultBulletWeapon = defaultWeapon & itConsumption .~ defaultBulletLoadable
defaultBulletWeapon = defaultWeapon
& itConsumption .~ defaultBulletLoadable
& itUse .~ ruseAmmoParams
defaultItemValue :: ItemValue
-2
View File
@@ -5,7 +5,6 @@ import Dodge.Data
import Dodge.Creature.State
import Dodge.Creature.Damage
import Dodge.Creature.Impulse
import Dodge.Creature.Picture
import Dodge.LevelGen.Data
import Dodge.Default
import Dodge.Movement.Turn
@@ -75,7 +74,6 @@ updateTurret rotSpeed mc w
& crOldPos .~ mcpos
& crRad .~ 1
& crDir .~ mcdir
& crPict .~ drawCrEquipment
& crUpdate .~ stateUpdate followThenClearImpulses
& crStance . posture .~ Aiming
& crApplyDamage .~ applyNoDamage
+1 -1
View File
@@ -53,7 +53,7 @@ addCrGibs cr w = case damageDirection $ _csDamage $ _crState cr of
& addGibsAtDir d 13 20 (_skinUpper skin) cpos
& addGibAtDir d 25 (_skinHead skin) cpos
where
skin = _crSkin cr
skin = _crType cr -- this should be cleaned up
cpos = _crPos cr
addGibsAt :: Float -> Float -> Color -> Point2 -> World -> World
+7 -1
View File
@@ -2,6 +2,7 @@ module Dodge.Render.ShapePicture
( worldSPic
) where
import Dodge.Creature.Picture.Awareness
import Dodge.Creature.Picture
import Dodge.Particle.Draw
import Dodge.RadarBlip
import Dodge.Flare
@@ -54,7 +55,7 @@ worldSPic cfig w
<> foldup (shiftDraw _blPos _blDir _blDraw) (filtOn' _blPos _blocks)
<> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _shapes)
<> foldup (dbArg _cpPict) (filtOn' _cpPos _corpses)
<> foldup (dbArg _crPict) (filtOn' _crPos _creatures)
<> foldup drawCreature (filtOn' _crPos _creatures)
<> foldup floorItemSPic (filtOn' _flItPos _floorItems)
<> foldup btSPic (filtOn' _btPos _buttons)
<> foldup mcSPic (filtOn' _mcPos _machines)
@@ -71,6 +72,11 @@ anyTargeting cfig w = (mempty,pictures $ IM.elems $ IM.mapMaybe f $ _crInv cr)
cr = you w
f it = fmap (\g -> g it cr cfig w) (it ^? itTargeting . tgDraw)
drawCreature :: Creature -> SPic
drawCreature cr = case _crType cr of
Humanoid {} -> basicCrPict cr
DrawnCreature f -> f cr
shiftDraw :: (a -> Point2) -> (a -> Float) -> (a -> a -> SPic) -> a -> SPic
shiftDraw fpos fdir fdraw x = uncurryV translateSPf (fpos x)
. rotateSP (fdir x)
+2 -2
View File
@@ -118,7 +118,7 @@ pokeShapeObj
-> (Int,Int,Int)
-> ShapeObj
-> IO (Int,Int,Int)
--{-# INLINE pokeShapeObj #-}
{-# INLINE pokeShapeObj #-}
pokeShapeObj ptr iptr ieptr counts (ShapeObj shtype shVerts) = case shtype of
TopPrism size -> pokeTopPrism (size - 2) ptr iptr ieptr counts (S.each shVerts)
@@ -127,7 +127,7 @@ pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort
-> (Int,Int,Int)
-> Stream (Of ShapeV) IO ()
-> IO (Int,Int,Int)
--{-# INLINE pokeTopPrism #-}
{-# INLINE pokeTopPrism #-}
pokeTopPrism size ptr iptr ieptr (nv,nshapeindices,nedgeindices) svs = do
nv' <- S.foldM_ (pokeJustV ptr) (return nv) return svs
nshapeindices' <- UV.foldM' (pokeTopPrismIndex nv iptr) nshapeindices