Work on inventory selection list

src/Dodge/Update.hs

@@ -6,22 +6,19 @@ Description : Simulation update
 -}
 module Dodge.Update (updateUniverse) where
 
---import Dodge.Menu.Option
-import Dodge.Menu.Option
-import Dodge.SelectionList
-import Dodge.Data.SelectionList
-import Dodge.InputFocus
 import Color
 import Control.Applicative
 import Data.List
 import qualified Data.Map.Strict as M
 import Data.Maybe
+import qualified Data.Text as T
 import Dodge.Base
 import Dodge.Beam
 import Dodge.Bullet
 import Dodge.CrGroupUpdate
 import Dodge.Creature.Update
 import Dodge.CullBox
+import Dodge.Data.SelectionList
 import Dodge.Data.Universe
 import Dodge.Distortion
 import Dodge.DrWdWd
@@ -29,6 +26,7 @@ import Dodge.EnergyBall
 import Dodge.Flame
 import Dodge.Flare
 import Dodge.Hammer
+import Dodge.InputFocus
 import Dodge.Inventory
 import Dodge.Item.Location
 import Dodge.Laser.Update
@@ -37,6 +35,7 @@ import Dodge.LinearShockwave.Update
 import Dodge.Machine.Update
 import Dodge.Magnet.Update
 import Dodge.Menu
+import Dodge.Menu.Option
 import Dodge.ModificationEffect
 import Dodge.PosEvent
 import Dodge.PressPlate
@@ -44,6 +43,7 @@ import Dodge.Projectile.Update
 import Dodge.Prop.Update
 import Dodge.RadarBlip
 import Dodge.RadarSweep
+import Dodge.SelectionList
 import Dodge.Shockwave.Update
 import Dodge.SoundLogic
 import Dodge.Spark
@@ -62,12 +62,9 @@ import Dodge.Zoning.Creature
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
---import MaybeHelp
 import SDL
 import Sound.Data
 import StrictHelp
-import qualified Data.Text as T
---import ListHelp
 
 updateUniverse :: Universe -> Universe
 updateUniverse u =
@@ -95,23 +92,27 @@ gotoTerminal w = case _uvScreenLayers w of
 
 mouseClickOptionsList :: ScreenLayer -> Universe -> Universe
 mouseClickOptionsList screen u = fromMaybe u $ do
-  sl <- screen ^? scSelectionList
-  Just $ case u ^. uvWorld . input . mouseButtons . at ButtonLeft of
-    Just False -> fromMaybe u $ do
-        i <- sl ^. slSelPos
-        f <- sl ^? slItems . ix i . siPayload
-        return $ f u
-    _ -> u
+    sl <- screen ^? scSelectionList
+    Just $ case u ^. uvWorld . input . mouseButtons . at ButtonLeft of
+        Just False -> fromMaybe u $ do
+            i <- sl ^. slSelPos
+            f <- sl ^? slItems . ix i . siPayload
+            return $ f u
+        _ -> u
 
 mouseOverSelectionList :: ListDisplayParams -> SelectionList (Universe -> Universe) -> Universe -> Universe
 mouseOverSelectionList ldps sl u
     | x > xl && x < xr && ylower == yupper && mmoving
-        && ylower >= 0 && ylower < ymax && isselectable = u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper
+        && ylower >= 0
+        && ylower < ymax
+        && isselectable =
+        u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper
     | otherwise = u
   where
-    isselectable = fromMaybe False 
-        $ u ^? uvScreenLayers . _head . scSelectionList . slItems . ix yupper . siIsSelectable
-    ymax = maybe 0 length $ sl ^? slItems 
+    isselectable =
+        fromMaybe False $
+            u ^? uvScreenLayers . _head . scSelectionList . slItems . ix yupper . siIsSelectable
+    ymax = maybe 0 length $ sl ^? slItems
     mmoving = u ^. uvWorld . input . mouseMoving
     ylower = ceiling $ (hh - (75 + y + _ldpPosY ldps)) / 50
     yupper = floor $ (hh - (15 + y + _ldpPosY ldps)) / 50
