module Dodge.Update.Input.InGame ( updateUseInputInGame, updateMouseInGame, ) where 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 Dodge.Base.You import Dodge.Button.Event import Dodge.Camera import Dodge.Creature.Action import Dodge.Data.Combine import Dodge.Data.Universe import Dodge.DisplayInventory import Dodge.Event.Test import Dodge.InputFocus import Dodge.Inventory import Dodge.Inventory.Add import Dodge.ListDisplayParams import Dodge.Menu import Dodge.Save import Dodge.SelectionSections import Dodge.SoundLogic import Dodge.Terminal import Dodge.Update.Input.Text import Dodge.WorldPos import Geometry import LensHelp import SDL updateUseInputInGame :: Universe -> Universe updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudElement of DisplayCarte -> over uvWorld updatePressedButtonsCarte u DisplayInventory{_subInventory = si} -> case si of DisplayTerminal tmid -> updateKeysInTerminal tmid u CombineInventory{_ciSections = sss, _ciSelection = msel} | inSubInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . subInventory %~ docombineregexinput sss msel & uvWorld . worldEventFlags . at CombineInventoryChange ?~ () _ | inInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement %~ dodisplayregexinput (-1) & uvWorld . worldEventFlags . at InventoryChange ?~ () & uvWorld %~ setInvPosFromSS _ | inCloseRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement %~ dodisplayregexinput' 2 & uvWorld . worldEventFlags . at InventoryChange ?~ () & uvWorld %~ setInvPosFromSS _ -> M.foldlWithKey' updateKeyInGame u pkeys where pkeys = u ^. uvWorld . input . pressedKeys dodisplayregexinput x di = fromMaybe di $ do sss <- di ^? diSections msel <- di ^? diSelection filts <- di ^? diInvFilter let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) x sss msel filts return $ di & diSections .~ sss' & diSelection .~ msel' & diInvFilter .~ filts' dodisplayregexinput' x di = fromMaybe di $ do sss <- di ^? diSections msel <- di ^? diSelection filts <- di ^? diCloseFilter let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) x sss msel filts return $ di & diSections .~ sss' & diSelection .~ msel' & diCloseFilter .~ 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' updateMouseInGame :: Configuration -> World -> World updateMouseInGame cfig w = case w ^? input . mouseButtons . ix ButtonLeft of Just 0 -> updateMouseClickInGame cfig w Just _ -> updateMouseHeldInGame cfig w Nothing -> case w ^? input . mouseButtonsReleased . ix ButtonLeft of Just 0 -> updateMouseReleaseInGame w _ -> w updateMouseHeldInGame :: Configuration -> World -> World updateMouseHeldInGame cfig w = case w ^. input . mouseContext of OverInvDragSelect sstart _ -> fromMaybe w $ do sss <- w ^? hud . hudElement . diSections let msel = inverseSelNumPos cfig ldp sss (w ^. input . mousePos) guard $ Just (fst sstart) == fmap fst msel || isNothing msel return $ w & input . mouseContext . mcoSelEnd .~ msel OverInvDrag k mmouseover -> fromMaybe w $ do ss <- w ^? hud . hudElement . diSections . ix k . ssItems x <- mmouseover is <- w ^? hud . hudElement . diSelectionExtra return $ if concurrentIS is then shiftInvItems k x is ss w else collectInvItems is w -- let mpos = w ^. input . mousePos -- return $ w & dragInvItems k xs cfig mpos ldp sss _ -> w where ldp = invDisplayParams 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 (0, _) <- w ^? hud . hudElement . diSelection . _Just xs <- w ^? hud . hudElement . diSelectionExtra return $ IS.foldr (dropItem cr) w xs tryPickupSelected :: Maybe (Int,Int) -> World -> Maybe World tryPickupSelected mpos w = do guard $ maybe True (\(i,_) -> i == 0) mpos -- cr <- w ^? cWorld . lWorld . creatures . ix 0 -- let nfreeslots = crNumFreeSlots cr (3, _) <- w ^? hud . hudElement . diSelection . _Just -- xs <- w ^? hud . hudElement . diSelectionExtra -- OverInvDrag 3 x <- w ^? input . mouseContext return w -- return $ IS.foldr (dropItem cr) w xs updateMouseReleaseInGame :: World -> World updateMouseReleaseInGame w = case w ^. input . mouseContext of --OverInvDrag i mpos -> OverInvDrag _ mpos -> input . mouseContext .~ MouseInGame $ fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected mpos w -- OverInvDrag i mpos -> fromMaybe (dropSelected w & input . mouseContext .~ MouseInGame) $ do -- j <- mpos -- guard $ fst j == i -- return $ w & input . mouseContext .~ OverInvSelect j OverInvDragSelect _ Nothing -> w & input . mouseContext .~ MouseInGame & hud . hudElement . diSelectionExtra .~ mempty OverInvDragSelect ssel (Just esel) -> w & input . mouseContext .~ MouseInGame & hud . hudElement . diSelectionExtra .~ h ssel (snd esel) -- IM.keysSet [min (snd ssel) (snd esel) + 1 .. max (snd ssel) (snd esel)] & augInvDirectSelect (min ssel esel) _ -> w where h (k,i) j = fold $ do sss <- w ^? hud . hudElement . 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 updateMouseClickInGame :: Configuration -> World -> World updateMouseClickInGame cfig w = case w ^. input . mouseContext of MouseInGame -> fromMaybe w $ do sss <- w ^? hud . hudElement . diSections ysel <- inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss return $ w & input . mouseContext .~ OverInvDragSelect ysel Nothing OverInvSelect x -> startDrag x w OverTerminalReturn tmid -> terminalReturnEffect tmid w OverTerminalEscape -> w & hud . hudElement . subInventory .~ NoSubInventory --MouseInvNothing OverCombSelect x -> w & hud . hudElement . subInventory . ciSelection ?~ x & worldEventFlags . at CombineInventoryChange ?~ () OverCombFilter -> w & hud . hudElement . subInventory . ciFilter .~ Nothing & worldEventFlags . at CombineInventoryChange ?~ () OverCombCombine x -> w & tryCombine x & worldEventFlags . at CombineInventoryChange ?~ () & worldEventFlags . at InventoryChange ?~ () & maybeExitCombine OverCombEscape -> w & worldEventFlags . at InventoryChange ?~ () & hud . hudElement . subInventory .~ NoSubInventory --MouseInvNothing OverInvFilt (i, j) -> fromMaybe w $ do guard $ i == 0 str <- fmap (take 5) $ w ^? hud . hudElement . diSections . ix i . ssItems . ix j . siPictures . ix 0 return . (worldEventFlags . at CombineInventoryChange ?~ ()) $ case w ^? hud . hudElement . subInventory . ciFilter . _Just of Just (_ : xs) | str == xs -> w & hud . hudElement . subInventory . ciFilter .~ Nothing _ -> w & hud . hudElement . subInventory . ciFilter ?~ ("<" ++ str) _ -> w where ldp = invDisplayParams w mpos = w ^. input . mousePos startDrag :: (Int, Int) -> World -> World startDrag (a, b) w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen mempty w) $ do --(i, j) <- w ^? hud . hudElement . diSelection . _Just (i, _) <- w ^? hud . hudElement . diSelection . _Just xs <- w ^? hud . hudElement . diSelectionExtra guard $ i == a && b `IS.member` xs return $ setmichosen xs w where setmichosen x = (input . mouseContext .~ OverInvDrag a (Just (a, b))) . (hud . hudElement . diSelectionExtra .~ x) concurrentIS :: IS.IntSet -> Bool concurrentIS = go . IS.minView where go Nothing = True go (Just (i, is)) = fromMaybe True $ do (j, js) <- IS.minView is return $ i + 1 == j && go (Just (j, js)) collectInvItems :: IS.IntSet -> World -> World collectInvItems is w = fromMaybe w $ do (j, js) <- IS.minView is return $ h j js w where h j js w' = fromMaybe w' $ do (k, ks) <- IS.minView js return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w' shiftInvItems :: Int -> (Int,Int) -> IS.IntSet -> IM.IntMap (SelectionItem a) -> World -> World shiftInvItems k x xs ss w = fromMaybe w $ do (maxi,_) <- IS.maxView xs (mini,_) <- IS.minView xs if x < (k,mini) then do minss <- IM.lookupMin ss guard (mini > fst minss) return $ shiftInvItemsUp k xs w else do guard $ x > (k,maxi) maxss <- IM.lookupMax ss guard (maxi < fst maxss) return $ shiftInvItemsDown k xs w shiftInvItemsUp :: Int -> IS.IntSet -> World -> World shiftInvItemsUp j is w = IS.foldl' f w is where f w' i' = swapItemWith g (j, i') w' g i' m = fst <$> IM.lookupLT i' m shiftInvItemsDown :: Int -> IS.IntSet -> World -> World shiftInvItemsDown j is w = fromMaybe w $ do let i = IS.findMax is guard . isJust $ w ^? hud . hudElement . diSections . ix j . ssItems . ix i return $ IS.foldr f w is where f i' w' = swapItemWith g (j, i') w' g i' m = fst <$> IM.lookupGT i' m updateFunctionKeys :: Universe -> Universe updateFunctionKeys u = M.foldlWithKey' updateFunctionKey u (u ^. uvWorld . input . pressedKeys) updateFunctionKey :: Universe -> Scancode -> PressType -> Universe updateFunctionKey uv sc InitialPress = case sc of ScancodeF1 -> useNormalCamera uv ScancodeF2 -> pauseAndFloatCam uv ScancodeF5 -> doQuicksave uv ScancodeF9 -> doQuickload uv ScancodeEscape -> pauseGame uv _ -> uv updateFunctionKey uv _ _ = uv updatePressedButtonsCarte :: World -> World updatePressedButtonsCarte w = updatePressedButtonsCarte' (_mouseButtons (_input w)) w updatePressedButtonsCarte' :: M.Map MouseButton Int -> World -> World updatePressedButtonsCarte' pkeys w | isDown ButtonRight = w & hud . carteCenter %~ (-.- trans) | isDown ButtonLeft = w & hud . carteRot -~ rot & hud . carteZoom *~ czoom | otherwise = w where isDown but = but `M.member` pkeys mbutpos but = theinput ^. heldPos . at but rot = maybe 0 (angleBetween (_mousePos (_input w))) $ mbutpos SDL.ButtonLeft czoom = fromMaybe 1 $ do p <- mbutpos SDL.ButtonLeft return $ magV (_mousePos theinput) / magV p theinput = w ^. input trans = fromMaybe 0 $ do p <- mbutpos SDL.ButtonRight return . rotateV (w ^. hud . carteRot) $ 1 / (w ^. hud . carteZoom) *.* (_mousePos (_input w) -.- p) updateKeysInTerminal :: Int -> Universe -> Universe updateKeysInTerminal tmid u = u & doTextInputOverUniverse (uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText) & checkEndStatus where checkEndStatus | u ^. uvWorld . input . pressedKeys . at ScancodeReturn == Just InitialPress = uvWorld %~ terminalReturnEffect tmid | otherwise = id updateKeyInGame :: Universe -> Scancode -> PressType -> Universe updateKeyInGame uv sc pt = case pt of InitialPress -> updateInitialPressInGame uv sc LongPress -> updateLongPressInGame uv sc _ -> uv updateInitialPressInGame :: Universe -> Scancode -> Universe updateInitialPressInGame uv sc = case sc of ScancodeSpace -> over uvWorld spaceAction uv ScancodeP -> pauseGame uv ScancodeF -> over uvWorld youDropItem uv ScancodeM -> toggleMap uv -- ScancodeR -> over (uvWorld . cWorld . lWorld . creatures . ix 0) crReloadToggle uv ScancodeT -> over uvWorld testEvent uv ScancodeX -> uv & uvWorld %~ toggleTweakInv 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 sc = case sc of ScancodeF -> over uvWorld youDropItem uv ScancodeSpace -> over uvWorld spaceAction uv _ -> uv doRegexInput :: Input -> Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int) -> Maybe String -> (IM.IntMap (SelectionSection a), Maybe (Int, Int), 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 & ix i . ssItems .~ mempty , 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 InitialPress endkeys = any ((== Just InitialPress) . (`M.lookup` pkeys)) [ScancodeReturn, ScancodeSlash] backspacetonothing = filts == Just "" && ScancodeBackspace `M.lookup` pkeys == Just InitialPress pkeys = inp ^. pressedKeys updateBackspaceRegex :: World -> World updateBackspaceRegex w = case di ^? subInventory of Just NoSubInventory{} | secfocus (-1) 0 -> w & hud . hudElement %~ trybackspace (-1) & worldEventFlags . at InventoryChange ?~ () Just NoSubInventory{} | secfocus 2 3 -> w & hud . hudElement %~ trybackspace'' 2 & worldEventFlags . at InventoryChange ?~ () Just CombineInventory{} -> w & hud . hudElement . subInventory %~ trybackspace' (-1) & worldEventFlags . at InventoryChange ?~ () _ -> w where secfocus a b = fromMaybe False $ do i <- di ^? diSelection . _Just . _1 return $ i == a || i == b trybackspace x he = fromMaybe he $ do str <- he ^? diInvFilter . _Just return $ case str of (_ : _) -> he & diInvFilter . _Just %~ init & diSelection ?~ (x, 0) [] -> he & diInvFilter .~ Nothing trybackspace'' x he = fromMaybe he $ do str <- he ^? diCloseFilter . _Just return $ case str of (_ : _) -> he & diCloseFilter . _Just %~ init & diSelection ?~ (x, 0) [] -> he & diCloseFilter .~ Nothing trybackspace' x ci = fromMaybe ci $ do str <- ci ^? ciFilter . _Just return $ case str of (_ : _) -> ci & ciFilter . _Just %~ init & ciSelection ?~ (x, 0) [] -> ci & ciFilter .~ Nothing di = w ^. hud . hudElement updateEnterRegex :: World -> World updateEnterRegex w = case w ^? hud . hudElement . subInventory of Just NoSubInventory{} | secfocus (-1) 0 -> w & hud . hudElement . diSelection ?~ (-1, 0) & hud . hudElement . diInvFilter %~ enterregex Just NoSubInventory{} | secfocus 2 3 -> w & hud . hudElement . diSelection ?~ (2, 0) & hud . hudElement . diCloseFilter %~ enterregex Just CombineInventory{} -> w & hud . hudElement . subInventory . ciFilter %~ enterregex & hud . hudElement . subInventory . ciSelection ?~ (-1, 0) _ -> w where di = w ^. hud . hudElement secfocus a b = fromMaybe False $ do i <- di ^? diSelection . _Just . _1 return $ i == a || i == b enterregex = (<|> Just "") pauseGame :: Universe -> Universe pauseGame u = u & uvScreenLayers .~ [pauseMenu u] spaceAction :: World -> World spaceAction w = case w ^. hud . hudElement of DisplayCarte -> w & hud . carteCenter .~ theLoc DisplayInventory{_subInventory = NoSubInventory{}} -> case Left <$> selectedCloseItem w of Just (Left flit) -> pickUpItem 0 flit w & worldEventFlags . at InventoryChange ?~ () Just (Right but) -> doButtonEvent (_btEvent but) but w & worldEventFlags . at InventoryChange ?~ () _ -> w DisplayInventory{_subInventory = DisplayTerminal{}} -> w & hud . hudElement . subInventory .~ NoSubInventory --MouseInvNothing & worldEventFlags . at InventoryChange ?~ () _ -> w & hud . hudElement . subInventory .~ NoSubInventory --MouseInvNothing where theLoc = doWorldPos (w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1) w toggleMap :: Universe -> Universe toggleMap u = case u ^. uvWorld . hud . hudElement of DisplayCarte -> u & uvWorld . hud . hudElement .~ DisplayInventory { _subInventory = NoSubInventory , _diSections = mempty , _diSelection = Nothing , _diSelectionExtra = mempty , _diInvFilter = mempty , _diCloseFilter = mempty } _ -> u & uvWorld . hud . hudElement .~ DisplayCarte toggleTweakInv :: World -> World toggleTweakInv w = case w ^? hud . hudElement . subInventory of Just ExamineInventory{} -> w & thepointer .~ NoSubInventory --MouseInvNothing _ -> w & thepointer .~ ExamineInventory -- mi where thepointer = hud . hudElement . subInventory tryCombine :: -- IM.IntMap (SelectionSection CombinableItem) -> (Int, Int) -> World -> World tryCombine (i, j) w = fromMaybe w $ do sss <- w ^? hud . hudElement . subInventory . ciSections CombinableItem is it <- sss ^? ix i . ssItems . ix j . siPayload p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos return $ snd (createItemYou it (foldr (destroyInvItem 0) w (sort is))) & cWorld . lWorld . creatures . ix 0 . crHammerPosition .~ HammerDown & soundStart InventorySound p wrench1S Nothing maybeExitCombine :: World -> World maybeExitCombine w | ButtonRight `M.member` (w ^. input . mouseButtons) = w | otherwise = w & hud . hudElement . subInventory .~ NoSubInventory