Push more data out of selection list into menu screen

src/Dodge/Data/SelectionList.hs

@@ -19,7 +19,6 @@ data SelectionList = SelectionList
     , _slWidth :: SelectionWidth
     , _slLength :: Int
     , _slSizeRestriction :: SelectionSizeRestriction
---    , _slSpecialItem :: SpecialSelectionItem
     }
 
 data SelectionItemIndex = ListedSelectionItem Int
@@ -31,10 +30,7 @@ data SpecialSelectionItem = NoSpecialSelectionItem
 
 data SelectionSizeRestriction = NoSelectionSizeRestriction
     | SelectionSizeRestriction
-        { _maxSelectionLines :: Int
+        { _overflowItemBottom :: SelectionItem
-        , _overflowItemTop :: SelectionItem
-        , _overflowItemBottom :: SelectionItem
-        , _ssrType :: SSRType
         }
 
 newtype SSRType = SSRFromScreenBottom {_ssrFromScreenBottom :: Float}

src/Dodge/Data/Universe.hs

@@ -56,6 +56,7 @@ data ScreenLayer
         , _scMaybeOption :: Maybe MenuOption
         , _scOptionFlag :: OptionScreenFlag
         , _scSelectionList :: SelectionList
+        , _scAvailableLines :: Int
         }
     | ColumnsScreen
         { _scTitle :: String

src/Dodge/Menu/Option.hs

@@ -2,7 +2,7 @@ module Dodge.Menu.Option
     where
 --import Dodge.ScodeToChar
 --import Data.Maybe
-import Dodge.WindowLayout
+--import Dodge.WindowLayout
 import Padding
 import Picture.Base
 import Dodge.Data.CardinalPoint
@@ -20,6 +20,7 @@ slTitleOptionsEff title ops defstr eff u =
         , _scMaybeOption = fmap (Toggle eff . const . MODString) defstr
         , _scOptionFlag = NormalOptions
         , _scSelectionList = makeOptionsSelectionList (Just 0) u ops
+        , _scAvailableLines = 10
         }
 
 refreshOptionsSelectionList :: Universe -> Universe
@@ -29,9 +30,6 @@ refreshOptionsSelectionList u = u & uvScreenLayers . ix 0 %~ f
         OptionScreen {_scOptions = mops} -> sl & scSelectionList . slItems .~ optionsToSelections u mops
         _ -> sl
      
-
---makeOptionsSelectionList :: Maybe Int -> Universe -> [MenuOption] -> Maybe String -> SelectionList
---makeOptionsSelectionList mselpos u mos defstr = SelectionList
 makeOptionsSelectionList :: Maybe Int -> Universe -> [MenuOption] -> SelectionList
 makeOptionsSelectionList mselpos u mos = SelectionList
     { _slPosX = 50
@@ -44,8 +42,7 @@ makeOptionsSelectionList mselpos u mos = SelectionList
     , _slCursorType = BorderCursor (Set.fromList [North,South,West])
     , _slWidth = FixedSelectionWidth 15
     , _slLength = length $ optionsToSelections u mos
-    , _slSizeRestriction = SelectionSizeRestriction (availableMenuLines cfig) overflowit overflowit
+    , _slSizeRestriction = SelectionSizeRestriction overflowit
-        (SSRFromScreenBottom 5)
 --    , _slSpecialItem = fromMaybe NoSpecialSelectionItem $ do
 --        str <- defstr
 --        return $ BottomSelectionItem SelectionItem 
@@ -58,7 +55,6 @@ makeOptionsSelectionList mselpos u mos = SelectionList
 --            }
     }
   where
-    cfig = u ^. uvConfig
     overflowit = SelectionItem
         { _siPictures = [text "MORE OPTIONS"]
         , _siHeight = 1

src/Dodge/SelectionList.hs

@@ -1,18 +1,20 @@
 module Dodge.SelectionList where
 
 --import Color
+--import Dodge.WindowLayout
 import Dodge.Data.Universe
 import LensHelp
 import Data.Maybe
 
-setShownSelectionItems :: ScreenLayer -> ScreenLayer
+setShownSelectionItems :: Configuration -> ScreenLayer -> ScreenLayer
-setShownSelectionItems sl = fromMaybe sl $ do
+setShownSelectionItems cfig sl = fromMaybe sl $ do
     offset <- sl ^? scOffset
-    return $ sl & scSelectionList %~ setShownSelectionItems' offset
+    maxlines <- sl ^? scAvailableLines
+    return $ sl & scSelectionList %~ setShownSelectionItems' maxlines offset
 
-setShownSelectionItems' :: Int -> SelectionList -> SelectionList
+setShownSelectionItems' :: Int -> Int -> SelectionList -> SelectionList
-setShownSelectionItems' offset sl = case sl ^? slSizeRestriction of
+setShownSelectionItems' maxlines offset sl = case sl ^? slSizeRestriction of
-    Just (SelectionSizeRestriction maxlines _ botit _)
+    Just (SelectionSizeRestriction botit)
         | length allitems > maxlines -> 
             sl & slShownItems .~ take (maxlines - 2) (drop offset allitems) -- ++ repeat dummyitem))
                 ++ [(botit,ScrollSelectionItem)]

