Introduce idea of world event flags

src/Dodge/Creature/Impulse/UseItem.hs

@@ -26,6 +26,7 @@ useItem cr' w = fromMaybe (f w) $ do
     itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
     it <- cr ^? crInv . ix itRef
     return $ itemEffect cr it w
+        & worldEventFlags . at InventoryChange ?~ ()
   where
     f = cWorld . lWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown
 

src/Dodge/Data/World.hs

@@ -13,6 +13,7 @@ module Dodge.Data.World (
     module Dodge.Data.Input,
 ) where
 
+import Data.Set (Set)
 import Dodge.Data.SaveSlot
 import Control.Lens
 import qualified Data.Map.Strict as M
@@ -24,6 +25,10 @@ import Dodge.Data.SoundOrigin
 import Sound.Data
 import System.Random
 
+data WorldEventFlag = InventoryChange
+    | CombineInventoryChange
+    deriving (Eq,Ord,Enum,Bounded)
+
 data World = World
     { _cWorld :: CWorld
     , _randGen :: StdGen
@@ -33,6 +38,7 @@ data World = World
     , _testFloat :: Float
     , _rbOptions :: RightButtonOptions
     , _hud :: HUD
+    , _worldEventFlags :: Set WorldEventFlag
     }
 
 --    deriving (Eq, Ord, Show, Read) --Generic, Flat)

src/Dodge/Default/World.hs

@@ -40,6 +40,7 @@ defaultWorld =
         , _testFloat = 0
         , _rbOptions = NoRightButtonOptions
         , _hud = defaultHUD
+        , _worldEventFlags = mempty
         }
 
 defaultCWGen :: CWGen

src/Dodge/DisplayInventory.hs

@@ -2,8 +2,9 @@
 
 module Dodge.DisplayInventory (
     toggleCombineInv,
-    updatePositionHUD,
     updateInventorySectionItems,
+    updateInventoryPositioning,
+    updateCombinePositioning,
 ) where
 
 import Dodge.ListDisplayParams
@@ -25,21 +26,17 @@ import LensHelp
 import Picture.Base
 import Regex
 
--- this should ONLY change the shownitems
-updatePositionHUD :: Universe -> Universe
-updatePositionHUD u = case u ^? uvWorld . hud . hudElement . subInventory of
-    Just NoSubInventory -> u & updateDisplayInventory
-    Just CombineInventory {} -> u & uvWorld . hud . hudElement . subInventory . ciSections
-        %~ updateCombineInventory (_uvWorld u) (_uvConfig u)
-    _ -> u
-
 toggleCombineInv :: Universe -> Universe
 toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
     Just CombineInventory{} -> uv & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
     _ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig)
 
-updateCombineInventory :: World -> Configuration -> SelectionSections CombinableItem -> SelectionSections CombinableItem
-updateCombineInventory w cfig sss =
+updateCombinePositioning :: Universe -> Universe
+updateCombinePositioning u = u & uvWorld . hud . hudElement . subInventory . ciSections
+        %~ updateCombineSections (_uvWorld u) (_uvConfig u)
+
+updateCombineSections :: World -> Configuration -> SelectionSections CombinableItem -> SelectionSections CombinableItem
+updateCombineSections w cfig sss =
     sss & sssSections
         %~ updateSectionsPositioning
             mselpos
@@ -83,8 +80,8 @@ orRegex f x str = case words str of
     [] -> True
     xs -> any (f x) xs
 
-updateDisplayInventory :: Universe -> Universe
-updateDisplayInventory u = u & uvWorld . hud . hudElement . diSections
+updateInventoryPositioning :: Universe -> Universe
+updateInventoryPositioning u = u & uvWorld . hud . hudElement . diSections
         %~ updateDisplaySections (_uvWorld u) (_uvConfig u)
 
 updateDisplaySections :: World -> Configuration -> SelectionSections () -> SelectionSections ()

src/Dodge/Inventory.hs

