Refactor in lens direction

src/Dodge/Creature/State.hs

@@ -158,7 +158,8 @@ applyPastDamages cr w
 
 -- a map updating all inventory items
 updateInv :: Creature -> World -> World
-updateInv cr = cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.map itemUpdate
+updateInv cr = cWorld . lWorld . creatures . ix (_crID cr) . crInv . each 
+    . itUse %~ useUpdate
 
 -- a loop going over all inventory items
 invSideEff :: Creature -> World -> World
@@ -425,15 +426,8 @@ setRBCreatureTargeting cr w ituse
         cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos
         Just $ hasLOS cpos (_crPos cr) w
 
-itemUpdate :: Item -> Item
---itemUpdate = updateAutoRecharge . (itUse %~ useUpdate)
-itemUpdate = itUse %~ useUpdate
-
 useUpdate :: ItemUse -> ItemUse
 useUpdate =
---    (heldHammer %~ moveHammerUp)
---        . (leftHammer %~ moveHammerUp)
---        . (leftDelay . rateTime %~ decreaseToZero)
          (heldDelay . warmTime %~ decreaseToZero)
         . (heldDelay . rateTime %~ decreaseToZero)
 

src/Dodge/DisplayInventory.hs

@@ -303,17 +303,15 @@ updateSection indent mcsel sis availablelines oldoffset =
     offset = fromMaybe oldoffsetbounded $ do
         csel <- mcsel
         maxcsel <- fst <$> IM.lookupMax sis
-        si <- sis ^? ix csel
-        let xselsize = length $ _siPictures si
+        xselsize <- fmap length $ sis ^? ix csel . siPictures
         return $ case sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis of
             pos | pos == 0 || length allstrings <= availablelines -> 0
             pos | pos - 1 < oldoffset -> pos - 1
             pos | maxcsel == csel -> pos - availablelines + xselsize
-            pos
-                | pos + 1 + xselsize - availablelines > oldoffset ->
+            pos | pos + 1 + xselsize - availablelines > oldoffset ->
                     pos - availablelines + 1 + xselsize
-            _
-                | length allstrings - oldoffset < availablelines ->
+--            _   | length allstrings - oldoffset < availablelines ->
+            _   | length allstrings - availablelines < oldoffset ->
                     length allstrings - availablelines
             _ -> oldoffsetbounded
     tweakfirst
@@ -330,9 +328,12 @@ updateSection indent mcsel sis availablelines oldoffset =
     shownstrings = drop offset allstrings
 
 listSelectionColorPicture :: SelectionItem a -> [STup.Pair Color Picture]
+--listSelectionColorPicture si = []
 listSelectionColorPicture si = g <$> _siPictures si
   where
-    g str = _siColor si STup.:!: translate lindent 0 (color (_siColor si) $ text str)
+    g str = 
+        _siColor si STup.:!: 
+        translate lindent 0 (color (_siColor si) $ text str)
     lindent = 100 * fromIntegral (_siOffX si)
 
 regexList :: String -> [String] -> Bool

src/Dodge/Update.hs

@@ -486,9 +486,8 @@ setOldPos cr =
 --    Nothing' -> w & timeFlow .~ NormalTimeFlow
 
 zoneCreatures :: World -> World
-zoneCreatures w =
-    w & crZoning
-        .~ foldl' (flip zoneCreature) mempty (w ^. cWorld . lWorld . creatures)
+zoneCreatures w = w & crZoning
+        .~ foldl' zoneCreature mempty (w ^. cWorld . lWorld . creatures)
 
 updateCreatureSoundPositions :: World -> World
 updateCreatureSoundPositions w =

src/Dodge/Zoning/Base.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 module Dodge.Zoning.Base 
     ( zoneExtract
     , zoneOfPoint
@@ -79,7 +80,7 @@ yIntercepts' s sp ep = map f $ xIntercepts s (f sp) (f ep)
 
 zoneMonoid :: Semigroup m => Int2 -> m -> IM.IntMap (IM.IntMap m) -> IM.IntMap (IM.IntMap m)
 {-# INLINE zoneMonoid #-}
-zoneMonoid (V2 x y) a = IM.insertWith f x $! IM.singleton y a
+zoneMonoid !(V2 !x !y) a = IM.insertWith f x $! IM.singleton y a
   where
     f _ = IM.insertWith (<>) y a
 

src/Dodge/Zoning/Creature.hs

@@ -5,10 +5,10 @@ import qualified Data.IntSet as IS
 import Data.Maybe
 import Dodge.Data.World
 import Dodge.Zoning.Base
+import Dodge.Zoning.Common
 import FoldableHelp
 import Geometry
 import qualified IntMapHelp as IM
-import Dodge.Zoning.Common
 
 crIXsNearPoint :: Point2 -> World -> IS.IntSet
 --crIXsNearPoint p w = zoneExtract (zoneOfPoint crZoneSize p) (w ^. cWorld . lWorld . crZoning)
@@ -18,13 +18,14 @@ crsNearPoint :: Point2 -> World -> [Creature]
 crsNearPoint p w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearPoint p w
 
 crsNearSeg :: Point2 -> Point2 -> World -> [Creature]
-crsNearSeg sp ep w = 
+crsNearSeg sp ep w =
     mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid)
-    . IS.toList
-    $ crixsNearSeg sp ep w
+        . IS.toList
+        $ crixsNearSeg sp ep w
 
 crixsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
 crixsNearSeg = nearSeg crZoneSize _crZoning
+
 --crixsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . crZoning) (zoneOfSeg crZoneSize sp ep)
 
 crIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
@@ -49,8 +50,11 @@ minCrIXOn f is w = fst <$> IS.foldl' g Nothing is
     getpair cid = fmap h $ w ^? cWorld . lWorld . creatures . ix cid
     h cr = (cr, f cr)
 
-zoneCreature :: Creature -> IM.IntMap (IM.IntMap IS.IntSet) -> IM.IntMap (IM.IntMap IS.IntSet)
+zoneCreature ::
+    IM.IntMap (IM.IntMap IS.IntSet) ->
+    Creature ->
+    IM.IntMap (IM.IntMap IS.IntSet)
 {-# INLINE zoneCreature #-}
-zoneCreature cr im = foldl' f im (zoneOfCr cr)
+zoneCreature im cr = foldl' f im (zoneOfCr cr)
   where
-    f im' i2 = zoneMonoid i2 (IS.singleton $ _crID cr) im'
+    f im' i2 = zoneMonoid i2 (IS.singleton $! _crID cr) im'