Remove explicit scancode from menu items

src/Dodge/Data/Input.hs

@@ -17,6 +17,7 @@ data PressType = InitialPress
 
 data Input = Input
     { _mousePos :: Point2
+    , _mouseMoving :: Bool
     , _pressedKeys :: M.Map Scancode PressType
     , _mouseButtons :: M.Map MouseButton Bool
     , _scrollAmount         :: Int

src/Dodge/Data/SelectionList.hs

@@ -16,6 +16,7 @@ data SelectionList = SelectionList
     , _slSelPos :: Maybe Int
     , _slCursorType :: CursorType
     , _slWidth :: SelectionWidth
+    , _slLength :: Int
     }
 
 data SelectionWidth = FixedSelectionWidth Int
@@ -28,6 +29,7 @@ data SelectionItem = SelectionItem
     { _siPictures :: [Picture]
     , _siHeight :: Int
     , _siIsSelectable :: Bool
+    , _siWidth  :: Int
     , _siColor  :: Color
     , _siOffX   :: Int
     }

src/Dodge/Data/Universe.hs

@@ -81,17 +81,14 @@ data MenuOption
     = Toggle
         { _moEff :: Universe -> Universe
         , _moString :: Universe -> MenuOptionDisplay
-        , _moKey :: Scancode
         }
     | Toggle2