@@ -22,22 +22,22 @@ module Dodge.Inventory (
     setInvPosFromSS,
 ) where
 
-import Dodge.DisplayInventory
-import Dodge.SelectionSections
-import Control.Applicative
-import Dodge.Data.SelectionList
 import Color
+import Control.Applicative
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Base
 import Dodge.Data.Config
+import Dodge.Data.SelectionList
 import Dodge.Data.World
+import Dodge.DisplayInventory
 import Dodge.Euse
 import Dodge.Inventory.CheckSlots
 import Dodge.Inventory.CloseObject
 import Dodge.Inventory.Color
 import Dodge.ItEffect
 import Dodge.Reloading
+import Dodge.SelectionSections
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
@@ -45,6 +45,7 @@ import ListHelp
 import Padding
 
 -- TODO check what happens to selection index when dropping non-selected items
+
 -- | after this the item at the inventory position will no longer exist
 rmInvItem ::
     -- | Creature id
@@ -55,6 +56,7 @@ rmInvItem ::
     World
 rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount of
     Just x | x > 1 -> w & pointcid . crInv . ix invid . itUse . useAmount -~ 1
+            & worldEventFlags . at InventoryChange ?~ ()
     _ ->
         w
             & pointcid %~ crCancelReloading
@@ -66,16 +68,16 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
             & pointcid . crInvEquipped %~ IM.delete invid
             & pointcid . crInvEquipped %~ IM.mapKeys g
             & updateselection
+            & worldEventFlags . at InventoryChange ?~ ()
   where
-
     getcid = cWorld . lWorld . creatures . ix cid
     pointcid = cWorld . lWorld . creatures . ix cid
 
     updateselection
-        | cid == 0 && cr ^? crManipulation . manObject . inInventory . ispItem == Just invid
-            = scrollAugInvSel (-1) . scrollAugInvSel 1 . updateInventorySectionItems
-        | otherwise
-            = pointcid . crManipulation . manObject . inInventory . ispItem %~ g
+        | cid == 0 && cr ^? crManipulation . manObject . inInventory . ispItem == Just invid =
+            scrollAugInvSel (-1) . scrollAugInvSel 1 . updateInventorySectionItems
+        | otherwise =
+            pointcid . crManipulation . manObject . inInventory . ispItem %~ g
 
     cr = w ^?! cWorld . lWorld . creatures . ix cid
     itm = _crInv cr IM.! invid
@@ -111,13 +113,14 @@ rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crMan
     Nothing -> w
 
 selNumPos :: ManipulatedObject -> World -> Maybe Int
-selNumPos mo w = w ^? hud . hudElement . diSections >>=
-    case mo of
-        InInventory SortInventory -> selSecSelPos (-1) 0
-        InInventory (SelItem i _) -> selSecSelPos 0 i
-        SelNothing -> selSecSelPos 1 0
-        InNearby SortNearby -> selSecSelPos 2 0
-        InNearby (SelCloseObject i) -> selSecSelPos 3 i
+selNumPos mo w =
+    w ^? hud . hudElement . diSections
+        >>= case mo of
+            InInventory SortInventory -> selSecSelPos (-1) 0
+            InInventory (SelItem i _) -> selSecSelPos 0 i
+            SelNothing -> selSecSelPos 1 0
+            InNearby SortNearby -> selSecSelPos 2 0
+            InNearby (SelCloseObject i) -> selSecSelPos 3 i
 
 -- there are still more ListDisplayParams to integrate here
 selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2
@@ -130,8 +133,13 @@ selNumTextEndPos cfig ldp sss i j = do
     hh = halfHeight cfig
     hw = halfWidth cfig
 
-selNumEndMidHeight :: Configuration -> ListDisplayParams -> SelectionSections a -> Int 
-    -> Int -> Maybe Point2
+selNumEndMidHeight ::
+    Configuration ->
+    ListDisplayParams ->
+    SelectionSections a ->
+    Int ->
+    Int ->
+    Maybe Point2
 selNumEndMidHeight cfig ldp sss i j = do
     ipos <- selSecSelPos i j sss
     size <- selSecSelSize i j sss
