{- | 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.Event.Keyboard --import Dodge.Event.Menu import Dodge.Data import Dodge.Base import Dodge.Base.Window import Dodge.PreloadData --import Dodge.Creature.Action import Dodge.SoundLogic import Dodge.Inventory --import Geometry --import Preload.Update import qualified IntMapHelp as IM import Control.Lens --import Data.Maybe --import Data.Char --import Data.List --import Data.Function (on) import qualified Data.Set as S import SDL --handleEvent :: Event -> Universe -> Maybe Universe --handleEvent e uv = case handleEvent' e (_uvWorld uv) of -- Nothing -> Nothing -- Just w -> Just $ uv & uvWorld .~ w handleEvent :: Event -> Universe -> Maybe Universe handleEvent e = case eventPayload e of KeyboardEvent kev -> handleKeyboardEvent kev MouseMotionEvent mmev -> handleMouseMotionEvent mmev MouseButtonEvent mbev -> handleMouseButtonEvent mbev MouseWheelEvent mwev -> handleMouseWheelEvent mwev WindowSizeChangedEvent sev -> handleResizeEvent sev WindowMovedEvent mev -> handleWindowMoveEvent mev _ -> Just handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2 (fromIntegral x - 0.5*getWindowX w) (0.5*getWindowY w - fromIntegral y) where w = _uvWorld u P (V2 x y) = mouseMotionEventPos mmev handleMouseButtonEvent :: MouseButtonEventData -> Universe -> Maybe Universe handleMouseButtonEvent mbev u = case mouseButtonEventMotion mbev of Released -> Just $ u & uvWorld . mouseButtons %~ S.delete but Pressed -> handlePressedMouseButton but (u & uvWorld . mouseButtons %~ S.insert but) where but = mouseButtonEventButton mbev {- | Sets window position in config. -} handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Maybe Universe handleWindowMoveEvent mev u = Just $ u & uvWorld . config . windowPosX .~ fromIntegral x & uvWorld . 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. -} handleResizeEvent :: WindowSizeChangedEventData -> Universe -> Maybe Universe handleResizeEvent sev u = Just $ u & uvWorld . config . windowX .~ fromIntegral x & uvWorld . config . windowY .~ fromIntegral y & uvWorld . sideEffects %~ sideEffectUpdatePreload divRes x y where w = _uvWorld u x = fromIntegral x' y = fromIntegral y' V2 x' y' = windowSizeChangedEventSize sev divRes = w ^. config . resolution_factor handlePressedMouseButton :: MouseButton -> Universe -> Maybe Universe handlePressedMouseButton but w | but == ButtonMiddle || _carteDisplay (_uvWorld w) = Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w) | otherwise = Just 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 (_carteDisplay w, _inventoryMode w) of (True, _) | rbDown -> w & carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * ) | otherwise -> w & selLocation %~ (`mod` numLocs) . (+ yi) (_, TopInventory) | rbDown -> case yourItem w ^? itScroll of Nothing -> closeObjScrollDir y w Just f -> w & creatures . ix 0 . crInv . ix (_crInvSel $ you w) %~ f y (you w) | lbDown -> w & cameraZoom +~ y | invKeyDown -> swapInvDir yi $ stopSoundFrom (CrReloadSound 0) $ dirInvPos yi w | otherwise -> stopSoundFrom (CrReloadSound 0) $ dirInvPos yi w (_, TweakInventory) | invKeyDown && rbDown -> w & moveYourAmmoSel yi | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ dirInvPos yi w | rbDown -> w & moveYourAmmoParam yi | otherwise -> w & moveYourAmmoSel yi (_, _) -> w where 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 moveYourAmmoSel :: Int -> World -> World moveYourAmmoSel i w = case yourItem w ^? wpAmmo . aoType. amPjParams of Just l -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w)) . wpAmmo . aoType. amParamSel %~ (`mod` length l) . subtract i _ -> w moveYourAmmoParam :: Int -> World -> World moveYourAmmoParam i w = case yourItem w ^? wpAmmo . aoType. amPjParams . ix paramid . pjMaxParam of Just n -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w)) . wpAmmo . aoType. amPjParams . ix paramid . pjIntParam %~ (`mod` n) . (+ i) _ -> w where paramid = _amParamSel $ _aoType $ _wpAmmo $ yourItem w