diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index afa85c7c8..0dd209990 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -1,11 +1,12 @@ {-# LANGUAGE TupleSections #-} module Dodge.DisplayInventory ( - enterCombineInv, toggleCombineInv, updatePositionHUD, + updateInventorySectionItems, ) where +import Dodge.ListDisplayParams import ListHelp import Dodge.Data.Combine import Control.Monad @@ -19,7 +20,6 @@ import Dodge.Data.Universe import Dodge.Inventory.CheckSlots import Dodge.Inventory.Color import Dodge.Inventory.SelectionList -import Dodge.Render.HUD import Dodge.SelectionList import LensHelp import Picture.Base @@ -28,8 +28,7 @@ import Regex -- this should ONLY change the shownitems updatePositionHUD :: Universe -> Universe updatePositionHUD u = case u ^? uvWorld . hud . hudElement . subInventory of - Just NoSubInventory -> u & uvWorld . hud . hudElement . diSections - %~ updateDisplayInventory (_uvWorld u) (_uvConfig u) + Just NoSubInventory -> u & updateDisplayInventory Just CombineInventory {} -> u & uvWorld . hud . hudElement . subInventory . ciSections %~ updateCombineInventory (_uvWorld u) (_uvConfig u) _ -> u @@ -84,8 +83,12 @@ orRegex f x str = case words str of [] -> True xs -> any (f x) xs -updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections () -updateDisplayInventory w cfig sss = +updateDisplayInventory :: Universe -> Universe +updateDisplayInventory u = u & uvWorld . hud . hudElement . diSections + %~ updateDisplaySections (_uvWorld u) (_uvConfig u) + +updateDisplaySections :: World -> Configuration -> SelectionSections () -> SelectionSections () +updateDisplaySections w cfig sss = sss & sssSections %~ updateSectionsPositioning mselpos @@ -129,6 +132,17 @@ updateDisplayInventory w cfig sss = return $ IM.filter (plainRegex str) itms numfiltitems = " " ++ show (length itms - length itms') ++ " FILTERED" +-- it is annoying that this is necessary +updateInventorySectionItems :: World -> World +updateInventorySectionItems w = w + & hud . hudElement . diSections . sssSections . ix 0 . ssItems %~ f + where + f olditems = fromMaybe olditems $ do + cr <- w ^? cWorld . lWorld . creatures . ix 0 + invitms <- cr ^? crInv + str <- w ^? hud . hudElement . diSections . sssExtra . sssFilters . ix (-1) . _Just + return $ IM.filter (plainRegex str) $ IM.mapWithKey (invSelectionItem' cr) invitms + plainRegex :: String -> SelectionItem a -> Bool plainRegex = flip $ andOrRegex (\si str -> regexList str (_siPictures si)) diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 5eb870c2b..dff86db15 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -22,6 +22,7 @@ module Dodge.Inventory ( setInvPosFromSS, ) where +import Dodge.DisplayInventory import Dodge.SelectionSections import Control.Applicative import Dodge.Data.SelectionList @@ -43,6 +44,7 @@ import LensHelp import ListHelp import Padding +-- TODO check what happens to selection index when dropping non-selected items -- | after this the item at the inventory position will no longer exist rmInvItem :: -- | Creature id @@ -55,8 +57,8 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount Just x | x > 1 -> w & pointcid . crInv . ix invid . itUse . useAmount -~ 1 _ -> w - & pointcid . crInv %~ f & pointcid %~ crCancelReloading + & pointcid . crInv %~ f & pointcid . crLeftInvSel . lisMPos %~ g' & removeAnySlotEquipment & dounequipfunction @@ -71,7 +73,7 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount updateselection | cid == 0 && cr ^? crManipulation . manObject . inInventory . ispItem == Just invid - = scrollAugInvSel (-1) . scrollAugInvSel 1 + = scrollAugInvSel (-1) . scrollAugInvSel 1 . updateInventorySectionItems | otherwise = pointcid . crManipulation . manObject . inInventory . ispItem %~ g @@ -83,9 +85,12 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount doanyitemeffect = fromMaybe id $ do rmf <- itm ^? itEffect . ieOnDrop return $ doInvEffect rmf itm cr - removeAnySlotEquipment = case w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid of - Just epos -> pointcid . crEquipment . at epos .~ Nothing - Nothing -> id + --removeAnySlotEquipment = case w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid of + -- Just epos -> pointcid . crEquipment . at epos .~ Nothing + -- Nothing -> id + removeAnySlotEquipment = fromMaybe id $ do + epos <- w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid + return $ pointcid . crEquipment . at epos .~ Nothing maxk = fmap fst $ IM.lookupMax $ cr ^. crInv f inv = let (xs, ys) = IM.split invid inv diff --git a/src/Dodge/Inventory/Add.hs b/src/Dodge/Inventory/Add.hs index b6fe9c163..f712b480b 100644 --- a/src/Dodge/Inventory/Add.hs +++ b/src/Dodge/Inventory/Add.hs @@ -1,5 +1,10 @@ -module Dodge.Inventory.Add where +module Dodge.Inventory.Add + ( tryPutItemInInv + , createPutItem + , createAndSelectItem + )where +import Dodge.Data.SelectionList import Control.Lens import Data.Maybe import Dodge.Base.You @@ -38,6 +43,7 @@ tryPutItemInInv cid flit w = case maybeInvSlot of createAndSelectItem :: Item -> World -> World createAndSelectItem itm w = case createPutItem itm w of (Just i, w') -> w' + & hud . hudElement . diSections . sssExtra . sssSelPos ?~ (0,i) & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ InInventory (SelItem i NoInvSelAction) (Nothing, w') -> w' diff --git a/src/Dodge/Inventory/CheckSlots.hs b/src/Dodge/Inventory/CheckSlots.hs index d3bde0303..914d15049 100644 --- a/src/Dodge/Inventory/CheckSlots.hs +++ b/src/Dodge/Inventory/CheckSlots.hs @@ -1,4 +1,8 @@ -module Dodge.Inventory.CheckSlots where +module Dodge.Inventory.CheckSlots ( + checkInvSlotsYou, + crNumFreeSlots, + crInvSize, +) where import Control.Lens import Data.Maybe @@ -13,11 +17,10 @@ import qualified IntMapHelp as IM checkInvSlotsYou :: Item -> World -> Maybe Int checkInvSlotsYou it w | crNumFreeSlots ycr >= ceiling (_itInvSize it) = - Just $ findItemSlot it inv + Just $ findItemSlot it (_crInv ycr) | otherwise = Nothing where ycr = you w - inv = _crInv ycr -- Assumes that the item is singular. -- Do not want to stack floor items for now diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index c2608c0a1..bafb8a84d 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -1,8 +1,6 @@ --{-# LANGUAGE TupleSections #-} module Dodge.Render.HUD ( drawHUD, - invDisplayParams, - secondColumnParams, ) where import Dodge.ListDisplayParams diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index bee6bd8d5..a915e3eae 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -2,376 +2,12 @@ module Dodge.Update.Input ( updateUseInput, ) where ---import Control.Monad - ---import Control.Monad - ---import Control.Monad -import Dodge.DisplayInventory -import Data.List (sort) -import Dodge.Inventory.Add -import Dodge.Data.Combine -import Geometry -import Dodge.SelectionList -import Dodge.Base.Window -import Dodge.Menu.Option -import Dodge.InputFocus -import Dodge.SelectionSections -import Dodge.Default.World -import Data.Char -import qualified Data.IntMap.Strict as IM -import qualified Data.Map.Strict as M -import Data.Maybe ---import Data.Monoid (First) -import Dodge.Base.You -import Dodge.Button.Event -import Dodge.Creature.Action import Dodge.Data.Universe -import Dodge.Debug.Terminal ---import Dodge.DisplayInventory -import Dodge.Event.Test -import Dodge.Inventory -import Dodge.Menu -import Dodge.Reloading -import Dodge.Save -import Dodge.Terminal.LeftButton -import Dodge.WorldPos -import LensHelp -import SDL +import Dodge.Update.Input.InGame +import Dodge.Update.Input.ScreenLayer +import Control.Lens updateUseInput :: Universe -> Universe updateUseInput u = case u ^? uvScreenLayers . _head of Just sl -> updateUseInputOnScreen sl u Nothing -> updateUseInputInGame (u ^. uvWorld . hud . hudElement) u - -updateUseInputOnScreen :: ScreenLayer -> Universe -> Universe -updateUseInputOnScreen sl = case sl of - InputScreen thetext _-> doInputScreenInput thetext - screen@OptionScreen{_scPositionedMenuOption = mop, _scOptionFlag = flag, _scSelectionList = sellist, _scListDisplayParams = ldps} -> - optionScreenUpdate screen mop flag ldps sellist - -updateUseInputInGame :: HUDElement -> Universe -> Universe -updateUseInputInGame h u = case h of - DisplayCarte -> over uvWorld updatePressedButtonsCarte u - DisplayInventory {_subInventory = si} -> case si of - DisplayTerminal tmid - | lbinitialpress && inTermFocus w -> - over uvWorld (doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid)) u - | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u - | lbinitialpress -> - u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True - CombineInventory {_ciSections = sss} - | inSubInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . subInventory . ciSections %~ doRegexInput u (-1) - | lbinitialpress -> maybeExitCombine $ over uvWorld (tryCombine sss) u --- _ -> case regexFocus w of --- Nothing -> M.foldlWithKey' updateKeyInGame u pkeys --- Just (filtpoint,selpoint,i) -> u & uvWorld . p %~ doRegexInput - _ | inInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . diSections %~ doRegexInput u (-1) - _ | inCloseRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . diSections %~ doRegexInput u 2 - _ -> M.foldlWithKey' updateKeyInGame u pkeys - where - w = u ^. uvWorld - pkeys = u ^. uvWorld . input . pressedKeys - pmb = u ^. uvWorld . input . mouseButtons - lbinitialpress = pmb ^? ix ButtonLeft == Just False - -tryCombine :: SelectionSections CombinableItem -> World -> World -tryCombine sss w = fromMaybe w $ do - (i,j) <- sss ^? sssExtra . sssSelPos . _Just - CombinableItem is it _ <- sss ^? sssSections . ix i . ssItems . ix j . siPayload - return $ createAndSelectItem it $ foldr (rmInvItem 0) w (sort is) - -maybeExitCombine :: Universe -> Universe -maybeExitCombine u - | ButtonRight `M.member` (u ^. uvWorld . input . mouseButtons) - = u & uvWorld %~ enterCombineInv (u ^. uvConfig) - | otherwise = u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory - -doTextInputOver :: ASetter' Universe String -> Universe -> Universe -doTextInputOver p u = doTextInputOver' u p u - -doTextInputOver' :: Universe -> ASetter' a String -> a -> a -doTextInputOver' u p x = - x & p %~ (++ map toUpper str) - & checkBackspace - where - str = u ^. uvWorld . input . textInput - checkBackspace - | backspaceInputted u = p %~ doBackspace - | otherwise = id - -doBackspace :: String -> String -doBackspace [] = [] -doBackspace s = init s - -backspaceInputted :: Universe -> Bool -backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBackspace of - Just InitialPress -> True - Just LongPress -> True - _ -> False - -doRegexInput :: Universe -> Int -> SelectionSections a -> SelectionSections a -doRegexInput u i sss - | backspacetonothing || escapekey = endregex i 0 - | endkeys || endmouse = endregex (i + 1) (j -1) - | otherwise = sss & doTextInputOver' u (sssExtra . sssFilters . ix i . _Just) - where - endregex a b = - sss - & sssExtra . sssFilters . ix i .~ Nothing - & sssSections . ix i . ssItems .~ mempty - & ssSetCursor (ssLookupDown a b) - j = fromMaybe 0 $ do - itms <- sss ^? sssSections . ix (i + 1) . ssItems - fst <$> IM.lookupMin itms - escapekey = ScancodeEscape `M.lookup` pkeys == Just InitialPress - endkeys = - any - ((== Just InitialPress) . (`M.lookup` pkeys)) - [ScancodeReturn, ScancodeSlash] - endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft) - backspacetonothing = - sss ^? sssExtra . sssFilters . ix i . _Just == Just "" - && ScancodeBackspace `M.lookup` pkeys == Just InitialPress - pkeys = u ^. uvWorld . input . pressedKeys - -doInputScreenInput :: String -> Universe -> Universe -doInputScreenInput s u = - u & doTextInputOver (uvScreenLayers . _head . scInput) - & checkEndStatus - where - pkeys = u ^. uvWorld . input . pressedKeys - checkEndStatus - | ScancodeReturn `M.member` pkeys = - (uvScreenLayers %~ tail) - . applyTerminalString (words s) - | ScancodeEscape `M.member` pkeys = uvScreenLayers %~ tail - | otherwise = id - -updateKeysInTerminal :: Int -> Universe -> Universe -updateKeysInTerminal tmid u = - u & doTextInputOver tmpoint - & checkEndStatus - where - tmpoint = uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText - pkeys = u ^. uvWorld . input . pressedKeys - checkEndStatus - | pkeys ^. at ScancodeReturn == Just InitialPress = - over uvWorld (\w -> terminalReturnEffect (w ^?! cWorld . lWorld . terminals . ix tmid) w) - | 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 - ScancodeF5 -> doQuicksave uv - ScancodeF9 -> loadSaveSlot QuicksaveSlot uv - ScancodeEscape -> pauseGame uv - ScancodeSpace -> over uvWorld spaceAction uv - ScancodeP -> pauseGame uv - ScancodeF -> over uvWorld youDropItem uv - ScancodeM -> toggleMap uv - ScancodeR -> over (uvWorld . cWorld . lWorld . creatures . ix 0) crToggleReloading 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 - -updateBackspaceRegex :: World -> World -updateBackspaceRegex w = case di ^? subInventory of - Just NoSubInventory | secfocus (-1) 0 -> w & hud . hudElement . diSections %~ trybackspace (-1) - Just NoSubInventory | secfocus 2 3 -> w & hud . hudElement . diSections %~ trybackspace 2 - Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections %~ trybackspace (-1) - _ -> w - where - secfocus a b = fromMaybe False $ do - i <- di ^? diSections . sssExtra . sssSelPos . _Just . _1 - return $ i == a || i == b - trybackspace x sss = fromMaybe sss $ do --- i <- fss ^? fssSections . sssSelPos . _Just . _1 --- guard (i == x || i == x+1) - str <- sss ^? sssExtra . sssFilters . ix x . _Just - return $ case str of - (_ : _) -> sss & sssExtra . sssFilters . ix x . _Just %~ init - & sssExtra . sssSelPos ?~ (x,0) - [] -> sss & sssExtra . sssFilters . ix x .~ Nothing - di = w ^. hud . hudElement - -updateEnterRegex :: World -> World -updateEnterRegex w = case w ^? hud . hudElement . subInventory of - Just NoSubInventory - | secfocus (-1) 0 -> - w & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject - .~ InInventory SortInventory - & hud . hudElement . diSections %~ enterregex (-1) - Just NoSubInventory - | secfocus 2 3 -> - w & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ InNearby SortNearby - & hud . hudElement . diSections %~ enterregex 2 - Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections %~ enterregex (-1) - & hud . hudElement . subInventory . ciSections . sssExtra . sssSelPos ?~ (-1,0) - _ -> w - where - di = w ^. hud . hudElement - secfocus a b = fromMaybe False $ do - i <- di ^? diSections . sssExtra . sssSelPos . _Just . _1 - return $ i == a || i == b - enterregex x sss = sss & sssExtra . sssFilters . ix x %~ f - & sssExtra . sssSelPos ?~ (x,0) - f Nothing = Just "" - f x = x - ---overSection :: (SelectionSection a -> SelectionSection a) -> SelectionSections a -> SelectionSections a ---overSection f sss = fromMaybe sss $ do --- i <- sss ^? sssSelPos . _Just . _1 --- return $ sss & sssSections . ix i %~ f - -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 selectedCloseObject w of - Just (Left flit) -> pickUpItem 0 flit w - Just (Right but) -> doButtonEvent (_btEvent but) but w - _ -> w - DisplayInventory{_subInventory = DisplayTerminal{}} -> - w & hud . hudElement . subInventory .~ NoSubInventory - _ -> w & hud . hudElement . subInventory .~ NoSubInventory - 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 = defaultInvSections} - _ -> u & uvWorld . hud . hudElement .~ DisplayCarte - -toggleTweakInv :: World -> World -toggleTweakInv w = case w ^? hud . hudElement . subInventory of - Just ExamineInventory{} -> w & thepointer .~ NoSubInventory - _ -> w & thepointer .~ ExamineInventory mi - 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) - -updatePressedButtonsCarte :: World -> World -updatePressedButtonsCarte w = updatePressedButtonsCarte' (_mouseButtons (_input w)) w - -updatePressedButtonsCarte' :: M.Map MouseButton Bool -> World -> World -updatePressedButtonsCarte' pkeys w - | isDown ButtonRight = - w - & input . clickMousePos .~ _mousePos (_input w) - & hud . carteCenter %~ (-.- trans) - | isDown ButtonLeft = - w - & input . clickMousePos .~ _mousePos (_input w) - & hud . carteRot -~ rot - & hud . carteZoom *~ czoom - | otherwise = w - where - isDown but = but `M.member` pkeys - rot = angleBetween (_mousePos (_input w)) (_clickMousePos (_input w)) - czoom = magV (_mousePos (_input w)) / magV (_clickMousePos (_input w)) - trans = rotateV (w ^. hud . carteRot) - $ 1 / (w ^. hud . carteZoom) *.* (_mousePos (_input w) -.- _clickMousePos (_input w))