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

src/Dodge/Creature.hs

@@ -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,autoRifle & itConsumption . ammoLoaded .~ 1000)]
---    , _crInv = IM.fromList [(0,miniGun')]
+    , _crInv = IM.fromList [(0,miniGun)]
 --    , _crInv = IM.fromList [(0,autoRifle)]
     , _crInvSel = 0
     , _crRad = 10

src/Dodge/Creature/Impulse.hs

@@ -2,6 +2,7 @@ module Dodge.Creature.Impulse
     ( impulsiveAIR
 --    , impulsiveAI
     , impulsiveAI
+    , followImpulses
     ) where
 import Dodge.Data
 import Dodge.Creature.Vocalization

src/Dodge/Creature/Picture.hs

@@ -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 
+basicCrPict :: Color    -- ^ Creature color
-    :: Color    -- ^ Creature color
     -> Creature 
     -> Configuration
     -> World
     -> SPic
-basicCrPict col cr cfig w = (,) (basicCrShape col cr) $ pictures $
+basicCrPict col cr cfig w = 
-    targetingPic ++
+    drawCrEquipment cr
-    [ creatureDisplayText cfig w cr
+    <>
-    , tr . rotdir $ _spPicture $ drawEquipment 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 . _spShape $ drawEquipment cr
-    , rotdir . dm . translateSHz 20 $ scalp cr
+     rotdir . dm . translateSHz 20 $ scalp cr
     , rotdir . dm $ upperBody col cr
     , dm . rotmdir $ feet cr
     ]

src/Dodge/Creature/ReaderUpdate.hs

@@ -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

src/Dodge/Creature/SentinelAI.hs

@@ -63,8 +63,8 @@ sentinelFireType f = chainCreatureUpdatesLR
         )
       , (crAwayFromPost, goToPostStrat)
       ] 
---    , Left $ perceptionUpdate' [0]
+    , Left $ perceptionUpdate' [0]
-    , Left $ perceptionUp 0
+--    , Left $ perceptionUp 0
     , Right doStrategyActions
     , Right reloadOverride
     , Left targetYouWhenCognizant

src/Dodge/Creature/State.hs

@@ -2,8 +2,10 @@ module Dodge.Creature.State
     ( stateUpdate
     , stateUpdate'
     , stateUpdateDamage
+    , stateUpdateDamage'
     , doDamage
     , clearDamage
+    , invSideEff
     ) where
 import Dodge.Data
 import Dodge.Hammer

src/Dodge/Placement/Instance/Turret.hs

@@ -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')
+        Nothing -> w' & machines . ix mcid . mcType . tuMCrID ?~ cid
-        _ -> w'
+            & creatures . at cid ?~ thecreature
-    doDamage = machines . ix mcid %~ 
+          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)
+--    <> translateSPz 20 (itSPic it)
-  where
+--  where
-    it = _tuWeapon $ _mcType mc
+--    it = _tuWeapon $ _mcType mc
 
 wdth :: Float
 wdth = 10

src/Dodge/Placement/PlaceSpot.hs

@@ -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
+placeMachine color wallpoly mc p rot gw = (mcid
-    , w & gWorld . machines  %~ addMc
+    , gw & gWorld . machines  %~ addMc
-        & gWorld . walls     %~ placeMachineWalls color wallpoly mcid wlid
+         & 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

src/Dodge/Reloading.hs

@@ -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

src/DoubleStack.hs

@@ -1,5 +1,4 @@
-module DoubleStack
+module DoubleStack where
-    where
 
 newtype DS a = DS (a,[a],[a])
     deriving (Eq, Ord, Read, Show)