Use a creature to "use" the weapon of a turret

2021-12-11 18:06:04 +00:00
parent 15e1fbc060
commit cdeb3dfa67
10 changed files with 80 additions and 34 deletions
@@ -9,8 +9,7 @@ module Dodge.Creature
    , chaseCrit
    , armourChaseCrit
    , smallChaseCrit
-    )
-  where
+    ) where
 import Dodge.Creature.State.Data
 --import Dodge.Item.Weapon.Grenade
 import Dodge.Item.Weapon.Booster
@@ -77,8 +76,8 @@ miniGunCrit = defaultCreature
        , _crStrategy   = StrategyActions WatchAndWait [StartSentinelPost]
        , _crGoal       = []
        }
-    , _crInv = IM.fromList [(0,autoRifle & itConsumption . ammoLoaded .~ 1000)]
--    , _crInv = IM.fromList [(0,miniGun')]
+--    , _crInv = IM.fromList [(0,autoRifle & itConsumption . ammoLoaded .~ 1000)]
+    , _crInv = IM.fromList [(0,miniGun)]
 --    , _crInv = IM.fromList [(0,autoRifle)]
    , _crInvSel = 0
    , _crRad = 10
@@ -2,6 +2,7 @@ module Dodge.Creature.Impulse
    ( impulsiveAIR
 --    , impulsiveAI
    , impulsiveAI
+    , followImpulses
    ) where
 import Dodge.Data
 import Dodge.Creature.Vocalization
@@ -4,6 +4,7 @@ Drawing of creatures.
 Takes into account damage etc. -}
 module Dodge.Creature.Picture
    ( basicCrPict
+    , drawCrEquipment
    , circLine
    , picAtCrPos
    , shapeAtCrPos
@@ -24,22 +25,27 @@ import ShapePicture
 import Control.Lens
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Vector as V
-basicCrPict 
-    :: Color    -- ^ Creature color
+basicCrPict :: Color    -- ^ Creature color
    -> Creature 
    -> Configuration
    -> World
    -> SPic
-basicCrPict col cr cfig w = (,) (basicCrShape col cr) $ pictures $
-    targetingPic ++
-    [ creatureDisplayText cfig w cr
-    , tr . rotdir $ _spPicture $ drawEquipment cr
-    ]
+basicCrPict col cr cfig w = 
+    drawCrEquipment cr
+    <>
+    (basicCrShape col cr
+    , pictures $
+        targetingPic ++
+        [ creatureDisplayText cfig w cr
+        --, tr . rotdir $ _spPicture $ drawEquipment cr
+        ]
+    )
  where 
    targetingPic = IM.elems $ IM.mapMaybeWithKey f $ _crInv cr
    f invid it = fmap ((\g -> g invid it cr w) . snd) (it ^? itTargeting . _Just)
-    tr = uncurryV translate (_crPos cr) 
-    rotdir = rotate (_crDir cr)
+
+drawCrEquipment :: Creature -> SPic
+drawCrEquipment cr = uncurryV translateSPf (_crPos cr) (rotateSP (_crDir cr) $ drawEquipment cr)

 shapeAtCrPos :: Shape -> Creature -> Configuration -> World -> SPic
 shapeAtCrPos sh cr _ _ = 
@@ -52,8 +58,8 @@ basicCrShape
    -> Creature 
    -> Shape
 basicCrShape col cr = tr . scaleSH (V3 crsize crsize crsize) $ mconcat
-    [ rotdir . _spShape $ drawEquipment cr
-    , rotdir . dm . translateSHz 20 $ scalp cr
+    [ --rotdir . _spShape $ drawEquipment cr
+     rotdir . dm . translateSHz 20 $ scalp cr
    , rotdir . dm $ upperBody col cr
    , dm . rotmdir $ feet cr
    ]
@@ -202,5 +202,6 @@ targetYouWhenCognizantR cr = reader $ \w -> case cr ^? crPerception . crAwarenes
 targetYouWhenCognizant :: World -> Creature -> Creature
 targetYouWhenCognizant w cr = case cr ^? crPerception . crAwarenessLevel . ix 0 of
 -- so this caused a space leak: be careful with ?~
+-- consider changing targeted creature to be just an index
    Just (Cognizant _)  -> _creatures w IM.! 0 `seq` cr & crIntention . targetCr ?~ _creatures w IM.! 0
    _                   -> cr & crIntention . targetCr .~ Nothing
@@ -63,8 +63,8 @@ sentinelFireType f = chainCreatureUpdatesLR
        )
      , (crAwayFromPost, goToPostStrat)
      ] 
--    , Left $ perceptionUpdate' [0]
-    , Left $ perceptionUp 0
+    , Left $ perceptionUpdate' [0]
+--    , Left $ perceptionUp 0
    , Right doStrategyActions
    , Right reloadOverride
    , Left targetYouWhenCognizant
@@ -2,8 +2,10 @@ module Dodge.Creature.State
    ( stateUpdate
    , stateUpdate'
    , stateUpdateDamage
+    , stateUpdateDamage'
    , doDamage
    , clearDamage
+    , invSideEff
    ) where
 import Dodge.Data
 import Dodge.Hammer
@@ -1,8 +1,13 @@
 module Dodge.Placement.Instance.Turret where
 import Color
 import Dodge.Data
+import Dodge.Reloading
+import Dodge.Creature.State
+import Dodge.Creature.Impulse
+import Dodge.Creature.Picture
 import Dodge.LevelGen.Data
 import Dodge.Default
+import Dodge.Creature.Impulse.UseItem
 import Dodge.FloorItem
 import Dodge.Wall.Delete
 import Dodge.WorldEvent.Explosion
@@ -10,7 +15,7 @@ import Dodge.Item.Weapon.BatteryGuns
 import Dodge.Item.Weapon.BulletGun.Cane
 --import Dodge.SoundLogic.LoadSound
 --import Dodge.SoundLogic
-import Dodge.Item.Draw
+--import Dodge.Item.Draw
 import Geometry
 import ShapePicture
 import Shape
@@ -20,6 +25,7 @@ import LensHelp
 import qualified IntMapHelp as IM

 import Data.List
+import Data.Maybe

 putLasTurret :: Float -> Placement
 putLasTurret rotSpeed = sps0 $ PutMachine blue (reverse $ square wdth) defaultMachine
@@ -45,14 +51,33 @@ updateTurret rotSpeed mc w
        & copyItemToFloor mcpos lasGun
    | otherwise = w 
        & initHomonculus
-        & doDamage 
+        & dodamage 
        & maybeFire 
        & elecDamBranch
  where
    initHomonculus w' = case w' ^? machines . ix mcid . mcType . tuMCrID . _Just  of
-        Nothing -> w' & machines . ix mcid . mcType . tuMCrID ?~ IM.newKey (_creatures w')
-        _ -> w'
-    doDamage = machines . ix mcid %~ 
+        Nothing -> w' & machines . ix mcid . mcType . tuMCrID ?~ cid
+            & creatures . at cid ?~ thecreature
+          where
+            cid = IM.newKey (_creatures w')
+            thecreature = defaultCreature
+                & crID .~ cid
+                & crInv . at 0 ?~ (_tuWeapon (_mcType mc) & itDimension . dimPortage . handlePos -~ 20
+                    & itConsumption . ammoLoaded .~ 1
+                    )
+                & crPos .~ mcpos
+                & crOldPos .~ mcpos
+                & crRad    .~ 1
+                & crDir .~ mcdir
+                & crPict .~ (\cr _ _ -> drawCrEquipment cr)
+                -- & crPict .~ basicCrPict red
+                -- & crUpdate .~ (\cr -> crUpCrUp stepReloading cr . invSideEff cr)
+                & crUpdate .~ stateUpdate' (\cr w -> followImpulses w cr)
+                & crStance . posture .~ Aiming
+        Just cid -> w'
+            & creatures . ix cid . crPos .~ mcpos
+            & creatures . ix cid . crDir .~ mcdir
+    dodamage = machines . ix mcid %~ 
        ( (mcDamage .~ [Electrical (min 2500 $ max 0 (elecDam - 10)) 0 0 0])
        . (mcHP -~ dam)
        )
@@ -60,11 +85,19 @@ updateTurret rotSpeed mc w
        | elecDam < 10 = updateFiringStatus . doTurn
        | otherwise = id
    -- TODO make this use the same function as the lasgun
-    it = _tuWeapon (_mcType mc)
+    --it = _tuWeapon (_mcType mc)
    maybeFire
        | _tuFireTime (_mcType mc) > 0
            -- massive hack
-            = _rUse (_itUse it) it (defaultCreature {_crPos = mcpos,_crDir = mcdir})
+            = fromMaybe id $ do
+                cid <- _tuMCrID (_mcType mc)
+                --return $ useItem cid
+      --          return id
+                return $ creatures . ix cid . crActionPlan . crImpulse .~ [UseItem]
+--                cr  <- w ^? creatures . ix cid
+--                it  <- cr ^? crInv . ix 0
+--                return $  _rUse (_itUse it) it cr
+--            = _rUse (_itUse it) it (defaultCreature {_crPos = mcpos,_crDir = mcdir})
 --            = ( particles .:~ makeLaserAt 5 (mcpos + 15 *.* unitVectorAtAngle mcdir) mcdir )
 --            . soundContinue (MachineSound mcid) mcpos tone440sawtoothquietS (Just 1)
        | otherwise = id
@@ -99,9 +132,9 @@ drawTurret :: Machine -> SPic
 drawTurret mc = (rotateSH (-_mcDir mc) . colorSH blue $ upperPrismPoly 20 (square wdth)
    , mempty -- setLayer 5 $ scale 0.5 0.5 $ text $ show $ _mcDir mc )
    )
