Allow selection items to have a payload

src/Dodge/Update.hs

@@ -6,7 +6,7 @@ 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
@@ -98,18 +98,11 @@ mouseClickOptionsList mos screen u = fromMaybe u $ do
   Just $ case u ^. uvWorld . input . mouseButtons . at ButtonLeft of
     Just False -> fromMaybe u $ do
         i <- sl ^. slSelPos
-        si <- screen ^? scShownItems . ix i . _2
-        return $ maybe u ($ u) $ case si of
-            ListedSelectionItem j -> fmap (refreshOptionsSelectionList .) (mos ^? ix j . moEff)
-            ScrollSelectionItem -> do
-                maxlines <- screen ^? scAvailableLines
-                alllines <- sl ^? slLength
-                Just $ uvScreenLayers . _head . scOffset %~ 
-                    (\x -> if x + maxlines - 2 >= alllines then 0 else x + maxlines - 2)
-            SpecialSelectionItem -> Just id
+        f <- sl ^? slItems . ix i . siPayload
+        return $ f u
     _ -> u
 
-mouseOverSelectionList :: ListDisplayParams -> SelectionList -> Universe -> Universe
+mouseOverSelectionList :: ListDisplayParams -> SelectionList (Universe -> Universe) -> Universe -> Universe
 mouseOverSelectionList ldps sl u
     | x > xl && x < xr && ylower == yupper && mmoving
         && ylower >= 0 && ylower < ymax  = u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper
@@ -145,7 +138,7 @@ updateUseInput u = case u ^? uvScreenLayers . _head of
 
 optionScreenUpdate :: ScreenLayer -> [MenuOption] -> PositionedMenuOption -> OptionScreenFlag
     -> ListDisplayParams
-    -> SelectionList
+    -> SelectionList (Universe -> Universe)
     -> Universe -> Universe
 optionScreenUpdate screen mos mop _ ldps sl u = 
      optionScreenDefEff mop
@@ -153,8 +146,8 @@ optionScreenUpdate screen mos mop _ ldps sl u =
     . mouseOverSelectionList ldps sl
     . menuWheelEvents
     . over (uvScreenLayers . _head) (setSelectionListRestriction' cfig)
-    $ over (uvScreenLayers . _head) setShownSelectionItems
-    u
+--    $ over (uvScreenLayers . _head) setShownSelectionItems
+    $ u
   where
     cfig = u ^. uvConfig