-        { _moKey1 :: Scancode
+        { _moEff1 :: Universe -> Universe
-        , _moEff1 :: Universe -> Universe
-        , _moKey2 :: Scancode
         , _moEff2 :: Universe -> Universe
         , _moString :: Universe -> MenuOptionDisplay
         }
     | InvisibleToggle
-        { _moKey :: Scancode
+        { _moChar :: Scancode
         , _moEff :: Universe -> Universe
         }
 

src/Dodge/Default/World.hs

@@ -10,12 +10,14 @@ import qualified IntMapHelp as IM
 import System.Random
 
 defaultInput :: Input
-defaultInput = Input
+defaultInput =
+    Input
         { _clickMousePos = V2 0 0
         , _textInput = mempty
         , _pressedKeys = mempty
         , _mouseButtons = mempty
         , _mousePos = V2 0 0
+        , _mouseMoving = False
         , _scrollAmount = 0
         , _previousScrollAmount = 0
         , _hammers = defaultWorldHammers
@@ -24,7 +26,7 @@ defaultInput = Input
         , _rLine = (0, 0)
         , _lSelect = 0
         , _rSelect = 0
-    }
+        }
 
 defaultWorld :: World
 defaultWorld =

src/Dodge/Event/Input.hs

@@ -31,10 +31,11 @@ handleKeyboardEvent kev = case keyboardEventKeyMotion kev of
 
 handleMouseMotionEvent :: MouseMotionEventData -> Configuration -> Input -> Input
 handleMouseMotionEvent mmev cfig =
-    mousePos
+    (mousePos
         .~ V2
             (fromIntegral x - 0.5 * _windowX cfig)
             (0.5 * _windowY cfig - fromIntegral y)
+    ) . (mouseMoving .~ True)
   where
     P (V2 x y) = mouseMotionEventPos mmev
 

src/Dodge/Event/Menu.hs

@@ -1,5 +1,5 @@
 module Dodge.Event.Menu (
-    optionListToEffects,
+    --optionListToEffects,
 ) where
 
 import Control.Lens
@@ -8,36 +8,26 @@ import Dodge.Data.Universe
 import Dodge.WindowLayout
 import SDL
 
-optionListToEffects ::
+--optionListToEffects ::
-    (Universe -> Universe) ->
+--    (Universe -> Universe) ->
-    Scancode ->
+--    Scancode ->
-    [MenuOption] ->
+--    [MenuOption] ->
-    Universe ->
+--    Universe ->
-    Universe
+--    Universe
-optionListToEffects defaulteff sc mops u = case sc of
+--optionListToEffects defaulteff sc mops u = case sc of
-    ScancodeSpace ->
+--    ScancodeSpace ->
-        (uvScreenLayers . ix 0 . scOptionsOffset %~ (f . (+ mlines)))
+--        (uvScreenLayers . ix 0 . scOptionsOffset %~ (f . (+ mlines)))
-            u
+--            u
-    _ ->
+--    _ ->
-        ( fromMaybe defaulteff
+--        ( fromMaybe defaulteff
-            . lookup sc
+--            . lookup sc
-            . concatMap menuOptionToEffects
+--            . concatMap menuOptionToEffects
-            $ mops
+--            $ mops
-        )
+--        )
-            u
+--            u
-  where
+--  where
-    f x
+--    f x
-        | x > length mops = 0
+--        | x > length mops = 0
-        | otherwise = x
+--        | otherwise = x
-    mlines = availableMenuLines $ _uvConfig u
+--    mlines = availableMenuLines $ _uvConfig u
 
-menuOptionToEffects :: MenuOption -> [(Scancode, Universe -> Universe)]
-menuOptionToEffects Toggle{_moKey = k, _moEff = eff} = [(k, eff)]
-menuOptionToEffects InvisibleToggle{_moKey = k, _moEff = eff} = [(k, eff)]
-menuOptionToEffects
-    Toggle2
-        { _moKey1 = k1
-        , _moEff1 = eff1
-        , _moKey2 = k2
-        , _moEff2 = eff2
-        } = [(k1, eff1), (k2, eff2)]

src/Dodge/Menu.hs

@@ -31,7 +31,6 @@ splashMenu =
 
 splashMenuOptions :: [MenuOption]
 splashMenuOptions =
-    basicKeyOptions
         [ Toggle ( loadSaveSlot (SaveSlotNum 0)) displaycontinue
         , Toggle id (\u -> MODString $ show $ u ^? uvScreenLayers . _head . scSelPos . _Just)
         , Toggle id (\u -> MODString $ shortShow $ u ^. uvWorld . input . mousePos)
@@ -55,7 +54,6 @@ pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions unpause
 
 pauseMenuOptions :: [MenuOption]
 pauseMenuOptions =
-    basicKeyOptions
         [ Toggle popScreen (opText "CONTINUE")
         , Toggle (startNewGameInSlot 0) (opText "NEW GAME")
         , Toggle reloadLevelStart (opText "RESTART")
@@ -84,7 +82,7 @@ seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen
 
 seedStartOptions :: [MenuOption]
 seedStartOptions =
-    [ Toggle (uvIOEffects .~ trySeedFromClipboard) (const $ MODString "PASTE NUMBER FROM CLIPBOARD") ScancodeA
+    [ Toggle (uvIOEffects .~ trySeedFromClipboard) (const $ MODString "PASTE NUMBER FROM CLIPBOARD")
     --    , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER")
     ]
 
@@ -106,11 +104,11 @@ optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions popScreen
 
 optionsOptions :: [MenuOption]
 optionsOptions =
-    basicKeyOptions
         [ makeSubmenuOption soundMenu $ MODString "VOLUME"
         , makeSubmenuOption graphicsMenu $ MODString "GRAPHICS"
         , makeSubmenuOption gameplayMenu $ MODString "GAMEPLAY"
         , makeSubmenuOption debugMenu $ MODString "DEBUG OPTIONS"
+        , Toggle popScreen $ const $ MODString "BACK"
         ]
 
 debugMenu :: ScreenLayer
@@ -121,12 +119,9 @@ debugMenu =
 
 debugMenuOptions :: [MenuOption]
 debugMenuOptions =
-    zipWith
-        ($)
         (map f [minBound ..] ++ [makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" id])
-        $ map Scancode [4 ..]
   where
-    f :: DebugBool -> Scancode -> MenuOption
+    f :: DebugBool -> MenuOption
     f bd =
         Toggle
             (uvConfig . debug_booleans . at bd %~ toggleJust)
@@ -156,13 +151,9 @@ gameplayMenu =
 
 gameplayMenuOptions :: [MenuOption]
 gameplayMenuOptions =
-    basicKeyOptions
         [ makeBoolOption gameplay_rotate_to_wall "ROTATE TO WALL"
         ]
 
-basicKeyOptions :: [Scancode -> c] -> [c]
-basicKeyOptions xs = zipWith ($) xs $ map Scancode [4 ..]
-
 soundMenu :: ScreenLayer
 soundMenu =
     slTitleOptions
@@ -178,9 +169,7 @@ soundMenuOptions =
   where
     theoption scod1 stype scod2 str voltype =
         Toggle2
-            scod1
             (change dec stype)
-            scod2
             (change inc stype)
             (\w -> MODStringOption str (leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w) :: Int)))
     change g vt uv = uv & uvConfig . vt %~ g
@@ -197,7 +186,6 @@ graphicsMenu = slTitleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions
 
 graphicsMenuOptions :: [MenuOption]
 graphicsMenuOptions =
-    basicKeyOptions
         [ makeEnumOption graphics_resolution_factor "RESOLUTION" (uvIOEffects .~ updateFramebufferSize)
         , makeBoolOption graphics_wall_textured "WALL TEXTURES"
         , makeBoolOption graphics_object_shadows "OBJECT SHADOWS"

src/Dodge/Menu/Option.hs

@@ -3,7 +3,6 @@ module Dodge.Menu.Option
 import Dodge.ScodeToChar
 import Padding
 import Picture.Base
-import Color
 import Dodge.Data.CardinalPoint
 import Dodge.Data.SelectionList
 import Dodge.Data.Universe
@@ -31,13 +30,14 @@ makeOptionsSelectionList mselpos u mos = SelectionList
     , _slSelPos = mselpos
     , _slCursorType = BorderCursor (Set.fromList [North,South,West])
     , _slWidth = FixedSelectionWidth 15
+    , _slLength = length $ optionsToSelections u mos
     }
 
 optionsToSelections :: Universe -> [MenuOption] -> [SelectionItem]
 optionsToSelections u ops = map colStrToSelItem colstrs
   where
     maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) visibleops)
-    colstrs = map (menuOptionToString u maxOptionLength) visibleops
+    colstrs = zipWith (menuOptionToString u maxOptionLength) ['A'..] visibleops
     visibleops = filter notInvisible ops
     notInvisible InvisibleToggle{} = False
     notInvisible _ = True
@@ -47,6 +47,7 @@ colStrToSelItem (col,str) = SelectionItem
     { _siPictures = [color col $ text str]
     , _siHeight = 1
     , _siIsSelectable = True
+    , _siWidth = length str
     , _siColor = col
     , _siOffX = 0
     }
@@ -56,8 +57,8 @@ optionValueOffset u mo = case _moString mo u of
     MODStringOption s _ -> length s
     _ -> 0
 
-menuOptionToString :: Universe -> Int -> MenuOption -> (Color, String)
+menuOptionToString :: Universe -> Int -> Char -> MenuOption -> (Color, String)
-menuOptionToString w padAmount mo = (thecol, theKeys ++ optionText)
+menuOptionToString w padAmount char mo = (thecol, (char:":") ++ optionText)
   where
     thecol = case _moString mo w of
         MODBlockedString{} -> greyN 0.5
@@ -65,8 +66,3 @@ menuOptionToString w padAmount mo = (thecol, theKeys ++ optionText)
     optionText = case _moString mo w of
         MODStringOption s t -> rightPad padAmount '.' s ++ t
         x -> _modString x
-    theKeys = case mo of
-        Toggle{_moKey = k} -> stc k : ":"
-        Toggle2{_moKey1 = k1, _moKey2 = k2} -> stc k1 : '/' : stc k2 : ":"
-        _ -> undefined
-    stc = scodeToChar

src/Dodge/Render/HUD.hs

@@ -78,16 +78,17 @@ subInvSelectionList = SelectionList
 
 inventorySelectionList :: World -> [SelectionItem]
 inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv)
-    ++ [SelectionItem displayFreeSlots 1 False white 0]
+    ++ [SelectionItem displayFreeSlots 1 False (length thetext) white 0]
             ++ map (closeObjectToSelectionItem nfreeslots) (w ^. cWorld . lWorld . closeObjects)
   where
     cr = you w
     inv = _crInv cr
     nfreeslots = crNumFreeSlots cr
-    displayFreeSlots = case nfreeslots of
+    thetext = case nfreeslots of
-        0 -> [color invDimColor . text $ "  INVENTORY FULL"]
+        0 -> "  INVENTORY FULL"
-        1 -> [color invDimColor . text $ "  +1 FREE SLOT"]
+        1 -> "  +1 FREE SLOT"
-        x -> [color invDimColor . text $ "  +" ++ show x ++ " FREE SLOTS"]
+        x -> "  +" ++ show x ++ " FREE SLOTS"
+    displayFreeSlots = [color invDimColor $ text thetext]
 
 inventoryCursorPos :: SubInventory -> World -> Maybe Int
 inventoryCursorPos subinv w = case subinv of
@@ -316,11 +317,14 @@ combineListSelection w = subInvSelectionList & slItems .~ combineListSelectionIt
 
 combineListSelectionItems :: World -> [SelectionItem]
 combineListSelectionItems w = case combineListSelectionItems' w of
-    [] -> [SelectionItem [text "NO POSSIBLE COMBINATIONS"] 1 False white 0]
+    [] -> [SelectionItem [text thetext] 1 False (length thetext) white 0]
     xs -> xs
+  where
+    thetext = "NO POSSIBLE COMBINATIONS"
+    
 
 combineListSelectionItems' :: World -> [SelectionItem]
-combineListSelectionItems' w = map (picsToSelectable . itemText . snd) $ combineItemListYou w
+combineListSelectionItems' w = map (picsToSelectable 15 . itemText . snd) $ combineItemListYou w
 
 ammoTweakSelectionItems :: Maybe Item -> [SelectionItem]
 ammoTweakSelectionItems = textSelItems . ammoTweakStrings
@@ -349,6 +353,7 @@ closeObjectToSelectionItem n e = SelectionItem
     { _siPictures = pics
     , _siHeight = length pics
     , _siIsSelectable = True
+    , _siWidth = 15
     , _siColor = col
     , _siOffX = 2
     }
@@ -447,23 +452,25 @@ mapWall cfig thehud wl =
 mainListCursor :: Color -> Int -> Configuration -> Picture
 mainListCursor c = openCursorAt 120 c 5 0
 
-picsToSelectable :: [Picture] -> SelectionItem
+picsToSelectable :: Int -> [Picture] -> SelectionItem
-picsToSelectable pics = SelectionItem
+picsToSelectable wdth pics = SelectionItem
     { _siPictures = pics
     , _siHeight = length pics
     , _siIsSelectable = True
+    , _siWidth = wdth
     , _siColor = white
     , _siOffX = 0
     }
 
 textSelItems :: [String] -> [SelectionItem]
-textSelItems = map (picsToSelectable . (:[]) . text)
+textSelItems = map (picsToSelectable 15 . (:[]) . text)
 
 invSelectionItem :: Creature -> (Int,Item) -> SelectionItem
 invSelectionItem cr (i,it) = SelectionItem
     { _siPictures = pics
     , _siHeight = length pics
     , _siIsSelectable = True
+    , _siWidth = 15
     , _siColor = col
     , _siOffX = 0
     }

src/Dodge/Render/MenuScreen.hs

@@ -5,17 +5,14 @@ module Dodge.Render.MenuScreen (
 ) where
 
 import Dodge.Menu.Option
-import Dodge.Data.CardinalPoint
 import Dodge.Render.List
 import Dodge.Data.SelectionList
 import qualified Data.Text as T
 import Dodge.Base.Window
 import Dodge.Data.Universe
-import Dodge.ScodeToChar
 import Dodge.WindowLayout
 import Padding
 import Picture
-import qualified Data.Set as Set
 
 menuScreen' :: Universe -> ScreenLayer -> Picture
 menuScreen' w screen = case screen of
@@ -95,8 +92,8 @@ drawOptions u title ops off mselpos footer =
         x | x < length ops -> take (availableMenuLines cfig) (drop off visibleops)
         _ -> visibleops
     ops'' = case availableMenuLines cfig of
-        x | x < length ops -> map (menuOptionToString u maxOptionLength) ops' ++ [(white, "SPACE: MORE OPTIONS")]
+        x | x < length ops -> zipWith (menuOptionToString u maxOptionLength) ['A'..] ops' ++ [(white, "SPACE: MORE OPTIONS")]
-        _ -> map (menuOptionToString u maxOptionLength) ops'
+        _ -> zipWith (menuOptionToString u maxOptionLength) ['A'..] ops'
     visibleops = filter notInvisible ops
     notInvisible InvisibleToggle{} = False
     notInvisible _ = True

src/Dodge/Update.hs

@@ -66,6 +66,7 @@ import SDL
 import Sound.Data
 import StrictHelp
 import qualified Data.Text as T
+import ListHelp
 
 updateUniverse :: Universe -> Universe
 updateUniverse u =
@@ -93,16 +94,29 @@ gotoTerminal w = case _uvScreenLayers w of
 
 optionScreenUpdates :: Universe -> Universe
 optionScreenUpdates u = case u ^? uvScreenLayers . _head of
-    Just (OptionScreen {_scOptions = mos, _scSelPos = mselpos}) -> mouseOverSelectionList 
+    Just (OptionScreen {_scOptions = mos, _scSelPos = mselpos}) -> 
+        mouseClickSelectionList mos mselpos
+        $ mouseOverSelectionList 
         (makeOptionsSelectionList mselpos u mos) u
     _ -> u
 
+mouseClickSelectionList :: [MenuOption] -> Maybe Int -> Universe -> Universe
+mouseClickSelectionList mos mi u = case u ^. uvWorld . input . mouseButtons . at ButtonLeft of
+    Just False -> fromMaybe u $ do
+        i <- mi
+        mo <- mos !? i
+        return $ _moEff mo u
+    _ -> u
+
 mouseOverSelectionList :: SelectionList -> Universe -> Universe
 mouseOverSelectionList sl u
-    | x > xl && x < xr = u & uvScreenLayers . _head . scSelPos .~ Just (ceiling $ y' / 50)
+    | x > xl && x < xr && ylower == yupper && mmoving
+        && ylower >= 0 && ylower < _slLength sl  = u & uvScreenLayers . _head . scSelPos ?~ yupper
     | otherwise = u
   where
-    y' = hh - (75 + y + _slPosY sl)
+    mmoving = u ^. uvWorld . input . mouseMoving
+    ylower = ceiling $ (hh - (75 + y + _slPosY sl)) / 50
+    yupper = floor $ (hh - (15 + y + _slPosY sl)) / 50
     xl = _slPosX sl - hw
     xr = xl + _slScale sl * 15 * 9
     V2 x y = u ^. uvWorld . input . mousePos
@@ -113,8 +127,8 @@ mouseOverSelectionList sl u
 updateUseInput :: Universe -> Universe
 updateUseInput u = case u ^? uvScreenLayers . _head of
     Just (InputScreen thetext _) -> doInputScreenInput thetext u
-    Just OptionScreen{_scOptions = mos, _scDefaultEff = defeff} -> optionScreenUpdates . menuWheelEvents $
+    Just OptionScreen{_scOptions = mos, _scDefaultEff = defeff} -> optionScreenUpdates . menuWheelEvents $ u
-        foldl' (\u' scode -> optionListToEffects defeff scode mos u') u (M.keys $ M.filter (== InitialPress) pkeys)
+--        foldl' (\u' scode -> optionListToEffects defeff scode mos u') u (M.keys $ M.filter (== InitialPress) pkeys)
     Just ColumnsScreen{} -> u & uvScreenLayers %~ tail
     _ -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
         Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u-- M.foldlWithKey' (updateKeyInTerminal tmid) u pkeys
@@ -126,6 +140,7 @@ updateUniverseLast :: Universe -> Universe
 updateUniverseLast =
     over uvWorld (input . mouseButtons . each .~ True) -- to determine if the mouse button is held
         . over uvWorld (input . pressedKeys . each %~ f)
+        . over uvWorld (input . mouseMoving .~ False)
   where
     f LongPress = LongPress
     f _ = ShortPress