Separate out concrete part of world

This commit is contained in:
2022-07-25 12:10:50 +01:00
parent 3354d108be
commit b2efbd2b3e
134 changed files with 933 additions and 930 deletions
+34 -34
View File
@@ -19,57 +19,57 @@ import qualified Data.Map.Strict as M
import Control.Lens
updateUsingInput :: World -> World
updateUsingInput w = case _hudElement $ _hud w of
updateUsingInput w = case _hudElement $ _hud (_cWorld w) of
DisplayInventory subinv
-> updatePressedButtons subinv (_mouseButtons w) w
-> updatePressedButtons subinv (_mouseButtons (_cWorld w)) w
DisplayCarte
-> updatePressedButtonsCarte (_mouseButtons w) w
-> updatePressedButtonsCarte (_mouseButtons (_cWorld 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
| ButtonLeft `M.member` pkeys && w ^?! cWorld . hammers . ix SubInvHam /= HammerUp
-> w & cWorld . 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
-> maybeexitcombine (maybe id doCombine mi w) & cWorld . hammers . ix SubInvHam .~ HammerDown
DisplayTerminal tmid
| pkeys ^? ix ButtonLeft == Just False && inTermFocus w
-> doTerminalEffectLB (w ^?! terminals . ix tmid) w
& hammers . ix SubInvHam .~ HammerDown
-> doTerminalEffectLB (w ^?! cWorld . terminals . ix tmid) w
& cWorld . hammers . ix SubInvHam .~ HammerDown
| pkeys ^? ix ButtonLeft == Just False
-> w & terminals . ix tmid . tmInput . tiFocus %~ const True
& hammers . ix SubInvHam .~ HammerDown
-> w & cWorld . terminals . ix tmid . tmInput . tiFocus %~ const True
& cWorld . hammers . ix SubInvHam .~ HammerDown
_ | ButtonLeft `M.member` pkeys
-> w & hammers . ix SubInvHam .~ HammerDown
-> w & cWorld . hammers . ix SubInvHam .~ HammerDown
_ -> w
where
maybeexitcombine
| ButtonRight `M.member` _mouseButtons w = id
| otherwise = hud . hudElement .~ DisplayInventory NoSubInventory
| ButtonRight `M.member` _mouseButtons (_cWorld w) = id
| otherwise = cWorld . 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
= useItem (you w) w & cWorld . hammers . ix DoubleMouseHam .~ HammerDown
| isDown ButtonLeft && (inTopInv || _timeFlow (_cWorld w) == RewindingLastFrame)
&& w ^?! cWorld . hammers . ix DoubleMouseHam == HammerUp
= useLeftItem (_yourID (_cWorld w)) w
| isDown ButtonLeft && (inTopInv || _timeFlow (_cWorld w) == RewindingLastFrame)
= w & cWorld . hammers . ix DoubleMouseHam .~ HammerDown
| isDown ButtonRight && inTopInv = w
| isDown ButtonMiddle
= w & cameraRot -~ rotation
& clickMousePos .~ _mousePos w
| isDown ButtonLeft = w & hammers . ix DoubleMouseHam .~ HammerDown
= w & cWorld . cameraRot -~ rotation
& cWorld . clickMousePos .~ _mousePos (_cWorld w)
| isDown ButtonLeft = w & cWorld . hammers . ix DoubleMouseHam .~ HammerDown
| otherwise = w
where
inTopInv = case _hudElement (_hud w) of
inTopInv = case _hudElement (_hud (_cWorld w)) of
DisplayInventory NoSubInventory -> True
_ -> False
isDown but = but `M.member` pkeys
rotation = angleBetween (_mousePos w) (_clickMousePos w)
rotation = angleBetween (_mousePos (_cWorld w)) (_clickMousePos (_cWorld w))
-- note "sort" on the inventory indices; otherwise
@@ -82,23 +82,23 @@ doCombine i w = case combineItemListYou w ^? ix i of
. createPutItem it
$ foldr (rmInvItem yid) w (sort is)
where
yid = _yourID w
selectinv (Just i', w') = w' & creatures . ix yid . crInvSel .~ InvSel i' NoInvSelAction
yid = _yourID (_cWorld w)
selectinv (Just i', w') = w' & cWorld . 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)
& cWorld . clickMousePos .~ _mousePos (_cWorld w)
& cWorld . hud . carteCenter %~ (-.- trans)
| isDown ButtonLeft = w
& clickMousePos .~ _mousePos w
& hud . carteRot -~ rot
& hud . carteZoom *~ czoom
& cWorld . clickMousePos .~ _mousePos (_cWorld w)
& cWorld . hud . carteRot -~ rot
& cWorld . 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)
rot = angleBetween (_mousePos (_cWorld w)) (_clickMousePos (_cWorld w))
czoom = magV (_mousePos (_cWorld w)) / magV (_clickMousePos (_cWorld w))
trans = rotateV (_carteRot (_hud (_cWorld w))) $ 1 / _carteZoom (_hud (_cWorld w)) *.* (_mousePos (_cWorld w) -.- _clickMousePos (_cWorld w))