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

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')
-        _ -> 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

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