Cleanup

src/Dodge/HeldUse.hs

@@ -7,14 +7,12 @@ module Dodge.HeldUse (
     mcUseHeld,
 ) where
 
-import NewInt
-import Dodge.Creature.Action.Blink
-import Dodge.RadarSweep
 import Color
 import Control.Monad
 import Data.Maybe
 import Dodge.Base.Collide
 import Dodge.Base.Coordinate
+import Dodge.Creature.Action.Blink
 import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
 import Dodge.Data.MuzzleEffect
@@ -25,21 +23,31 @@ import Dodge.Item.HeldOffset
 import Dodge.Item.Weapon.Shatter
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Projectile.Create
+import Dodge.RadarSweep
 import Dodge.SoundLogic
 import Dodge.Tesla.Arc
 import Geometry
 import LensHelp
 import ListHelp
+import NewInt
 import Picture.Base
 import RandomHelp
 import qualified SDL
 
 heldEffect :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
-heldEffect = hammerCheck $ heldEffectNoHammerCheck
+heldEffect = hammerCheck heldEffectNoHammerCheck
 
-heldEffectNoHammerCheck :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
+heldEffectNoHammerCheck ::
+    LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
 heldEffectNoHammerCheck = useTimeCheck heldEffectMuzzles
 
+type ChainEffect =
+    (LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World) ->
+    LabelDoubleTree ComposeLinkType Item ->
+    Creature ->
+    World ->
+    World
+
 hammerCheck :: ChainEffect
 hammerCheck f it cr w = case it ^? ldtValue . itUse . heldTriggerType of
     Just HammerTrigger -> case w ^? input . mouseButtons . ix SDL.ButtonLeft of
@@ -47,6 +55,32 @@ hammerCheck f it cr w = case it ^? ldtValue . itUse . heldTriggerType of
         _ -> w
     _ -> f it cr w
 
+-- | Applies a world effect after an item use cooldown check.
+useTimeCheck :: ChainEffect
+useTimeCheck f item cr w = case item ^? ldtValue . itUse . heldDelay of
+    Just (FixedRate _ 0) -> f item cr $ setUseRate w
+    Just (FixedRate _ _) -> w
+    Just (WarmUpNoDelay wt wm ws)
+        | wt < wm ->
+            w
+                & soundContinue (CrWeaponSound cid 0) (_crPos cr) ws (Just 2)
+                & cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . warmTime +~ 2
+    Just (WarmUpNoDelay _ wm _) ->
+        f item cr w
+            & cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . warmTime .~ (wm + 1)
+    Just NoDelay -> f item cr w
+    --    Just (VariableRate rmax rtime rmaxmax rminmax) -> undefined
+    Nothing -> w
+  where
+    cid = _crID cr
+    setUseRate =
+        cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . rateTime
+            +~ userate
+    -- the following is unsafe, but if ilInvID isn't correctly set we probably
+    -- will have problems elsewhere also
+    itRef = item ^?! ldtValue . itLocation . ilInvID
+    userate = fromMaybe 0 $ item ^? ldtValue . itUse . heldDelay . rateMax
+
 heldEffectMuzzles :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
 heldEffectMuzzles t cr w =
     uncurry (applyCME (_ldtValue t) cr) cmew
@@ -147,13 +181,13 @@ loadMuzzle t@(LDT _ l _) mz = fromMaybe (t, Nothing) $ do
     availableammo <- mag ^? ldtValue . itConsumables . magLoadStatus . iaLoaded
     let usedammo = case amamount of
             UseUpTo x -> min x availableammo
-            UseExactly x 
+            UseExactly x
                 | x <= availableammo -> x
                 | otherwise -> 0
     guard $ usedammo > 0
     return
