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

Refactor, try to limit dependencies

Browse Source
This commit is contained in:
justin
2022-07-28 00:59:56 +01:00
parent 8aa5c17ab9
commit 160560af5f
418 changed files with 15104 additions and 13342 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update/Camera.hs
+132 -112
View File
@@ -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