137 lines
5.0 KiB
Haskell
137 lines
5.0 KiB
Haskell
{- |
|
|
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.Creature.Action
|
|
import Dodge.SoundLogic
|
|
import Dodge.Inventory
|
|
import Dodge.Config.Data
|
|
--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 :: World -> Event -> Maybe World
|
|
handleEvent = flip handleEvent'
|
|
|
|
handleEvent' :: Event -> World -> Maybe World
|
|
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
|
|
_ -> Just
|
|
|
|
handleMouseMotionEvent :: MouseMotionEventData -> World -> Maybe World
|
|
handleMouseMotionEvent mmev w = Just $ w & mousePos .~ V2
|
|
(fromIntegral x - 0.5*getWindowX w)
|
|
(0.5*getWindowY w - fromIntegral y)
|
|
where
|
|
P (V2 x y) = mouseMotionEventPos mmev
|
|
|
|
handleMouseButtonEvent :: MouseButtonEventData -> World -> Maybe World
|
|
handleMouseButtonEvent mbev w = case mouseButtonEventMotion mbev of
|
|
Released -> Just $ over mouseButtons (S.delete but) w
|
|
Pressed -> handlePressedMouseButton but $ over mouseButtons (S.insert but) w
|
|
where
|
|
but = mouseButtonEventButton mbev
|
|
|
|
{- | Resets the world window size, and resizes the fbo that gets the light map drawn into it. -}
|
|
handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World
|
|
handleResizeEvent sev w = Just
|
|
. set (config . windowX) (fromIntegral x)
|
|
. set (config . windowY) (fromIntegral y)
|
|
$ over sideEffects ( sizeFBOs (x `div` divRes) (y `div` divRes) x y : )
|
|
w
|
|
where
|
|
x = fromIntegral x'
|
|
y = fromIntegral y'
|
|
V2 x' y' = windowSizeChangedEventSize sev
|
|
divRes = w ^. config . shadow_resolution
|
|
|
|
handlePressedMouseButton :: MouseButton -> World -> Maybe World
|
|
handlePressedMouseButton but w
|
|
| but == ButtonMiddle || _carteDisplay w
|
|
= Just $ w & clickMousePos .~ _mousePos w
|
|
| otherwise = Just w
|
|
|
|
handleMouseWheelEvent :: MouseWheelEventData -> World -> Maybe World
|
|
handleMouseWheelEvent mwev w = case _menuLayers w of
|
|
[] -> case mouseWheelEventPos mwev of
|
|
V2 _ y -> Just $ wheelEvent (fromIntegral y) w
|
|
_ -> 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 -> fromMaybe (closeObjScrollDir y w) $ (yourItem w ^? itScroll)
|
|
<*> pure y
|
|
<*> pure (you w)
|
|
<*> pure w
|
|
| lbDown -> w & cameraZoom +~ y
|
|
| invKeyDown -> swapInvDir yi $ dirInvPos yi w
|
|
| otherwise -> dirInvPos yi w
|
|
(_, TweakInventory)
|
|
| invKeyDown && rbDown -> w & moveYourAmmoSel yi
|
|
| invKeyDown -> 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 . amPjParams of
|
|
Just l -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w))
|
|
. wpAmmo . amParamSel %~ (`mod` length l) . subtract i
|
|
_ -> w
|
|
moveYourAmmoParam :: Int -> World -> World
|
|
moveYourAmmoParam i w = case yourItem w ^? wpAmmo . amPjParams . ix paramid . pjMaxParam of
|
|
Just n -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w))
|
|
. wpAmmo . amPjParams . ix paramid . pjIntParam %~ (`mod` n) . (+ i)
|
|
_ -> w
|
|
where
|
|
paramid = _amParamSel $ _wpAmmo $ yourItem w
|
|
swapInvDir :: Int -> World -> World
|
|
swapInvDir k w = w & creatures . ix (_yourID w) . crInv %~ IM.swapKeys (i `mod` n) ((i + k) `mod` n)
|
|
where
|
|
i = _crInvSel $ you w
|
|
n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w
|
|
|
|
dirInvPos :: Int -> World -> World
|
|
dirInvPos i w = stopSoundFrom (CrReloadSound 0) $ w
|
|
& creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
|
|
where
|
|
n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w
|