Make examine inventory controlled by item, perhaps still buggy

src/Dodge/Creature/Action.hs

@@ -3,9 +3,7 @@
 -- | Actions performed by creatures within the world
 module Dodge.Creature.Action (
     performActions,
-    --    stripNoItems,
     setMinInvSize,
-    --    dropUnselected,
     dropExcept,
     dropItem,
     blinkActionMousePos,
@@ -13,12 +11,9 @@ module Dodge.Creature.Action (
     unsafeBlinkAction,
     sizeSelf,
     youDropItem,
---    pickUpItem,
 ) where
 
 import Control.Applicative
---import Data.List (findIndex)
-
 import Control.Monad
 import Data.Bifunctor
 import Data.Maybe
@@ -31,6 +26,7 @@ import Dodge.Default
 import Dodge.FloatFunction
 import Dodge.FloorItem
 import Dodge.Inventory
+import Dodge.ItEffect
 --import Dodge.Inventory.Add
 import Dodge.Path
 import Dodge.SoundLogic
@@ -176,11 +172,15 @@ dropExcept cr invid w =
 -- why not a cid (Int)?
 dropItem :: Creature -> Int -> World -> World
 dropItem cr invid =
-    maybeshiftseldown
+    doanyitemdropeffect
-    .   rmInvItem (_crID cr) invid
+        . maybeshiftseldown
+        . rmInvItem (_crID cr) invid
         . copyItemToFloor (_crPos cr) itm -- . mayberemoveequip
         . soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
   where
+    doanyitemdropeffect = fromMaybe id $ do
+        rmf <- itm ^? itEffect . ieOnDrop
+        return $ doInvEffect rmf itm cr
     itm = fromMaybe (error "dropItem cannot find item") $ cr ^? crInv . ix invid
     maybeshiftseldown w = fromMaybe w $ do
         3 <- w ^? hud . hudElement . diSelection . _Just . _1

src/Dodge/Creature/Impulse/UseItem.hs

@@ -4,8 +4,8 @@ module Dodge.Creature.Impulse.UseItem (
     useItem,
 ) where
 
+import Dodge.ToggleExamine
 import Control.Lens
-import Control.Monad
 import Data.Maybe
 import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
@@ -15,6 +15,7 @@ import Dodge.Euse
 import Dodge.HeldUse
 import Dodge.Inventory
 import Dodge.Item.Grammar
+import Dodge.Item.Location
 import qualified IntMapHelp as IM
 
 useItem :: Int -> PressType -> World -> Maybe World
@@ -30,27 +31,33 @@ useItemLoc ::
     PressType ->
     World ->
     Maybe World
-useItemLoc cr loc pt w = case loc ^. locLDT . ldtValue . _2 of
+useItemLoc cr loc pt w
-    HeldPlatformSF -> do
+    | HeldPlatformSF <- sf
-        guard $ fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsRoot
+      , fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsRoot
-        guard $ cr ^. crStance . posture == Aiming
+      , cr ^. crStance . posture == Aiming =
         return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
-    GadgetPlatformSF ->
+    | GadgetPlatformSF <- sf =
-        return $
-            heldEffect pt (bimap _iatType (^. _1) ldt) cr w
-    UnderBarrelPlatformSF -> do
-        guard $ fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsAttached
-        guard $ cr ^. crStance . posture == Aiming
         return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
-    RemoteDetonatorSF -> do
+    | UnderBarrelPlatformSF <- sf
-        guard $ pt == InitialPress
+      , fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsAttached
+      , cr ^. crStance . posture == Aiming =
+        return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
+    | RemoteDetonatorSF <- sf
+      , pt == InitialPress =
         return $ activateDetonator ldt w
-    _ | isJust $ itm ^? itUse . uequipEffect -> do
+    | ITEMSCANNER <- itm ^. itType
-        guard $ pt == InitialPress
+      , pt == InitialPress =
-        invid' <- itm ^? itLocation . ilInvID
+        return $ toggleExamineInv w
+    | Just b <- itm ^? itUse . useToggle
+      , pt == InitialPress =
+        return $ w & pointerToItem itm . itUse . useToggle .~ not b
+    | isJust $ itm ^? itUse . uequipEffect
+      , pt == InitialPress
+      , Just invid' <- itm ^? itLocation . ilInvID =
         return $ toggleEquipmentAt invid' cr w
-    _ -> Nothing
+    | otherwise = Nothing
   where
+    sf = loc ^. locLDT . ldtValue . _2
     ldt = loc ^. locLDT
     itm = ldt ^. ldtValue . _1
 

src/Dodge/Creature/YourControl.hs

@@ -23,8 +23,8 @@ import qualified SDL
 yourControl :: Creature -> World -> World
 yourControl _ w
     | inTextInputFocus w = w
-    | Just NoSubInventory{} <- w ^? hud . hudElement . subInventory =
+    | Just x <- w ^? hud . hudElement . subInventory 
-        w
+    , f x = w
             & cWorld . lWorld . creatures . ix 0
                 %~ (wasdWithAiming w . setCrPosture pkeys)
             & tryClickUse pkeys
@@ -32,6 +32,9 @@ yourControl _ w
     | otherwise =
         w & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
   where
+    f NoSubInventory = True
+    f ExamineInventory = True
+    f _ = False
     pkeys = w ^. input . mouseButtons
 
 handleHotkeys :: World -> World

src/Dodge/Data/ComposedItem.hs

@@ -61,6 +61,7 @@ data ItemStructuralFunction
     | MakeAutoSF
     | ProjectileStabiliserSF
     | GrenadeHitEffectSF
+    | ToggleSF
     deriving (Eq, Ord, Show, Read)
 
 type ComposedItem = (Item, ItemStructuralFunction, LinkTest)

src/Dodge/Data/HUD.hs

@@ -25,12 +25,6 @@ data HUDElement
         }
     | DisplayCarte
 
