{-# LANGUAGE LambdaCase #-} module Dodge.Update.Input.InGame ( updateUseInputInGame, updateMouseInGame, ) where import Dodge.Data.ScreenPos import Geometry.Data import Dodge.Base.Coordinate import Dodge.Button.Event import Control.Applicative import Control.Monad import Data.Foldable import qualified Data.IntMap.Strict as IM import qualified Data.IntSet as IS import Data.List (sort) import qualified Data.Map.Strict as M import Data.Maybe import Data.Monoid import Dodge.Base.Collide import Dodge.Camera import Dodge.Creature.Action import Dodge.Data.CardinalPoint import Dodge.Data.Combine import Dodge.Data.Terminal.Status import Dodge.Data.Universe import Dodge.DisplayInventory import Dodge.Event.Test import Dodge.Inventory import Dodge.Inventory.Add import Dodge.Inventory.CheckSlots import Dodge.Item.Display import Dodge.Item.InvSize import Dodge.ListDisplayParams import Dodge.Menu import Dodge.Save import Dodge.SelectedClose import Dodge.SelectionSections import Dodge.SoundLogic import Dodge.Terminal import Dodge.Update.Input.DebugTest import Dodge.Update.Input.Text import Geometry.Vector import LensHelp import NewInt import SDL updateUseInputInGame :: Universe -> Universe updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . subInventory of DisplayTerminal tmid -> updateKeysInTerminal tmid u CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (Sel (-1) _ _))} -> u & tohud . subInventory %~ docombineregexinput sss msel & uvWorld . worldEventFlags . at CombineInventoryChange ?~ () _ | disel == Just (-1) -> u & tohud %~ dodisplayregexinput diInvFilter diInvFilter (-1) & uvWorld . worldEventFlags . at InventoryChange ?~ () & uvWorld %~ setInvPosFromSS _ | disel == Just 2 -> u & tohud %~ dodisplayregexinput diCloseFilter diCloseFilter 2 & uvWorld . worldEventFlags . at InventoryChange ?~ () & uvWorld %~ setInvPosFromSS _ -> updateKeysInGame u where disel = u ^? uvWorld . hud . diSelection . _Just . slSec tohud = uvWorld . hud dodisplayregexinput filterprism filterlens x di = fromMaybe di $ do sss <- di ^? diSections msel <- di ^? diSelection filts <- di ^? filterprism let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) x sss msel filts return $ di & diSections .~ sss' & diSelection .~ msel' & filterlens .~ filts' docombineregexinput sss msel ci = fromMaybe ci $ do filts <- ci ^? ciFilter let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) (-1) sss msel filts return $ ci & ciSections .~ sss' & ciSelection .~ msel' & ciFilter .~ filts' updateKeysInGame :: Universe -> Universe updateKeysInGame u = M.foldlWithKey' updateKeyInGame u (u ^. uvWorld . input . pressedKeys) updateMouseInGame :: Config -> World -> World updateMouseInGame cfig w | Just 0 <- lbpress = updateMouseClickInGame cfig w | Just _ <- lbpress = updateMouseHeldInGame cfig w | Just 0 <- lbrelease = updateMouseReleaseInGame w | otherwise = w where lbpress = w ^? input . mouseButtons . ix ButtonLeft lbrelease = w ^? input . mouseButtonsReleased . ix ButtonLeft updateMouseHeldInGame :: Config -> World -> World updateMouseHeldInGame cfig w = case w ^. input . mouseContext of OverInvDragSelect{} | ButtonRight `M.member` (w ^. input . mouseButtons) -> w & input . mouseContext .~ MouseGameRotate (dist (mouseWorldPosW w) (w ^. wCam . camCenter)) OverInvDragSelect (Just sstart) _ -> let sss = w ^. hud . diSections msel = inverseSelNumPos cfig invDP (w ^. input . mousePos) sss in case msel of Nothing -> w & input . mouseContext . mcoSelEnd .~ Nothing Just (i, j) | i == fst sstart -> w & input . mouseContext . mcoSelEnd ?~ j | i < fst sstart -> w & input . mouseContext . mcoSelEnd ?~ 0 | otherwise -> w & input . mouseContext . mcoSelEnd .~ fmap fst (IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems) -- not sure how the above performs when filtering... OverInvDragSelect Nothing _ -> fromMaybe w $ do sss <- w ^? hud . diSections ysel <- inverseSelSecYint (posSelSecYint cfig invDP (w ^. input . mousePos . _y)) sss ^? nonInf guard (isGroupSelectableSection $ fst ysel) return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing OverInvDrag k mmouseover -> doDrag cfig 30 k mmouseover w OverTerminalBar p -> w & tmLDP %~ setPixelOffsetBounded cfig (p + w ^. input . mousePos) _ -> w setPixelOffsetBounded :: Config -> Point2 -> LDParams -> LDParams setPixelOffsetBounded cfig (V2 x y) ldp = ldp & ldpPos . spPixelOff .~ V2 x' y' where -- (V2 xmin ymax, V2 xmax ymin) = ldpRect cfig ldp h = fromIntegral $ cfig ^. windowX w = fromIntegral $ cfig ^. windowY V2 ax ay = -V2 w h + ldp ^. ldpPos . spScreenOff * V2 w h x' = min w $ max 1 x y' = y boundPixelOffset :: Config -> Point2 -> Point2 -> Point2 -> Point2 boundPixelOffset cfig nw se p = p --leftHeldPosShift :: World -> Point2 --leftHeldPosShift w = fromMaybe 0 $ do -- p <- w ^? input . heldPos . ix SDL.ButtonLeft -- return $ w ^. input . mousePos - p doDrag :: Config -> Int -> Int -> Maybe (Int, Int) -> World -> World doDrag cfig n k mmouseover w = fromMaybe w $ do guard (n /= 0) ss <- w ^? hud . diSections . ix k . ssItems x <- mmouseover is <- w ^? hud . diSelection . _Just . slSet return $ if concurrentIS is then shiftInvItems cfig n k x is ss w else collectInvItems k is w tryDropSelected :: Maybe (Int, Int) -> World -> Maybe World tryDropSelected mpos w = do guard $ maybe True (\(i, _) -> i == 3) mpos cr <- w ^? cWorld . lWorld . creatures . ix 0 Sel 0 _ xs <- w ^? hud . diSelection . _Just return . foldl' (flip $ dropItem cr) w . IS.toDescList $ xs tryPickupSelected :: Int -> Maybe (Int, Int) -> World -> Maybe World tryPickupSelected k mpos w = do guard $ k == 3 guard $ maybe True (\(i, _) -> i == 0 || i == 1) mpos cr <- w ^? cWorld . lWorld . creatures . ix 0 xs <- w ^? hud . diSelection . _Just . slSet let nfreeslots = crNumFreeSlots (w ^. cWorld . lWorld . items) cr itmstopickup = mapMaybe g $ IS.toList xs slotsneeded = alaf Sum foldMap itInvHeight itmstopickup ispickup = map (_unNInt . _itID) itmstopickup guard $ nfreeslots >= slotsneeded return $ case mpos of Just (0, j) -> foldr (pickUpItemAt j 0) w ispickup & newdisel j xs _ -> foldl' (flip $ pickUpItem 0) w ispickup & newdisel (length (cr ^. crInv)) xs where newdisel j xs = hud . diSelection ?~ Sel 0 j (IS.fromDistinctAscList [j .. j + IS.size xs -1]) g i = do NInt j <- w ^? hud . closeItems . ix i w ^? cWorld . lWorld . items . ix j updateMouseReleaseInGame :: World -> World updateMouseReleaseInGame w = case w ^. input . mouseContext of OverInvDrag k mpos -> input . mouseContext .~ MouseInGame $ fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected k mpos w OverInvDragSelect (Just ssel) mesel | ScancodeLShift `M.member` (w ^. input . pressedKeys) -> w & input . mouseContext .~ MouseInGame & hud . diSelection . _Just . slSet %~ getuniques ( maybe mempty (h ssel) (guard (ssel ^? _1 == w ^? hud . diSelection . _Just . slSec) >> mesel ^? _Just) ) OverInvDragSelect (Just ssel) (Just esel) -> w & input . mouseContext .~ MouseInGame & invSetSelection (f (fst ssel, esel) (h ssel esel)) OverInvDragSelect{} -> w & input . mouseContext .~ MouseInGame & hud . diSelection . _Just . slSet %~ const mempty _ -> w where getuniques x y = IS.union x y IS.\\ IS.intersection x y f (x, y) = Sel x y h (k, i) j = fold $ do sss <- w ^? hud . diSections . ix k . ssItems let (_, xss) = IM.split (min i j -1) sss (yss, _) = IM.split (max i j + 1) xss return . IM.keysSet $ yss isGroupSelectableSection :: Int -> Bool isGroupSelectableSection = \case 0 -> True 3 -> True _ -> False updateMouseClickInGame :: Config -> World -> World updateMouseClickInGame cfig w = case w ^. input . mouseContext of MouseInGame -> fromMaybe (w & input . mouseContext .~ OverInvDragSelect Nothing Nothing) $ do let sss = w ^. hud . diSections ysel <- inverseSelSecYint (posSelSecYint cfig invDP (w ^. input . mousePos . _y)) sss ^? nonInf guard (isGroupSelectableSection $ fst ysel) return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing OverInvSelect (-1, _) | selsec == Just (-1) -> w & hud . diSelection %~ endRegex (-1) w & hud . diInvFilter .~ Nothing OverInvSelect (2, _) | selsec == Just 2 -> w & hud . diSelection %~ endRegex 2 w & hud . diCloseFilter .~ Nothing OverInvSelect (5, j) -> fromMaybe w $ do k <- w ^? hud . closeButtons . ix j but <- w ^? cWorld . lWorld . buttons . ix k return $ doButtonEvent (but ^. btEvent) but w OverInvSelect x | ScancodeLShift `M.member` (w ^. input . pressedKeys) && isGroupSelectableSection (fst x) -> w & input . mouseContext .~ OverInvDragSelect (Just x) (Just $ snd x) OverInvSelect x -> startDrag x w OverTerminal tmid TerminalTextInput{} -> terminalReturnEffect tmid w OverTerminal tmid TerminalPressTo{} -> continueTerminal tmid w OutsideTerminal -> w & hud . subInventory .~ NoSubInventory OverCombSelect x -> w & hud . subInventory . ciSelection ?~ f x & worldEventFlags . at CombineInventoryChange ?~ () OverCombFilter -> w & hud . subInventory . ciFilter .~ Nothing & worldEventFlags . at CombineInventoryChange ?~ () & hud . subInventory . ciSelection %~ endCombineRegex w OverCombCombine x -> w & tryCombine x & worldEventFlags . at CombineInventoryChange ?~ () & worldEventFlags . at InventoryChange ?~ () & maybeExitCombine OverCombEscape -> w & worldEventFlags . at InventoryChange ?~ () & hud . subInventory .~ NoSubInventory OverCombFiltInv (0, j) -> fromMaybe w $ do str <- fmap (take 5) $ w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt j) >>= \k -> w ^? cWorld . lWorld . items . ix k >>= (listToMaybe . basicItemDisplay) return . (worldEventFlags . at CombineInventoryChange ?~ ()) $ case w ^? hud . subInventory . ciFilter . _Just of Just ('#' : xs) | str == xs -> w & hud . subInventory . ciFilter .~ Nothing _ -> w & hud . subInventory . ciFilter ?~ ("#" ++ str) _ -> w where f (x, y) = Sel x y mempty selsec = w ^? hud . diSelection . _Just . slSec endRegex :: Int -> World -> Maybe Selection -> Maybe Selection endRegex i w = ssSetCursor (ssLookupDown i j) sss where sss = w ^. hud . diSections j = maybe 0 fst $ IM.lookupMin =<< sss ^? ix i . ssItems endCombineRegex :: World -> Maybe Selection -> Maybe Selection endCombineRegex w = ssSetCursor (ssLookupDown 0 j) sss where sss = w ^. hud . subInventory . ciSections j = fromMaybe 0 $ do itms <- sss ^? ix 0 . ssItems (k, _) <- IM.lookupMin itms return (k -1) startDrag :: (Int, Int) -> World -> World startDrag (a, b) w = setcontext $ case w ^? hud . diSelection . _Just of Just (Sel i _ xs) | i == a && b `IS.member` xs -> w _ -> invSetSelection (Sel a b (IS.singleton b)) w where setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b)) shiftInvItems :: Config -> Int -> -- recurse limit Int -> -- section where drag started (Int, Int) -> -- selection item mouse is over IS.IntSet -> IM.IntMap (SelectionItem a) -> World -> World shiftInvItems cfig n k x xs ss w = setSelWhileDragging . fromMaybe w $ do let xk = fst x let yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y) bn = (\v -> inverseSelSecYint (yint + 1) v ^? nonInf) =<< w ^? hud . diSections ab = (\v -> inverseSelSecYint (yint - 1) v ^? nonInf) =<< w ^? hud . diSections guard $ xk == k || xk + 1 == k || xk -1 == k (maxi, _) <- IS.maxView xs (mini, _) <- IS.minView xs case True of _ | x < (k, mini) -> do guard $ not . null . fst $ IM.split mini ss guard $ Just (k, mini -1) /= ab return . doDrag cfig (n -1) k (Just x) $ shiftInvItemsUp k xs w _ | x > (k, maxi) -> do guard $ not . null . snd $ IM.split maxi ss guard $ Just (k, maxi + 1) /= bn return . doDrag cfig (n -1) k (Just x) $ shiftInvItemsDown k xs w _ -> Nothing setSelWhileDragging :: World -> World setSelWhileDragging w = fromMaybe w $ do Sel i _ xs <- w ^? hud . diSelection . _Just (k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just guard $ i == k && j `IS.member` xs return $ w & hud . diSelection . _Just . slInt .~ j updateFunctionKeys :: Universe -> Universe updateFunctionKeys u = M.foldlWithKey' updateFunctionKey u (u ^. uvWorld . input . pressedKeys) updateFunctionKey :: Universe -> Scancode -> Int -> Universe updateFunctionKey uv sc 0 = case sc of ScancodeF1 -> useNormalCamera uv ScancodeF2 -> pauseAndFloatCam uv ScancodeF5 -> doQuicksave uv ScancodeF9 -> doQuickload uv ScancodeF6 -> doDebugTestF6 uv ScancodeF7 -> doDebugTestF7 uv ScancodeF8 -> doDebugTestF8 uv ScancodeF10 -> doDebugTestF10 uv ScancodeF11 -> doDebugTestF11 uv ScancodeF12 -> doDebugTestF12 uv ScancodeEscape -> pauseGame uv _ -> uv updateFunctionKey uv ScancodeF3 _ = doDebugTest uv updateFunctionKey uv ScancodeF4 _ = doDebugTest2 uv updateFunctionKey uv _ _ = uv -- look also at yourControl updateKeysInTerminal :: Int -> Universe -> Universe updateKeysInTerminal tmid u = fromMaybe deactivate $ do tm <- u ^? uvWorld . cWorld . lWorld . terminals . ix tmid x <- u ^? uvWorld . cWorld . lWorld . buttons . ix (tm ^. tmButtonID) . btPos y <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crPos . _xy case tm ^. tmStatus of _ | dist x y > 40 || not (hasButtonLOS x y (u ^. uvWorld)) -> Nothing TerminalDeactivated -> Nothing TerminalTextInput{} -> Just $ updateKeysTextInputTerminal tmid u TerminalPressTo{} -> Just $ updateKeyContinueTerminal tmid u _ -> Just $ updateKeysInGame u where deactivate = u & uvWorld . hud . subInventory .~ NoSubInventory updateKeyContinueTerminal :: Int -> Universe -> Universe updateKeyContinueTerminal tmid u | isJust (u ^. uvWorld . input . pressedKeys . at ScancodeEscape) = u | elem 0 $ u ^. uvWorld . input . pressedKeys = u & uvWorld %~ continueTerminal tmid | otherwise = u continueTerminal :: Int -> World -> World continueTerminal tmid = cWorld . lWorld . terminals . ix tmid . tmStatus .~ TerminalLineRead updateKeysTextInputTerminal :: Int -> Universe -> Universe updateKeysTextInputTerminal tmid u = u & doTextInputOverUniverse (uvWorld . cWorld . lWorld . terminals . ix tmid . tmStatus . tiText) & checkEndStatus & tryTabComplete & uvWorld . cWorld . lWorld . terminals . ix tmid . tmStatus . tiText %~ take 42 where checkEndStatus | u ^. uvWorld . input . pressedKeys . at ScancodeReturn == Just 0 = uvWorld %~ terminalReturnEffect tmid | otherwise = id tryTabComplete | u ^. uvWorld . input . pressedKeys . at ScancodeTab == Just 0 = uvWorld . cWorld . lWorld . terminals . ix tmid %~ doTabComplete (u ^. uvWorld) | otherwise = id updateKeyInGame :: Universe -> Scancode -> Int -> Universe updateKeyInGame uv sc = \case 0 -> updateInitialPressInGame uv sc & uvWorld . input . inputMemory .~ WasNotMouseGameRotating x | x >= 30 -> updateLongPressInGame uv sc _ -> uv updateInitialPressInGame :: Universe -> Scancode -> Universe updateInitialPressInGame uv = \case ScancodeSpace -> over uvWorld spaceAction uv ScancodeP -> pauseGame uv ScancodeF -> over uvWorld youDropItem uv -- ScancodeM -> toggleMap uv ScancodeT -> over uvWorld testEvent uv ScancodeC -> toggleCombineInv uv -- the following should be put in a more sensible place ScancodeSlash -> uv & uvWorld %~ updateEnterRegex ScancodeBackspace -> uv & uvWorld %~ updateBackspaceRegex _ -> uv updateLongPressInGame :: Universe -> Scancode -> Universe updateLongPressInGame uv = \case ScancodeF -> over uvWorld youDropItem uv ScancodeSpace -> over uvWorld spaceAction uv _ -> uv doRegexInput :: Input -> Int -> IMSS a -> Maybe Selection -> Maybe String -> (IMSS a, Maybe Selection, Maybe String) doRegexInput inp i sss msel filts | backspacetonothing || escapekey = endregex i 0 | endkeys = endregex (i + 1) (j -1) | otherwise = ( sss , msel , filts & doTextInputOver inp _Just ) where endregex a b = ( sss , msel & ssSetCursor (ssLookupDown a b) sss , Nothing ) j = fromMaybe 0 $ do itms <- sss ^? ix (i + 1) . ssItems fst <$> IM.lookupMin itms escapekey = ScancodeEscape `M.lookup` pkeys == Just 0 endkeys = any ((== Just 0) . (`M.lookup` pkeys)) [ScancodeReturn, ScancodeSlash] backspacetonothing = filts == Just "" && ScancodeBackspace `M.lookup` pkeys == Just 0 pkeys = inp ^. pressedKeys updateBackspaceRegex :: World -> World updateBackspaceRegex w = case di ^? subInventory of Just NoSubInventory{} | secfocus (-1) 0 -> w & hud %~ trybackspace (-1) diInvFilter diInvFilter diSelection & worldEventFlags . at InventoryChange ?~ () Just NoSubInventory{} | secfocus 2 3 -> w & hud %~ trybackspace 2 diCloseFilter diCloseFilter diSelection & worldEventFlags . at InventoryChange ?~ () Just CombineInventory{} -> w & hud . subInventory %~ trybackspace (-1) ciFilter ciFilter ciSelection & worldEventFlags . at InventoryChange ?~ () _ -> w where secfocus a b = fromMaybe False $ do i <- di ^? diSelection . _Just . slSec return $ i == a || i == b trybackspace x filtget filtset selset he = fromMaybe he $ do str <- he ^? filtget . _Just return $ case str of (_ : _) -> he & filtset . _Just %~ init & selset ?~ Sel x 0 mempty [] -> he & filtset .~ Nothing di = w ^. hud updateEnterRegex :: World -> World updateEnterRegex w = case w ^? hud . subInventory of Just NoSubInventory{} | secfocus [-1, 0, 1] -> w & hud . diSelection ?~ Sel (-1) 0 mempty & hud . diInvFilter %~ enterregex Just NoSubInventory{} | secfocus [2, 3] -> w & hud . diSelection ?~ Sel 2 0 mempty & hud . diCloseFilter %~ enterregex Just CombineInventory{} -> w & hud . subInventory . ciFilter %~ enterregex & hud . subInventory . ciSelection ?~ Sel (-1) 0 mempty _ -> w where secfocus xs = fromMaybe False $ do i <- w ^? hud . diSelection . _Just . slSec return $ i `elem` xs enterregex = (<|> Just "") pauseGame :: Universe -> Universe pauseGame u = u & uvScreenLayers .~ [pauseMenu u] & pauseSound spaceAction :: World -> World spaceAction w = case w ^. hud . subInventory of NoSubInventory -> maybe id interactWithCloseObj (getCloseObj w) w _ -> w & hud . subInventory .~ NoSubInventory getCloseObj :: World -> Maybe (Either (NewInt ItmInt) Button) getCloseObj w = getSelectedCloseObj w <|> topcitem <|> topcbut where topcitem = do k <- (w ^? hud . diSections . ix 3 . ssItems) >>= (fmap fst . IM.lookupMin) Left <$> w ^? hud . closeItems . ix k topcbut = do k <- w ^? hud . closeButtons . ix 0 Right <$> w ^? cWorld . lWorld . buttons . ix k tryCombine :: (Int, Int) -> World -> World tryCombine (i, j) w = fromMaybe w $ do CombItem is it <- w ^? hud . subInventory . ciSections . ix i . ssItems . ix j . siPayload . _Just p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos . _xy return $ createItemYou it (foldr (destroyInvItem 0 . NInt) w (sort is)) & soundStart InventorySound p wrench1S Nothing & hud . diSelection . _Just . slSet .~ mempty maybeExitCombine :: World -> World maybeExitCombine w | ButtonRight `M.member` (w ^. input . mouseButtons) = w | otherwise = w & hud . subInventory .~ NoSubInventory