From 910984165868f4e264830478aa124ef4471abc2e Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 19 Feb 2023 11:57:45 +0000 Subject: [PATCH] Shuffle functions --- src/Dodge/Creature/YourControl.hs | 2 +- src/Dodge/Update.hs | 93 -------------------------- src/Dodge/Update/Input.hs | 105 +++++++++++++++++++++++++++++- 3 files changed, 105 insertions(+), 95 deletions(-) diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 41cdb35bc..23e15a01b 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -20,7 +20,7 @@ import qualified SDL yourControl :: Creature -> World -> World yourControl cr w | inputFocus w = w - | intopinv = w & cWorld . lWorld . creatures . ix (_crID cr) + | not intopinv = w & cWorld . lWorld . creatures . ix (_crID cr) %~ wasdWithAiming w (_mvSpeed $ _crMvType cr) | otherwise = w diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 05d8c931a..b959c4398 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -96,86 +96,10 @@ gotoTerminal w = case _uvScreenLayers w of (InputScreen{} : _) -> w _ -> w & uvScreenLayers .:~ InputScreen mempty "Enter command" -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 -setSelectionListRestriction :: Configuration -> ScreenLayer -> ScreenLayer -setSelectionListRestriction cfig screen = fromMaybe screen $ do - ldps <- screen ^? scListDisplayParams - return $ screen & scAvailableLines %~ const (getAvailableListLines ldps cfig) -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 -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 updateUniverseLast :: Universe -> Universe updateUniverseLast = @@ -323,23 +247,6 @@ functionalUpdate w = -- & cWorld . lWorld . hud . hudElement . augmentedInventory .~ makeInventorySelectionList w -- this can probably be unified with updateWheelEvents -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 --updateWheelEvents :: World -> World --updateWheelEvents w = foldr ($) w (replicate (abs y) (updateWheelEvent (signum y))) diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index ae2955571..8f24a42a6 100644 --- a/src/Dodge/Update/Input.hs +++ b/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)