---data MouseInventorySelection
---    = MouseInvSelect
---        {_misSelStart :: (Int, Int), _misMaybeEnd :: Maybe (Int, Int)}
---    | MouseInvDrag
---    | MouseInvNothing
-
 data SubInventory
     = NoSubInventory
     | ExamineInventory

src/Dodge/Data/Item/Effect.hs

@@ -1,13 +1,17 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Dodge.Data.Item.Effect where
+module Dodge.Data.Item.Effect (
+    module Dodge.Data.Item.Effect,
+    module Dodge.Data.BlBl,
+) where
 
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
+import Dodge.Data.BlBl
 
 data ItEffect = ItEffect
     { _ieInv :: ItInvEffect --Item -> Creature -> World -> World
@@ -23,6 +27,8 @@ data ItInvEffect
     | RemoveShieldWall
     | EffectWhileRoot ItInvEffect
     | EffectWhileAttached ItInvEffect
+    | ItemUseToggle BlBl
+    | ItemCancelExamineInventory
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data ItDropEffect = NoDropEffect

src/Dodge/Data/Item/Use.hs

@@ -43,6 +43,7 @@ data ItemUse
     | UseNothing
     | UseScope { _uScope :: Scope }
     | UseBulletMod { _ubMod :: BulletMod }
+    | UseToggle {_useToggle :: Bool}
     deriving (Eq, Show, Read)
 
 data HeldUseEffect

src/Dodge/Data/Item/Use/Consumption/Ammo.hs

@@ -19,7 +19,6 @@ data ProjectileUpdate
     = ThrustPU {_pjuStart :: Int, _pjuEnd :: Int}
     | StartSpinPU {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
     | RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int}
---    | ApplyGravityPU
     deriving (Show, Eq, Ord, Read) --Generic, Flat)
 
 data AmmoType

src/Dodge/Data/Terminal.hs

