Add source files, commit before reverting pictures to lists

2021-02-15 00:07:55 +01:00
parent c6bcfacc7a
commit 8447844bcd
41 changed files with 13677 additions and 35 deletions
@@ -0,0 +1,245 @@
+module Dodge.CreatureState where
+-- imports {{{
+import Dodge.Data
+import Dodge.Base
+import Dodge.SoundLogic
+import Dodge.RandomHelp
+import Dodge.WorldActions
+import Dodge.WallCreatureCollisions
+import Dodge.CreatureActions
+
+import Geometry
+
+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 translateDrawing (_crPos crBeforeDeath) 
+        addCorpse = insertNewKey $ uncurry translateDrawing (_crOldPos cr) 
+                                 $ rotateDrawing (radToDeg (_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
+-- applyDamage (cr ^. crState . crDamage) cr
+          afterHP = _crHP damagedCr
+          hpLost = startHP - afterHP  -- note this can be negative 
+--          applyDamage :: DamageType -> Creature -> Creature
+--          applyDamage dt cr = snd $ (cr ^. crState . crApplyDamage) dt cr
+
+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) 
+                -> makeFlamelet (oldPos +.+ (_crRad cr + 3) *.* (unitVectorAtAngle $ _crDir cr + pi))
+                                (momentum +.+ 1 *.* rotateV randDir (vInverse v)) 
+                                66
+                                Nothing
+                                1
+--                    $ smokeGen v
+                    $ 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:[])
+              (t1:t2:t3:_) = randomRs ( 15,20) $ _randGen w
+              (s1:s2:s3:_) = map (\s -> fromIntegral s * 0.1 - 1) (t3:t2:t1:[])
+              smokeGen v =  makeSmokeAt'' v1 s1 t1 
+                                (r1 +.+ oldPos +.+ ((_crRad cr + 3) *.* vInverse (unitVectorAtAngle $ _crDir cr)))
+
+              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
+
+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)
+--                    | otherwise   = ((makeExplosionAt (_crPos cr) . stopSounds , 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