Cleanup

src/Dodge/Creature/Impulse/UseItem.hs

@@ -54,30 +54,11 @@ useItemLoc cr loc pt w
       , Just invid' <- itm ^? itLocation . ilInvID =
         return $ toggleEquipmentAt invid' cr w
     | otherwise = (\loc' -> useItemLoc cr loc' pt w) =<< locUp' loc
-        -- ie try location above
   where
     sf = loc ^. locDT . dtValue . _2
     ldt = loc ^. locDT
     itm = ldt ^. dtValue . _1
 
---chooseUseLocation :: LocationLDT ItemLink OItem -> LocationLDT ItemLink OItem
---chooseUseLocation loc
---    | isJust $ loc ^? locLDT . ldtValue . _1 . itType . ibtEquip = loc
---    | isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apProjectiles . ix 0 =
---        loc
---    | sf <- loc ^. locLDT . ldtValue . _2
---      , structureUseAtLoc sf =
---        loc
---    | otherwise = maybe loc chooseUseLocation $ locUp loc
---
---structureUseAtLoc :: ItemStructuralFunction -> Bool
---structureUseAtLoc = \case
---    HeldPlatformSF -> True
---    UnderBarrelPlatformSF -> True
---    GadgetPlatformSF -> True
---    MapperSF -> True
---    _ -> False
-
 activateDetonator :: DTree OItem -> World -> World
 activateDetonator det = fromMaybe id $ do
     pjid <- det ^? dtValue . _1 . itUse . uaParams . apProjectiles . ix 0
@@ -118,9 +99,7 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation invid w of
     crpoint = cWorld . lWorld . creatures . ix (_crID cr)
     itmat i = _crInv cr IM.! i
     itm = itmat invid
-    --onequip itm' = doItmCrWdWd ((_eeOnEquip . _uequipEffect . _itUse) itm') itm'
     onequip itm' = effectOnEquip itm'
-    --onremove itm' = doItmCrWdWd ((_eeOnRemove . _uequipEffect . _itUse) itm') itm'
     onremove itm' = effectOnRemove itm'
 
 toggleExamineInv :: World -> World

src/Dodge/Data/ComposedItem.hs

@@ -1,7 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
 
 module Dodge.Data.ComposedItem where
 
+import Control.Lens
 import Dodge.Data.AmmoType
 import Dodge.Data.Item
 import Linear
@@ -19,7 +21,7 @@ data ItemSF -- Structural Function
     | IntroScanSF
     | TriggerSF
     | ARHUDSF
-    | AmmoMagSF Int AmmoType
+    | AmmoMagSF {_amsfLink :: Int , _amsfType :: AmmoType}
     | RemoteScreenSF
     | JoystickSF
     | RemoteDetonatorSF
@@ -41,3 +43,5 @@ data ItemSF -- Structural Function
 type CItem = (Item, ItemSF)
 
 type OItem = (Item, ItemSF, (V3 Float,Q.Quaternion Float))
+
+makeLenses ''ItemSF

src/Dodge/HeldUse.hs

@@ -44,8 +44,7 @@ import Sound.Data
 
 gadgetEffect :: PressType -> LocationDT OItem -> Creature -> World -> World
 gadgetEffect pt loc
-    | UseHeld{} <- loc ^. locDT . dtValue . _1 . itUse =
+    | UseHeld{} <- loc ^. locDT . dtValue . _1 . itUse = heldEffect pt loc
-        heldEffect pt loc
     | DROPPER x <- loc ^. locDT . dtValue . _1 . itType
       , Just i <- loc ^? locDT . dtValue . _1 . itUse . uInt
       , pt == InitialPress =
@@ -69,19 +68,27 @@ hammerCheck f pt loc cr w = case itemTriggerType loc of
     WarmUpNoDelay wm
         | _wTime (_itParams it) < wm ->
             w & setwarming