-    <> translateSPz 20 (itSPic it)
-  where
-    it = _tuWeapon $ _mcType mc
+--    <> translateSPz 20 (itSPic it)
+--  where
+--    it = _tuWeapon $ _mcType mc

 wdth :: Float
 wdth = 10
@@ -17,6 +17,7 @@ import Dodge.ShiftPoint
 --import Dodge.RandomHelp
 --import Dodge.Placements.Spot
 import Geometry
+--import Geometry.ConvexPoly
 import Shape
 import qualified IntMapHelp as IM
 import Color
@@ -176,16 +177,17 @@ mvCr :: Point2 -> Float -> Creature -> Creature
 mvCr p rot cr = cr {_crPos = p,_crOldPos = p,_crDir = rot}

 placeMachine :: Color -> [Point2] -> Machine -> Point2 -> Float -> GenWorld -> (Int,GenWorld)
-placeMachine color wallpoly mc p rot w = (mcid
-    , w & gWorld . machines  %~ addMc
-        & gWorld . walls     %~ placeMachineWalls color wallpoly mcid wlid
+placeMachine color wallpoly mc p rot gw = (mcid
+    , gw & gWorld . machines  %~ addMc
+         & gWorld . walls     %~ placeMachineWalls color wallpoly mcid wlid
    )
  where 
-    w' = _gWorld w
+    w' = _gWorld gw
    mcid = IM.newKey $ _machines w'
    wlid = IM.newKey $ _walls w'
    wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
-    addMc mcs = IM.insert mcid (mc {_mcPos = p,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids}) mcs
+    --addMc = IM.insert mcid (mc {_mcPos = centroid wallpoly,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids})
+    addMc = IM.insert mcid (mc {_mcPos = p,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids})

 -- TODO correctly remove/shift pathfinding lines (removePathsCrossing)
 placeMachineWalls :: Color -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
@@ -20,6 +20,9 @@ icTryStartReloading am
 crStopReloading :: Creature -> Creature
 crStopReloading cr = cr & crInv . ix (_crInvSel cr) . itConsumption . reloadState .~ Nothing'

+crUpCrUp :: (Creature -> Creature) -> Creature -> World -> World
+crUpCrUp f cr = creatures . ix (_crID cr) %~ f
+
 stepReloading :: Creature -> Creature
 stepReloading cr = case cr ^? crInv . ix isel . itConsumption . reloadState . _Just' of
    Just 0 -> cr & crInv . ix isel . itConsumption %~ doload