Rename Critters -> Creature

2021-03-27 00:17:01 +01:00
parent e6a57653b3
commit d603ef549d
4 changed files with 4 additions and 4 deletions
@@ -0,0 +1,396 @@
+module Dodge.Creature where
+-- imports {{{
+import Dodge.Data
+import Dodge.AIs
+import Dodge.CreatureState
+import Dodge.Default
+import Dodge.Base
+import Dodge.Item.Weapon
+import Dodge.Item.Consumable
+import Dodge.WorldEvent.Cloud
+import Dodge.Creature.YourControl
+
+import Picture
+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 Codec.BMP
+import qualified Data.ByteString as B
+import Control.Lens
+import Control.Applicative
+import Control.Monad.State
+import Control.Monad
+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
+---}
+
+--colouredEnemy col = pictures [color (greyN 0.8) $ circleSolid 10, color col $ circLine 10]
+colouredEnemy col = pictures [color col $ circleSolid 10, circLine 10]
+
+
+--  armouredSwarmCrit :: Int -> Creature
+--  armouredSwarmCrit n = (defaultCreature n)
+--  --    { _crUpdate = encircleAI' n
+--      { _crUpdate = swarmAI lineOrth n
+--      , _crHP = 30
+--      , _crPict = equipOnTop goalPict
+--      , _crState = defaultState {_goals = [[]], _faction = EncircleFlock}
+--      , _crInv = IM.fromList [(0,frontArmour)]
+--      }
+--  
+--  swarmCrit :: Int -> Creature
+--  swarmCrit n = (defaultCreature n)
+--  --    { _crUpdate = encircleAI' n
+--      { _crUpdate = swarmAI lineOrth n
+--      , _crHP = 30
+--      , _crPict = equipOnTop goalPict
+--      , _crState = defaultState {_goals = [[]], _faction = EncircleFlock}
+--      , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
+--      }
+--  
+--  encircleCrit :: Int -> Creature
+--  encircleCrit n = (defaultCreature n)
+--  --    { _crUpdate = encircleAI' n
+--      { _crUpdate = swarmAI lineOrth n
+--      , _crHP = 30
+--      , _crPict = equipOnTop goalPict
+--      , _crState = defaultState {_goals = [[]], _faction = EncircleFlock}
+--      , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
+--      }
+--  
+spawnerCrit :: Creature
+spawnerCrit = defaultCreature
+    { _crUpdate = stateUpdate $ spawnerAI chaseCrit
+    , _crHP = 300
+    , _crPict = enemyPict blue
+    , _crState = defaultState {_goals = [[WaitFor 0]]
+                            }
+    , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
+    }
+--  
+--  guardMelee :: Int -> Creature
+--  guardMelee n = (defaultCreature n)
+--      { _crUpdate = meleeAI' n
+--      , _crHP = 30
+--      , _crPict = equipOnTop goalPict
+--      , _crState = defaultState {_goals = [[InitGuard]]
+--                              ,_faction = ChaseCritters}
+--      , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
+--      }
+smallChaseCrit :: Creature
+smallChaseCrit = defaultCreature
+    { _crUpdate = stateUpdate chaseAI
+    , _crHP = 1
+    , _crRad = 4
+    --, _crPict = equipOnTop goalPict
+    , _crPict = enemyPict green
+    , _crState = defaultState {_goals = [[Wait]]
+                            ,_faction = ChaseCritters}
+    , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
+    , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 4
+    }
+chaseCrit :: Creature
+chaseCrit = defaultCreature
+    { _crUpdate = stateUpdate chaseAI
+    , _crHP = 300
+--    , _crPict = goalPict -- enemyPict green
+    , _crPict = enemyPict green
+    , _crState = defaultState {_goals = [[Wait]]
+                            ,_faction = ChaseCritters}
+    , _crInv = IM.empty 
+             --  IM.fromList [(0,frontArmour)]
+    }
+armourChaseCrit :: Creature
+armourChaseCrit = defaultCreature
+    { _crUpdate = stateUpdate chaseAI
+    , _crHP = 300
+    , _crPict = enemyPict green
+    , _crState = defaultState {_goals = [[Wait]]}
+    , _crInv = IM.fromList [(0,frontArmour)]
+    }
+miniGunCrit :: Creature
+miniGunCrit = defaultCreature
+    { _crPict = enemyPict red
+    --, _crUpdate =  checkDeadStopSound n . shooterFootsteps n . makeStateAI autoShooterAI n
+    , _crUpdate = stateUpdate  miniAI
+    --, _crUpdate = shooterFootsteps n . makeStateAI autoShooterAI n
+    , _crInv = IM.fromList [(0,miniGun)]
+    , _crInvSel = 0
+    , _crRad = 10
+    --, _crState = ShooterWait
+    , _crState = defaultState {_goals = [[InitGuard]]}
+    , _crHP = 500
+    }
+longCrit :: Creature
+longCrit = defaultCreature
+    { _crPict = enemyPict red
+    --, _crUpdate =  checkDeadStopSound n . shooterFootsteps n . makeStateAI autoShooterAI n
+    , _crUpdate = stateUpdate sniperAI
+    --, _crUpdate = shooterFootsteps n . makeStateAI autoShooterAI n
+    , _crInv = IM.fromList [(0,longGun),(1,medkit 100)]
+    , _crInvSel = 0
+    , _crRad = 10
+    --, _crState = ShooterWait
+    , _crState = defaultState {_goals = [[InitGuard]]}
+    , _crHP = 300
+    }
+multGunCrit :: Creature
+multGunCrit = defaultCreature
+    { _crPict = enemyPict red
+    --, _crUpdate =  checkDeadStopSound n . shooterFootsteps n . makeStateAI autoShooterAI n
+    , _crUpdate = stateUpdate (twitchMissAI 300 350)
+    --, _crUpdate = shooterFootsteps n . makeStateAI autoShooterAI n
+    , _crInv = IM.fromList [(0,multGun),(1,medkit 100)]
+    , _crInvSel = 0
+    , _crRad = 10
+    --, _crState = ShooterWait
+    , _crState = defaultState {_goals = [[InitGuard]]}
+    , _crHP = 300
+    }
+launcherCrit :: Creature
+launcherCrit = defaultCreature
+    { _crPict = enemyPict red
+    --, _crUpdate =  checkDeadStopSound n . shooterFootsteps n . makeStateAI autoShooterAI n
+    , _crUpdate = stateUpdate (launcherAI 150 200)
+    --, _crUpdate = shooterFootsteps n . makeStateAI autoShooterAI n
+    , _crInv = IM.fromList [(0,launcher),(1,medkit 100)]
+    , _crInvSel = 0
+    , _crRad = 10
+    --, _crState = ShooterWait
+    , _crState = defaultState {_goals = [[Init]]}
+    , _crHP = 300
+    }
+spreadGunCrit :: Creature
+spreadGunCrit = defaultCreature
+    { _crPict = enemyPict red
+    --, _crUpdate =  checkDeadStopSound n . shooterFootsteps n . makeStateAI autoShooterAI n
+    , _crUpdate = stateUpdate chargeAI
+    --, _crUpdate = shooterFootsteps n . makeStateAI autoShooterAI n
+    , _crInv = IM.fromList [(0,spreadGun),(1,medkit 100)]
+    , _crInvSel = 0
+    , _crRad = 10
+    --, _crState = ShooterWait
+    , _crState = defaultState {_goals = [[Init]]}
+    , _crHP = 300
+    }
+pistolCrit :: Creature
+pistolCrit = defaultCreature
+    { _crPict = enemyPict red
+    --, _crUpdate =  checkDeadStopSound n . shooterFootsteps n . makeStateAI autoShooterAI n
+    , _crUpdate = stateUpdate (dodgeAI 150 200)
+    --, _crUpdate = shooterFootsteps n . makeStateAI autoShooterAI n
+    , _crInv = IM.fromList [(0,pistol),(1,medkit 100)]
+    , _crInvSel = 0
+    , _crRad = 10
+    --, _crState = ShooterWait
+    , _crState = defaultState {_goals = [[InitGuard]]}
+    , _crHP = 500
+    }
+autoCrit :: Creature
+autoCrit = defaultCreature
+    { _crPict = enemyPict red
+    --, _crUpdate =  checkDeadStopSound n . shooterFootsteps n . makeStateAI autoShooterAI n
+    , _crUpdate = stateUpdate  basicShooterAI
+    --, _crUpdate = shooterFootsteps n . makeStateAI autoShooterAI n
+    , _crInv = IM.fromList [(0,autoGun),(1,medkit 100)]
+    , _crInvSel = 0
+    , _crRad = 10
+    --, _crState = ShooterWait
+    , _crState = defaultState {_goals = [[InitGuard]]}
+    , _crHP = 300
+    }
+addArmour :: Creature -> Creature
+addArmour = over crInv insarmour
+    where insarmour xs = IM.insert i frontArmour xs
+            where i = newKey xs
+--closeShooterCrit :: Int -> Creature
+--closeShooterCrit n = (defaultCreature n)
+--    { _crPos = startPos
+--    , _crPict = equipOnTop goalPict
+--    , _crUpdate =  closeShooterAI n
+--    , _crInv = IM.fromList [(0,ltAutoGun)]
+--    , _crInvSel = 0
+--    , _crRad = 10
+--    , _crState = defaultState {_goals = [[InitGuard]]}
+--    , _crHP = 50
+--    }
+--    where startPos = (20*fromIntegral n-550,0)
+barrel :: Creature
+barrel = defaultCreature
+    { _crUpdate = updateBarrel
+    , _crHP = 500
+    , _crPict = \ _ -> onLayer CrLayer $ pictures [ color orange $ circleSolid 10
+                                , color (greyN 0.5) $ circleSolid 8
+                                ]
+    , _crState = defaultState {_goals = [[Wait]]
+                            ,_faction = ChaseCritters
+                            ,_crSpState = Barrel []
+                            }
+    , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
+    }
+
+explosiveBarrel :: Creature
+explosiveBarrel = defaultCreature
+    { _crUpdate = updateExpBarrel
+    , _crHP = 400
+    , _crPict = \ _ -> onLayer CrLayer $ pictures [ color orange $ circleSolid 10
+                                , color red $ circleSolid 8
+                                ]
+    , _crState = defaultState {_goals = [[Wait]]
+                            ,_faction = ChaseCritters
+                            ,_crSpState = Barrel []
+                            ,_crApplyDamage = \_ c -> (id, c)
+                            }
+    , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
+    }
+
+equipOnTop :: (Creature -> Picture) -> Creature -> Picture
+--equipOnTop f cr = onLayer CrLayer $ pictures $ fst (drawEquipment cr) ++ [f cr] ++ snd (drawEquipment cr)
+equipOnTop f cr = pictures [onLayer CrLayer (f cr) , drawEquipment cr]
+
+drawEquipment :: Creature -> Picture
+drawEquipment cr = pictures $ map f $ IM.toList (_crInv cr)
+    where f (i,it) = case it ^? itEquipPict of
+                        Just g -> g cr i
+                        _      -> blank
+
+--drawEquipment :: Creature -> ([Picture],[Picture])
+--drawEquipment cr = (map fst p1, map fst p2)
+--     where f (k,it) = join $ (it ^? itEquipPict) <*> (pure cr) <*> (pure k)
+--           picts = sortBy (compare `on` snd) $ mapMaybe f $ IM.toList (_crInv cr)
+--           (p1,p2) = partition (\ x -> snd x < 0) picts
+
+frontArmouredPict = const $ pictures [ color (greyN 0.8) $ circleSolid 20
+                             , color red $ circLine 20
+                             ]
+
+--packCrits :: (Int -> World -> World) -> [Int] -> [Creature]
+--packCrits ai is = [(defaultCreature i)
+--    { _crPos = (150,10+20*fromIntegral i)
+--    , _crPict = swarmPict
+--    , _crUpdate = ai i
+--    --, _crUpdate = swarmAI is i
+--    , _crRad = 3
+--    , _crHP = 1
+--    , _crMass = 2
+--    }
+--    | i <- is]
+
+--queenBeeCrit :: Int -> Creature
+--queenBeeCrit cID = (defaultCreature cID)
+--    { _crRad = 20
+--    , _crCorpse = color (greyN 0.5) $ circleSolid 20
+--    , _crPict = const $ pictures [color black $ circSolid 20
+--                         ,color yellow $ circLine 20
+--                         ]
+--    , _crUpdate = checkDead cID . makeStateAI queenBeeAI cID
+--    , _crState = QueenBee 0 20
+--    , _crMass = 20
+--    }
+
+--antCrit :: Int -> Creature
+--antCrit cID = (defaultCreature cID)
+--    { _crPos = (0,100 + 3 * fromIntegral cID)
+--    , _crUpdate = checkDead cID . makeStateAI (antAI 2) cID
+--    , _crState = AntMove 50
+--    , _crPict = antPic
+--    , _crRad = 3
+--    , _crHP = 1
+--    , _crMass = 2
+--    , _crCorpse = color (greyN 0.5) $ circSolid 3
+--    }
+--    where i = evalState (state (randomR (1::Int,100))) (mkStdGen cID)
+--antPic = const $ pictures [ translate (-1) 0 $ circleSolid 2
+--                  , translate (2) 0 $ circleSolid 1
+--                  , translate (1) 0 $ circleSolid 1
+--                  , line [(3,3),(-3,-3)]
+--                  , line [(-3,3),(3,-3)]
+--                  , line [(0,-3),(0,3)]
+--                  ]
+
+flamerPict = const $ pictures [color (light $ light $ light $ dim blue) $ circleSolid 10, circLine 10]
+
+
+
+goalPict cr = let r = _crRad cr in case _crState cr of
+    CrSt {_goals = gls ,_crDamage = crDam } 
+--            | crDam > _crHP cr -> color white $ circleSolid r
+            | otherwise        -> case head gls of
+                        [] -> sizeColEnemy r white
+                        (MoveToFor p i:_) -> dGoals $ sizeColEnemy r green
+                        (WaitFor x:_) -> dGoals $ sizeColEnemy r yellow
+                        (FireAt p:_) -> dGoals $ sizeColEnemy r red
+                        (Reload:_) -> dGoals $ sizeColEnemy r orange
+                        (PathTo p:_) -> dGoals $ sizeColEnemy r cyan
+                        (SubPathTo p i _:_) -> dGoals $ sizeColEnemy r blue
+                        (Search i:_) -> dGoals $ sizeColEnemy r black
+                        _ -> dGoals $ sizeColEnemy r magenta
+                    where dGoals p = pictures [p, rotate (0 - _crDir cr) $ scale 0.1 0.1 $ color white $ text $ show gls]
+    _                  -> sizeColEnemy r (light $ dim green)
+
+startCr :: Creature
+startCr = defaultCreature
+    { _crPos = (0,0)
+    , _crOldPos = (0,0)
+    , _crDir = 0
+    , _crID = 0
+    , _crPict = basicCrPict $ greyN 0.8
+                
+    , _crUpdate = stateUpdate yourControl
+    , _crRad = 10
+    , _crMass = 10
+    , _crHP = 10000
+    , _crMaxHP = 1500
+    , _crInv = IM.fromList (zip [0..20] 
+         (
+          [pistol,autoGun,launcher,lasGun,grenade
+          ,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher
+          ,longGun
+          ,hvAutoGun
+          ,teslaGun
+          ,latchkey 0
+          ,miniGun
+          ,medkit 50
+          ,bezierGun
+          ,poisonSprayer
+          ,blinkGun
+          ,frontArmour
+          ] 
+          ++ repeat NoItem)) 
+         -- startInv
+    , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10]
+    }
+
+smokeGenGun = effectGun "smoke" $ \_ -> spawnSmokeAtCursor
+
+enemyPict :: Color -> Creature -> Picture
+enemyPict col = equipOnTop $ sizeEnemy (light $ light $ light $ light col)
+
+sizeEnemy col cr 
+    | pdam > 200      = color red $ circleSolid $ _crRad cr
+    | pdam > 100      = color white $ circleSolid $ _crRad cr
+    | mod pdam 2 == 1 = color white $ circleSolid $ _crRad cr
+    | otherwise       = pictures [color col $ circleSolid $ _crRad cr
+                                 , circLine $ _crRad cr ]
+    where pdam = _crPastDamage $ _crState cr
+
+sizeColEnemy r col = pictures [color col $ circleSolid r, circLine r]
+
+basicCrPict :: Color -> Creature -> Picture
+basicCrPict col cr = pictures [ onLayer CrLayer naked , drawEquipment cr]
+    where naked | pdam > 200      = color red $ circleSolid $ _crRad cr
+                | pdam > 100      = color white $ circleSolid $ _crRad cr
+                | mod pdam 2 == 1 = color white $ circleSolid $ _crRad cr
+                -- | crDam > _crHP cr && odd (crDam - _crHP cr)
+                --     = [color white $ circleSolid $ _crRad cr]
+                | otherwise        =  pictures [color col $ circleSolid $ _crRad cr, circLine $ _crRad cr]
+          pdam = _crPastDamage $ _crState cr