Work on menus

src/Dodge/Menu/Option.hs

@@ -1,43 +1,68 @@
 module Dodge.Menu.Option
     where
-import Dodge.ScodeToChar
+--import Dodge.ScodeToChar
+import Data.Maybe
+import Dodge.WindowLayout
 import Padding
 import Picture.Base
 import Dodge.Data.CardinalPoint
 import Dodge.Data.SelectionList
 import Dodge.Data.Universe
 import qualified Data.Set as Set
+import LensHelp
 
-slTitleOptionsEff :: String -> [MenuOption] -> (Universe -> Universe) -> ScreenLayer
-slTitleOptionsEff title ops eff =
+slTitleOptionsEff :: String -> [MenuOption] -> Maybe String -> (Universe -> Universe) -> Universe -> ScreenLayer
+slTitleOptionsEff title ops defstr eff u =
     OptionScreen
-        { _scTitle = const title
+        { _scTitle = title
         , _scOptions = ops
-        , _scDefaultEff = eff
+        , _scMaybeOption = fmap (Toggle eff . const . MODString) defstr
         , _scOptionFlag = NormalOptions
-        , _scOptionsOffset = 0
-        , _scSelPos = Just 0
+        , _scSelectionList = makeOptionsSelectionList (Just 0) u ops defstr
         }
 
-makeOptionsSelectionList :: Maybe Int -> Universe -> [MenuOption] -> SelectionList
-makeOptionsSelectionList mselpos u mos = SelectionList
+makeOptionsSelectionList :: Maybe Int -> Universe -> [MenuOption] -> Maybe String -> SelectionList
+makeOptionsSelectionList mselpos u mos defstr = SelectionList
     { _slPosX = 50
     , _slPosY = 50
     , _slOffset = 0
     , _slScale = 2
     , _slVerticalGap = 30
     , _slItems = optionsToSelections u mos
+    , _slShownItems = []
     , _slSelPos = mselpos
     , _slCursorType = BorderCursor (Set.fromList [North,South,West])
     , _slWidth = FixedSelectionWidth 15
     , _slLength = length $ optionsToSelections u mos
+    , _slSizeRestriction = SelectionSizeRestriction (availableMenuLines cfig) overflowit overflowit
+        (SSRFromScreenBottom 5)
+    , _slSpecialItem = fromMaybe NoSpecialSelectionItem $ do
+        str <- defstr
+        return $ BottomSelectionItem SelectionItem 
+            { _siPictures = [color white $ text str]
+            , _siHeight = 1
+            , _siIsSelectable = True
+            , _siWidth = length str
+            , _siColor = white
+            , _siOffX = 0
+            }
     }
+  where
+    cfig = u ^. uvConfig
+    overflowit = SelectionItem
+        { _siPictures = [text "MORE OPTIONS"]
+        , _siHeight = 1
+        , _siIsSelectable = True
+        , _siWidth = length "MORE OPTIONS"
+        , _siColor = white
+        , _siOffX = 0
+        }
 
 optionsToSelections :: Universe -> [MenuOption] -> [SelectionItem]
 optionsToSelections u ops = map colStrToSelItem colstrs
   where
     maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops)
-    colstrs = zipWith (menuOptionToString u maxOptionLength) ['A'..] ops
+    colstrs = map (menuOptionToString u maxOptionLength) ops
 
 colStrToSelItem :: (Color,String) -> SelectionItem
 colStrToSelItem (col,str) = SelectionItem
@@ -54,8 +79,8 @@ optionValueOffset u mo = case _moString mo u of
     MODStringOption s _ -> length s
     _ -> 0
 
-menuOptionToString :: Universe -> Int -> Char -> MenuOption -> (Color, String)
-menuOptionToString w padAmount char mo = (thecol, (char:":") ++ optionText)
+menuOptionToString :: Universe -> Int -> MenuOption -> (Color, String)
+menuOptionToString w padAmount mo = (thecol, optionText)
   where
     thecol = case _moString mo w of
         MODBlockedString{} -> greyN 0.5

src/Dodge/Menu/PushPop.hs

@@ -6,6 +6,6 @@ import LensHelp
 popScreen :: Universe -> Universe
 popScreen = uvScreenLayers %~ tail
 
-pushScreen :: ScreenLayer -> Universe -> Universe
-pushScreen ml = uvScreenLayers .:~ ml
+pushScreen :: (Universe -> ScreenLayer) -> Universe -> Universe
+pushScreen ml u = u & uvScreenLayers .:~ ml u