Allow selection items to have a payload

src/Dodge/Menu/Option.hs

@@ -1,7 +1,7 @@
 module Dodge.Menu.Option
     where
 --import Dodge.ScodeToChar
---import Data.Maybe
+import Data.Maybe
 --import Dodge.WindowLayout
 import Dodge.SelectionList
 import Padding
@@ -19,18 +19,8 @@ optionListDisplayParams = ListDisplayParams
             , _ldpScale = 2
             , _ldpVerticalGap = 30
             , _ldpWidth = FixedSelectionWidth 15
-            , _ldpSizeRestriction = SelectionSizeRestriction overflowit
             , _ldpCursorType = BorderCursor (Set.fromList [North,South,West])
             } 
-  where
-    overflowit = SelectionItem
-        { _siPictures = [text "MORE OPTIONS"]
-        , _siHeight = 1
-        , _siIsSelectable = True
-        , _siWidth = length "MORE OPTIONS"
-        , _siColor = white
-        , _siOffX = 0
-        }
 
 initializeOptionMenu :: String -> [MenuOption] -> Maybe String -> (Universe -> Universe) -> Universe -> ScreenLayer
 initializeOptionMenu title ops defstr eff u =
@@ -44,7 +34,6 @@ initializeOptionMenu title ops defstr eff u =
         , _scOptionFlag = NormalOptions
         , _scSelectionList = makeOptionsSelectionList 10 (Just 0) u ops
         , _scAvailableLines = getAvailableListLines optionListDisplayParams (u ^. uvConfig)
-        , _scShownItems = []
         , _scListDisplayParams = optionListDisplayParams
         }
 
@@ -57,26 +46,30 @@ refreshOptionsSelectionList u = u & uvScreenLayers . ix 0 %~ f
             -> sl & scSelectionList . slItems .~ optionsToSelections maxlines u mops
         _ -> sl
      
-makeOptionsSelectionList :: Int -> Maybe Int -> Universe -> [MenuOption] -> SelectionList
+makeOptionsSelectionList :: Int -> Maybe Int -> Universe -> [MenuOption] -> SelectionList (Universe -> Universe)
 makeOptionsSelectionList maxlines mselpos u mos = SelectionList
     { _slItems = optionsToSelections maxlines u mos
     , _slSelPos = mselpos
     , _slLength = length $ optionsToSelections maxlines u mos
     }
 
-optionsToSelections :: Int -> Universe -> [MenuOption] -> [SelectionItem]
-optionsToSelections maxlines u allops = map colStrToSelItem colstrs
+optionsToSelections :: Int -> Universe -> [MenuOption] -> [SelectionItem (Universe -> Universe)]
+optionsToSelections maxlines u allops = sits
   where
     ops | maxlines >= length allops = allops 
         | otherwise = take (maxlines - 1) allops ++ [cycleOptionsOption]
     maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops)
     colstrs = map (menuOptionToString u maxOptionLength) ops
+    sits = map (menuOptionToSelectionItem u maxOptionLength) ops
     cycleOptionsOption = Toggle cycleOptions (const (MODString "MORE OPTIONS"))
 
 cycleOptions :: Universe -> Universe
-cycleOptions = id
+cycleOptions u = fromMaybe u $ do
+    screen <- u ^? uvScreenLayers . ix 0
+    maxlines <- screen ^? scAvailableLines
+    return u
 
-colStrToSelItem :: (Color,String) -> SelectionItem
+colStrToSelItem :: (Color,String) -> SelectionItem (Universe -> Universe)
 colStrToSelItem (col,str) = SelectionItem
     { _siPictures = [color col $ text str]
     , _siHeight = 1
@@ -84,6 +77,7 @@ colStrToSelItem (col,str) = SelectionItem
     , _siWidth = length str
     , _siColor = col
     , _siOffX = 0
+    , _siPayload = id
     }
 
 optionValueOffset :: Universe -> MenuOption -> Int
@@ -91,6 +85,26 @@ optionValueOffset u mo = case _moString mo u of
     MODStringOption s _ -> length s
     _ -> 0
 
+menuOptionToSelectionItem :: Universe -> Int -> MenuOption -> SelectionItem (Universe -> Universe)
+menuOptionToSelectionItem w padAmount mo = SelectionItem
+    { _siPictures = [color thecol $ text optionText]
+    , _siHeight = 1
+    , _siIsSelectable = True
+    , _siWidth = length optionText
+    , _siColor = white
+    , _siOffX = 0
+    , _siPayload = f
+    }
+  where
+    f = fromMaybe id $ mo ^? moEff
+    thecol = case _moString mo w of
+        MODBlockedString{} -> greyN 0.5
+        _ -> white
+    optionText = case _moString mo w of
+        MODStringOption s t -> rightPad padAmount '.' s ++ t
+        x -> _modString x
+
+
 menuOptionToString :: Universe -> Int -> MenuOption -> (Color, String)
 menuOptionToString w padAmount mo = (thecol, optionText)
   where