Cleanup

2025-01-07 00:39:59 +00:00
parent beaf65f3f7
commit 1e7611ab81
13 changed files with 76 additions and 60 deletions
@@ -1,4 +1,5 @@
 --{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase #-}

 {- |
 Module      : Dodge.Update
@@ -25,7 +26,6 @@ import Dodge.DrWdWd
 import Dodge.EnergyBall
 import Dodge.Flame
 import Dodge.Inventory
--import Dodge.Item.Location
 import Dodge.Laser.Update
 import Dodge.LinearShockwave.Update
 import Dodge.ListDisplayParams
@@ -83,7 +83,8 @@ updateUniverseFirst :: Universe -> Universe
 updateUniverseFirst u =
    u
        & uvWorld . input . clickWorldPos %~ M.union (setClickWorldPos u)
-        & uvWorld . input . smoothScrollAmount %~ calcSmoothScroll (u ^. uvWorld . input . scrollAmount)
+        & uvWorld . input . smoothScrollAmount 
+            %~ calcSmoothScroll (u ^. uvWorld . input . scrollAmount)
        & over (uvWorld . input) updateScrollTestValue
        & updateDebugMessageOffset
        & over (uvWorld . cWorld . cClock) (+ 1)
@@ -119,21 +120,21 @@ updateWorldEventFlag wef = case wef of
    -- for now update inventory positioning every tick
    CombineInventoryChange -> updateCombinePositioning

-maybeOpenTerminal :: Universe -> Universe
-maybeOpenTerminal u = case u ^. uvWorld . input . pressedKeys . at ScancodeSemicolon of
-    Just InitialPress -> gotoTerminal u
+maybeOpenConsole :: Universe -> Universe
+maybeOpenConsole u = case u ^. uvWorld . input . pressedKeys . at ScancodeSemicolon of
+    Just InitialPress -> u & uvScreenLayers %~ openConsole
    _ -> u

-gotoTerminal :: Universe -> Universe
-gotoTerminal w = case _uvScreenLayers w of
-    (InputScreen{} : _) -> w
-    _ -> w & uvScreenLayers .:~ InputScreen mempty "Enter command"
+openConsole :: [ScreenLayer] -> [ScreenLayer]
+openConsole = \case
+    xs@(InputScreen{} : _) -> xs
+    xs -> InputScreen mempty "Enter command" : xs

 updateUniverseLast :: Universe -> Universe
 updateUniverseLast u =
    u
        & over (uvWorld . input . textInput) (const mempty)
-        & maybeOpenTerminal
+        & maybeOpenConsole
        & advanceScrollAmount
        & updateWorldEventFlags
        & uvWorld . input . pressedKeys . each %~ f
@@ -154,17 +155,7 @@ updateUniverseLast u =
 updateUniverseMid :: Universe -> Universe
 updateUniverseMid u = case _uvScreenLayers u of
    (OptionScreen{_scOptionFlag = LoadingScreen} : _) -> u
-    (sl@OptionScreen{_scOptionFlag = GameOverOptions} : _) ->
-        u & updateUseInputOnScreen sl
-            & uvWorld
-            %~ (
-                 --updateParticles
-                 (cWorld . lWorld . radarBlips .~ [])
-                    --        . updateIMl _props _pjUpdate
--                    might want to clear temp light sources here?
-                    . (cWorld . lWorld . lights .~ [])
-                    . updateClouds
-               )
+--    (sl@OptionScreen{_scOptionFlag = GameOverOptions} : _) -> u & updateUseInputOnScreen sl
    (sl : _) -> u & updateUseInputOnScreen sl
    [] ->
        timeFlowUpdate . updateUseInputInGame $
@@ -189,11 +180,12 @@ timeFlowUpdate u = case u ^. uvWorld . timeFlow of
 pauseTime :: NewInt ItmInt -> World -> World
 --pauseTime itmloc w
 pauseTime _ w
--    | justPressedButtonLeft || outofcharge = w & timeFlow .~ NormalTimeFlow
+    --    | justPressedButtonLeft || outofcharge = w & timeFlow .~ NormalTimeFlow
    | justPressedButtonLeft = w & timeFlow .~ NormalTimeFlow
    | otherwise = w -- & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix (_unNInt itmloc)) . itUse . leftConsumption . wpCharge -~ 1
  where
    justPressedButtonLeft = w ^? input . mouseButtons . ix ButtonLeft == Just 0
+
 --    outofcharge = maybe True (== 0) charge
 --    charge = w ^? pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix (_unNInt itmloc)) . itUse . leftConsumption . wpCharge

