253 lines
9.5 KiB
Haskell
253 lines
9.5 KiB
Haskell
{- 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.Data
|
|
import Dodge.Base
|
|
import Dodge.Zone
|
|
import Dodge.Equipment
|
|
import Dodge.Creature.Test
|
|
import Geometry
|
|
--import Geometry.ConvexPoly
|
|
import Dodge.GameRoom
|
|
import LensHelp
|
|
|
|
import qualified Data.Map.Strict as M
|
|
--import qualified Data.List.NonEmpty as NEL
|
|
--import Control.Applicative
|
|
--import Data.Foldable
|
|
import Data.Maybe
|
|
import Control.Monad
|
|
import qualified Data.Set as Set
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified SDL
|
|
--import Data.Monoid
|
|
--import Data.Semigroup
|
|
import qualified Control.Foldl as L
|
|
import qualified Streaming.Prelude as S
|
|
import Streaming
|
|
{- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers;
|
|
update where your avatar's view is from. -}
|
|
updateCamera :: Configuration -> World -> World
|
|
updateCamera cfig = setViewDistance cfig
|
|
. moveZoomCamera cfig
|
|
. updateScopeZoom
|
|
. rotateCamera cfig
|
|
|
|
moveZoomCamera :: Configuration -> World -> World
|
|
moveZoomCamera cfig w = w
|
|
& cameraCenter .~ newcen
|
|
& cameraViewFrom .~ newvf
|
|
& cameraZoom .~ newzoom
|
|
& defaultZoom .~ newDefaultZoom
|
|
& itemZoom .~ newItemZoom
|
|
where
|
|
cpos =_crPos (you w)
|
|
newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset
|
|
vfoffset = do
|
|
iscam <- yourItem w ^? _Just . itScope . scopeIsCamera
|
|
guard iscam
|
|
guard (SDL.ButtonRight `M.member` _mouseButtons w)
|
|
yourItem w ^? _Just . itScope . scopePos
|
|
mscopeoffset = do
|
|
guard (SDL.ButtonRight `M.member` _mouseButtons w)
|
|
yourItem w ^? _Just . itScope . scopePos
|
|
newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset
|
|
offset = rotateV (_cameraRot w) $ ((newzoom - newDefaultZoom)/(newDefaultZoom*newzoom)) *.* _mousePos w
|
|
--newzoom = changeZoom (_cameraZoom w) idealZoom'
|
|
newzoom = case yourItem w ^? _Just . itScope of
|
|
Just zs@ZoomScope {} -> _scopeZoom zs
|
|
_ -> newDefaultZoom * newItemZoom
|
|
idealDefaultZoom = clipZoom wallZoom
|
|
newDefaultZoom = case yourItem w ^? _Just . itScope of
|
|
Just zs@ZoomScope {} -> _scopeZoom zs
|
|
_ -> changeZoom (_defaultZoom w) idealDefaultZoom
|
|
idealItemZoom = fromMaybe 1 $ do
|
|
guard $ crIsAiming (you w)
|
|
zoomFromItem' <$> (yourItem w ^? _Just . itUse . useAim . aimZoom)
|
|
newItemZoom = changeZoom (_itemZoom 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)
|
|
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
|
|
hh = halfHeight cfig
|
|
-- = maybe clipZoom zoomFromItem (yourItem w ^? itZoom) wallZoom
|
|
-- these speeds are inverted, larger means slower
|
|
zoomInSpeed = 25
|
|
zoomOutSpeed = 15
|
|
|
|
|
|
updateScopeZoom :: World -> World
|
|
updateScopeZoom w
|
|
| SDL.ButtonRight `M.member` _mouseButtons w
|
|
= case w ^? creatures . ix 0 . crInv . ix (crSel (_creatures 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 & creatures . ix 0 . crInv . ix (crSel (_creatures 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
|
|
|
|
zoomInLongGun :: World -> World
|
|
zoomInLongGun w
|
|
| currentZoom < 8 = w
|
|
& wpPointer . itScope . scopePos .+.+~ (1-zoomSpeed) / newzoom *.* mousep
|
|
& wpPointer . itScope . scopeZoom %~ (/ zoomSpeed)
|
|
& decreaseScopeZoomChange
|
|
| 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)
|
|
Just currentZoom = wp ^? itScope . scopeZoom
|
|
newzoom = (wp ^?! itScope . scopeZoom) / zoomSpeed
|
|
mousep = rotateV (_cameraRot 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
|
|
| otherwise = w & wpPointer . itScope . scopeZoomChange .~ 0
|
|
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)
|
|
Just currentZoom = wp ^? itScope . scopeZoom
|
|
|
|
ifConfigWallRotate :: Configuration -> World -> World
|
|
ifConfigWallRotate cfig 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) (S.filter _wlRotateTo $ wallsNearPoint p w))
|
|
w
|
|
where
|
|
cr = you w
|
|
p = _crPos (you w)
|
|
|
|
doWallRotate :: Wall -> World -> World
|
|
doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - _cameraRot w
|
|
where
|
|
rotateUsing a
|
|
| b - b' > 0.01 = w & cameraRot +~ 0.01
|
|
| b - b' < negate 0.01 = w & cameraRot -~ 0.01
|
|
| otherwise = w
|
|
where
|
|
--b = a * (2 / pi)
|
|
b = a * (4 / pi)
|
|
b' = fromIntegral (round b :: Int)
|
|
|
|
rotateCameraBy :: Float -> World -> World
|
|
rotateCameraBy x w = w
|
|
& cameraRot +~ x
|
|
& creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0))
|
|
. itScope . scopePos %~ rotateV x
|
|
|
|
rotateCamera :: Configuration -> World -> World
|
|
rotateCamera cfig w
|
|
| keyl && keyr = w
|
|
| keyl = rotateCameraBy 0.025 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
|
|
|
|
-- TODO check where/how this is used
|
|
notAtTerminal :: World -> Bool
|
|
notAtTerminal w = isNothing $ w ^? hud . hudElement . subInventory . termID
|
|
|
|
--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
|
|
|
|
clipZoom
|
|
:: Float -- ^ Furthest viewable distance
|
|
-> Float
|
|
clipZoom = min 20 . max 0.2
|
|
|
|
setViewDistance :: Configuration -> World -> World
|
|
setViewDistance cfig w = w & viewDistance
|
|
.~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / _cameraZoom 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)
|
|
|
|
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))
|
|
where
|
|
extend outp = p +.+ maxViewDistance *.* squashNormalizeV (outp -.- p)
|
|
addDir a = p +.+ unitVectorAtAngle a
|
|
|
|
farWallDistDirection :: Point2 -> World -> (Maybe Float,Maybe Float,Maybe Float,Maybe Float)
|
|
farWallDistDirection p w = runIdentity $ L.purely S.fold_ ((,,,)
|
|
<$> L.premap (^?! _2) L.maximum
|
|
<*> L.premap (^?! _2) L.minimum
|
|
<*> L.premap (^?! _1) L.maximum
|
|
<*> L.premap (^?! _1) L.minimum
|
|
)
|
|
$ S.map f vps
|
|
where
|
|
f q = runIdentity (S.fold_ findPoint q (rotateV (negate $ _cameraRot w) . (-.- p)) (wls q))
|
|
wls q = S.filter wlIsOpaque $ wallsAlongLine 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)
|
|
)
|
|
where
|
|
extend outp = p +.+ maxViewDistance *.* squashNormalizeV (outp -.- p)
|
|
addDir a = p +.+ unitVectorAtAngle a
|
|
|
|
farWallPoints :: Point2 -> World -> [Point2]
|
|
farWallPoints p w = concatMap _grViewpoints grs ++ extendedViewPoints p grs
|
|
where
|
|
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
|
|
|
|
maxViewDistance :: Float
|
|
maxViewDistance = 800
|