-        ( t & ldtLeft . ix i . _2 . ldtValue . itConsumables . magLoadStatus . iaLoaded 
-                -~ usedammo
+        ( t & ldtLeft . ix i . _2 . ldtValue . itConsumables . magLoadStatus . iaLoaded
+            -~ usedammo
         , Just (mz, usedammo, mag)
         )
 
@@ -579,8 +613,8 @@ useTimeScrollGun itm _ =
     timeFlow
         .~ ItemScrollTimeFlow
             { _scrollSmoothing = 0
-            --, _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
-            , _reverseAmount = 100
+            , --, _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
+              _reverseAmount = 100
             , _futureWorlds = []
             , _scrollItemID = _itID itm
             }
@@ -589,8 +623,8 @@ useRewindGun :: NewInt ItmInt -> World -> World
 useRewindGun i =
     timeFlow
         .~ RewindLeftClick
---            { _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
-            { _reverseAmount = 100
+            { --            { _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
+              _reverseAmount = 100
             , _scrollItemID = i
             }
 
@@ -601,4 +635,3 @@ useRewindGun i =
 --                .~ Just' w'
 --            & cwTime . rewindWorlds .~ ws
 --    _ -> w
-

src/Dodge/Inventory/Lock.hs

@@ -1,4 +1,7 @@
-module Dodge.Inventory.Lock where
+module Dodge.Inventory.Lock (
+    lockInv,
+    unlockInv,
+) where
 
 import Control.Lens
 import Dodge.Data.World

src/Dodge/Item/Weapon/TriggerType.hs

@@ -1,185 +0,0 @@
---{-# LANGUAGE TupleSections #-}
-
-{- |
-Weapon effects when pulling the trigger.
--}
-module Dodge.Item.Weapon.TriggerType (
-    lockInvFor,
---    withCrPos,
---    withCrPosShift,
---    withOldDir,
---    trigDoAlso,
---    withTempLight,
---    withItem,
---    withSoundStart,
---    withSoundItemChoiceStart,
---    withSoundContinue,
---    withSoundForI,
---    withSoundForVol,
---    withSmoke,
---    withThickSmokeI,
---    withThinSmokeI,
---    withPositionOffset,
---    withPositionWallCheck,
---    withPosDirWallCheck,
-    --withWarmUp,
---    hammerCheckL,
---    shootL,
-    useTimeCheck,
---    ammoCheckI,
---    modClock,
---    blCheck,
-    ChainEffect,
-) where
-
-import Dodge.Data.ComposedItem
-import Dodge.Data.DoubleTree
-import Data.Maybe
-import Dodge.Data.World
-import Dodge.Inventory.Lock
-import Dodge.SoundLogic
-import LensHelp
-
-type ChainEffect =
-    (LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World) ->
-    LabelDoubleTree ComposeLinkType Item ->
-    Creature ->
-    World ->
-    World
-
-lockInvFor :: Int -> ChainEffect
-lockInvFor i f it cr =
-    f it cr . (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv (_crID cr)))
-        . lockInv (_crID cr)
-
---withSmoke :: Int -> Point4 -> Float -> Int -> Float -> ChainEffect
---withSmoke num col rad t alt eff item cr w =
---    eff item cr $
---        foldl' (flip $ smokeCloudAt col rad t alt . (+.+.+ pos) . (* 8)) w ps
---  where
---    dir = _crDir cr
---    pos = addZ 0 $ _crPos cr +.+ (_crRad cr + 15) *.* unitVectorAtAngle dir
---    ps = replicateM num randOnUnitSphere & evalState $ _randGen w
---
---withThinSmokeI :: ChainEffect
---withThinSmokeI eff item cr w =
---    eff item cr $
---        foldl' (flip $ makeThinSmokeAt . (+.+.+ pos) . (* 8)) w ps
---  where
---    dir = _crDir cr
---    pos = addZ 0 $ _crPos cr +.+ (_crRad cr + 0.5) *.* unitVectorAtAngle dir
---    ps = replicateM 5 randOnUnitSphere & evalState $ _randGen w
---
---withThickSmokeI :: ChainEffect
---withThickSmokeI eff item cr w =
---    eff item cr $
---        foldl' (flip $ makeThickSmokeAt . (+.+.+ pos) . (* 8)) w ps
---  where
---    dir = _crDir cr
---    pos = addZ 0 $ _crPos cr +.+ (_crRad cr + 15) *.* unitVectorAtAngle dir
---    ps = replicateM 20 randOnUnitSphere & evalState $ _randGen w
-
---itUseCharge :: Int -> Item -> Item
---itUseCharge x = itUse . leftConsumption . arLoaded %~ (max 0 . subtract x)
-
---{- | Fires at an increasing rate.
---Has different effect after first fire.
---Applies ammo check and use cooldown check.
----}
---rateIncAB ::
---    -- | Extra effect on first fire
---    ChainEffect ->
---    -- | Extra effect on continued fire
---    ChainEffect ->
---    ChainEffect
---rateIncAB exeffFirst exeffCont eff item cr w
---    | repeatFire =
---        w
---            & pointItem
---                %~ ( (itUse . heldDelay . rateMax .~ max fastRate (currentRate - 1))
-----                        . itUseAmmo 1
---                        . (itUse . heldDelay . rateTime .~ currentRate)
---                   )
---            & exeffCont eff item cr
---    | firstFire =
---        w
---            & pointItem
---                %~ ( (itUse . heldDelay . rateMax .~ startRate - 1)
-----                        . itUseAmmo 1
---                        . (itUse . heldDelay . rateTime .~ startRate)
---                   )
---            & exeffFirst eff item cr
---    | otherwise = w
---  where
---    item' = _ldtValue item
---    fastRate = _rateMinMax . _heldDelay $ _itUse item'
---    startRate = _rateMaxMax . _heldDelay $ _itUse item'
---    cid = _crID cr
---    itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
---    pointItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
---    currentRate = _rateMax (_heldDelay (_itUse item'))
---    repeatFire = crWeaponReady cr && _rateTime (_heldDelay (_itUse item')) == 1
---    firstFire = crWeaponReady cr && _rateTime (_heldDelay (_itUse item')) == 0
-
-{- |
-Applies a world effect after an item use cooldown check.
--}
-useTimeCheck :: ChainEffect
-useTimeCheck f item cr w = case item ^? ldtValue . itUse . heldDelay of
-    Just (FixedRate _ 0) -> f item cr $ setUseRate w
-    Just (FixedRate _ _) -> w
-    Just (WarmUpNoDelay wt wm ws) | wt < wm -> w 
-        & soundContinue (CrWeaponSound cid 0) (_crPos cr) ws (Just 2)
-        & cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . warmTime +~2
-    Just (WarmUpNoDelay _ wm _) -> f item cr w
-        & cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . warmTime .~ (wm+1)
-    Just NoDelay -> f item cr w
---    Just (VariableRate rmax rtime rmaxmax rminmax) -> undefined
-    Nothing -> w
-  where
-    cid = _crID cr
-    setUseRate = cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . rateTime 
-        +~ userate
-    -- the following is unsafe, but if ilInvID isn't correctly set we probably
-    -- will have problems elsewhere also
-    itRef = item ^?! ldtValue . itLocation . ilInvID
-    userate = fromMaybe 0 $ item ^? ldtValue . itUse . heldDelay . rateMax
-
---{- | Applies a world effect after a hammer position check.
---Arbitrary inventory position.
----}
---hammerCheckL ::
---    -- | Underlying effect
---    (Item -> Creature -> World -> World) ->
---    Item ->
---    Creature ->
---    World ->
---    World
---hammerCheckL f itm cr w = case itm ^? itUse . leftHammer of
---    Just HammerUp -> f itm cr w
---    _ -> w
-
---{- | Applies a world effect after an ammo check.
---Arbitrary inventory position -- cannot be replaced with ammoUseCheck.
----}
---shootL ::
---    -- | Underlying effect
---    (Item -> Creature -> World -> World) ->
---    Item ->
---    Creature ->
---    World ->
---    World
---shootL f item cr w
---    | fireCondition =
---        f item cr w & cWorld . lWorld . creatures . ix cid . crInv . ix invid
---            %~ ( itUseCharge 1
---                    . (itUse . leftDelay . rateTime .~ _rateMax (_leftDelay (_itUse item)))
---               )
---    --    | reloadCondition = fromMaybe w $ startReloadingWeapon cr w
---    | otherwise = w
---  where
---    cid = _crID cr
---    invid = _ilInvID $ _itLocation item
---    fireCondition =
---        _rateTime (_leftDelay (_itUse item)) == 0
---            && _arLoaded (_leftConsumption (_itUse item)) > 0

src/Dodge/TestString.hs

@@ -1,7 +1,7 @@
 {-# OPTIONS_GHC -Wno-unused-imports #-}
 module Dodge.TestString where
 
-import qualified SDL as SDL
+import qualified SDL
 import Linear
 import Dodge.ListDisplayParams
 import Dodge.SelectionSections
@@ -27,7 +27,7 @@ import qualified Data.Map.Strict as M
 
 testStringInit :: Universe -> [String]
 testStringInit u = 
-    (map show $ M.toList $ u ^. uvWorld . input . pressedKeys)
+    map show $ M.toList $ u ^. uvWorld . input . pressedKeys
 --  fromMaybe mempty $ do
 --        cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
 --        let itms = IM.elems $ cr ^. crInv