@@ -165,12 +173,12 @@ updateCloseObjects w =
         & updatecursorposifnecessary
   where
     newcloseobjects = unionBy closeObjEq oldCloseFiltered currentClose
-    updatecursorposifnecessary 
-        = case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject. inNearby . ispCloseObject of
-            Just i 
+    updatecursorposifnecessary =
+        case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject of
+            Just i
                 | i >= length newcloseobjects -> scrollAugInvSel 1
-                | isNothing (w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems . ix i) 
-                    -> scrollAugInvSel (-1)
+                | isNothing (w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems . ix i) ->
+                    scrollAugInvSel (-1)
             _ -> id
     filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w
     ypos = _crPos $ you w
@@ -321,17 +329,21 @@ closeObjScrollDir x
 
 changeSwapInvSel :: Int -> World -> World
 changeSwapInvSel k w = case you w ^? crManipulation . manObject of
-    Just (InInventory (SelItem i _)) -> w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i
-    Just (InNearby (SelCloseObject i)) -> w
-            & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject 
+    Just (InInventory (SelItem i _)) ->
+        w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i
+            & worldEventFlags . at InventoryChange ?~ ()
+    Just (InNearby (SelCloseObject i)) ->
+        w
+            & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject
                 .~ ((i - k) `mod` numCO)
             & hud . closeObjects %~ swapIndices i ((i - k) `mod` numCO)
+            & worldEventFlags . at InventoryChange ?~ ()
     _ -> w
   where
     updatecreature i =
         (crInv %~ IM.safeSwapKeys (i `mod` n) (swapi i))
             . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel i)
-            . (crManipulation . manObject . inInventory . ispItem  %~ (`mod` n) . subtract k)
+            . (crManipulation . manObject . inInventory . ispItem %~ (`mod` n) . subtract k)
             . (crInvEquipped %~ IM.safeSwapKeys i (swapi i))
             . swapSite i (swapi i)
             . swapSite (swapi i) i
@@ -352,15 +364,17 @@ scrollAugInvSel yi w
     | yi == 0 = w
     | otherwise =
         w & hud . hudElement . diSections %~ scrollSelectionSections yi
+            & worldEventFlags . at InventoryChange ?~ ()
             & setInvPosFromSS
 
 setInvPosFromSS :: World -> World
-setInvPosFromSS w = w
-    & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
+setInvPosFromSS w =
+    w
+        & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
   where
     thesel = fromMaybe SelNothing $ do
         sss <- w ^? hud . hudElement . diSections
-        (i,j) <- sss ^? sssExtra . sssSelPos . _Just
+        (i, j) <- sss ^? sssExtra . sssSelPos . _Just
         case i of
             (-1) -> Just $ InInventory SortInventory
             0 -> Just $ InInventory (SelItem j NoInvSelAction)
@@ -368,10 +382,10 @@ setInvPosFromSS w = w
             2 -> Just $ InNearby SortNearby
             3 -> Just $ InNearby $ SelCloseObject j
             _ -> error "selection out of bounds"
-            
 
 selectedCloseObject :: World -> Maybe (Either FloorItem Button)
 selectedCloseObject w = do
-    i <- you w ^? crManipulation . manObject . inNearby . ispCloseObject
-        <|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems)
+    i <-
+        you w ^? crManipulation . manObject . inNearby . ispCloseObject
+            <|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems)
     w ^? hud . closeObjects . ix i

src/Dodge/Update.hs

@@ -7,8 +7,7 @@ Description : Simulation update
 module Dodge.Update (updateUniverse) where
 
 --import Dodge.InputFocus
-import Dodge.DisplayInventory
-import Dodge.ScrollValue
+
 import Color
 import Control.Applicative
 import Data.List
