Refactor, try to limit dependencies
This commit is contained in:
+132
-112
@@ -1,56 +1,59 @@
|
||||
{- Functions controlling the movement of the screen camera:
|
||||
{- Functions controlling the movement of the screen camera:
|
||||
'_cameraCenter', '_cameraZoom', _cameraRot';
|
||||
and the position that the character sees from: '_cameraViewFrom'. -}
|
||||
module Dodge.Update.Camera
|
||||
( updateCamera
|
||||
, farWallPoints
|
||||
, streamViewpoints
|
||||
, farWallDistDirection
|
||||
) where
|
||||
import Dodge.Zoning.Wall
|
||||
import Dodge.Data
|
||||
import Dodge.Base
|
||||
import Dodge.Equipment
|
||||
import Dodge.Creature.Test
|
||||
import Geometry
|
||||
--import Geometry.ConvexPoly
|
||||
import Dodge.GameRoom
|
||||
import LensHelp
|
||||
import Bound
|
||||
module Dodge.Update.Camera (
|
||||
updateCamera,
|
||||
farWallPoints,
|
||||
streamViewpoints,
|
||||
farWallDistDirection,
|
||||
) where
|
||||
|
||||
import Bound
|
||||
import Control.Monad
|
||||
import Data.Foldable
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe
|
||||
import Control.Monad
|
||||
import qualified Data.Set as Set
|
||||
import Dodge.Base
|
||||
import Dodge.Creature.Test
|
||||
import Dodge.Data.Universe
|
||||
import Dodge.Equipment
|
||||
import Dodge.GameRoom
|
||||
import Dodge.Zoning.Wall
|
||||
import Geometry
|
||||
import qualified IntMapHelp as IM
|
||||
import LensHelp
|
||||
import qualified SDL
|
||||
--import Data.Monoid
|
||||
--import Data.Semigroup
|
||||
import qualified Streaming.Prelude as S
|
||||
|
||||
import Streaming
|
||||
{- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers;
|
||||
import qualified Streaming.Prelude as S
|
||||
|
||||
{- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers;
|
||||
update where your avatar's view is from. -}
|
||||
updateCamera :: Universe -> Universe
|
||||
updateCamera uv = uv
|
||||
& over uvWorld (setViewDistance cfig )
|
||||
& moveZoomCamera
|
||||
& over uvWorld updateScopeZoom
|
||||
& over uvWorld (rotateCamera cfig )
|
||||
updateCamera uv =
|
||||
uv
|
||||
& over uvWorld (setViewDistance cfig)
|
||||
& moveZoomCamera
|
||||
& over uvWorld updateScopeZoom
|
||||
& over uvWorld (rotateCamera cfig)
|
||||
where
|
||||
cfig = _uvConfig uv
|
||||
|
||||
moveZoomCamera :: Universe -> Universe
|
||||
moveZoomCamera uv = uv
|
||||
& uvWorld . cWorld . cameraCenter .~ newcen
|
||||
& uvWorld . cWorld . cameraViewFrom .~ newvf
|
||||
& uvWorld . cWorld . cameraZoom .~ newzoom
|
||||
& uvWorld . cWorld . defaultZoom .~ newDefaultZoom
|
||||
& uvWorld . cWorld . itemZoom .~ newItemZoom
|
||||
where
|
||||
moveZoomCamera uv =
|
||||
uv
|
||||
& uvWorld . cWorld . cameraCenter .~ newcen
|
||||
& uvWorld . cWorld . cameraViewFrom .~ newvf
|
||||
& uvWorld . cWorld . cameraZoom .~ newzoom
|
||||
& uvWorld . cWorld . defaultZoom .~ newDefaultZoom
|
||||
& uvWorld . cWorld . itemZoom .~ newItemZoom
|
||||
where
|
||||
cfig = _uvConfig uv
|
||||
w = _uvWorld uv
|
||||
cpos =_crPos (you w)
|
||||
cpos = _crPos (you w)
|
||||
newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset
|
||||
vfoffset = do
|
||||
iscam <- yourItem w ^? _Just . itScope . scopeIsCamera
|
||||
@@ -61,67 +64,72 @@ moveZoomCamera uv = uv
|
||||
guard (SDL.ButtonRight `M.member` _mouseButtons w)
|
||||
yourItem w ^? _Just . itScope . scopePos
|
||||
newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset
|
||||
offset = rotateV (_cameraRot (_cWorld w)) $ ((newzoom - newDefaultZoom)/(newDefaultZoom*newzoom)) *.* _mousePos w
|
||||
offset = rotateV (_cameraRot (_cWorld w)) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos w
|
||||
--newzoom = changeZoom (_cameraZoom w) idealZoom'
|
||||
newzoom = case yourItem w ^? _Just . itScope of
|
||||
Just zs@ZoomScope {} -> _scopeZoom zs
|
||||
Just zs@ZoomScope{} -> _scopeZoom zs
|
||||
_ -> newDefaultZoom * newItemZoom
|
||||
idealDefaultZoom = clipZoom wallZoom
|
||||
newDefaultZoom = case yourItem w ^? _Just . itScope of
|
||||
Just zs@ZoomScope {} -> _scopeZoom zs
|
||||
Just zs@ZoomScope{} -> _scopeZoom zs
|
||||
_ -> changeZoom (_defaultZoom (_cWorld w)) idealDefaultZoom
|
||||
idealItemZoom = fromMaybe 1 $ do
|
||||
guard $ crIsAiming (you w)
|
||||
zoomFromItem' <$> (yourItem w ^? _Just . itUse . useAim . aimZoom)
|
||||
zoomFromItem' <$> (yourItem w ^? _Just . itUse . heldAim . aimZoom)
|
||||
newItemZoom = changeZoom (_itemZoom (_cWorld w)) idealItemZoom
|
||||
changeZoom curZoom idealZoom
|
||||
| curZoom > idealZoom + 0.01 = ((zoomOutSpeed-1)*curZoom + idealZoom) / zoomOutSpeed
|
||||
| curZoom < idealZoom - 0.01 = ((zoomInSpeed -1)*curZoom + idealZoom) / zoomInSpeed
|
||||
| otherwise = idealZoom
|
||||
| curZoom > idealZoom + 0.01 = ((zoomOutSpeed -1) * curZoom + idealZoom) / zoomOutSpeed
|
||||
| curZoom < idealZoom - 0.01 = ((zoomInSpeed -1) * curZoom + idealZoom) / zoomInSpeed
|
||||
| otherwise = idealZoom
|
||||
--wallZoom = farWallDist newvf cfig w
|
||||
wallZoom = min4 (_boundDist (_cWorld w))
|
||||
min4 (a,b,c,d) = minimum [hh/maxd a,hh/maxd (-b),hw/maxd c,hw/maxd (-d)]
|
||||
min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)]
|
||||
maxd = max distFromEqmnt
|
||||
distFromEqmnt = foldr max 1 $ IM.mapMaybe (_eqViewDist . _eqEq. _itUse) $ getCrEquipment $ you w
|
||||
hw = halfWidth cfig
|
||||
distFromEqmnt = foldr max 1 $ IM.mapMaybe (_eeViewDist . _equipEffect . _itUse) $ getCrEquipment $ you w
|
||||
hw = halfWidth cfig
|
||||
hh = halfHeight cfig
|
||||
-- = maybe clipZoom zoomFromItem (yourItem w ^? itZoom) wallZoom
|
||||
-- = maybe clipZoom zoomFromItem (yourItem w ^? itZoom) wallZoom
|
||||
-- these speeds are inverted, larger means slower
|
||||
zoomInSpeed = 25
|
||||
zoomInSpeed = 25
|
||||
zoomOutSpeed = 15
|
||||
|
||||
|
||||
updateScopeZoom :: World -> World
|
||||
updateScopeZoom w
|
||||
| SDL.ButtonRight `M.member` _mouseButtons w
|
||||
= case w ^? cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0))
|
||||
. itScope . scopeZoomChange of
|
||||
Just x
|
||||
| x > 10 -> zoomInLongGun $ zoomInLongGun $ zoomInLongGun w
|
||||
| x > 5 -> zoomInLongGun $ zoomInLongGun w
|
||||
| x > 0 -> zoomInLongGun w
|
||||
| x < -10 -> zoomOutLongGun $ zoomOutLongGun $ zoomOutLongGun w
|
||||
| x < -5 -> zoomOutLongGun $ zoomOutLongGun w
|
||||
| x < 0 -> zoomOutLongGun w
|
||||
| otherwise -> w
|
||||
_ -> w
|
||||
| otherwise = w & cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0))
|
||||
. itScope %~ updateScope
|
||||
where
|
||||
updateScopeZoom w
|
||||
| SDL.ButtonRight `M.member` _mouseButtons w =
|
||||
case w
|
||||
^? cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0))
|
||||
. itScope
|
||||
. scopeZoomChange of
|
||||
Just x
|
||||
| x > 10 -> zoomInLongGun $ zoomInLongGun $ zoomInLongGun w
|
||||
| x > 5 -> zoomInLongGun $ zoomInLongGun w
|
||||
| x > 0 -> zoomInLongGun w
|
||||
| x < -10 -> zoomOutLongGun $ zoomOutLongGun $ zoomOutLongGun w
|
||||
| x < -5 -> zoomOutLongGun $ zoomOutLongGun w
|
||||
| x < 0 -> zoomOutLongGun w
|
||||
| otherwise -> w
|
||||
_ -> w
|
||||
| otherwise =
|
||||
w
|
||||
& cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0))
|
||||
. itScope
|
||||
%~ updateScope
|
||||
where
|
||||
updateScope (ZoomScope _ _ _ defz bl) = ZoomScope (V2 0 0) 0 defz defz bl
|
||||
updateScope otherAtt = otherAtt
|
||||
|
||||
zoomSpeed :: Float
|
||||
zoomSpeed = 39/40
|
||||
zoomSpeed = 39 / 40
|
||||
|
||||
zoomInLongGun :: World -> World
|
||||
zoomInLongGun w
|
||||
| currentZoom < 8 = w
|
||||
& wpPointer . itScope . scopePos .+.+~ (1-zoomSpeed) / newzoom *.* mousep
|
||||
& wpPointer . itScope . scopeZoom %~ (/ zoomSpeed)
|
||||
& decreaseScopeZoomChange
|
||||
zoomInLongGun w
|
||||
| currentZoom < 8 =
|
||||
w
|
||||
& wpPointer . itScope . scopePos .+.+~ (1 - zoomSpeed) / newzoom *.* mousep
|
||||
& wpPointer . itScope . scopeZoom %~ (/ zoomSpeed)
|
||||
& decreaseScopeZoomChange
|
||||
| otherwise = w & wpPointer . itScope . scopeZoomChange .~ 0
|
||||
where
|
||||
where
|
||||
decreaseScopeZoomChange = wpPointer . itScope . scopeZoomChange -~ 1
|
||||
wpPointer = cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0))
|
||||
wp = _crInv (_creatures (_cWorld w) IM.! 0) IM.! crSel (_creatures (_cWorld w) IM.! 0)
|
||||
@@ -130,14 +138,15 @@ zoomInLongGun w
|
||||
mousep = rotateV (_cameraRot (_cWorld w)) $ _mousePos w
|
||||
|
||||
zoomOutLongGun :: World -> World
|
||||
zoomOutLongGun w
|
||||
| currentZoom > 0.5 = w
|
||||
-- & wpPointer . itScope . scopePos .+.+~ ((1*zoomSpeed-1)) / currentZoom *.* mousep
|
||||
& wpPointer . itScope . scopeZoom *~ zoomSpeed
|
||||
& increaseScopeZoomChange
|
||||
-- | otherwise = increaseScopeZoomChange w
|
||||
zoomOutLongGun w
|
||||
| currentZoom > 0.5 =
|
||||
w
|
||||
-- & wpPointer . itScope . scopePos .+.+~ ((1*zoomSpeed-1)) / currentZoom *.* mousep
|
||||
& wpPointer . itScope . scopeZoom *~ zoomSpeed
|
||||
& increaseScopeZoomChange
|
||||
-- | otherwise = increaseScopeZoomChange w
|
||||
| otherwise = w & wpPointer . itScope . scopeZoomChange .~ 0
|
||||
where
|
||||
where
|
||||
--mousep = rotateV (_cameraRot w) $ _mousePos w
|
||||
increaseScopeZoomChange = wpPointer . itScope . scopeZoomChange +~ 1
|
||||
wpPointer = cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0))
|
||||
@@ -146,16 +155,17 @@ zoomOutLongGun w
|
||||
|
||||
ifConfigWallRotate :: Configuration -> World -> World
|
||||
ifConfigWallRotate cfig w
|
||||
| _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `M.member` _mouseButtons w)
|
||||
= rotateToOverlappingWall w
|
||||
| _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `M.member` _mouseButtons w) =
|
||||
rotateToOverlappingWall w
|
||||
| otherwise = w
|
||||
|
||||
rotateToOverlappingWall :: World -> World
|
||||
rotateToOverlappingWall w = maybe
|
||||
id
|
||||
(doWallRotate . snd)
|
||||
(overlapCircWallsClosest p (_crRad cr + 5) (filter _wlRotateTo $ wlsNearPoint p w))
|
||||
w
|
||||
rotateToOverlappingWall w =
|
||||
maybe
|
||||
id
|
||||
(doWallRotate . snd)
|
||||
(overlapCircWallsClosest p (_crRad cr + 5) (filter _wlRotateTo $ wlsNearPoint p w))
|
||||
w
|
||||
where
|
||||
cr = you w
|
||||
p = _crPos (you w)
|
||||
@@ -164,24 +174,27 @@ doWallRotate :: Wall -> World -> World
|
||||
doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - _cameraRot (_cWorld w)
|
||||
where
|
||||
rotateUsing a
|
||||
| b - b' > 0.01 = w & cWorld . cameraRot +~ 0.01
|
||||
| b - b' > 0.01 = w & cWorld . cameraRot +~ 0.01
|
||||
| b - b' < negate 0.01 = w & cWorld . cameraRot -~ 0.01
|
||||
| otherwise = w
|
||||
| otherwise = w
|
||||
where
|
||||
--b = a * (2 / pi)
|
||||
b = a * (4 / pi)
|
||||
b' = fromIntegral (round b :: Int)
|
||||
|
||||
rotateCameraBy :: Float -> World -> World
|
||||
rotateCameraBy x w = w
|
||||
& cWorld . cameraRot +~ x
|
||||
& cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0))
|
||||
. itScope . scopePos %~ rotateV x
|
||||
rotateCameraBy x w =
|
||||
w
|
||||
& cWorld . cameraRot +~ x
|
||||
& cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0))
|
||||
. itScope
|
||||
. scopePos
|
||||
%~ rotateV x
|
||||
|
||||
rotateCamera :: Configuration -> World -> World
|
||||
rotateCamera cfig w
|
||||
| keyl && keyr = w
|
||||
| keyl = rotateCameraBy 0.025 w
|
||||
| keyl = rotateCameraBy 0.025 w
|
||||
| keyr = rotateCameraBy (-0.025) w
|
||||
| otherwise = ifConfigWallRotate cfig w
|
||||
where
|
||||
@@ -194,49 +207,56 @@ notAtTerminal w = isNothing $ w ^? cWorld . hud . hudElement . subInventory . te
|
||||
|
||||
--zoomCamBy :: Float -> World -> World
|
||||
--zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01}
|
||||
zoomFromItem'
|
||||
:: ItZoom
|
||||
-> Float
|
||||
zoomFromItem' ItZoom {_itZoomMax = zMax, _itZoomMin = zMin, _itZoomFac = zFac}
|
||||
= min zMax $ max zMin zFac
|
||||
zoomFromItem' ::
|
||||
ItZoom ->
|
||||
Float
|
||||
zoomFromItem' ItZoom{_itZoomMax = zMax, _itZoomMin = zMin, _itZoomFac = zFac} =
|
||||
min zMax $ max zMin zFac
|
||||
|
||||
clipZoom
|
||||
:: Float -- ^ Furthest viewable distance
|
||||
-> Float
|
||||
clipZoom ::
|
||||
-- | Furthest viewable distance
|
||||
Float ->
|
||||
Float
|
||||
clipZoom = min 20 . max 0.2
|
||||
|
||||
setViewDistance :: Configuration -> World -> World
|
||||
setViewDistance cfig w = w & cWorld . viewDistance
|
||||
.~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / _cameraZoom (_cWorld w)
|
||||
setViewDistance cfig w =
|
||||
w & cWorld . viewDistance
|
||||
.~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / _cameraZoom (_cWorld w)
|
||||
|
||||
-- .~ max (halfWidth cfig) (halfHeight cfig) / _cameraZoom w
|
||||
|
||||
streamViewpoints :: Monad m => Point2 -> World -> Stream (Of Point2) m ()
|
||||
{-# INLINE streamViewpoints #-}
|
||||
streamViewpoints p w = flip S.for (gameRoomViewpoints p)
|
||||
$ S.filter (pointInOrOnPolygon p . _grBound) $ S.each (_gameRooms (_cWorld w))
|
||||
streamViewpoints p w =
|
||||
flip S.for (gameRoomViewpoints p) $
|
||||
S.filter (pointInOrOnPolygon p . _grBound) $ S.each (_gameRooms (_cWorld w))
|
||||
|
||||
gameRoomViewpoints :: Monad m => Point2 -> GameRoom -> Stream (Of Point2) m ()
|
||||
gameRoomViewpoints p gr = S.each (_grViewpoints gr)
|
||||
<> S.map extend (S.each (_grViewpointsEx gr) <> S.map addDir (S.each $ _grLinkDirs gr))
|
||||
gameRoomViewpoints p gr =
|
||||
S.each (_grViewpoints gr)
|
||||
<> S.map extend (S.each (_grViewpointsEx gr) <> S.map addDir (S.each $ _grLinkDirs gr))
|
||||
where
|
||||
extend outp = p +.+ maxViewDistance *.* squashNormalizeV (outp -.- p)
|
||||
addDir a = p +.+ unitVectorAtAngle a
|
||||
|
||||
farWallDistDirection :: Point2 -> World -> Maybe (Float,Float,Float,Float)
|
||||
farWallDistDirection p w = boundPoints
|
||||
$ S.map f vps
|
||||
farWallDistDirection :: Point2 -> World -> Maybe (Float, Float, Float, Float)
|
||||
farWallDistDirection p w =
|
||||
boundPoints $
|
||||
S.map f vps
|
||||
where
|
||||
f q = (rotateV (negate $ _cameraRot (_cWorld w)) . (-.- p)) (foldl' findPoint q (wls q))
|
||||
wls q = filter wlIsOpaque $ wlsNearSeg p q w
|
||||
findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine
|
||||
vps = streamViewpoints p w
|
||||
|
||||
|
||||
extendedViewPoints :: Point2 -> [GameRoom] -> [Point2]
|
||||
extendedViewPoints p grs = map extend
|
||||
(concatMap _grViewpointsEx grs
|
||||
++ map addDir (concatMap _grLinkDirs grs)
|
||||
)
|
||||
extendedViewPoints p grs =
|
||||
map
|
||||
extend
|
||||
( concatMap _grViewpointsEx grs
|
||||
++ map addDir (concatMap _grLinkDirs grs)
|
||||
)
|
||||
where
|
||||
extend outp = p +.+ maxViewDistance *.* squashNormalizeV (outp -.- p)
|
||||
addDir a = p +.+ unitVectorAtAngle a
|
||||
|
||||
@@ -1,15 +1,18 @@
|
||||
module Dodge.Update.Cloud where
|
||||
|
||||
import Data.Foldable
|
||||
import Dodge.Data.World
|
||||
import Dodge.Zoning.Creature
|
||||
import Dodge.Data
|
||||
import Geometry.Vector3D
|
||||
import LensHelp
|
||||
import Data.Foldable
|
||||
|
||||
cloudPoisonDamage :: Cloud -> World -> World
|
||||
cloudPoisonDamage c w = w & dodamagesto (filter f $ crsNearPoint clpos w)
|
||||
where
|
||||
where
|
||||
dodamagesto :: [Creature] -> World -> World
|
||||
dodamagesto scrs mcrs = foldl' (flip doDam) mcrs scrs
|
||||
doDam cr = cWorld . creatures . ix (_crID cr) . crState . csDamage
|
||||
.:~ Damage POISONDAM 1 clpos clpos clpos NoDamageEffect
|
||||
doDam cr =
|
||||
cWorld . creatures . ix (_crID cr) . crState . csDamage
|
||||
.:~ Damage POISONDAM 1 clpos clpos clpos NoDamageEffect
|
||||
f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
|
||||
clpos = stripZ $ _clPos c
|
||||
|
||||
@@ -1,48 +1,48 @@
|
||||
{- Functions that affect the world according to what pressed buttons are stored in a Set. -}
|
||||
module Dodge.Update.UsingInput
|
||||
( updateUsingInput
|
||||
) where
|
||||
import Dodge.Terminal.LeftButton
|
||||
import Dodge.Data
|
||||
module Dodge.Update.UsingInput (
|
||||
updateUsingInput,
|
||||
) where
|
||||
|
||||
import Control.Lens
|
||||
import qualified Data.Map.Strict as M
|
||||
import Dodge.Base.You
|
||||
import Dodge.Creature.Impulse.UseItem
|
||||
import Dodge.InputFocus
|
||||
import Dodge.Combine
|
||||
import Dodge.Creature.Impulse.UseItem
|
||||
import Dodge.Data.World
|
||||
import Dodge.InputFocus
|
||||
import Dodge.Inventory
|
||||
import Dodge.Inventory.Add
|
||||
import Dodge.Terminal.LeftButton
|
||||
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 (_cWorld w) of
|
||||
DisplayInventory subinv
|
||||
-> updatePressedButtons subinv (_mouseButtons w) w
|
||||
DisplayCarte
|
||||
-> updatePressedButtonsCarte (_mouseButtons w) w
|
||||
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
|
||||
| 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
|
||||
| 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 ^?! cWorld . terminals . ix tmid) w
|
||||
& hammers . ix SubInvHam .~ HammerDown
|
||||
| pkeys ^? ix ButtonLeft == Just False
|
||||
-> w & cWorld . terminals . ix tmid . tmInput . tiFocus %~ const True
|
||||
& hammers . ix SubInvHam .~ HammerDown
|
||||
_ | ButtonLeft `M.member` pkeys
|
||||
-> w & hammers . ix SubInvHam .~ HammerDown
|
||||
| pkeys ^? ix ButtonLeft == Just False && inTermFocus w ->
|
||||
doTerminalEffectLB (w ^?! cWorld . terminals . ix tmid) w
|
||||
& hammers . ix SubInvHam .~ HammerDown
|
||||
| pkeys ^? ix ButtonLeft == Just False ->
|
||||
w & cWorld . terminals . ix tmid . tmInput . tiFocus %~ const True
|
||||
& hammers . ix SubInvHam .~ HammerDown
|
||||
_
|
||||
| ButtonLeft `M.member` pkeys ->
|
||||
w & hammers . ix SubInvHam .~ HammerDown
|
||||
_ -> w
|
||||
where
|
||||
maybeexitcombine
|
||||
@@ -50,55 +50,56 @@ updatePressedButtons subinv pkeys w = case subinv of
|
||||
| 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
|
||||
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 (_cWorld w)) w
|
||||
| isDown ButtonLeft && (inTopInv || _timeFlow w == RewindingLastFrame)
|
||||
= w & hammers . ix DoubleMouseHam .~ HammerDown
|
||||
&& w ^?! hammers . ix DoubleMouseHam == HammerUp =
|
||||
useLeftItem (_yourID (_cWorld w)) w
|
||||
| isDown ButtonLeft && (inTopInv || _timeFlow w == RewindingLastFrame) =
|
||||
w & hammers . ix DoubleMouseHam .~ HammerDown
|
||||
| isDown ButtonRight && inTopInv = w
|
||||
| isDown ButtonMiddle
|
||||
= w & cWorld . cameraRot -~ rotation
|
||||
& cWorld . clickMousePos .~ _mousePos w
|
||||
| isDown ButtonMiddle =
|
||||
w & cWorld . cameraRot -~ rotation
|
||||
& cWorld . clickMousePos .~ _mousePos w
|
||||
| isDown ButtonLeft = w & hammers . ix DoubleMouseHam .~ HammerDown
|
||||
| otherwise = w
|
||||
where
|
||||
where
|
||||
inTopInv = case _hudElement (_hud (_cWorld w)) of
|
||||
DisplayInventory NoSubInventory -> True
|
||||
_ -> False
|
||||
isDown but = but `M.member` pkeys
|
||||
rotation = angleBetween (_mousePos w) (_clickMousePos (_cWorld 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)
|
||||
Just (is, it) ->
|
||||
-- set (hud . hudElement) (DisplayInventory NoSubInventory)
|
||||
selectinv --enterCombineInv
|
||||
. createPutItem it
|
||||
$ foldr (rmInvItem yid) w (sort is)
|
||||
. createPutItem it
|
||||
$ foldr (rmInvItem yid) w (sort is)
|
||||
where
|
||||
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
|
||||
& cWorld . clickMousePos .~ _mousePos w
|
||||
& cWorld . hud . carteCenter %~ (-.- trans)
|
||||
| isDown ButtonLeft = w
|
||||
& cWorld . clickMousePos .~ _mousePos w
|
||||
& cWorld . hud . carteRot -~ rot
|
||||
& cWorld . hud . carteZoom *~ czoom
|
||||
updatePressedButtonsCarte pkeys w
|
||||
| isDown ButtonRight =
|
||||
w
|
||||
& cWorld . clickMousePos .~ _mousePos w
|
||||
& cWorld . hud . carteCenter %~ (-.- trans)
|
||||
| isDown ButtonLeft =
|
||||
w
|
||||
& cWorld . clickMousePos .~ _mousePos w
|
||||
& cWorld . hud . carteRot -~ rot
|
||||
& cWorld . hud . carteZoom *~ czoom
|
||||
| otherwise = w
|
||||
where
|
||||
where
|
||||
isDown but = but `M.member` pkeys
|
||||
rot = angleBetween (_mousePos w) (_clickMousePos (_cWorld w))
|
||||
rot = angleBetween (_mousePos w) (_clickMousePos (_cWorld w))
|
||||
czoom = magV (_mousePos w) / magV (_clickMousePos (_cWorld w))
|
||||
trans = rotateV (_carteRot (_hud (_cWorld w))) $ 1 / _carteZoom (_hud (_cWorld w)) *.* (_mousePos w -.- _clickMousePos (_cWorld w))
|
||||
|
||||
@@ -1,15 +1,16 @@
|
||||
module Dodge.Update.WallDamage where
|
||||
import Dodge.Wall.Damage
|
||||
import Dodge.Data
|
||||
|
||||
import qualified IntMapHelp as IM
|
||||
import Control.Lens
|
||||
import Data.Maybe
|
||||
import Dodge.Data.World
|
||||
import Dodge.Wall.Damage
|
||||
import qualified IntMapHelp as IM
|
||||
|
||||
updateWallDamages :: World -> World
|
||||
updateWallDamages w = w
|
||||
& cWorld . wallDamages .~ IM.empty
|
||||
& flip (IM.foldrWithKey f) (_wallDamages (_cWorld w))
|
||||
updateWallDamages w =
|
||||
w
|
||||
& cWorld . wallDamages .~ IM.empty
|
||||
& flip (IM.foldrWithKey f) (_wallDamages (_cWorld w))
|
||||
where
|
||||
f k dams w' = fromMaybe w' $ do
|
||||
wl <- w' ^? cWorld . walls . ix k
|
||||
|
||||
Reference in New Issue
Block a user