Cleanup
This commit is contained in:
+98
-82
@@ -11,44 +11,47 @@ Nor could we handle continuous mouse button input.
|
||||
Instead we store button presses (in a Map) and deal with the combinations in
|
||||
the simulation step; in particular see 'updatePressedButtons'.
|
||||
-}
|
||||
module Dodge.Event
|
||||
( handleEvent
|
||||
) where
|
||||
import Dodge.Terminal
|
||||
import Dodge.Tweak
|
||||
import Dodge.HeldScroll
|
||||
import Dodge.InputFocus
|
||||
import Dodge.Combine
|
||||
import Dodge.Event.Keyboard
|
||||
import Dodge.Base
|
||||
import Dodge.Data
|
||||
import Dodge.PreloadData
|
||||
import Dodge.Inventory
|
||||
import Dodge.SoundLogic
|
||||
import qualified IntMapHelp as IM
|
||||
module Dodge.Event (
|
||||
handleEvent,
|
||||
) where
|
||||
|
||||
import Control.Lens
|
||||
import Data.Maybe
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Text as T
|
||||
import Dodge.Base
|
||||
import Dodge.Combine
|
||||
import Dodge.Data
|
||||
import Dodge.Event.Keyboard
|
||||
import Dodge.HeldScroll
|
||||
import Dodge.InputFocus
|
||||
import Dodge.Inventory
|
||||
import Dodge.PreloadData
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.Terminal
|
||||
import Dodge.Tweak
|
||||
import qualified IntMapHelp as IM
|
||||
import SDL
|
||||
|
||||
handleEvent :: Event -> Universe -> IO (Maybe Universe)
|
||||
handleEvent e = case eventPayload e of
|
||||
TextInputEvent tev -> return . Just . handleTextInput (textInputEventText tev)
|
||||
KeyboardEvent kev -> handleKeyboardEvent kev
|
||||
MouseMotionEvent mmev -> return . handleMouseMotionEvent mmev
|
||||
MouseButtonEvent mbev -> return . Just . over uvWorld (handleMouseButtonEvent mbev)
|
||||
MouseWheelEvent mwev -> return . handleMouseWheelEvent mwev
|
||||
TextInputEvent tev -> return . Just . handleTextInput (textInputEventText tev)
|
||||
KeyboardEvent kev -> handleKeyboardEvent kev
|
||||
MouseMotionEvent mmev -> return . handleMouseMotionEvent mmev
|
||||
MouseButtonEvent mbev -> return . Just . over uvWorld (handleMouseButtonEvent mbev)
|
||||
MouseWheelEvent mwev -> return . handleMouseWheelEvent mwev
|
||||
WindowSizeChangedEvent sev -> handleResizeEvent sev
|
||||
WindowMovedEvent mev -> return . handleWindowMoveEvent mev
|
||||
_ -> return . Just
|
||||
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)
|
||||
handleMouseMotionEvent mmev u =
|
||||
Just $
|
||||
u & uvWorld . mousePos
|
||||
.~ V2
|
||||
(fromIntegral x - 0.5 * _windowX cfig)
|
||||
(0.5 * _windowY cfig - fromIntegral y)
|
||||
where
|
||||
cfig = _uvConfig u
|
||||
P (V2 x y) = mouseMotionEventPos mmev
|
||||
@@ -56,26 +59,30 @@ handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2
|
||||
handleMouseButtonEvent :: MouseButtonEventData -> World -> World
|
||||
handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
|
||||
Released -> mouseButtons . at thebutton .~ Nothing
|
||||
Pressed -> mouseButtons . at thebutton ?~ False
|
||||
Pressed -> mouseButtons . at thebutton ?~ False
|
||||
where
|
||||
thebutton = mouseButtonEventButton mbev
|
||||
|
||||
{- | Sets window position in config. -}
|
||||
-- | Sets window position in config.
|
||||
handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Maybe Universe
|
||||
handleWindowMoveEvent mev = Just
|
||||
. (uvConfig . windowPosX .~ fromIntegral x)
|
||||
. (uvConfig . windowPosY .~ fromIntegral y)
|
||||
handleWindowMoveEvent mev =
|
||||
Just
|
||||
. (uvConfig . windowPosX .~ fromIntegral x)
|
||||
. (uvConfig . 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. -}
|
||||
-- | 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
|
||||
& uvConfig . windowX .~ fromIntegral x
|
||||
& uvConfig . windowY .~ fromIntegral y
|
||||
& uvIOEffects %~ sideEffectUpdatePreload divRes x y
|
||||
handleResizeEvent sev u =
|
||||
return . Just $
|
||||
u
|
||||
& uvConfig . windowX .~ fromIntegral x
|
||||
& uvConfig . windowY .~ fromIntegral y
|
||||
& uvIOEffects %~ sideEffectUpdatePreload divRes x y
|
||||
where
|
||||
x = fromIntegral x'
|
||||
y = fromIntegral y'
|
||||
@@ -91,44 +98,51 @@ handleMouseWheelEvent mwev w = case _menuLayers w of
|
||||
wheelEvent :: Float -> World -> World
|
||||
wheelEvent y w = case _hudElement $ _hud (_cWorld w) of
|
||||
DisplayCarte
|
||||
| rbDown -> w & cWorld . hud . carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * )
|
||||
| rbDown -> w & cWorld . hud . carteZoom %~ min 0.75 . max 0.05 . ((1 + y * 0.1) *)
|
||||
| otherwise -> w & cWorld . selLocation %~ (`mod` numLocs) . (+ yi)
|
||||
DisplayInventory NoSubInventory
|
||||
-- functions that modify the inventory should be centralised so that
|
||||
-- this lock can be sensibly applied, perhaps
|
||||
-- functions that modify the inventory should be centralised so that
|
||||
-- this lock can be sensibly applied, perhaps
|
||||
| _crInvLock (_creatures (_cWorld w) IM.! _yourID (_cWorld w)) -> w
|
||||
| rbDown -> case (yourItem w ^? _Just . itUse . heldScroll,_rbOptions w) of
|
||||
(_,EquipOptions{}) -> scrollRBOption y w
|
||||
(Nothing,_) -> closeObjScrollDir y w
|
||||
(Just f,_) -> w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w)
|
||||
| rbDown -> case (yourItem w ^? _Just . itUse . heldScroll, _rbOptions w) of
|
||||
(_, EquipOptions{}) -> scrollRBOption y w
|
||||
(Nothing, _) -> closeObjScrollDir y w
|
||||
(Just f, _) -> w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w)
|
||||
| lbDown -> w & cWorld . cameraZoom +~ y
|
||||
| invKeyDown -> changeSwapInvSel yi w
|
||||
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
|
||||
DisplayInventory TweakInventory
|
||||
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
|
||||
DisplayInventory (TweakInventory mi)
|
||||
| invKeyDown && rbDown -> w & moveTweakSel yi
|
||||
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
|
||||
| rbDown -> w & changeTweakParam yi
|
||||
| otherwise -> w & moveTweakSel yi
|
||||
DisplayInventory (CombineInventory _) -> w
|
||||
& cWorld . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
|
||||
| rbDown -> w & changeTweakParam mi yi
|
||||
| otherwise -> w & moveTweakSel yi
|
||||
DisplayInventory CombineInventory{} ->
|
||||
w
|
||||
& cWorld . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
|
||||
DisplayInventory (DisplayTerminal tmid)
|
||||
| rbDown && inTermFocus w -> guardDisconnectedID tmid w $ w
|
||||
& cWorld . terminals . ix tmid %~ updatetermsubsel
|
||||
| inTermFocus w -> w
|
||||
& cWorld . terminals . ix tmid %~ updatetermsel
|
||||
| rbDown && inTermFocus w ->
|
||||
guardDisconnectedID tmid w $
|
||||
w
|
||||
& cWorld . terminals . ix tmid %~ updatetermsubsel
|
||||
| inTermFocus w ->
|
||||
w
|
||||
& cWorld . terminals . ix tmid %~ updatetermsel
|
||||
_ -> w
|
||||
where
|
||||
updatetermsel tm = case tm ^? tmInput . tiSel of
|
||||
Nothing -> tm & tmInput . tiSel .~ (0,0)
|
||||
Just (i,_) -> let newi = (i - yi) `mod` length (scrollCommands tm)
|
||||
in tm & setInput newi 0 w
|
||||
Nothing -> tm & tmInput . tiSel .~ (0, 0)
|
||||
Just (i, _) ->
|
||||
let newi = (i - yi) `mod` length (scrollCommands tm)
|
||||
in tm & setInput newi 0 w
|
||||
updatetermsubsel tm = case tm ^? tmInput . tiSel of
|
||||
Nothing -> tm & tmInput . tiSel .~ (0,0)
|
||||
Just (i,j) -> let newj = (j - yi) `mod` length (getArguments' (scrollCommands tm !! i) tm w)
|
||||
in tm & setInput i newj w
|
||||
setInput i j w' tm = tm
|
||||
& tmInput . tiSel .~ (i,j)
|
||||
& tmInput . tiText .~ T.pack (_tcString tc ++ " " ++ arg)
|
||||
Nothing -> tm & tmInput . tiSel .~ (0, 0)
|
||||
Just (i, j) ->
|
||||
let newj = (j - yi) `mod` length (getArguments' (scrollCommands tm !! i) tm w)
|
||||
in tm & setInput i newj w
|
||||
setInput i j w' tm =
|
||||
tm
|
||||
& tmInput . tiSel .~ (i, j)
|
||||
& tmInput . tiText .~ T.pack (_tcString tc ++ " " ++ arg)
|
||||
where
|
||||
tc = scrollCommands tm !! i
|
||||
arg = getArguments' tc tm w' !! j
|
||||
@@ -144,37 +158,39 @@ getArguments' tc tm = ("" :) . getArguments tc tm
|
||||
|
||||
getArguments :: TerminalCommand -> Terminal -> World -> [String]
|
||||
getArguments tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
|
||||
NoArguments {} -> []
|
||||
NoArguments{} -> []
|
||||
OneArgument _ m -> M.keys m
|
||||
|
||||
scrollCommands :: Terminal -> [TerminalCommand]
|
||||
scrollCommands = (nullCommand :) . _tmScrollCommands
|
||||
|
||||
nullCommand :: TerminalCommand
|
||||
nullCommand = TerminalCommand
|
||||
{ _tcString = ""
|
||||
, _tcAlias = []
|
||||
, _tcHelp = ""
|
||||
, _tcEffect = TerminalCommandEffectNone -- \_ _ -> NoArguments []
|
||||
}
|
||||
nullCommand =
|
||||
TerminalCommand
|
||||
{ _tcString = ""
|
||||
, _tcAlias = []
|
||||
, _tcHelp = ""
|
||||
, _tcEffect = TerminalCommandEffectNone -- \_ _ -> NoArguments []
|
||||
}
|
||||
|
||||
scrollRBOption :: Float -> World -> World
|
||||
scrollRBOption y w
|
||||
| y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w))-1) . (+1))
|
||||
| y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w)) -1) . (+ 1))
|
||||
| y > 0 = w & rbOptions . opSel %~ (max 0 . subtract 1)
|
||||
| otherwise = w
|
||||
|
||||
moveTweakSel :: Int -> World -> World
|
||||
moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of
|
||||
Just l -> w & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w))
|
||||
. itTweaks . tweakSel %~ (`mod` length l) . subtract i
|
||||
Just l -> w & cWorld . hud . hudElement . subInventory . tweakInvSel . _Just %~ (`mod` length l) . subtract i
|
||||
_ -> w
|
||||
changeTweakParam :: Int -> World -> World
|
||||
changeTweakParam i w = w
|
||||
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w)) %~
|
||||
( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
|
||||
. doTweak (_tweakType params) x)
|
||||
where
|
||||
tweaks = _itTweaks . fromJust $ yourItem w
|
||||
params = _tweakParams tweaks IM.! paramid
|
||||
x = (_tweakVal params + i) `mod` _tweakMax params
|
||||
paramid = _tweakSel tweaks
|
||||
|
||||
changeTweakParam :: Maybe Int -> Int -> World -> World
|
||||
changeTweakParam mi i w = fromMaybe w $ do
|
||||
paramid <- mi
|
||||
params <- yourItem w ^? _Just . itTweaks . tweakParams . ix paramid
|
||||
let x = (_tweakVal params + i) `mod` _tweakMax params
|
||||
return $
|
||||
w & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w))
|
||||
%~ ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
|
||||
. doTweak (_tweakType params) x
|
||||
)
|
||||
|
||||
Reference in New Issue
Block a user