105 lines
3.4 KiB
Haskell
105 lines
3.4 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
{-
|
|
Inanimate objects such as lamps, barrels, etc
|
|
-}
|
|
module Dodge.Creature.Inanimate
|
|
( barrel
|
|
, explosiveBarrel
|
|
, module Dodge.Creature.Lamp
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Creature.Lamp
|
|
import Dodge.WorldEvent.Explosion
|
|
import Dodge.Creature.Picture
|
|
--import Dodge.Creature.Stance.Data
|
|
import Dodge.Particle.Spark
|
|
import Dodge.Default
|
|
import Dodge.Creature.State
|
|
import Picture
|
|
import qualified IntMapHelp as IM
|
|
import Geometry
|
|
--import Geometry.Data
|
|
--import Geometry.Vector3D
|
|
import Shape
|
|
import Dodge.SoundLogic
|
|
import LensHelp
|
|
|
|
import System.Random
|
|
import Data.List
|
|
|
|
barrel :: Creature
|
|
barrel = defaultInanimate
|
|
{ _crUpdate = updateBarrel
|
|
, _crHP = 500
|
|
, _crPict = picAtCrPos $ setDepth 20 $ pictures
|
|
[ color orange $ circleSolid 10
|
|
, setDepth 0.049 . color (greyN 0.5) $ circleSolid 8
|
|
, color (greyN 0.5) $ circleSolid 8
|
|
]
|
|
, _crState = defaultState
|
|
{_crSpState = Barrel []
|
|
}
|
|
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
|
|
}
|
|
|
|
explosiveBarrel :: Creature
|
|
explosiveBarrel = defaultInanimate
|
|
{ _crUpdate = updateExpBarrel
|
|
, _crHP = 400
|
|
, _crPict = shapeAtCrPos
|
|
. colorSH orange
|
|
. upperPrismPoly 20
|
|
$ polyCirc 4 10
|
|
, _crState = defaultState
|
|
{_crSpState = Barrel []
|
|
}
|
|
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
|
|
,_crApplyDamage = \_ _ -> id
|
|
}
|
|
updateBarrel :: Creature -> World -> World
|
|
updateBarrel cr
|
|
| _crHP cr > 0 = doDamage cr
|
|
| otherwise = creatures . at (_crID cr) .~ Nothing
|
|
|
|
-- should generate the sparks externally using new random generators
|
|
updateExpBarrel :: Creature -> World -> World
|
|
updateExpBarrel cr w
|
|
| _crHP cr > 0 = foldr ($) (hiss w & creatures . at (_crID cr) .~ newCr) pierceSparks
|
|
| otherwise = makeExplosionAt (_crPos cr) $ stopSounds w & creatures . at (_crID cr) .~ Nothing
|
|
where
|
|
g = _randGen w
|
|
damages = _crDamage $ _crState cr
|
|
pierceSparks :: [World -> World]
|
|
pierceSparks
|
|
= zipWith4 (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p) (Just $ _crID cr))
|
|
poss as times colids
|
|
as = randomRs (-0.7,0.7) g
|
|
colids = randomRs (0,11) g
|
|
times = randomRs (2,5) g
|
|
poss = _piercedPoints $ _crSpState $ _crState cr
|
|
newCr = Just $ applyFuseDamage $ set (crState . crDamage) [] $ damToExpBarrel damages cr
|
|
applyFuseDamage cr' = cr' & crHP %~
|
|
subtract (length . _piercedPoints . _crSpState $ _crState cr')
|
|
hiss | null poss = id
|
|
| otherwise = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] (_crPos cr) foamSprayLoopS (Just 1)
|
|
stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1)
|
|
|
|
damToExpBarrel :: [Damage] -> Creature -> Creature
|
|
damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
|
|
where
|
|
(pierceDam,otherDam) = partition isPierce ds
|
|
isPierce Damage{_dmType = PIERCING{}} = True
|
|
isPierce _ = False
|
|
|
|
damToExpBarrel' :: Damage -> Creature -> Creature
|
|
damToExpBarrel' dm cr = case _dmType dm of
|
|
PIERCING -> over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr)
|
|
$ cr & crHP -~ div amount 200
|
|
POISONDAM -> cr
|
|
SPARKING -> cr
|
|
PUSHDAM -> cr LensHelp.& crPos .+.+~ (1 / _crMass cr *.* _dePushBack (_dmEffect dm))
|
|
_ -> cr LensHelp.& crHP -~ amount
|
|
where
|
|
amount = _dmAmount dm
|
|
int = _dmAt dm
|