Allow selection items to have a payload

src/Dodge/Data/SelectionList.hs

@@ -14,29 +14,15 @@ data ListDisplayParams = ListDisplayParams
     , _ldpVerticalGap :: Float
     , _ldpCursorType :: CursorType
     , _ldpWidth :: SelectionWidth
-    , _ldpSizeRestriction :: SelectionSizeRestriction
+--    , _ldpSizeRestriction :: SelectionSizeRestriction
     }
 
-data SelectionList = SelectionList
+data SelectionList a = SelectionList
-    { _slItems :: [SelectionItem]
+    { _slItems :: [SelectionItem a]
     , _slSelPos :: Maybe Int
     , _slLength :: Int
     }
 
-data SelectionItemIndex = ListedSelectionItem Int
-    | ScrollSelectionItem
-    | SpecialSelectionItem
-
-data SpecialSelectionItem = NoSpecialSelectionItem
-    | BottomSelectionItem {_bottomSelectionItem :: SelectionItem}
-
-data SelectionSizeRestriction = NoSelectionSizeRestriction
-    | SelectionSizeRestriction
-        { _overflowItemBottom :: SelectionItem
-        }
-
-newtype SSRType = SSRFromScreenBottom {_ssrFromScreenBottom :: Float}
-
 data SelectionWidth = FixedSelectionWidth Int
     | VariableSelectionWidth (Int -> Int)
     | UseMaxSelectionItemWidth
@@ -44,18 +30,16 @@ data SelectionWidth = FixedSelectionWidth Int
 data CursorType = NoCursor
     | BorderCursor (Set CardinalPoint)
 
-data SelectionItem = SelectionItem
+data SelectionItem a = SelectionItem
     { _siPictures :: [Picture]
     , _siHeight :: Int
     , _siIsSelectable :: Bool
     , _siWidth  :: Int
     , _siColor  :: Color
     , _siOffX   :: Int
+    , _siPayload :: a
     }
     
 makeLenses ''ListDisplayParams
 makeLenses ''SelectionList
 makeLenses ''SelectionItem
-makeLenses ''SpecialSelectionItem
-makeLenses ''SelectionSizeRestriction
-makeLenses ''SSRType

src/Dodge/Data/Universe.hs

@@ -60,9 +60,9 @@ data ScreenLayer
         , _scOffset :: Int
         , _scPositionedMenuOption :: PositionedMenuOption
         , _scOptionFlag :: OptionScreenFlag
-        , _scSelectionList :: SelectionList
+        , _scSelectionList :: SelectionList (Universe -> Universe)
         , _scAvailableLines :: Int
-        , _scShownItems :: [(SelectionItem,SelectionItemIndex)]
+--        , _scShownItems :: [(SelectionItem,SelectionItemIndex)]
         , _scListDisplayParams :: ListDisplayParams
         }
     | ColumnsScreen

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 :: Int -> Universe -> [MenuOption] -> [SelectionItem (Universe -> Universe)]
-optionsToSelections maxlines u allops = map colStrToSelItem colstrs
+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

src/Dodge/Render/HUD.hs

@@ -57,10 +57,9 @@ defaultListDisplayParams  = ListDisplayParams
     , _ldpPosY = 0
     , _ldpCursorType = NoCursor
     , _ldpWidth = FixedSelectionWidth 15
-    , _ldpSizeRestriction = NoSelectionSizeRestriction
     } 
 
-defaultSelectionList :: SelectionList
+defaultSelectionList :: SelectionList a
 defaultSelectionList = SelectionList
     {_slItems = []
     , _slSelPos = Nothing
@@ -75,19 +74,18 @@ subInvListDisplayParams = ListDisplayParams
     , _ldpPosY = 60
     , _ldpCursorType = NoCursor
     , _ldpWidth = FixedSelectionWidth 15
-    , _ldpSizeRestriction = NoSelectionSizeRestriction
     }
 
-subInvSelectionList :: SelectionList
+subInvSelectionList :: SelectionList a
 subInvSelectionList = SelectionList
     { _slItems = []
     , _slSelPos = Nothing
     , _slLength = 0
     }
 
-inventorySelectionList :: World -> [SelectionItem]
+inventorySelectionList :: World -> [SelectionItem ()]
 inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv)
-    ++ [SelectionItem displayFreeSlots 1 False (length thetext) white 0]
+    ++ [SelectionItem displayFreeSlots 1 False (length thetext) white 0 ()]
             ++ map (closeObjectToSelectionItem nfreeslots) (w ^. cWorld . lWorld . closeObjects)
   where
     cr = you w
@@ -324,21 +322,21 @@ determineInvSelCursorWidth w = case _rbOptions w of
             then 47
             else topInvW
 
-combineListSelection :: World -> SelectionList
+combineListSelection :: World -> SelectionList ()
 combineListSelection w = subInvSelectionList & slItems .~ combineListSelectionItems w
 
-combineListSelectionItems :: World -> [SelectionItem]
+combineListSelectionItems :: World -> [SelectionItem ()]
 combineListSelectionItems w = case combineListSelectionItems' w of
-    [] -> [SelectionItem [text thetext] 1 False (length thetext) white 0]
+    [] -> [SelectionItem [text thetext] 1 False (length thetext) white 0 ()]
     xs -> xs
   where
     thetext = "NO POSSIBLE COMBINATIONS"
     
 
-combineListSelectionItems' :: World -> [SelectionItem]
+combineListSelectionItems' :: World -> [SelectionItem ()]
 combineListSelectionItems' w = map (picsToSelectable 15 . itemText . snd) $ combineItemListYou w
 
