105 lines
4.1 KiB
Haskell
105 lines
4.1 KiB
Haskell
{- Functions that affect the world according to what pressed buttons are stored in a Set. -}
|
|
module Dodge.Update.UsingInput
|
|
( updateUsingInput
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Base.You
|
|
import Dodge.Creature.Impulse.UseItem
|
|
import Dodge.Terminal
|
|
import Dodge.InputFocus
|
|
import Dodge.Combine
|
|
import Dodge.Inventory
|
|
import Dodge.Inventory.Add
|
|
import Geometry
|
|
|
|
import ListHelp
|
|
import SDL
|
|
--import qualified Data.Set as S
|
|
import qualified Data.Map.Strict as M
|
|
import Control.Lens
|
|
|
|
updateUsingInput :: World -> World
|
|
updateUsingInput w = case _hudElement $ _hud w of
|
|
DisplayInventory subinv
|
|
-> updatePressedButtons subinv (_mouseButtons w) w
|
|
DisplayCarte
|
|
-> updatePressedButtonsCarte (_mouseButtons w) w
|
|
|
|
updatePressedButtons :: SubInventory -> M.Map MouseButton Bool -> World -> World
|
|
updatePressedButtons subinv pkeys w = case subinv of
|
|
NoSubInventory
|
|
| ButtonLeft `M.member` pkeys && w ^?! hammers . ix SubInvHam /= HammerUp
|
|
-> w & hammers . ix SubInvHam .~ HammerDown
|
|
| otherwise -> updatePressedButtons' pkeys w
|
|
CombineInventory mi
|
|
| pkeys ^? ix ButtonLeft == Just False
|
|
-> maybeexitcombine (maybe id doCombine mi w) & hammers . ix SubInvHam .~ HammerDown
|
|
DisplayTerminal tmid
|
|
| pkeys ^? ix ButtonLeft == Just False && inTermFocus w
|
|
-> doTerminalEffectLB (w ^?! terminals . ix tmid) w
|
|
& hammers . ix SubInvHam .~ HammerDown
|
|
| pkeys ^? ix ButtonLeft == Just False
|
|
-> w & terminals . ix tmid . tmInput . tiFocus %~ const True
|
|
& hammers . ix SubInvHam .~ HammerDown
|
|
_ | ButtonLeft `M.member` pkeys
|
|
-> w & hammers . ix SubInvHam .~ HammerDown
|
|
_ -> w
|
|
where
|
|
maybeexitcombine
|
|
| ButtonRight `M.member` _mouseButtons w = id
|
|
| otherwise = hud . hudElement .~ DisplayInventory NoSubInventory
|
|
|
|
updatePressedButtons' :: M.Map MouseButton Bool -> World -> World
|
|
updatePressedButtons' pkeys w
|
|
| isDown ButtonLeft && isDown ButtonRight && inTopInv
|
|
= useItem (you w) w & hammers . ix DoubleMouseHam .~ HammerDown
|
|
| isDown ButtonLeft && (inTopInv || _timeFlow w == RewindingLastFrame)
|
|
&& w ^?! hammers . ix DoubleMouseHam == HammerUp
|
|
= useLeftItem (_yourID w) w
|
|
| isDown ButtonLeft && (inTopInv || _timeFlow w == RewindingLastFrame)
|
|
= w & hammers . ix DoubleMouseHam .~ HammerDown
|
|
| isDown ButtonRight && inTopInv = w
|
|
| isDown ButtonMiddle
|
|
= w & cameraRot -~ rotation
|
|
& clickMousePos .~ _mousePos w
|
|
| isDown ButtonLeft = w & hammers . ix DoubleMouseHam .~ HammerDown
|
|
| otherwise = w
|
|
where
|
|
inTopInv = case _hudElement (_hud w) of
|
|
DisplayInventory NoSubInventory -> True
|
|
_ -> False
|
|
isDown but = but `M.member` pkeys
|
|
rotation = angleBetween (_mousePos w) (_clickMousePos 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 ^? ix i of
|
|
Nothing -> w
|
|
Just (is,it) -> -- set (hud . hudElement) (DisplayInventory NoSubInventory)
|
|
selectinv --enterCombineInv
|
|
. createPutItem it
|
|
$ foldr (rmInvItem yid) w (sort is)
|
|
where
|
|
yid = _yourID w
|
|
selectinv (Just i', w') = w' & creatures . ix yid . crInvSel .~ InvSel i' NoInvSelAction
|
|
selectinv (Nothing, w') = w'
|
|
|
|
|
|
updatePressedButtonsCarte :: M.Map MouseButton Bool -> World -> World
|
|
updatePressedButtonsCarte pkeys w
|
|
| isDown ButtonRight = w
|
|
& clickMousePos .~ _mousePos w
|
|
& hud . carteCenter %~ (-.- trans)
|
|
| isDown ButtonLeft = w
|
|
& clickMousePos .~ _mousePos w
|
|
& hud . carteRot -~ rot
|
|
& hud . carteZoom *~ czoom
|
|
| otherwise = w
|
|
where
|
|
isDown but = but `M.member` pkeys
|
|
rot = angleBetween (_mousePos w) (_clickMousePos w)
|
|
czoom = magV (_mousePos w) / magV (_clickMousePos w)
|
|
trans = rotateV (_carteRot (_hud w)) $ 1 / _carteZoom (_hud w) *.* (_mousePos w -.- _clickMousePos w)
|