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