@@ -11,6 +11,7 @@ import Data.Aeson
 import Data.Aeson.TH
 import qualified Data.Map.Strict as M
 import Dodge.Data.WorldEffect
+import Dodge.Data.BlBl
 
 data TerminalStatus = TerminalOff | TerminalBusy | TerminalReady
     deriving Eq
@@ -85,11 +86,6 @@ data TerminalToggle = TerminalToggle
     }
     --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
-data BlBl
-    = BlNegate
-    | BlConst Bool
-    | BlId
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data EffectArguments
     = NoArguments {_cmdEffect :: [TerminalLine]}
@@ -135,7 +131,6 @@ concat <$> mapM (deriveJSON defaultOptions)
     , ''TmTm
     , ''TerminalLine
     , ''TerminalBootProgram
-    , ''BlBl
     , ''TerminalToggle
     , ''EffectArguments
     , ''TerminalCommandEffect

src/Dodge/DisplayInventory.hs

@@ -179,7 +179,7 @@ updateDisplaySections w cfig =
             ( \(indent, x) ->
                 invSelectionItem
                     indent
-                    (w ^. cWorld . lWorld)
+                    w
                     (x ^. locLDT . ldtValue)
             )
             (fmap (first removeindentiffiltering) . allInvLocs $ _crInv cr)

src/Dodge/Inventory.hs

