Shuffle functions

src/Dodge/Update/Input.hs

@@ -4,8 +4,13 @@ module Dodge.Update.Input (
     doInputScreenInput,
     doSubInvRegexInput,
     doRegexInput,
+    updateUseInput,
 ) where
 
+import Dodge.SelectionList
+import Dodge.Base.Window
+import Dodge.Menu.Option
+import Dodge.InputFocus
 import Dodge.SelectionSections
 import Dodge.Default.World
 import Data.Char
@@ -29,7 +34,22 @@ import Dodge.Terminal.LeftButton
 import Dodge.WorldPos
 import LensHelp
 import SDL
---import SelectionIntMap
+
+updateUseInput :: Universe -> Universe
+updateUseInput u = case u ^? uvScreenLayers . _head of
+    Just (InputScreen thetext _) -> doInputScreenInput thetext u
+    Just screen@OptionScreen{_scPositionedMenuOption = mop, _scOptionFlag = flag, _scSelectionList = sellist, _scListDisplayParams = ldps} ->
+        optionScreenUpdate screen mop flag ldps sellist u
+    _ -> case u ^? uvWorld . hud . hudElement . subInventory of
+        Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
+        Just (CombineInventory _ _ _)
+            | inSubInvRegex (u ^. uvWorld) -> doSubInvRegexInput u
+        -- _ | inInvRegex (u ^. uvWorld) -> doInvRegexInput u
+        _ | inInvRegex (u ^. uvWorld) -> doRegexInput (-1) invRegex invRegex u
+        _ | inCloseRegex (u ^. uvWorld) -> doRegexInput 2 closeRegex closeRegex u
+        _ -> M.foldlWithKey' updateKeyInGame u pkeys
+  where
+    pkeys = u ^. uvWorld . input . pressedKeys
 
 doTextInputOver :: ASetter' Universe String -> Universe -> Universe
 doTextInputOver p u =
@@ -268,3 +288,86 @@ toggleTweakInv w = case w ^? hud . hudElement . subInventory of
   where
     thepointer = hud . hudElement . subInventory
     mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0))
+
+optionScreenUpdate ::
+    ScreenLayer ->
+    PositionedMenuOption ->
+    OptionScreenFlag ->
+    ListDisplayParams ->
+    SelectionList (Universe -> Universe) ->
+    Universe ->
+    Universe
+optionScreenUpdate screen mop _ ldps sl u =
+    refreshOptionsSelectionList
+        . optionScreenDefaultEffect mop
+        . mouseClickOptionsList screen
+        . mouseOverSelectionList ldps sl
+        . menuWheelEvents
+        . over (uvScreenLayers . _head) (setSelectionListRestriction cfig)
+        $ u
+  where
+    cfig = u ^. uvConfig
+
+optionScreenDefaultEffect :: PositionedMenuOption -> Universe -> Universe
+optionScreenDefaultEffect f u = case u ^. uvWorld . input . pressedKeys . at ScancodeEscape of
+    Just InitialPress -> fromMaybe id (f ^? pmoMenuOption . moEff) u
+    _ -> u
+
+mouseClickOptionsList :: ScreenLayer -> Universe -> Universe
+mouseClickOptionsList 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
+            f <- sl ^? slItems . ix i . siPayload
+            return $ f u
+        _ -> u
+
+mouseOverSelectionList :: ListDisplayParams -> SelectionList (Universe -> Universe) -> Universe -> Universe
+mouseOverSelectionList ldps sl u
+    | x > xl && x < xr
+        && ylower == yupper
+        && mmoving
+        && ylower >= 0
+        && ylower < ymax
+        && isselectable =
+        u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper
+    | otherwise = u
+  where
+    isselectable =
+        fromMaybe False $
+            u ^? uvScreenLayers . _head . scSelectionList . slItems . ix yupper . siIsSelectable
+    ymax = maybe 0 length $ sl ^? slItems
+    mmoving = u ^. uvWorld . input . mouseMoving
+    ylower = ceiling $ (hh - (75 + y + _ldpPosY ldps)) / 50
+    yupper = floor $ (hh - (15 + y + _ldpPosY ldps)) / 50
+    xl = _ldpPosX ldps - hw
+    --xr = xl + _ldpScale ldps * 15 * 9
+    xr = xl + _ldpScale ldps * 26 * 9
+    V2 x y = u ^. uvWorld . input . mousePos
+    cfig = u ^. uvConfig
+    hh = halfHeight cfig
+    hw = halfWidth cfig
+
+menuWheelEvents :: Universe -> Universe
+menuWheelEvents u = foldr ($) u (replicate (abs y) (menuWheelStep (signum y)))
+  where
+    y = u ^. uvWorld . input . scrollAmount
+
+-- you probably want i to be 1 or -1
+menuWheelStep :: Int -> Universe -> Universe
+menuWheelStep i u = fromMaybe u $ do
+    sl <- u ^? uvScreenLayers . _head . scSelectionList
+    selpos <- sl ^? slSelPos . _Just
+    ymax <- fmap length (sl ^? slItems)
+    let newpos = (selpos - i) `mod` ymax
+    itm <- sl ^? slItems . ix newpos
+    let newu = u & uvScreenLayers . _head . scSelectionList . slSelPos . _Just %~ const newpos
+    if _siIsSelectable itm
+        then Just newu
+        else Just $ menuWheelStep i newu
+
+setSelectionListRestriction :: Configuration -> ScreenLayer -> ScreenLayer
+setSelectionListRestriction cfig screen = fromMaybe screen $ do
+    ldps <- screen ^? scListDisplayParams
+    return $ screen & scAvailableLines %~ const (getAvailableListLines ldps cfig)