justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Delete cruft, add Reader monad to some internal ai

Browse Source
This commit is contained in:
jgk
2021-05-16 21:42:11 +02:00
parent 0798cc0b0e
commit d7fcdbf550
69 changed files with 721 additions and 2894 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/State.hs
+32 -49
View File
@@ -2,7 +2,6 @@ module Dodge.Creature.State where
import Dodge.Data
import Dodge.Creature.State.Data
import Dodge.Creature.Stance.Data
import Dodge.Data
import Dodge.Base
import Dodge.SoundLogic
import Dodge.RandomHelp
@@ -16,16 +15,11 @@ 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
import qualified SDL.Mixer as Mix
import System.Random
import qualified Data.Set as S
@@ -38,7 +32,6 @@ type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World
meleeCooldown :: CRUpdate -> CRUpdate
meleeCooldown u w (f,g) cr = u w (f,g) $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1))
-- | 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
@@ -46,11 +39,11 @@ stateUpdate :: CRUpdate -> CRUpdate
stateUpdate u w (f,g) cr =
let (cr', g'') = updateMovement g cr
in case u w (f,g'') cr' of
((f',g') , maybeCr) -> ( (invSideEff cr . movementSideEff cr . deathEff . f'
, g')
, fmap (updateReloadCounter . doDamage . crAutoReload)
$ crOrCorpse =<< maybeCr
)
((f',g') , maybeCr) ->
( (invSideEff cr . movementSideEff cr . deathEff . f'
, g')
, fmap (updateReloadCounter . doDamage . crAutoReload) $ crOrCorpse =<< maybeCr
)
where
crOrCorpse cr
| cr ^. crHP > 0 = Just cr
@@ -60,11 +53,11 @@ stateUpdate u w (f,g) cr =
| otherwise = stopSoundFrom (CrWeaponSound (_crID cr))
. over decorations addCorpse
. dropByState cr
crBeforeDeath = colCrWall w $ cr
addCorpse = insertNewKey $ uncurry translate (_crOldPos cr)
$ rotate (_crDir cr)
(_crCorpse cr)
crBeforeDeath = colCrWall w cr
addCorpse = insertNewKey
$ uncurry translate (_crOldPos cr)
$ rotate (_crDir cr)
(_crCorpse cr)
-- | Drop items according to the creature state.
dropByState :: Creature -> World -> World
dropByState cr w = foldr (copyItemToFloor cr) w is
@@ -75,10 +68,8 @@ dropByState cr w = foldr (copyItemToFloor cr) w is
DropSpecific xs -> xs
DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w)
setOldPos :: Creature -> Creature
setOldPos cr = set crOldPos (_crPos cr) cr
{- |
Given a creature and a velocity, applies friction to that creature and evaluates a
velocity to carry across frames.
@@ -86,17 +77,12 @@ velocity to carry across frames.
crFriction :: Creature -> Point2 -> Point2
crFriction cr vel = (0,0)
{- | In order to force a list, apply with seq. -}
forceSpine :: [a] -> ()
forceSpine = foldr (const id) ()
doDamage :: Creature -> Creature
doDamage cr = set (crState . crDamage) []
$ over (crState . crPastDamage) (f . take 20 . (dams :) ) damagedCr
$ over (crState . crPastDamage) (forceList . take 20 . (dams :) ) damagedCr
where
f l = seq (forceSpine l) l
dams = _crDamage $ _crState cr
damagedCr = snd $ (_crApplyDamage cr) dams cr
damagedCr = snd $ _crApplyDamage cr dams cr
sumDamage :: Creature -> DamageType -> Int -> Int
sumDamage cr dm x = x + _dmAmount dm
@@ -107,7 +93,7 @@ movementSideEff cr w
= case cr ^? crStance . carriage of
Just (Boosting v)
-> makeFlameletTimed
(oldPos +.+ (_crRad cr + 3) *.* (unitVectorAtAngle $ _crDir cr + pi))
(oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
(momentum +.+ 1 *.* rotateV randDir (vInverse v))
Nothing
1
@@ -128,9 +114,6 @@ movementSideEff cr w
(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
@@ -139,15 +122,16 @@ movementSideEff cr w
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'
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
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
@@ -171,7 +155,7 @@ updateMovement g cr
isFrictionless :: Creature -> Bool
isFrictionless cr = case cr ^? crStance . carriage of
Just (Boosting _) -> True
Just (Floating) -> True
Just Floating -> True
_ -> False
updateReloadCounter :: Creature -> Creature
@@ -212,12 +196,11 @@ updateExpBarrel w (f,g) cr
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
= 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
(g',_) = split g
poss = _piercedPoints $ _crSpState $ _crState cr
--newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages
@@ -229,7 +212,7 @@ updateExpBarrel w (f,g) cr
applyFuseDamage cr = over crHP (\hp -> hp - length (_piercedPoints
$ _crSpState $ _crState cr))
cr
hiss | poss == [] = id
hiss | null poss = id
| otherwise = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] 41 50 1
stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1)
@@ -237,14 +220,14 @@ damToExpBarrel :: [DamageType] -> Creature -> Creature
damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
where
(pierceDam,otherDam) = partition isPierce ds
isPierce (Piercing {}) = True
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' 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