-                & soundContinue (CrWeaponSound cid 0) (_crPos cr) (warmupSound $ it ^. itType) (Just 2)
+                & soundContinue
-                & cWorld . lWorld . creatures . ix cid . crInv . ix invid . itParams . wTime +~ 1
+                    (CrWeaponSound cid 0)
+                    (_crPos cr)
+                    (warmupSound $ it ^. itType)
+                    (Just 2)
+                & itmset . itParams . wTime +~ 1
     WarmUpNoDelay{} -> f loc cr w & setwarming
     WarmUpCoolDown ws _ _
         -- UNSAFE:
         | _wTime (_itParams it) < ws ->
             w & setwarming
-                & soundContinue (CrWeaponSound cid 0) (_crPos cr) (warmupSound $ it ^. itType) (Just 2)
+                & soundContinue
-                & cWorld . lWorld . creatures . ix cid . crInv . ix invid . itParams . wTime +~ 1
+                    (CrWeaponSound cid 0)
+                    (_crPos cr)
+                    (warmupSound $ it ^. itType)
+                    (Just 2)
+                & itmset . itParams . wTime +~ 1
     WarmUpCoolDown _ cs _
         | _wTime (_itParams it) < cs ->
             f loc cr w & setwarming
-                & cWorld . lWorld . creatures . ix cid . crInv . ix invid . itParams . wTime +~ 1
+                & itmset . itParams . wTime +~ 1
     WarmUpCoolDown{} -> w & setwarming
     BurstTrigger is t
         | w ^. cWorld . lWorld . lClock - t > timelastused
@@ -96,12 +103,11 @@ hammerCheck f pt loc cr w = case itemTriggerType loc of
                     & randGen .~ gen
     HammerTrigger t
         | w ^. cWorld . lWorld . lClock - t > timelastused
-          , --          , isNothing $ lookup MakeAutoLink (tree ^. ldtRight)
+          , isNothing $ find ((== MakeAutoSF) . (^. dtValue . _2)) (loc ^. locDT . dtRight)
-            pt == InitialPress ->
+          , pt == InitialPress ->
             f loc cr w
     AutoTrigger t
-        | w ^. cWorld . lWorld . lClock - t > timelastused ->
+        | w ^. cWorld . lWorld . lClock - t > timelastused -> f loc cr w
-            f loc cr w
     NoTrigger -> f loc cr w
     _ -> w
   where
@@ -110,13 +116,12 @@ hammerCheck f pt loc cr w = case itemTriggerType loc of
     -- the following is unsafe, but if ilInvID isn't correctly set we probably
     -- will have problems elsewhere also
     invid = it ^?! itLocation . ilInvID
-    setwarming =
+    itmset = cWorld . lWorld . creatures . ix cid . crInv . ix invid
-        cWorld . lWorld . creatures . ix cid . crInv . ix invid . itParams . isWarming
+    setwarming = itmset . itParams . isWarming %~ const True
-            %~ const True
     timelastused = it ^. itTimeLastUsed
     g x = (x, WdWdBurstFireRepetition (_crID cr) invid)
 
