{- | Module : Dodge.Event Description : Direct event handling Deals with direct events. This includes individual key or mouse presses, but /not/ continuous held down input. We cannot handle multiple keys held down at once here, (eg left mouse button + right mouse button) because these are separate events. Instead we store the events in a set, and deal with the combinations in "Dodge.Update". -} module Dodge.Event ( handleEvent ) where import Dodge.Combine import Dodge.Event.Keyboard --import Dodge.Event.Menu import Dodge.Base import Dodge.Data --import Dodge.Base.Window import Dodge.PreloadData --import Dodge.Creature.Action import Dodge.Inventory import Dodge.Inventory.Add import Dodge.SoundLogic --import Geometry --import Preload.Update import Dodge.FloorItem import qualified IntMapHelp as IM import ListHelp --import Data.Monoid import Control.Lens import Data.Maybe --import Data.Maybe --import Data.Char --import Data.List --import Data.Function (on) import qualified Data.Set as S import SDL handleEvent :: Event -> Universe -> IO (Maybe Universe) handleEvent e = case eventPayload e of TextInputEvent tev -> handleTextInputEvent tev KeyboardEvent kev -> handleKeyboardEvent kev MouseMotionEvent mmev -> return . handleMouseMotionEvent mmev MouseButtonEvent mbev -> return . handleMouseButtonEvent mbev MouseWheelEvent mwev -> return . handleMouseWheelEvent mwev WindowSizeChangedEvent sev -> handleResizeEvent sev WindowMovedEvent mev -> return . handleWindowMoveEvent mev _ -> return . Just handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2 (fromIntegral x - 0.5*_windowX cfig) (0.5*_windowY cfig - fromIntegral y) where cfig = _config u P (V2 x y) = mouseMotionEventPos mmev handleMouseButtonEvent :: MouseButtonEventData -> Universe -> Maybe Universe handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of Released -> Just . updateButtons S.delete Pressed -> handlePressedMouseButton thebutton . updateButtons S.insert where thebutton = mouseButtonEventButton mbev updateButtons f = uvWorld . mouseButtons %~ f thebutton {- | Sets window position in config. -} handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Maybe Universe handleWindowMoveEvent mev = Just . (config . windowPosX .~ fromIntegral x) . (config . windowPosY .~ fromIntegral y) where P (V2 x y) = windowMovedEventPosition mev {- | Resets the world window size, and resizes the fbo that gets the light map drawn into it. -} -- using a sideeffect here for the io change seems to work better, more testing -- later may be a good idea handleResizeEvent :: WindowSizeChangedEventData -> Universe -> IO (Maybe Universe) handleResizeEvent sev u = return . Just $ u & config . windowX .~ fromIntegral x & config . windowY .~ fromIntegral y & uvWorld . sideEffects %~ sideEffectUpdatePreload divRes x y where x = fromIntegral x' y = fromIntegral y' V2 x' y' = windowSizeChangedEventSize sev divRes = resFactorNum $ u ^. config . graphics_resolution_factor handlePressedMouseButton :: MouseButton -> Universe -> Maybe Universe handlePressedMouseButton but w = case (_hudElement (_hud $ _uvWorld w), but) of (DisplayCarte,_) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w) (_,ButtonMiddle) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w) ( DisplayInventory (CombineInventory mi) , ButtonLeft) -> Just $ fromMaybe (w & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory) $ do -- ugly i <- mi return $ over uvWorld (doCombine i) w _ -> Just w -- note "sort" on the inventory indices; otherwise -- lower items may be shifted up and items below these removed instead doCombine :: Int -> World -> World doCombine i w = case combineItemListYou w !? i of Nothing -> w Just (is,it) -> enterCombineInv . uncurry (putItemInInvID yid) . copyItemToFloorID (_crPos $ you w) it $ foldr (rmInvItem yid) w (sort is) where yid = _yourID w handleMouseWheelEvent :: MouseWheelEventData -> Universe -> Maybe Universe handleMouseWheelEvent mwev w = case _menuLayers w of [] -> case mouseWheelEventPos mwev of V2 _ y -> Just $ w & uvWorld %~ wheelEvent (fromIntegral y) _ -> Just w wheelEvent :: Float -> World -> World wheelEvent y w = case _hudElement $ _hud w of DisplayCarte | rbDown -> w & hud . carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * ) | otherwise -> w & selLocation %~ (`mod` numLocs) . (+ yi) DisplayInventory NoSubInventory -- functions that modify the inventory should be centralised so that -- this lock can be sensibly applied, perhaps | _crInvLock (_creatures w IM.! _yourID w) -> w | rbDown -> case (yourItem w ^? _Just . itUse . heldScroll,_rbOptions w) of (_,EquipOptions{}) -> scrollRBOption y w (Nothing,_) -> closeObjScrollDir y w (Just f,_) -> w & creatures . ix 0 . crInv . ix (_crInvSel $ you w) %~ f y (you w) | lbDown -> w & cameraZoom +~ y | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeSwapInvSel yi w | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w DisplayInventory TweakInventory | invKeyDown && rbDown -> w & moveTweakSel yi | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w | rbDown -> w & changeTweakParam yi | otherwise -> w & moveTweakSel yi DisplayInventory (CombineInventory _) -> w & hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi) _ -> w where numcombs = length $ combineItemListYou w yi = round $ signum y numLocs = (fst . IM.findMax $ _seenLocations w) + 1 rbDown = ButtonRight `S.member` _mouseButtons w lbDown = ButtonLeft `S.member` _mouseButtons w invKeyDown = ScancodeCapsLock `S.member` _keys w scrollRBOption :: Float -> World -> World scrollRBOption y w | y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w))-1) . (+1)) | y > 0 = w & rbOptions . opSel %~ (max 0 . (subtract 1)) | otherwise = w -- nice idea, but the chain of setters and getters seems prohibitive --scrollOver :: Foldable t -- => ASetter s s Int Int -- index setter -- -> Getting (First (t a)) s (t a) -- pointer to object of size -- -> Float -- direction -- -> s -> s --scrollOver theset theget y w = case w ^? theget of -- Just t -> w & theset %~ ( (`mod` length t) . (subtract y')) -- Nothing -> w -- where -- y' = round $ signum y moveTweakSel :: Int -> World -> World moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of Just l -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w)) . itTweaks . tweakSel %~ (`mod` length l) . subtract i _ -> w changeTweakParam :: Int -> World -> World changeTweakParam i w = w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w)) %~ ( (itTweaks . tweakParams . ix paramid . curTweak .~ x) . _doTweak params x) where tweaks = _itTweaks . fromJust $ yourItem w params = _tweakParams tweaks IM.! paramid x = (_curTweak params + i) `mod` _maxTweak params paramid = _tweakSel tweaks