@@ -1,6 +1,6 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Inventory (
-   rmInvItem,
+    rmInvItem,
     destroyInvItem,
     updateCloseObjects,
     changeSwapSel,
@@ -14,9 +14,8 @@ module Dodge.Inventory (
     swapItemWith,
 ) where
 
-import qualified Data.IntSet as IS
-import Dodge.Inventory.Swap
 import Data.Function
+import qualified Data.IntSet as IS
 import Data.Maybe
 import Dodge.Base
 import Dodge.Data.SelectionList
@@ -25,7 +24,7 @@ import Dodge.Euse
 import Dodge.Inventory.CheckSlots
 import Dodge.Inventory.Location
 import Dodge.Inventory.RBList
-import Dodge.ItEffect
+import Dodge.Inventory.Swap
 import Dodge.SelectionSections
 import Geometry
 import qualified IntMapHelp as IM
@@ -43,8 +42,9 @@ destroyInvItem ::
     Int ->
     World ->
     World
-destroyInvItem cid invid w = rmInvItem cid invid w & removeitloc
+destroyInvItem cid invid w =
-    & removeithotkey
+    rmInvItem cid invid w & removeitloc
+        & removeithotkey
   where
     removeitloc = fromMaybe id $ do
         itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itID . unNInt
@@ -54,7 +54,7 @@ destroyInvItem cid invid w = rmInvItem cid invid w & removeitloc
         hk <- w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid
         return $
             (cWorld . lWorld . imHotkeys . unNIntMap . at itid .~ Nothing)
-            . ( cWorld . lWorld . hotkeys . at hk .~ Nothing)
+                . (cWorld . lWorld . hotkeys . at hk .~ Nothing)
 
 -- | after this the item at the inventory position will no longer exist
 rmInvItem ::
@@ -66,7 +66,6 @@ rmInvItem ::
     World
 rmInvItem cid invid w =
     w
-        & doanyitemeffect
         & dounequipfunction --the ordering of these is
         & pointcid . crInv %~ f -- important
         & removeAnySlotEquipment
@@ -90,12 +89,13 @@ rmInvItem cid invid w =
     dounequipfunction = fromMaybe id $ do
         rmf <- itm ^? itUse . uequipEffect . eeOnRemove
         return $ doItmCrWdWd rmf itm cr
-    doanyitemeffect = fromMaybe id $ do
-        rmf <- itm ^? itEffect . ieOnDrop
-        return $ doInvEffect rmf itm cr
     removeAnySlotEquipment = fromMaybe id $ do
-        epos <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
+        epos <-
-            . itLocation . ilEquipSite . _Just
+            w
+                ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
+                    . itLocation
+                    . ilEquipSite
+                    . _Just
         return $ pointcid . crEquipment . at epos .~ Nothing
     maxk = fmap fst $ IM.lookupMax $ cr ^. crInv
     f inv =

src/Dodge/Inventory/SelectionList.hs

@@ -19,8 +19,8 @@ import NewInt
 import Padding
 import Picture.Base
 
-invSelectionItem :: Int -> LWorld -> ComposedItem -> SelectionItem ()
+invSelectionItem :: Int -> World -> ComposedItem -> SelectionItem ()
-invSelectionItem indent lw ci =
+invSelectionItem indent w ci =
     SelectionItem
         { _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
         , _siHeight = itInvHeight $ ci ^. _1
@@ -31,13 +31,14 @@ invSelectionItem indent lw ci =
         , _siPayload = ()
         }
   where
+    lw = w ^. cWorld . lWorld
     cr = lw ^?! creatures . ix 0
     itid = ci ^. _1 . itID . unNInt
     anyhotkey = maybe [] ((' ' :) . hotkeyToString) (lw ^? imHotkeys . unNIntMap . ix itid)
     anyequippos = maybe [] (rightPad 8 ' ' . (' ' :) . eqPosText) 
         (ci ^? _1 . itLocation . ilEquipSite . _Just)
     col = itemInvColor ci
-    pics = itemDisplay cr ci
+    pics = itemDisplay w cr ci
 
 hotkeyToString :: Hotkey -> String
 hotkeyToString x = case x of

src/Dodge/ItEffect.hs

@@ -3,6 +3,8 @@ module Dodge.ItEffect (
     doInvEffect,
 ) where
 
+import Dodge.BlBl
+import Dodge.Item.Location
 import Control.Lens
 import Dodge.Data.World
 import Dodge.Euse
@@ -15,6 +17,15 @@ doInvEffect = \case
     RemoveShieldWall -> removeShieldWall
     EffectWhileRoot f -> rootNotrootEff f NoInvEffect
     EffectWhileAttached f -> effectWhileAttached f
+    ItemUseToggle f -> \itm _ 
+        -> pointerToItemID (itm ^. itID) . itUse . useToggle %~ doBlBl f
+    ItemCancelExamineInventory -> \_ _ -> cancelExamineInventory
+
+cancelExamineInventory :: World -> World
+cancelExamineInventory = hud . hudElement . subInventory %~ f
+  where
+    f ExamineInventory = NoSubInventory
+    f x = x
 
 rootNotrootEff :: ItInvEffect -> ItInvEffect -> Item -> Creature -> World -> World
 rootNotrootEff f g it

src/Dodge/Item/Display.hs

@@ -6,9 +6,9 @@ module Dodge.Item.Display (
     basicItemDisplay,
 ) where
 
+import Dodge.Data.World
 import Data.Maybe
 import Dodge.Data.ComposedItem
-import Dodge.Data.Creature
 import Dodge.Item.InvSize
 import LensHelp
 import Padding
@@ -18,14 +18,14 @@ import ShortShow
 -- variety of factors but typically don't depend on functional quality,
 -- colour gives an indication of an item's function within a structure
 
-itemDisplay :: Creature -> ComposedItem -> [String]
+itemDisplay :: World -> Creature -> ComposedItem -> [String]
-itemDisplay cr ci =
+itemDisplay w cr ci =
     zipWithDefaults
         id
         (leftPad 15 ' ')
         itemDisplayPad
         (basicItemDisplay itm)
-        (itemNumberDisplay cr ci)
+        (itemNumberDisplay w cr ci)
   where
     itm = ci ^. _1
 
@@ -92,8 +92,12 @@ showEquipItem eit = case eit of
 -- this can change, but probably won't when (say) dropped and then picked up
 -- again
 -- that is to say, it should not change based on functional positioning
-itemNumberDisplay :: Creature -> ComposedItem -> [String]
+itemNumberDisplay :: World -> Creature -> ComposedItem -> [String]
-itemNumberDisplay cr ci
+itemNumberDisplay w cr ci
+    | Just x <- ci ^? _1 . itUse . useToggle = [show x]
+    | ITEMSCANNER <- ci ^. _1 . itType
+    , Just ExamineInventory <- w ^? hud . hudElement . subInventory
+        = ["ACTIVE"]
     | EQUIP WRIST_ECG <- ci ^. _1 . itType =
         [displayPulse $ cr ^?! crType . avatarPulse . pulseProgress]
     | HELD ALTERIFLE <- ci ^. _1 . itType = 

src/Dodge/Item/Grammar.hs

@@ -131,6 +131,7 @@ getAmmoLinks itm =
 
 itemToFunction :: Item -> ItemStructuralFunction
 itemToFunction itm = case itm ^. itType of
+    ITEMSCANNER -> ToggleSF
     INTROSCAN {} -> IntroScanSF
     HELD LASER -> WeaponTargetingSF
     HELD{} -> case itm ^? itUseCondition of

src/Dodge/Item/InventoryColor.hs

@@ -10,6 +10,7 @@ itemInvColor :: ComposedItem -> Color
 itemInvColor ci = case ci ^. _2 of
     GrenadeHitEffectSF -> yellow
     IntroScanSF -> white
+    ToggleSF -> white
     UnloadedWeaponSF -> mixColorsLinear 0.5 0.5 red white
     HeldPlatformSF -> white
     MakeAutoSF -> white

src/Dodge/Item/Scope.hs

@@ -19,6 +19,7 @@ module Dodge.Item.Scope (
     introScan,
 ) where
 
+--import Dodge.Data.BlBl
 import Dodge.Item.Attach
 import Control.Lens
 import Dodge.Data.Item
@@ -59,7 +60,7 @@ itemScanner =
     defaultHeldItem
         & itType .~ ITEMSCANNER
         & itUse .~ UseNothing
-
+        & itEffect . ieOnDrop .~ ItemCancelExamineInventory
 
 bulletModule :: BulletMod -> Item
 bulletModule bm =

src/Dodge/ListDisplayParams.hs

@@ -35,7 +35,7 @@ invDP =
 
 invCursorParams :: World -> CursorDisplay
 invCursorParams w = BoundaryCursor $ case w ^? hud . hudElement . subInventory of
-    Just ExamineInventory{} -> [North, South, East, West]
+--    Just ExamineInventory{} -> [North, South, East, West]
     Just CombineInventory{} -> []
     _ | ButtonRight `M.member` _mouseButtons (_input w) -> [North, South, East, West]
     _ -> [North, South, West]

src/Dodge/Projectile/Create.hs

@@ -3,49 +3,56 @@ module Dodge.Projectile.Create (
     PJStabiliser (..),
 ) where
 
-import NewInt
 --import Dodge.Data.ComposedItem
 --import Dodge.Data.DoubleTree
-import Dodge.Item.Location
+
 import Data.Maybe
 import Dodge.Data.World
+import Dodge.Item.Location
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
+import NewInt
 
 data PJStabiliser
     = StabOrthReduce
     | StabSpinIncrease
 
-
 -- assumes the mscreen is in your inventory
-createShell ::Maybe (NewInt ItmInt) 
+createShell ::
-    -> Maybe (NewInt ItmInt) 
+    Maybe (NewInt ItmInt) ->
-    -> Maybe PJStabiliser
+    Maybe (NewInt ItmInt) ->
-    -> ProjectileType
+    Maybe PJStabiliser ->
-    -> Payload -> Muzzle -> Creature -> World -> World
+    ProjectileType ->
-createShell mdetonator mscreen stab pjtype payload muz cr w = w
+    Payload ->
-    & updatescreen
+    Muzzle ->
-    & updatedetonator
+    Creature ->
-    & cWorld . lWorld . projectiles . at i
+    World ->
-        ?~ Shell
+    World
-            { _pjPos = pos
+createShell mdetonator mscreen stab pjtype payload muz cr w =
-            , _pjZ = 20
+    w
-            , _pjZVel = 5
+        & updatescreen
-            , _pjVel = rotateV dir (V2 speed 0) + crvelcomponent
+        & updatedetonator
-            , _pjID = i
+        & cWorld . lWorld . projectiles . at i
-            , _pjDir = dir
+            ?~ Shell
-            , _pjSpin = 0
+                { _pjPos = pos
-            , _pjPayload = payload
+                , _pjZ = 20
-            , _pjTimer = lifespan
+                , _pjZVel = 5
-            , _pjUpdates =
+                , _pjVel = rotateV dir (V2 speed 0) + crvelcomponent
-                anyspin <>
+                , _pjID = i
-                [ RemoteDirectionPU (lifespan - thrustdelay) 0
+                , _pjDir = dir
-                ] <> thrustorgrav
+                , _pjSpin = 0
-            , _pjType = pjtype
+                , _pjPayload = payload
-            , _pjDetonatorID = mdetonator
+                , _pjTimer = lifespan
-            , _pjScreenID = mscreen
+                , _pjUpdates =
-            }
+                    anyspin
+                        <> [ RemoteDirectionPU (lifespan - thrustdelay) 0
+                           ]
+                        <> thrustorgrav
+                , _pjType = pjtype
+                , _pjDetonatorID = mdetonator
+                , _pjScreenID = mscreen
+                }
   where
     crvelcomponent = case stab of
         Just StabOrthReduce -> projV (cr ^. crPos - cr ^. crOldPos) (unitVectorAtAngle dir)
@@ -55,27 +62,27 @@ createShell mdetonator mscreen stab pjtype payload muz cr w = w
         Just StabSpinIncrease -> [StartSpinPU (lifespan - 15) (_crID cr) 4]
         _ -> [StartSpinPU (lifespan - 15) (_crID cr) 2]
     speed = case pjtype of
-        Grenade {} -> 4
+        Grenade{} -> 4
         Rocket{} -> 1
         RetiredProjectile -> 0
     lifespan = 350
     thrustorgrav = case pjtype of
-        Grenade {}-> []
+        Grenade{} -> []
         Rocket{} -> [ThrustPU (lifespan - thrustdelay) 0]
         RetiredProjectile -> []
     thrustdelay = 20
     updatedetonator = fromMaybe id $ do
         screenid <- mdetonator
-        return $ pointerToItemID screenid . itUse . uaParams
+        return $
+            pointerToItemID screenid . itUse . uaParams
                 . apProjectiles
                 .:~ i
     updatescreen = fromMaybe id $ do
         screenid <- mscreen
-        return $ pointerToItemID screenid . itUse . uaParams
+        return $
+            pointerToItemID screenid . itUse . uaParams
                 . apProjectiles
                 .:~ i
---                . apLinkedProjectile
---                ?~ i
     i = IM.newKey $ w ^. cWorld . lWorld . projectiles
     dir = _crDir cr + _mzRot muz
     pos = _crPos cr +.+ rotateV dir (_mzPos muz)

src/Dodge/Projectile/Update.hs

@@ -42,14 +42,15 @@ upProjectile pj pu = case pu of
     RemoteDirectionPU st et
         | act st et -> pjRemoteSetDirection (pj ^? pjType . rkHoming) pj
         | otherwise -> id
---    ApplyGravityPU -> applyGravityPU pj
   where
+    --    ApplyGravityPU -> applyGravityPU pj
+
     time = _pjTimer pj
     act st et = time <= st && time >= et
 
 doGravityPU :: Projectile -> World -> World
 doGravityPU pj
-    | Grenade GBounce {} <- pj ^. pjType = applyGravityPU pj
+    | Grenade GBounce{} <- pj ^. pjType = applyGravityPU pj
     | Grenade GStick <- pj ^. pjType = applyGravityPU pj
     | otherwise = id
 
@@ -106,14 +107,16 @@ tryShellBounce :: (Point2, Either Creature Wall) -> Projectile -> World -> World
 tryShellBounce (p, Right wl) pj w
     | Just GStuckCreature{} <- pj ^? pjType . gnHitEffect = w
     | Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
-    | Just GStick <- pj ^? pjType . gnHitEffect = w
+    | Just GStick <- pj ^? pjType . gnHitEffect =
-        & cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
+        w
-            .~ Grenade (GStuckWall (wl ^. wlStructure))
+            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
---        & cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates %~ delete ApplyGravityPU
+                .~ Grenade (GStuckWall (wl ^. wlStructure))
-        & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
+            --        & cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates %~ delete ApplyGravityPU
+            & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
     | Just x <- pj ^? pjType . gnHitEffect . bounceTolerance =
         if abs (dotV (pj ^. pjVel) (vNormal hitline)) < x
-            then w
+            then
+                w
                     & cWorld . lWorld . projectiles . ix (_pjID pj) . pjVel
                         %~ reflectIn hitline
                     & cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos .~ p
@@ -124,16 +127,17 @@ tryShellBounce (p, Right wl) pj w
 tryShellBounce (p, Left cr) pj w
     | Just GStuckCreature{} <- pj ^? pjType . gnHitEffect = w
     | Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
-    | Just GStick <- pj ^? pjType . gnHitEffect = w
+    | Just GStick <- pj ^? pjType . gnHitEffect =
-        & cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
+        w
-            .~ Grenade
+            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
-                (GStuckCreature 
+                .~ Grenade
-                (cr ^. crID) 
+                    ( GStuckCreature
-                (rotateV (- cr ^. crDir) (p - cr ^. crPos))
+                        (cr ^. crID)
-                (pj ^. pjDir - cr ^. crDir)
+                        (rotateV (- cr ^. crDir) (p - cr ^. crPos))
-                )
+                        (pj ^. pjDir - cr ^. crDir)
---        & cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates %~ delete ApplyGravityPU
+                    )
-        & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
+            --        & cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates %~ delete ApplyGravityPU
+            & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
 tryShellBounce _ pj w = explodeShell pj w
 
 destroyProjectile :: Maybe (NewInt ItmInt) -> Int -> World -> World
@@ -210,15 +214,16 @@ pjMovement :: Projectile -> World -> World
 pjMovement pj w
     | Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
     | Just (GStuckCreature crid p d) <- pj ^? pjType . gnHitEffect = fromMaybe
-            (w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjType .~ Grenade GStick)
+        (w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjType .~ Grenade GStick)
         $ do
             cpos <- w ^? cWorld . lWorld . creatures . ix crid . crPos
             cdir <- w ^? cWorld . lWorld . creatures . ix crid . crDir
             return $
-                w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjPos
+                w
-                    .~ cpos + rotateV cdir p
+                    & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjPos
-                  & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir
+                        .~ cpos + rotateV cdir p
-                    .~ d + cdir
+                    & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir
+                        .~ d + cdir
     | otherwise =
         w
             & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjSpin *~ 0.99

src/Dodge/Room/Warning.hs

@@ -2,8 +2,6 @@
 module Dodge.Room.Warning where
 
 import Color
---import qualified Data.Set as S
-
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Cleat

src/Dodge/Update/Input/InGame.hs

@@ -440,7 +440,6 @@ updateInitialPressInGame uv sc = case sc of
     ScancodeM -> toggleMap uv
     --    ScancodeR -> over (uvWorld . cWorld . lWorld . creatures . ix 0) crReloadToggle uv
     ScancodeT -> over uvWorld testEvent uv
-    ScancodeX -> uv & uvWorld %~ toggleTweakInv
     ScancodeC -> toggleCombineInv uv
     -- the following should be put in a more sensible place
     ScancodeSlash -> uv & uvWorld %~ updateEnterRegex
@@ -470,8 +469,7 @@ doRegexInput inp i sss msel filts
         )
   where
     endregex a b =