@@ -130,27 +131,30 @@ setSelectionListRestriction' cfig screen = fromMaybe screen $ do
 updateUseInput :: Universe -> Universe
 updateUseInput u = case u ^? uvScreenLayers . _head of
     Just (InputScreen thetext _) -> doInputScreenInput thetext u
-    Just screen@OptionScreen{_scPositionedMenuOption = mop, _scOptionFlag = flag, _scSelectionList = sellist, _scListDisplayParams = ldps}
-        -> optionScreenUpdate screen mop flag ldps sellist u
---    Just ColumnsScreen{} -> u & uvScreenLayers %~ tail
+    Just screen@OptionScreen{_scPositionedMenuOption = mop, _scOptionFlag = flag, _scSelectionList = sellist, _scListDisplayParams = ldps} ->
+        optionScreenUpdate screen mop flag ldps sellist u
     _ -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
         Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
         _ -> M.foldlWithKey' updateKeyInGame u pkeys
   where
     pkeys = u ^. uvWorld . input . pressedKeys
 
-optionScreenUpdate :: ScreenLayer -> PositionedMenuOption -> OptionScreenFlag
-    -> ListDisplayParams
-    -> SelectionList (Universe -> Universe)
-    -> Universe -> Universe
-optionScreenUpdate screen mop _ ldps sl u = 
+optionScreenUpdate ::
+    ScreenLayer ->
+    PositionedMenuOption ->
+    OptionScreenFlag ->
+    ListDisplayParams ->
+    SelectionList (Universe -> Universe) ->
+    Universe ->
+    Universe
+optionScreenUpdate screen mop _ ldps sl u =
     refreshOptionsSelectionList
-    . optionScreenDefEff mop
-    . mouseClickOptionsList screen
-    . mouseOverSelectionList ldps sl
-    . menuWheelEvents
-    . over (uvScreenLayers . _head) (setSelectionListRestriction' cfig)
-    $ u
+        . optionScreenDefEff mop
+        . mouseClickOptionsList screen
+        . mouseOverSelectionList ldps sl
+        . menuWheelEvents
+        . over (uvScreenLayers . _head) (setSelectionListRestriction' cfig)
+        $ u
   where
     cfig = u ^. uvConfig
 
@@ -291,12 +295,7 @@ functionalUpdate w =
         . over uvWorld updateWheelEvents
         $ over uvWorld updatePastWorlds w
 
---menuWheelEvents :: Universe -> Universe
---menuWheelEvents u = u & uvScreenLayers . _head . scSelectionList . slSelPos . _Just %~ (\y' -> (y' - y) `mod` ymax)
---  where
---    ymax = max 1 $ maybe 1 length (u ^? uvScreenLayers . _head . scSelectionList . slItems)
---    y = u ^. uvWorld . input . scrollAmount
-
+-- this can probably be unified with updateWheelEvents
 menuWheelEvents :: Universe -> Universe
 menuWheelEvents u = foldr ($) u (replicate (abs y) (menuWheelStep (signum y)))
   where
@@ -306,13 +305,13 @@ menuWheelEvents u = foldr ($) u (replicate (abs y) (menuWheelStep (signum y)))
 menuWheelStep :: Int -> Universe -> Universe
 menuWheelStep i u = fromMaybe u $ do
     sl <- u ^? uvScreenLayers . _head . scSelectionList
-    selpos <- sl ^? slSelPos . _Just 
+    selpos <- sl ^? slSelPos . _Just
     ymax <- fmap length (sl ^? slItems)
     let newpos = (selpos - i) `mod` ymax
     itm <- sl ^? slItems . ix newpos
     let newu = u & uvScreenLayers . _head . scSelectionList . slSelPos . _Just %~ const newpos
     if _siIsSelectable itm
-        then Just newu 
+        then Just newu
         else Just $ menuWheelStep i newu
 
 updateWheelEvents :: World -> World