justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Separate out concrete part of world

Browse Source
This commit is contained in:
justin
2022-07-25 12:10:50 +01:00
parent 3354d108be
commit b2efbd2b3e
134 changed files with 933 additions and 930 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update/Camera.hs
+33 -33
View File
@@ -42,11 +42,11 @@ updateCamera uv = uv
moveZoomCamera :: Universe -> Universe
moveZoomCamera uv = uv
& uvWorld . cameraCenter .~ newcen
& uvWorld . cameraViewFrom .~ newvf
& uvWorld . cameraZoom .~ newzoom
& uvWorld . defaultZoom .~ newDefaultZoom
& uvWorld . itemZoom .~ newItemZoom
& 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
@@ -55,13 +55,13 @@ moveZoomCamera uv = uv
vfoffset = do
iscam <- yourItem w ^? _Just . itScope . scopeIsCamera
guard iscam
guard (SDL.ButtonRight `M.member` _mouseButtons w)
guard (SDL.ButtonRight `M.member` _mouseButtons (_cWorld w))
yourItem w ^? _Just . itScope . scopePos
mscopeoffset = do
guard (SDL.ButtonRight `M.member` _mouseButtons w)
guard (SDL.ButtonRight `M.member` _mouseButtons (_cWorld w))
yourItem w ^? _Just . itScope . scopePos
newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset
offset = rotateV (_cameraRot w) $ ((newzoom - newDefaultZoom)/(newDefaultZoom*newzoom)) *.* _mousePos w
offset = rotateV (_cameraRot (_cWorld w)) $ ((newzoom - newDefaultZoom)/(newDefaultZoom*newzoom)) *.* _mousePos (_cWorld w)
--newzoom = changeZoom (_cameraZoom w) idealZoom'
newzoom = case yourItem w ^? _Just . itScope of
Just zs@ZoomScope {} -> _scopeZoom zs
@@ -69,17 +69,17 @@ moveZoomCamera uv = uv
idealDefaultZoom = clipZoom wallZoom
newDefaultZoom = case yourItem w ^? _Just . itScope of
Just zs@ZoomScope {} -> _scopeZoom zs
_ -> changeZoom (_defaultZoom w) idealDefaultZoom
_ -> changeZoom (_defaultZoom (_cWorld w)) idealDefaultZoom
idealItemZoom = fromMaybe 1 $ do
guard $ crIsAiming (you w)
zoomFromItem' <$> (yourItem w ^? _Just . itUse . useAim . aimZoom)
newItemZoom = changeZoom (_itemZoom w) idealItemZoom
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
--wallZoom = farWallDist newvf cfig w
wallZoom = min4 (_boundDist w)
wallZoom = min4 (_boundDist (_cWorld w))
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
@@ -93,8 +93,8 @@ moveZoomCamera uv = uv
updateScopeZoom :: World -> World
updateScopeZoom w
| SDL.ButtonRight `M.member` _mouseButtons w
= case w ^? creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0))
| SDL.ButtonRight `M.member` _mouseButtons (_cWorld 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
@@ -105,7 +105,7 @@ updateScopeZoom w
| x < 0 -> zoomOutLongGun w
| otherwise -> w
_ -> w
| otherwise = w & creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0))
| 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
@@ -123,11 +123,11 @@ zoomInLongGun w
| otherwise = w & wpPointer . itScope . scopeZoomChange .~ 0
where
decreaseScopeZoomChange = wpPointer . itScope . scopeZoomChange -~ 1
wpPointer = creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0))
wp = _crInv (_creatures w IM.! 0) IM.! crSel (_creatures w IM.! 0)
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)
Just currentZoom = wp ^? itScope . scopeZoom
newzoom = (wp ^?! itScope . scopeZoom) / zoomSpeed
mousep = rotateV (_cameraRot w) $ _mousePos w
mousep = rotateV (_cameraRot (_cWorld w)) $ _mousePos (_cWorld w)
zoomOutLongGun :: World -> World
zoomOutLongGun w
@@ -140,13 +140,13 @@ zoomOutLongGun w
where
--mousep = rotateV (_cameraRot w) $ _mousePos w
increaseScopeZoomChange = wpPointer . itScope . scopeZoomChange +~ 1
wpPointer = creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0))
wp = _crInv (_creatures w IM.! 0) IM.! crSel (_creatures w IM.! 0)
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)
Just currentZoom = wp ^? itScope . scopeZoom
ifConfigWallRotate :: Configuration -> World -> World
ifConfigWallRotate cfig w
| _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `M.member` _mouseButtons w)
| _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `M.member` _mouseButtons (_cWorld w))
= rotateToOverlappingWall w
| otherwise = w
@@ -161,11 +161,11 @@ rotateToOverlappingWall w = maybe
p = _crPos (you w)
doWallRotate :: Wall -> World -> World
doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - _cameraRot w
doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - _cameraRot (_cWorld w)
where
rotateUsing a
| b - b' > 0.01 = w & cameraRot +~ 0.01
| b - b' < negate 0.01 = w & cameraRot -~ 0.01
| b - b' > 0.01 = w & cWorld . cameraRot +~ 0.01
| b - b' < negate 0.01 = w & cWorld . cameraRot -~ 0.01
| otherwise = w
where
--b = a * (2 / pi)
@@ -174,8 +174,8 @@ doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - _camer
rotateCameraBy :: Float -> World -> World
rotateCameraBy x w = w
& cameraRot +~ x
& creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0))
& cWorld . cameraRot +~ x
& cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0))
. itScope . scopePos %~ rotateV x
rotateCamera :: Configuration -> World -> World
@@ -185,12 +185,12 @@ rotateCamera cfig w
| keyr = rotateCameraBy (-0.025) w
| otherwise = ifConfigWallRotate cfig w
where
keyl = SDL.ScancodeQ `Set.member` _keys w && notAtTerminal w
keyr = SDL.ScancodeE `Set.member` _keys w && notAtTerminal w
keyl = SDL.ScancodeQ `Set.member` _keys (_cWorld w) && notAtTerminal w
keyr = SDL.ScancodeE `Set.member` _keys (_cWorld w) && notAtTerminal w
-- TODO check where/how this is used
notAtTerminal :: World -> Bool
notAtTerminal w = isNothing $ w ^? hud . hudElement . subInventory . termID
notAtTerminal w = isNothing $ w ^? cWorld . hud . hudElement . subInventory . termID
--zoomCamBy :: Float -> World -> World
--zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01}
@@ -206,14 +206,14 @@ clipZoom
clipZoom = min 20 . max 0.2
setViewDistance :: Configuration -> World -> World
setViewDistance cfig w = w & viewDistance
.~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / _cameraZoom 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 w)
$ 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)
@@ -226,7 +226,7 @@ farWallDistDirection :: Point2 -> World -> Maybe (Float,Float,Float,Float)
farWallDistDirection p w = boundPoints
$ S.map f vps
where
f q = (rotateV (negate $ _cameraRot w) . (-.- p)) (foldl' findPoint q (wls q))
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
@@ -244,7 +244,7 @@ extendedViewPoints p grs = map extend
farWallPoints :: Point2 -> World -> [Point2]
farWallPoints p w = concatMap _grViewpoints grs ++ extendedViewPoints p grs
where
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms (_cWorld w))
maxViewDistance :: Float
maxViewDistance = 800
src/Dodge/Update/Cloud.hs
+1 -1
View File
@@ -9,7 +9,7 @@ cloudPoisonDamage c w = w & dodamagesto (filter f $ crsNearPoint clpos w)
where
dodamagesto :: [Creature] -> World -> World
dodamagesto scrs mcrs = foldl' (flip doDam) mcrs scrs
doDam cr = creatures . ix (_crID cr) . crState . csDamage
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
src/Dodge/Update/UsingInput.hs
+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))
src/Dodge/Update/WallDamage.hs
+3 -3
View File
@@ -8,9 +8,9 @@ import Data.Maybe
updateWallDamages :: World -> World
updateWallDamages w = w
& wallDamages .~ IM.empty
& flip (IM.foldrWithKey f) (_wallDamages w)
& cWorld . wallDamages .~ IM.empty
& flip (IM.foldrWithKey f) (_wallDamages (_cWorld w))
where
f k dams w' = fromMaybe w' $ do
wl <- w' ^? walls . ix k
wl <- w' ^? cWorld . walls . ix k
return $ foldr (`damageWall` wl) w' dams