-ammoTweakSelectionItems :: Maybe Item -> [SelectionItem]
+ammoTweakSelectionItems :: Maybe Item -> [SelectionItem ()]
 ammoTweakSelectionItems = textSelItems . ammoTweakStrings
 
 ammoTweakStrings :: Maybe Item -> [String]
@@ -360,7 +358,7 @@ invHead cfig s =
 invDimColor :: Color
 invDimColor = greyN 0.7
 
-closeObjectToSelectionItem :: Int -> Either FloorItem Button -> SelectionItem
+closeObjectToSelectionItem :: Int -> Either FloorItem Button -> SelectionItem ()
 closeObjectToSelectionItem n e = SelectionItem
     { _siPictures = pics
     , _siHeight = length pics
@@ -368,6 +366,7 @@ closeObjectToSelectionItem n e = SelectionItem
     , _siWidth = 15
     , _siColor = col
     , _siOffX = 2
+    , _siPayload = ()
     }
   where
     (pics,col) = closeObjectToTextPictures' n e
@@ -464,7 +463,7 @@ mapWall cfig thehud wl =
 mainListCursor :: Color -> Int -> Configuration -> Picture
 mainListCursor c = openCursorAt 120 c 5 0
 
-picsToSelectable :: Int -> [Picture] -> SelectionItem
+picsToSelectable :: Int -> [Picture] -> SelectionItem ()
 picsToSelectable wdth pics = SelectionItem
     { _siPictures = pics
     , _siHeight = length pics
@@ -472,12 +471,13 @@ picsToSelectable wdth pics = SelectionItem
     , _siWidth = wdth
     , _siColor = white
     , _siOffX = 0
+    , _siPayload = ()
     }
 
-textSelItems :: [String] -> [SelectionItem]
+textSelItems :: [String] -> [SelectionItem ()]
 textSelItems = map (picsToSelectable 15 . (:[]) . text)
 
-invSelectionItem :: Creature -> (Int,Item) -> SelectionItem
+invSelectionItem :: Creature -> (Int,Item) -> SelectionItem ()
 invSelectionItem cr (i,it) = SelectionItem
     { _siPictures = pics
     , _siHeight = length pics
@@ -485,6 +485,7 @@ invSelectionItem cr (i,it) = SelectionItem
     , _siWidth = 15
     , _siColor = col
     , _siOffX = 0
+    , _siPayload = ()
     }
   where
     col = _itInvColor it

src/Dodge/Render/List.hs

@@ -14,7 +14,7 @@ import ListHelp
 import Picture
 --import LensHelp
 
-drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList -> Picture
+drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
 drawSelectionList ldps cfig sl =
     listPicturesAtScaleOff
         (_ldpVerticalGap ldps)
@@ -26,13 +26,13 @@ drawSelectionList ldps cfig sl =
         (makeSelectionListPictures sl)
         <> drawSelectionCursor ldps cfig sl
 
-makeSelectionListPictures :: SelectionList -> [Picture]
+makeSelectionListPictures :: SelectionList a -> [Picture]
 makeSelectionListPictures sl = concatMap _siPictures $ _slItems sl
         --case sl ^. slSizeRestriction of
 --    SelectionSizeRestriction {} -> concatMap (_siPictures . fst) $ _slShownItems sl
 --    _ -> concatMap _siPictures $ _slItems sl
 
-drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList -> Picture
+drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
 drawSelectionCursor ldps cfig sl = fromMaybe mempty $ do
     i <- _slSelPos sl
     selit <- filter _siIsSelectable lis !? i

src/Dodge/Render/MenuScreen.hs

@@ -82,7 +82,7 @@ drawOptions ::
     -- | Title
     String ->
     -- | Select position
-    SelectionList ->
+    SelectionList a ->
     -- | Help Text
     String ->
     Picture

src/Dodge/SelectionList.hs

@@ -6,25 +6,6 @@ import Dodge.Data.Universe
 import LensHelp
 import Data.Maybe
 
-setShownSelectionItems :: ScreenLayer -> ScreenLayer
-setShownSelectionItems sl = fromMaybe sl $ do
-    offset <- sl ^? scOffset
-    maxlines <- sl ^? scAvailableLines
-    return $ setShownSelectionItems' maxlines offset sl
-
-setShownSelectionItems' :: Int -> Int -> ScreenLayer -> ScreenLayer
-setShownSelectionItems' maxlines offset sl = case sl ^? scListDisplayParams . ldpSizeRestriction of
-    Just (SelectionSizeRestriction botit)
-        | length allitems > maxlines -> 
-            sl & scShownItems .~ take (maxlines - 2) (drop offset allitems) -- ++ repeat dummyitem))
-                ++ [(botit,ScrollSelectionItem)]
-                & scSelectionList . slItems .~ map fst ( take (maxlines - 2) (drop offset allitems) -- ++ repeat dummyitem))
-                ++ [(botit,ScrollSelectionItem)])
-    _ -> sl & scShownItems .~ allitems
-  where
---    dummyitem = (SelectionItem [] 1 False 0 white 0, DummySelectionItem)
-    allitems = zipWith (\x y -> (x,ListedSelectionItem y)) (sl ^. scSelectionList . slItems) [0..]
-
 getAvailableListLines :: ListDisplayParams -> Configuration -> Int
 getAvailableListLines ldps cfig = nlines
   where

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
+        f <- sl ^? slItems . ix i . siPayload
-        return $ maybe u ($ u) $ case si of
+        return $ f u
-            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
     _ -> 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
+--    $ over (uvScreenLayers . _head) setShownSelectionItems
-    u
+    $ u
   where
     cfig = u ^. uvConfig