@@ -229,8 +221,9 @@ scrollTimeBack w = case w ^? pastWorlds . _head of
    mupdateitem _ = fromMaybe id $ do
        --i <- w ^? timeFlow . scrollItemID . unNInt
        _ <- w ^? timeFlow . scrollItemID . unNInt
--        let pointituse = pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse
+        --        let pointituse = pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse
        return id
+
 --            (pointituse . leftConsumption . wpCharge .~ (x -1))
 --                . (pointituse . leftHammer .~ HammerDown)

@@ -250,7 +243,6 @@ scrollTimeForward w = case w ^? timeFlow . futureWorlds . _head of
        _ <- w ^? timeFlow . scrollItemID . unNInt
        return id -- pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse . leftConsumption . wpCharge .~ ramount

-
 -- | The update step.
 functionalUpdate :: Universe -> Universe
 functionalUpdate u =
@@ -265,7 +257,8 @@ functionalUpdate u =
        . over uvWorld (updateIMl (_doors . _lWorld . _cWorld) (doDrWdWd . _drMech))
        . over uvWorld doWorldEvents
        . over uvWorld updateDelayedEvents
-        . over uvWorld (updateIMl (_modifications . _lWorld . _cWorld) (doModificationEffect . _mdUpdate))
+        . over uvWorld (updateIMl (_modifications . _lWorld . _cWorld) 
+            (doModificationEffect . _mdUpdate))
        . over uvWorld updateSparks
        . over uvWorld updateRadarSweeps
        . over uvWorld updatePosEvents
@@ -305,8 +298,9 @@ functionalUpdate u =
        $ over uvWorld updatePastWorlds u

 updateMagnets :: LWorld -> LWorld
-updateMagnets lw = lw & oldMagnets .~ (lw ^. magnets)
-    & magnets .~ mempty
+updateMagnets lw =
+    lw & oldMagnets .~ (lw ^. magnets)
+        & magnets .~ mempty

 checkTermDist :: World -> World
 checkTermDist w = fromMaybe w $ do
@@ -410,16 +404,13 @@ isOverTerminalScreen cfig tm (V2 x y) =

 updateWheelEvents :: World -> World
 updateWheelEvents w
-    | yi == 0 = w
-    | otherwise = updateWheelEvent yi w
-  where
-    yi = w ^. input . scrollAmount
+    | 0 <- w ^. input . scrollAmount = w
+    | yi <- w ^. input . scrollAmount = updateWheelEvent yi w

 advanceScrollAmount :: Universe -> Universe
-advanceScrollAmount u =
-    u
-        & uvWorld . input . scrollAmount .~ 0
-        & uvWorld . input . smoothScrollAmount %~ advanceSmoothScroll
+advanceScrollAmount =
+    (uvWorld . input . scrollAmount .~ 0)
+        . (uvWorld . input . smoothScrollAmount %~ advanceSmoothScroll)

 updatePastWorlds :: World -> World
 updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
@@ -486,7 +477,8 @@ setOldPos cr =
 --    Nothing' -> w & timeFlow .~ NormalTimeFlow

 zoneCreatures :: World -> World
-zoneCreatures w = w & crZoning
+zoneCreatures w =
+    w & crZoning
        .~ foldl' zoneCreature mempty (w ^. cWorld . lWorld . creatures)

 updateCreatureSoundPositions :: World -> World
@@ -542,11 +534,13 @@ updateRadarBlips = updateObjMapMaybe radarBlips updateRadarBlip

 -- if changing, make sure that bullets can still spawn new bullets
 updateBullets :: World -> World
-updateBullets w = w'
-    & cWorld . lWorld . bullets %~ (++ catMaybes ps)
+updateBullets w =
+    w'
+        & cWorld . lWorld . bullets %~ (++ catMaybes ps)
  where
-    (w', ps) = mapAccumR updateBullet (w & cWorld . lWorld . bullets .~ [])
-        $ w ^. cWorld . lWorld . bullets
+    (w', ps) =
+        mapAccumR updateBullet (w & cWorld . lWorld . bullets .~ []) $
+            w ^. cWorld . lWorld . bullets

 updateTeslaArcs :: World -> World
 updateTeslaArcs = updateObjCatMaybes teslaArcs updateTeslaArc