-        --( sss & ix i . ssItems .~ mempty
+        ( sss
-        ( sss -- & ix i . ssItems .~ mempty
         , msel & ssSetCursor (ssLookupDown a b) sss
         , Nothing
         )
@@ -596,15 +594,6 @@ toggleMap u = case u ^. uvWorld . hud . hudElement of
                 }
     _ -> u & uvWorld . hud . hudElement .~ DisplayCarte
 
-toggleTweakInv :: World -> World
-toggleTweakInv w = case w ^? hud . hudElement . subInventory of
-    Just ExamineInventory{} ->
-        w
-            & thepointer .~ NoSubInventory --MouseInvNothing
-    _ -> w & thepointer .~ ExamineInventory -- mi
-  where
-    thepointer = hud . hudElement . subInventory
-
 tryCombine :: (Int, Int) -> World -> World
 tryCombine (i, j) w = fromMaybe w $ do
     sss <- w ^? hud . hudElement . subInventory . ciSections

src/Dodge/Update/Scroll.hs

@@ -27,10 +27,6 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
         -- functions that modify the inventory should be centralised so that
         -- this lock can be sensibly applied, perhaps
         | w ^?! cWorld . lWorld . creatures . ix 0 . crInvLock -> w
---        | rbDown -> case  (yourScrollAttachment w, _rbOptions w) of
---            (_,EquipOptions{}) -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax
---            (Nothing, _) -> w
---            (Just (invid,hs), _) -> doHeldScroll invid hs y w
         | bdown ButtonRight -> case   _rbOptions w of
             EquipOptions{} -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax
             NoRightButtonOptions -> selectedItemScroll yi w
@@ -38,12 +34,9 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
         | invKeyDown -> changeSwapSel yi w
         | otherwise -> scrollAugInvSel yi w
     DisplayInventory{_subInventory = ExamineInventory}
-        | invKeyDown -> scrollAugInvSel yi w
+--        | invKeyDown 
-        | otherwise -> w
+        -> scrollAugInvSel yi w
---        | invKeyDown && rbDown -> w & moveTweakSel yi
+--        | otherwise -> w
---        | invKeyDown -> scrollAugInvSel yi w
---        | rbDown -> w & changeTweakParam mi yi
---        | otherwise -> w & moveTweakSel yi
     DisplayInventory{_subInventory = CombineInventory{}} -> w & moveCombineSel yi
     DisplayInventory{_subInventory = DisplayTerminal tmid} -> terminalWheelEvent yi tmid w
     _ -> w

src/Dodge/WorldEffect.hs

@@ -5,6 +5,7 @@ module Dodge.WorldEffect (
     lineOutputTerminal,
 ) where
 
+import Dodge.BlBl
 import Dodge.Data.Input
 import Dodge.HeldUse
 import Dodge.Data.ComposedItem
@@ -88,12 +89,6 @@ doDeathTriggers tm = cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathTo
 doDeathToggle :: TerminalToggle -> IM.IntMap Bool -> IM.IntMap Bool
 doDeathToggle (TerminalToggle trid f) = ix trid %~ doBlBl f
 
-doBlBl :: BlBl -> Bool -> Bool
-doBlBl bb = case bb of
-    BlNegate -> not
-    BlConst bl -> const bl
-    BlId -> id
-
 doTerminalBootProgram :: TerminalBootProgram -> Terminal -> World -> [TerminalLine]
 doTerminalBootProgram tbp = case tbp of
     TerminalBootMempty -> \_ _ -> []