src/Dodge/Update.hs

@@ -6,7 +6,6 @@ Description : Simulation update
 -}
 module Dodge.Update (updateUniverse) where
 
---import Dodge.Menu.Option
 import Dodge.Menu.Option
 import Dodge.SelectionList
 import Dodge.Data.SelectionList
@@ -93,15 +92,17 @@ gotoTerminal w = case _uvScreenLayers w of
     (InputScreen{} : _) -> w
     _ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command"
 
-mouseClickOptionsList :: [MenuOption] -> SelectionList -> Universe -> Universe
+mouseClickOptionsList :: [MenuOption] -> ScreenLayer -> Universe -> Universe
-mouseClickOptionsList mos sl u = case u ^. uvWorld . input . mouseButtons . at ButtonLeft of
+mouseClickOptionsList mos 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
         si <- sl ^? slShownItems . ix i . _2
         return $ maybe u ($ u) $ case si of
             ListedSelectionItem j -> fmap (refreshOptionsSelectionList .) (mos ^? ix j . moEff)
             ScrollSelectionItem -> do
-                maxlines <- sl ^? slSizeRestriction . maxSelectionLines
+                maxlines <- screen ^? scAvailableLines
                 alllines <- sl ^? slLength
                 Just $ uvScreenLayers . _head . scOffset %~ 
                     (\x -> if x + maxlines - 2 >= alllines then 0 else x + maxlines - 2)
@@ -125,20 +126,25 @@ mouseOverSelectionList sl u
     hh = halfHeight cfig
     hw = halfWidth cfig
 
-setSelectionListRestriction :: Configuration -> SelectionList -> SelectionList
+setSelectionListRestriction' :: Configuration -> ScreenLayer -> ScreenLayer
-setSelectionListRestriction cfig sl = sl & slSizeRestriction . maxSelectionLines %~ const nlines
+setSelectionListRestriction' cfig screen = fromMaybe screen $ do
+    sl <- screen ^? scSelectionList
+    return $ screen & scAvailableLines %~ const (setSelectionListRestriction cfig sl)
+
+setSelectionListRestriction :: Configuration -> SelectionList -> Int
+setSelectionListRestriction cfig sl = nlines
   where
     nlines = floor ((dToBot - vgap) / itmHeight)
     vgap = sl ^. slVerticalGap
     itmHeight = 10 * sl ^. slScale + vgap
     dToBot = cfig ^. windowY - (sl ^. slPosY + dFromScreenBot)
-    dFromScreenBot = fromMaybe 0 $ sl ^? slSizeRestriction . ssrType . ssrFromScreenBottom
+    dFromScreenBot = 5 -- fromMaybe 0 $ sl ^? slSizeRestriction . ssrType . ssrFromScreenBottom
 
 updateUseInput :: Universe -> Universe
 updateUseInput u = case u ^? uvScreenLayers . _head of
     Just (InputScreen thetext _) -> doInputScreenInput thetext u
-    Just OptionScreen{_scOptions = mos, _scMaybeOption = mop, _scOptionFlag = flag, _scSelectionList = sellist} 
+    Just screen@OptionScreen{_scOptions = mos, _scMaybeOption = mop, _scOptionFlag = flag, _scSelectionList = sellist}
-        -> optionScreenUpdate mos mop flag sellist u
+        -> optionScreenUpdate screen mos mop flag sellist u
 --    Just ColumnsScreen{} -> u & uvScreenLayers %~ tail
     _ -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
         Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
@@ -146,16 +152,16 @@ updateUseInput u = case u ^? uvScreenLayers . _head of
   where
     pkeys = u ^. uvWorld . input . pressedKeys
 
-optionScreenUpdate :: [MenuOption] -> Maybe MenuOption -> OptionScreenFlag
+optionScreenUpdate :: ScreenLayer -> [MenuOption] -> Maybe MenuOption -> OptionScreenFlag
     -> SelectionList
     -> Universe -> Universe
-optionScreenUpdate mos mop _ sl u = 
+optionScreenUpdate screen mos mop _ sl u = 
      optionScreenDefEff mop
-    . mouseClickOptionsList mos sl
+    . mouseClickOptionsList mos screen
     . mouseOverSelectionList sl
     . menuWheelEvents
-    . over (uvScreenLayers . _head . scSelectionList) (setSelectionListRestriction cfig)
+    . over (uvScreenLayers . _head) (setSelectionListRestriction' cfig)
-    $ over (uvScreenLayers . _head) setShownSelectionItems
+    $ over (uvScreenLayers . _head) (setShownSelectionItems cfig)
     u
   where
     cfig = u ^. uvConfig