module Dodge.Update.Scroll ( updateWheelEvent, ) where import Dodge.Data.Terminal.Status import Dodge.Data.EquipType import Padding import Control.Monad import qualified Data.Map.Strict as M import Data.Maybe import Dodge.Base import Dodge.Data.Universe import Dodge.Inventory import Dodge.SelectionSections import Dodge.Terminal import Geometry import LensHelp import SDL -- yi should be nonzero updateWheelEvent :: Int -> World -> World updateWheelEvent yi w = case w ^. hud . hudElement . subInventory of NoSubInventory -> updateBaseWheelEvent yi w ExamineInventory -> updateBaseWheelEvent yi w MapperInventory{} -> updateBaseWheelEvent yi w CombineInventory{} -> moveCombineSel yi w DisplayTerminal tmid -> terminalWheelEvent yi tmid w -- yi should be nonzero updateBaseWheelEvent :: Int -> World -> World updateBaseWheelEvent yi w -- | Just True <- w ^? cWorld . lWorld . creatures . ix 0 . crInvLock = w | Just True <- w ^? cWorld . lWorld . lInvLock = w | bdown ButtonRight = case _rbOptions w of EquipOptions{} -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax NoRightButtonOptions -> fromMaybe w (selectedItemScroll yi w) | bdown ButtonLeft = w & wCam . camZoom +~ fromIntegral yi | ScancodeCapsLock `M.member` _pressedKeys (_input w) = changeSwapSel yi w | otherwise = scrollAugInvSel yi w where bdown b = w & has (input . mouseButtons . ix b) rbscrollmax = fromMaybe 1 $ do invid <- you w ^? crManipulation . manObject . imSelectedItem esite <- you w ^? crInv . ix invid >>= equipType -- . itUse . uequipEffect . eeType return . length $ eqSiteToPositions esite selectedItemScroll :: Int -> World -> Maybe World selectedItemScroll yi w = do i <- you w ^? crManipulation . manObject . imSelectedItem itm <- you w ^? crInv . ix i return $ itemScroll yi i itm w itemScroll :: Int -> Int -> Item -> World -> World itemScroll yi invid itm w -- | isJust $ itm ^? itUse . uInt = w & itmlens . itUse . uInt +~ yi | Just xs <- itm ^? itUse . uaParams . apProjectiles = w & itmlens . itUse . uaParams . apProjectiles .~ rotateList yi xs | ATTACH ZOOMSCOPE <- itm ^. itType = updateScopeZoom invid w | HELD ALTERIFLE <- itm ^. itType , yi /= 0 = w & itmlens . itParams . alteRifleSwitch %~ ((`mod` 2) . (+ 1)) | isJust $ itm ^? itScroll . itsInt = w & itmlens . itScroll . itsInt +~ yi | Just y <- itm ^? itScroll . itsMax = w & itmlens . itScroll . itsRangeInt %~ ((`mod` y) . (+ yi)) | otherwise = w where itmlens = cWorld . lWorld . creatures . ix 0 . crInv . ix invid -- note that your _crInvLock does not apply to this TODO check that this is what -- is wanted updateScopeZoom :: Int -> World -> World updateScopeZoom i w | Just 0 <- w ^. input . mouseButtons . at SDL.ButtonRight = w & wppointer %~ resetscope | Just _ <- w ^. input . mouseButtons . at SDL.ButtonRight = w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) (w ^. input . mousePos) | otherwise = w & wppointer %~ resetscope where wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itUse . uScope resetscope (OpticScope _ _ defz) = OpticScope (V2 0 0) defz defz doScopeZoom :: Int -> Point2 -> Scope -> Scope doScopeZoom scrollamount mp sc = case scrollamount of x | x > 10 -> (zoomInLongGun mp . zoomInLongGun mp . zoomInLongGun mp) sc | x > 5 -> (zoomInLongGun mp . zoomInLongGun mp) sc | x > 0 -> zoomInLongGun mp sc | x < -10 -> (zoomOutLongGun . zoomOutLongGun . zoomOutLongGun) sc | x < -5 -> (zoomOutLongGun . zoomOutLongGun) sc | x < 0 -> zoomOutLongGun sc | otherwise -> sc zoomSpeed :: Float zoomSpeed = 39 / 40 zoomInLongGun :: Point2 -> Scope -> Scope zoomInLongGun mousep sc = fromMaybe sc $ do curzoom <- sc ^? opticZoom guard $ curzoom < 8 return $ sc & opticPos .+.+~ (1 - zoomSpeed) * zoomSpeed / curzoom *.* mousep & opticZoom %~ (/ zoomSpeed) zoomOutLongGun :: Scope -> Scope zoomOutLongGun sc = fromMaybe sc $ do curzoom <- sc ^? opticZoom guard $ curzoom > 0.5 return $ sc & opticPos %~ (\p -> p +.+ (zoomSpeed - 1) / curzoom *.* p) & opticZoom *~ zoomSpeed moveCombineSel :: Int -> World -> World moveCombineSel yi = ( hud . hudElement . subInventory %~ doscroll ) . (worldEventFlags . at CombineInventoryChange ?~ ()) where doscroll ci = fromMaybe ci $ do sss <- ci ^? ciSections return $ ci & ciSelection %~ scrollSelectionSections yi sss terminalWheelEvent :: Int -> Int -> World -> World --terminalWheelEvent yi tmid w terminalWheelEvent _ tmid w | w & has (input . mouseButtons . ix ButtonRight) , Just TerminalTextInput{} <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus = w -- & cWorld . lWorld . terminals . ix tmid %~ updatetermsubsel | Just TerminalTextInput{} <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus = w -- & cWorld . lWorld . terminals . ix tmid %~ updatetermsel | otherwise = w where -- updatetermsel tm = case tm ^? tmInput . tiSel of -- Nothing -> tm & tmInput . tiSel .~ (0, 0) -- Just (i, _) -> -- let newi = (i - yi) `mod` length (scrollCommandStrings w tm) -- in tm & setInput newi 0 -- updatetermsubsel tm = case tm ^? tmInput . tiSel of -- Nothing -> tm & tmInput . tiSel .~ (0, 0) -- Just (i, j) -> -- let newj = (j - yi) `mod` length (getArguments' (scrollCommands tm !! i) tm w) -- in tm & setInput i newj -- setInput i j tm = -- tm -- & tmInput . tiSel .~ (i, j) -- & tmStatus . tiText .~ comstr ++ arg -- where -- comstr = scrollCommandStrings w tm !! i -- tc = scrollCommands tm !! i -- arg = getArguments' tc tm w !! j scrollRBOption :: Int -> Int -> Int -> Int scrollRBOption dy ymax | dy < 0 = min (ymax -1) . subtract dy | dy > 0 = max 0 . subtract dy | otherwise = id --scrollCommands :: Terminal -> [TerminalCommand] --scrollCommands = (nullCommand :) . _tmScrollCommands --scrollCommandStrings :: World -> Terminal -> [String] --scrollCommandStrings w tm = case tm ^? tmPartialCommand . _Just of -- Nothing -> map _tcString $ scrollCommands tm -- Just tc -> "" : map tail (getArguments tc tm w) --getArguments' :: TerminalCommand -> Terminal -> World -> [String] --getArguments' tc tm = ("" :) . getArguments tc tm --nullCommand :: TerminalCommand --nullCommand = -- TerminalCommand -- { _tcString = "" -- , _tcAlias = [] -- , _tcHelp = "" -- , _tcEffect = TerminalCommandEffectNone -- \_ _ -> NoArguments [] -- } getArguments :: TerminalCommand -> Terminal -> World -> [String] getArguments tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of NoArguments{} -> [] OneArgument _ m -> map (' ' :) $ M.keys m