--{-# LANGUAGE TupleSections #-} {- Inanimate objects such as lamps, barrels, etc -} module Dodge.Creature.Inanimate ( lamp , colorLamp , barrel , explosiveBarrel ) where import Dodge.Data import Dodge.WorldEvent.Explosion import Dodge.Creature.Picture --import Dodge.Creature.Stance.Data import Dodge.Picture.Layer import Dodge.Default import Dodge.Creature.State import Dodge.LightSource import Dodge.WorldEvent.Flash import Dodge.WorldEvent.Sound import Dodge.Creature.Update import Picture import qualified IntMapHelp as IM import Geometry --import Geometry.Data --import Geometry.Vector3D import Polyhedra import Shape import Dodge.WorldEvent import Dodge.SoundLogic import System.Random import Data.List import Control.Lens import Data.Monoid defaultInanimate :: Creature defaultInanimate = defaultCreature & crActionPlan .~ Inanimate colorLamp :: Point3 -- color of lamp -> Float -- height of lamp -> Creature colorLamp col h = defaultInanimate { _crUpdate = initialiseColorLamp col h , _crHP = 100 , _crPict = 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 } -- it is not clear that any of the attempts with Foldl help at all here lampCrPic :: Float -> Picture lampCrPic h = pictures [ setLayer 1 (setDepth h . color white $ circleSolid 3) , concatMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1) ] where f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] 0 polyNum --lTriFold :: a -> a -> L.Fold a [a] --lTriFold s x = L.Fold (f s) (x,[]) snd -- where -- f s' (x1,l) x2 = (x2,s':x1:x2:l) -- --preTriFold :: (a -> b) -> [a] -> [b] --preTriFold f (s:x:xs) = L.fold (L.premap f $ lTriFold (f s) (f x)) xs --preTriFold _ _ = [] -- --polyToTriFold :: [a] -> [a] --polyToTriFold (s:x:xs) = L.fold (lTriFold s x) xs --polyToTriFold _ = [] initialiseLamp :: Float -> CRUpdate initialiseLamp = initialiseColorLamp 0.75 initialiseColorLamp :: Point3 -> Float -> CRUpdate initialiseColorLamp col h cr _ = ( Endo addLS , Just $ cr & crUpdate .~ updateLamp h i) where i = _crID cr addLS w = w & lightSources %~ IM.insert lsid (lsColPosID col (V3 x y h) lsid) & creatures . ix i . crUpdate .~ updateLamp h lsid where lsid = IM.newKey $ _lightSources w (V2 x y) = _crPos cr updateLamp :: Float -> Int -> CRUpdate updateLamp h i = unrandUpdate handleLS internalUpdate where handleLS cr w | _crHP cr < 0 = explosionFlashAt cPos $ mkSoundBreakGlass cPos w & lightSources %~ IM.delete i | otherwise = w & lightSources . ix i . lsParam . lsPos .~ f cPos where cPos = _crPos cr f (V2 x y) = V3 x y h internalUpdate cr | _crHP cr < 0 = Nothing | otherwise = Just $ doDamage cr barrel :: Creature barrel = defaultInanimate { _crUpdate = updateBarrel , _crHP = 500 , _crPict = picAtCrPos $ onLayer CrLayer $ 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 = \_ c -> (id, c) } updateBarrel :: Creature -> World -> (Endo World, Maybe Creature) updateBarrel cr _ | _crHP cr > 0 = (Endo id, newCr) | otherwise = (Endo id, Nothing) where newCr = Just $ doDamage cr -- should generate the sparks externally using new random generators updateExpBarrel :: Creature -> World -> (Endo World, Maybe Creature) updateExpBarrel cr w | _crHP cr > 0 = (Endo $ foldr (.) id pierceSparks . hiss, newCr) | otherwise = (Endo $ makeExplosionAt (_crPos cr) . stopSounds , 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 $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages newCr = Just $ applyFuseDamage $ set (crState . crDamage) [] $ damToExpBarrel damages cr --perforate :: DamageType -> Creature -> Creature --perforate (Piercing amount sp int ep) cr = over (crState . crSpState . piercedPoints) -- ((:) $ int -.- _crPos cr) cr --perforate _ cr = 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 :: [DamageType] -> Creature -> Creature damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam where (pierceDam,otherDam) = partition isPierce ds isPierce Piercing{} = True isPierce _ = False damToExpBarrel' :: DamageType -> Creature -> Creature damToExpBarrel' (Piercing amount _ int _) cr = over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr) $ over crHP (\hp -> hp - div amount 200) cr damToExpBarrel' PoisonDam {} cr = cr damToExpBarrel' SparkDam {} cr = cr damToExpBarrel' PushDam{_dmPushBack = v} cr = cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* v) damToExpBarrel' dt cr = cr Control.Lens.& crHP -~ _dmAmount dt