-getVolleyBurst :: (Random a, RandomGen b, Num a) => Int -> b -> ([a], b)
+getVolleyBurst :: Int -> StdGen -> ([Int], StdGen)
 getVolleyBurst i g =
     let (is, g') = runState (replicateM (i -1) (state $ randomR (0, 6))) g
      in (scanl1 (+) is, g')
@@ -328,67 +333,20 @@ doHeldUseEffect t cr w = case t ^. dtValue . _1 . itType of
             return $
                 w
                     & randGen .~ g
-                    & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i
+                    & crinvset . ix i . itParams . unfiredBarrels %~ const is
-                        . itParams
-                        . unfiredBarrels
-                        %~ const is
         Just (_ : _ : _) -> fromMaybe w $ do
             i <- itm ^? itLocation . ilInvID
-            return $
+            return $ w & crinvset . ix i . itParams . unfiredBarrels %~ tail
-                w
-                    & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i
-                        . itParams
-                        . unfiredBarrels
-                        %~ tail
         _ -> w
     HELD ALTERIFLE -> fromMaybe w $ do
         i <- t ^? dtValue . _1 . itLocation . ilInvID
         return $
-            w
+            w & crinvset . ix i . itParams . alteRifleSwitch %~ ((`mod` 2) . (+ 1))
-                & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i
-                    . itParams
-                    . alteRifleSwitch
-                --                    . itUse
-                --                    . heldMuzzles
-                --                    . ix 0
-                --                    . mzAmmoSlot
-                %~ ((`mod` 2) . (+ 1))
     _ -> w
   where
+    crinvset = cWorld . lWorld . creatures . ix (_crID cr) . crInv
     itm = t ^. dtValue . _1
 
---doHeldUseEffect t cr w = case t ^? ldtValue . itUse . heldUseEffect of
---    Just (RandomiseMuzzleFrames x) -> fromMaybe w $ do
---        i <- t ^? ldtValue . itLocation . ilInvID
---        let g = w ^. randGen
---            (is, g') = runState (shuffle [0 .. x -1]) g
---        return $
---            w & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i . itUse . heldMuzzles %~ zipWith (\j mz -> mz & mzFrame .~ j) is
---                & randGen .~ g'
---    Just SwitchAlteRifle -> fromMaybe w $ do
---        i <- t ^? ldtValue . itLocation . ilInvID
---        return $
---            w
---                & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i
---                    . itUse
---                    . heldMuzzles
---                    . ix 0
---                    . mzAmmoSlot
---                %~ ((`mod` 2) . (+ 1))
---    Just NoHeldUseEffect -> w
---    Nothing -> w
-
----- need to be careful about inventory lock or item ids here
---doWeaponRepetitions :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
---doWeaponRepetitions itm cr = case itm ^? ldtValue . itUse . heldParams . weaponRepeat of
---    Just xs -> cWorld . lWorld . delayedEvents .++~ map f xs
---    _ -> id
---  where
---    f x = (x, WdWdFromItCrixWdWd (upitm x) (_crID cr) ItCrWdItemHeldEffect)
---    upitm x =
---        itm & ldtValue . itUse . heldParams . weaponRepeat .~ []
---            & ldtValue . itUse . heldFrame .~ x
-
 -- should probably unify failure with time use check in some way...
 applyCME :: LocationDT OItem -> Creature -> Bool -> World -> World
 applyCME loc cr cme
@@ -461,8 +419,7 @@ applyInvLock :: Item -> Creature -> World -> World
 applyInvLock itm cr = case itemInvLock itm of
     i
         | i > 0 && cid == 0 ->
-            (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv))
+            (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv)) . lockInv
-                . lockInv
     _ -> id
   where
     cid = _crID cr
@@ -662,10 +619,7 @@ heldTorqueAmount = \case
     BLINKER -> 0
     BLINKERUNSAFE -> 0
 
-loadMuzzle ::
+loadMuzzle :: DTree OItem -> Muzzle -> (DTree OItem, Maybe (Muzzle, Int, DTree OItem))
-    DTree OItem ->
-    Muzzle ->
-    (DTree OItem, Maybe (Muzzle, Int, DTree OItem))
 loadMuzzle t@(DT _ l _) mz = fromMaybe (t, Nothing) $ do
     let as = _mzAmmoSlot mz
         amamount = _mzAmmoPerShot mz
@@ -749,8 +703,10 @@ basicMuzFlare pos dir =
         . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
 
 isAmmoIntLink :: Int -> ItemSF -> Bool
-isAmmoIntLink i (AmmoMagSF j _) = i == j
+isAmmoIntLink i sf = Just i == sf ^? amsfLink
-isAmmoIntLink _ _ = False
+
+-- (AmmoMagSF j _) = i == j
+--isAmmoIntLink _ _ = False
 
 useLoadedAmmo ::
     LocationDT OItem ->
@@ -850,18 +806,11 @@ tractorBeamAt pos outpos dir power =
     TractorBeam
         { _tbPos = pos
         , _tbStartPos = outpos
-        , _tbVel = d
+        , _tbVel = unitVectorAtAngle dir * power
         , _tbTime = 10
         }
-  where
-    d = unitVectorAtAngle dir * power
 
-creatureShootLaser ::
+creatureShootLaser :: LocationDT OItem -> Creature -> Muzzle -> World -> World
-    LocationDT OItem ->
-    Creature ->
-    Muzzle ->
-    World ->
-    World
 creatureShootLaser loc cr mz w =
     w
         & randGen .~ g
@@ -1125,14 +1074,12 @@ useGasParams mmagid mz loc cr w =
     (V3 x y _, q) =
         locOrient loc cr
             `Q.comp` ((_mzPos mz + V2 0 offset) `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz))
-    --    (moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
     pos = _crPos cr + rotateV (_crDir cr) (V2 x y)
     (a, g') = randomR (- inacc, inacc) g
     inacc = _mzInaccuracy mz
     offset = case mz ^. mzRandomOffset of
         0 -> 0
         i -> fst . randomR (- i, i) $ _randGen w
-    --    dir = _crDir cr + mrot + a + _nzAngle (_itParams itm)
     dir = _crDir cr + Q.qToAng q + a + _nzAngle (_itParams itm)
 
 gasType :: HeldItemType -> GasFuel -> Maybe GasCreate
@@ -1192,14 +1139,11 @@ mcShootLaser _ mc =
 
 mcShootAuto :: Item -> Machine -> World -> World
 mcShootAuto itm mc w
-    | Just (AutoTrigger rate) <- baseItemTriggerType <$> mc ^? mcType . mctTurret . tuWeapon -- . itUse . heldDelay
+    | Just (AutoTrigger rate) <- baseItemTriggerType <$> mc ^? mcType . mctTurret . tuWeapon
       , w ^. cWorld . lWorld . lClock - rate > lastused =
         w
             & cWorld . lWorld . machines . ix (_mcID mc) . mcType . mctTurret . tuWeapon
                 . itTimeLastUsed
-                --                . itUse
-                --                . heldDelay
-                --                . rateTimeLastUsed
                 .~ w ^. cWorld . lWorld . lClock
             & makeBullet defaultBullet itm pos dir
     | otherwise = w
@@ -1214,8 +1158,6 @@ shootTeslaArc loc cr mz w =
     w' & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itParams .~ ip
         & soundContinue (CrWeaponSound (_crID cr) 0) pos elecCrackleS (Just 2)
   where
-    -- use items item location instead
-    --    itRef = cr ^?! crManipulation . manObject . imRootSelectedItem -- unsafe!! TODO change
     itm = loc ^. locDT . dtValue . _1
     invid = itm ^?! itLocation . ilInvID
     (w', ip) = makeTeslaArc (itm ^. itParams) pos dir w
@@ -1230,8 +1172,7 @@ shootTeslaArc loc cr mz w =
 
 determineProjectileTracking :: DTree OItem -> DTree OItem -> RocketHoming
 determineProjectileTracking magtree itmtree =
-    fromMaybe NoHoming $
+    fromMaybe NoHoming $ finddronecontrols <|> findexternaltracking
-        finddronecontrols <|> findexternaltracking
   where
     finddronecontrols = do
         screen <- find isremscreen (magtree ^. dtLeft)
@@ -1448,15 +1389,11 @@ useInventoryPath pt i ip loc cr w = case ip of
     RELCURS -> fromMaybe w $ do
         j <- cr ^? crManipulation . manObject . imSelectedItem
         guard $ (i + j) `IM.member` (cr ^. crInv)
-        return $
+        return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
-            w
-                & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
     RELITEM -> fromMaybe w $ do
         j <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID
         guard $ (i + j) `IM.member` (cr ^. crInv)
-        return $
+        return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
-            w
-                & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
 
 --useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
 --    [w'] -> w & cwTime . maybeWorld .~ Just' w'

src/Dodge/Item/Grammar.hs

@@ -106,7 +106,7 @@ extraWeaponLinksBelow itm
     | otherwise = []
 
 getAmmoLinks :: Item -> [ItemSF]
-getAmmoLinks itm = map (uncurry AmmoMagSF) (IM.toList $ itemAmmoSlots itm)
+getAmmoLinks = map (uncurry AmmoMagSF) . IM.toList . itemAmmoSlots
 
 itemToFunction :: Item -> ItemSF
 itemToFunction itm = case itm ^. itType of