@@ -21,6 +20,7 @@ import Dodge.CrGroupUpdate
 import Dodge.Creature.Update
 --import Dodge.Data.SelectionList
 import Dodge.Data.Universe
+import Dodge.DisplayInventory
 import Dodge.Distortion
 import Dodge.DrWdWd
 import Dodge.EnergyBall
@@ -43,6 +43,7 @@ import Dodge.Projectile.Update
 import Dodge.Prop.Update
 import Dodge.RadarBlip
 import Dodge.RadarSweep
+import Dodge.ScrollValue
 import Dodge.Shockwave.Update
 import Dodge.SoundLogic
 import Dodge.Spark
@@ -69,10 +70,10 @@ updateUniverse :: Universe -> Universe
 updateUniverse u =
     updateUniverseLast
         . advanceScrollAmount
+        . updateWorldEventFlags
         . maybeOpenTerminal
         . over (uvWorld . input . textInput) (const mempty)
         . updateUniverseMid
-        . updatePositionHUD
         . updateUseInput
         . over uvWorld (updateCamera cfig)
         . over (uvWorld . input) updateScrollTestValue
@@ -81,6 +82,17 @@ updateUniverse u =
   where
     cfig = u ^. uvConfig
 
+updateWorldEventFlags :: Universe -> Universe
+updateWorldEventFlags u =
+    (uvWorld . worldEventFlags .~ mempty)
+        . updateInventoryPositioning
+        $ foldr updateWorldEventFlag u (u ^. uvWorld . worldEventFlags)
+
+updateWorldEventFlag :: WorldEventFlag -> Universe -> Universe
+updateWorldEventFlag wef = case wef of
+    InventoryChange -> id -- TODO determine more precisely when the inventory does change
+    CombineInventoryChange -> updateCombinePositioning
+
 maybeOpenTerminal :: Universe -> Universe
 maybeOpenTerminal u = case u ^. uvWorld . input . pressedKeys . at ScancodeSemicolon of
     Just InitialPress -> gotoTerminal u
@@ -91,11 +103,6 @@ gotoTerminal w = case _uvScreenLayers w of
     (InputScreen{} : _) -> w
     _ -> w & uvScreenLayers .:~ InputScreen mempty "Enter command"
 
-
-
-
-
-
 updateUniverseLast :: Universe -> Universe
 updateUniverseLast =
     over uvWorld (input . mouseButtons . each .~ True) -- to determine if the mouse button is held
@@ -248,13 +255,12 @@ functionalUpdate w =
 --  where
 --    y = w ^. input . scrollAmount
 updateWheelEvents :: World -> World
-updateWheelEvents w 
+updateWheelEvents w
     | yi == 0 = w
     | otherwise = updateWheelEvent yi w
   where
     yi = w ^. input . scrollAmount
 
-
 advanceScrollAmount :: Universe -> Universe
 advanceScrollAmount u =
     u
@@ -267,10 +273,11 @@ updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. lWorld
 --updatePastWorlds w = w & pastWorlds .~ []
 
 doWorldEvents :: World -> World
-doWorldEvents w = foldl' 
-    (flip doWdWd) 
-    (w & cWorld . lWorld . worldEvents .~ []) 
-    (w ^. cWorld . lWorld . worldEvents)
+doWorldEvents w =
+    foldl'
+        (flip doWdWd)
+        (w & cWorld . lWorld . worldEvents .~ [])
+        (w ^. cWorld . lWorld . worldEvents)
 
 updateLasers :: World -> World
 updateLasers w =
@@ -565,6 +572,7 @@ updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w
 
 markWallSeen :: World -> Int -> World
 markWallSeen w i = w & cWorld . seenWalls . at i ?~ ()
+
 --markWallSeen !w !i = w & cWorld . lWorld . walls %~ IM.adjust markSeen i
 -- in the past there might have been a space leak, which the following was meant
 -- to fix