module Dodge.CreatureState where -- imports {{{ import Dodge.Data import Dodge.Base import Dodge.SoundLogic import Dodge.RandomHelp import Dodge.WorldEvent import Dodge.WallCreatureCollisions import Dodge.CreatureAction import Geometry import Picture import Data.List import Data.Char import Data.Maybe import Data.Function import Data.Graph.Inductive.Graph import Data.Graph.Inductive.PatriciaTree import Data.Graph.Inductive.Query.SP import Codec.BMP import qualified Data.ByteString as B import Control.Lens import Control.Applicative import Control.Monad.State import Control.Monad import qualified SDL as SDL import qualified SDL.Mixer as Mix import System.Random import qualified Data.Set as S import qualified Data.IntMap.Strict as IM import qualified Data.Map as M import Foreign.ForeignPtr import Control.Concurrent ---} type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) -- the movement is updated before the ai in order to correctly set the oldpos -- the whole of this update cycle could do with a rethink, it is becoming -- convoluted stateUpdate :: CRUpdate -> CRUpdate stateUpdate u w (f,g) cr = case u w (f,g) (updateMovement g cr) of ((f',g') , maybeCr) -> ( (invSideEff cr . movementSideEff cr . dropifdead . f' , g') , fmap (updateReloadCounter . reducePastDamage . doDamage) $ crOrCorpse =<< maybeCr ) where crOrCorpse cr | cr ^. crHP > 0 = Just cr | otherwise = Nothing dropifdead | cr ^.crHP > 0 = id | otherwise = stopSoundFrom (CrWeaponSound (_crID cr)) . over decorations addCorpse . insertIt crBeforeDeath = colCrWall w $ cr addCorpse = insertNewKey $ uncurry translate (_crOldPos cr) $ rotate (_crDir cr) (_crCorpse cr) maybeIt = evalState (maybeTakeOne $ IM.elems (_crInv cr)) (_randGen w) insertIt = case maybeIt of -- Just it -> createItemAt (offset +.+ _crPos crBeforeDeath) Just it -> createItemAt (offset +.+ _crOldPos cr) (FlIt {_flIt=it,_flItPos=(0,0),_flItRot=rot,_flItID=0}) Nothing -> id offset = _crRad cr *.* unitVectorAtAngle rot (rot,_) = randomR (-pi,pi) g setOldPos :: Creature -> Creature setOldPos cr = set crOldPos (_crPos cr) cr doDamage :: Creature -> Creature doDamage cr = set (crState . crDamage) [] $ over (crState . crPastDamage) (+ hpLost) damagedCr where dams = _crDamage $ _crState cr startHP = _crHP cr damagedCr = snd $ (_crApplyDamage (_crState cr)) dams cr afterHP = _crHP damagedCr hpLost = startHP - afterHP -- note this can be negative sumDamage :: Creature -> DamageType -> Int -> Int sumDamage cr dm x = x + _dmAmount dm reducePastDamage :: Creature -> Creature reducePastDamage = over (crState . crPastDamage) rdpdam where rdpdam x | x > 500 = x - 55 | x > 200 = x - 25 | x > 20 = x - 5 | x > 0 = x - 1 | otherwise = 0 movementSideEff :: Creature -> World -> World movementSideEff cr w | hasJetPack = case cr ^? crState . stance . carriage of Just (Boosting v) -> makeFlameletTimed (oldPos +.+ (_crRad cr + 3) *.* (unitVectorAtAngle $ _crDir cr + pi)) (momentum +.+ 1 *.* rotateV randDir (vInverse v)) Nothing 1 20 $ set randGen g w _ -> w | otherwise = case cr ^? crState . stance . carriage of Just (Walking x y) -> takeStep x y w _ -> w where hasJetPack = any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr oldPos = _crOldPos cr momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr) momentum'' | magV momentum' > 3 = 3 *.* normalizeV momentum' | otherwise = momentum' momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng (randDir,g) = randomR (-0.5,0.5) $ _randGen w (randAng,_) = randomR (0,2*pi) $ _randGen w (v1:v2:v3:_) = fst $ runState ((sequence . repeat . randInCirc) 0.1) $ _randGen w (r1:r2:r3:_) = map ((*.*) 100) (v2:v3:v1:[]) crHasMoved = dist (_crPos cr) (_crOldPos cr) > 0.5 takeStep x y | crHasMoved && x < 20 && x + y >= 20 = soundMultiFrom footor 22 3 0 | crHasMoved && x < 80 && x + y >= 80 = soundMultiFrom footor 23 3 0 | otherwise = id footor = [FootstepSound 0,FootstepSound 1] invSideEff :: Creature -> World -> World invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr) where f i it w' = case it ^? itEffect . itInvEffect of Nothing -> w' Just g -> g cr i w' weaponReloadSounds :: Creature -> World -> World weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of Just (Weapon {_wpReloadState = 0}) -> w Just (Weapon {_wpReloadState = 1}) -> stopSoundFrom (CrReloadSound cid) w Just (Weapon {}) -> soundFrom (CrReloadSound cid) reloadSound (1) 0 w _ -> w where cid = _crID cr updateMovement :: StdGen -> Creature -> Creature updateMovement g cr | isFrictionless cr = over crPos (+.+ momentum) $ setOldPos cr | otherwise = case cr ^? crState . stance . carriage of Just (Walking x y) -> set (crState . stance . carriage) (Walking ((x+y)`mod`120) 0) $ setOldPos cr _ -> set (crState . stance . carriage) (Walking 0 0) $ setOldPos cr where momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr) momentum'' | magV momentum' > 3 = 3 *.* normalizeV momentum' | otherwise = momentum' momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng (randAng,_) = randomR (0,2*pi) g isFrictionless :: Creature -> Bool isFrictionless cr = case cr ^? crState . stance . carriage of Just (Boosting _) -> True Just (Floating) -> True _ -> False updateReloadCounter :: Creature -> Creature updateReloadCounter cr = over (crInv . ix iSel . wpFireState) decreaseToZero . over (crInv . ix iSel . wpReloadState) decreaseToZero $ cr where iSel = _crInvSel cr decreaseToZero :: Int -> Int decreaseToZero x | x > 0 = x - 1 | otherwise = 0 --comb :: (StdGen -> Creature -> World -> World) -> (StdGen -> Creature -> Maybe Creature) -- -> CRUpdate --comb onDeath :: (Creature -> World -> World) -> CRUpdate -> CRUpdate onDeath h u w (f,g) cr | _crHP cr > 0 = u w (f,g) cr | otherwise = ( ( h cr . f, g ) , Nothing ) updateBarrel :: World -> (World -> World,StdGen) -> Creature -> ((World -> World , StdGen), Maybe Creature) updateBarrel w (f,g) cr | _crHP cr > 0 = ((f, g), newCr) | otherwise = ((f, g), Nothing) where damages = _crDamage $ _crState cr newCr = Just $ doDamage cr -- it is easy to leave off the "f" here -- should find some better way of doing all this that is less prone to error updateExpBarrel :: World -> (World -> World,StdGen) -> Creature -> ((World -> World , StdGen), Maybe Creature) updateExpBarrel w (f,g) cr | _crHP cr > 0 = ((f . foldr (.) id pierceSparks . hiss, g'), newCr) | otherwise = ((f . makeExplosionAt (_crPos cr) . stopSounds , g'), Nothing) where damages = _crDamage $ _crState cr pierceSparks :: [World -> World] pierceSparks = zipWith4 (\p a colid time-> (createBarrelSpark time colid (_crPos cr +.+ p) (a + argV p)) (Just $ _crID cr)) poss as colids times as = randomRs (-0.7,0.7) $ g colids = randomRs (0,11) $ g times = randomRs (2,5) $ g (g',_) = split 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 = over crHP (\hp -> hp - length (_piercedPoints $ _crSpState $ _crState cr)) cr hiss | poss == [] = id | otherwise = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] 41 50 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 sp int ep) 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