273 lines
9.4 KiB
Haskell
273 lines
9.4 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
{- 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,
|
|
) where
|
|
|
|
import NewInt
|
|
import Dodge.Update.Camera.Rotate
|
|
import Linear.V3
|
|
import Dodge.Creature.Radius
|
|
import Bound
|
|
import Control.Monad
|
|
import Data.Foldable
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Maybe
|
|
import Dodge.Base
|
|
import Dodge.Creature.Test
|
|
import Dodge.Data.Config
|
|
import Dodge.Data.World
|
|
import Dodge.SmoothScroll
|
|
import Dodge.Viewpoints
|
|
import Dodge.WASD
|
|
import Dodge.Zoning.Wall
|
|
import Geometry
|
|
import LensHelp
|
|
import SDL (MouseButton (..))
|
|
import qualified SDL
|
|
import qualified Data.IntMap.Strict as IM
|
|
|
|
{- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers;
|
|
update where your avatar's view is from. -}
|
|
updateCamera :: Config -> World -> World
|
|
updateCamera cfig w = case w ^. wCam . camControl of
|
|
CamInGame{} -> updateInGameCamera cfig w
|
|
CamFloat -> updateFloatingCamera cfig w
|
|
|
|
updateFloatingCamera :: Config -> World -> World
|
|
updateFloatingCamera cfig w =
|
|
w
|
|
& updateBounds cfig
|
|
& wCam %~ setViewDistance cfig
|
|
& wCam %~ translateFloatingCamera theinput
|
|
& rotateCamera cfig
|
|
& wCam %~ translateFloatingCameraKeys theinput
|
|
& wCam %~ zoomFloatingCamera theinput
|
|
where
|
|
theinput = w ^. input
|
|
|
|
translateFloatingCamera :: Input -> Camera -> Camera
|
|
translateFloatingCamera _ cam = cam -- fromMaybe cam $ do
|
|
---- lpresstime <- theinput ^. mouseButtons . at ButtonLeft
|
|
-- _ <- theinput ^. mouseButtons . at ButtonRight
|
|
---- guard (theinput ^. mouseButtons . at ButtonRight == Nothing)
|
|
---- if lpresstime > rpresstime
|
|
---- then do
|
|
-- hpos <- theinput ^? heldPos . ix ButtonRight
|
|
-- let thetran =
|
|
-- screenToWorldPos cam hpos
|
|
-- -.- screenToWorldPos cam (theinput ^. mousePos)
|
|
-- return $
|
|
-- cam & camCenter +~ thetran
|
|
-- & camViewFrom +~ thetran
|
|
---- else do
|
|
---- a <- theinput ^. heldPos . at SDL.ButtonRight
|
|
---- return $ cam & camRot -~ angleBetween (theinput ^. mousePos) a
|
|
|
|
translateFloatingCameraKeys :: Input -> Camera -> Camera
|
|
translateFloatingCameraKeys theinput cam =
|
|
cam
|
|
& camCenter -~ x
|
|
& camViewFrom -~ y
|
|
where
|
|
x = rotateV (cam ^. camRot) $ negate 10 *.* wasdDir theinput
|
|
y | SDL.ScancodeLShift `M.member` (theinput ^. pressedKeys) = 0
|
|
| otherwise = x
|
|
|
|
zoomFloatingCamera :: Input -> Camera -> Camera
|
|
zoomFloatingCamera theinput
|
|
| ButtonRight `M.member` (theinput ^. mouseButtons) =
|
|
camZoom *~ ((39 / 40) ^^ negate (getSmoothScrollValue theinput))
|
|
| otherwise = id
|
|
|
|
-- the 39/40 is taken from zoomSpeed
|
|
|
|
updateInGameCamera :: Config -> World -> World
|
|
updateInGameCamera cfig w =
|
|
w
|
|
& updateBounds cfig
|
|
& wCam %~ moveZoomCamera cfig (w ^. input) (you w) w
|
|
& rotateCamera cfig
|
|
& over wCam (setViewDistance cfig) -- I think this should be updated after the zoom?
|
|
|
|
moveZoomCamera :: Config -> Input -> Creature -> World -> Camera -> Camera
|
|
moveZoomCamera cfig theinput cr w campos =
|
|
campos
|
|
& camCenter .~ fromMaybe (cr ^. crPos . _xy +.+ offset) mremotepos
|
|
& camViewFrom .~ fromMaybe (cr ^. crPos . _xy) mremotepos
|
|
& camZoom .~ newzoom
|
|
& camDefaultZoom .~ newDefaultZoom
|
|
& camItemZoom .~ newItemZoom
|
|
where
|
|
mremotepos = do
|
|
Sel 0 i <- w^?hud .diSelection._Just
|
|
itid <- cr ^? crInv . ix (NInt i)
|
|
j <- w ^? cWorld . lWorld . items . ix itid . itUse . uaParams . apProjectiles . ix 0
|
|
guard $ Just REMOTESCREEN == w ^? cWorld . lWorld . items . ix itid . itType . ibtAttach
|
|
w ^? cWorld . lWorld . projectiles . ix j . pjPos . _xy
|
|
docamrot = rotateV (campos ^. camRot)
|
|
offset = fromMaybe noscopeoffset $ do
|
|
guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
|
|
Sel 0 i <- w^?hud.diSelection._Just
|
|
itid <- cr ^? crInv . ix (NInt i)
|
|
fmap docamrot (w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticPos)
|
|
noscopeoffset =
|
|
docamrot $
|
|
((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
|
|
newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do
|
|
Sel 0 i <- w^?hud .diSelection._Just
|
|
itid <- cr ^? crInv . ix (NInt i)
|
|
w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom
|
|
idealDefaultZoom = clipZoom wallZoom
|
|
newDefaultZoom = fromMaybe (changeZoom (campos ^. camDefaultZoom) idealDefaultZoom) $ do
|
|
Sel 0 i <- w^?hud .diSelection._Just
|
|
itid <- cr ^? crInv . ix (NInt i)
|
|
w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom
|
|
idealItemZoom = fromMaybe 1 $ do
|
|
guard $ crIsAiming cr
|
|
Sel 0 i <- w^?hud .diSelection._Just
|
|
itid <- cr ^? crInv . ix (NInt i)
|
|
getAimZoom <$> (w ^? cWorld . lWorld . items . ix itid)
|
|
newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom
|
|
changeZoom curZoom idealZoom
|
|
| curZoom > 1.01 * idealZoom
|
|
= ((zoomOutSpeed -1) * curZoom + (0.99*idealZoom)) / zoomOutSpeed
|
|
| curZoom < 0.99 * idealZoom
|
|
= ((zoomInSpeed -1) * curZoom + (1.01*idealZoom)) / zoomInSpeed
|
|
| otherwise = idealZoom
|
|
wallZoom = min4 (f (campos ^. camBoundDist))
|
|
f (a,b,c,d) = (a+bordersize,b-bordersize,c+bordersize,d-bordersize)
|
|
bordersize = 20
|
|
min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)]
|
|
maxd = max distFromEqmnt
|
|
distFromEqmnt = viewDistanceFromItems cr
|
|
--distFromEqmnt = foldl' max 1 $ IM.mapMaybe (_eeViewDist . _uequipEffect . _itUse) $ getCrEquipment cr
|
|
hw = halfWidth cfig
|
|
hh = halfHeight cfig
|
|
-- these speeds are inverted, larger means slower
|
|
zoomInSpeed = 25
|
|
zoomOutSpeed = 15
|
|
|
|
getAimZoom :: Item -> Float
|
|
getAimZoom itm = case itm ^. itType of
|
|
HELD hit -> heldAimZoom hit
|
|
LASER -> 1.5
|
|
_ -> 1
|
|
|
|
heldAimZoom :: HeldItemType -> Float
|
|
heldAimZoom = \case
|
|
BANGSTICK{} -> 1
|
|
REWINDER -> 1
|
|
TIMESTOPPER -> 1
|
|
TIMESCROLLER -> 1
|
|
PISTOL -> 1
|
|
MACHINEPISTOL -> 1
|
|
AUTOPISTOL -> 1
|
|
SMG -> 1
|
|
BANGCONE -> 1
|
|
BLUNDERBUSS -> 1.5
|
|
GRAPECANNON{} -> 1.5
|
|
MINIGUNX{} -> 1.5
|
|
VOLLEYGUN{} -> 1.5
|
|
RIFLE -> 1.5
|
|
ALTERIFLE -> 1.5
|
|
AUTORIFLE -> 1.5
|
|
BURSTRIFLE -> 1.5
|
|
BANGROD -> 1.5
|
|
ELEPHANTGUN -> 1.5
|
|
AMR -> 1.5
|
|
AUTOAMR -> 1.5
|
|
SNIPERRIFLE -> 0.5
|
|
FLAMESPITTER -> 1
|
|
FLAMETHROWER -> 1.5
|
|
FLAMETORRENT -> 1
|
|
FLAMEWALL -> 1
|
|
BLOWTORCH -> 1
|
|
TESLACOIL -> 1.5
|
|
TRACTORGUN -> 1.5
|
|
RLAUNCHER -> 1.5
|
|
RLAUNCHERX{} -> 1.5
|
|
GLAUNCHER -> 1.5
|
|
POISONSPRAYER -> 1
|
|
SHATTERGUN -> 1
|
|
LED -> 1
|
|
FLATSHIELD -> 1
|
|
KEYCARD {} -> 1
|
|
BLINKER -> 1
|
|
BLINKERUNSAFE -> 1
|
|
|
|
-- for example, this should be 400 or so when you have an unsafe blink gun
|
|
-- capable of firing, should be expanded when you have a radar of some sort, etc
|
|
viewDistanceFromItems :: Creature -> Float
|
|
viewDistanceFromItems _ = 1
|
|
|
|
rotateCamera :: Config -> World -> World
|
|
rotateCamera cfig w
|
|
| MouseGameRotate {} <- w ^. input . mouseContext
|
|
, Just rotation <-
|
|
angleBetween (w ^. input . mousePos)
|
|
<$> (w ^. input . heldPos . at SDL.ButtonRight) =
|
|
w & wCam . camRot -~ rotation
|
|
& input . inputMemory .~ WasMouseGameRotating
|
|
| _gameplay_rotate_to_wall cfig
|
|
, WasNotMouseGameRotating <- w ^. input . inputMemory
|
|
, isNothing $ w ^? input . mouseButtons . ix SDL.ButtonRight =
|
|
rotateToOverlappingWall w
|
|
| otherwise = w
|
|
|
|
rotateToOverlappingWall :: World -> World
|
|
rotateToOverlappingWall w =
|
|
maybe
|
|
id
|
|
(doWallRotate . snd)
|
|
(overlapCircWallsClosest p r (filter _wlRotateTo . IM.elems $ wlsNearCirc p r w))
|
|
w
|
|
where
|
|
r = crRad (cr ^. crType) + 10
|
|
cr = you w
|
|
p = you w ^. crPos . _xy
|
|
|
|
doWallRotate :: Wall -> World -> World
|
|
doWallRotate = rotateTo8 . argV . uncurry (-) . _wlLine
|
|
|
|
clipZoom ::
|
|
-- | Furthest viewable distance
|
|
Float ->
|
|
Float
|
|
clipZoom = min 20 . max 0.2
|
|
|
|
setViewDistance :: Config -> Camera -> Camera
|
|
setViewDistance cfig w =
|
|
w & camViewDistance
|
|
.~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. camZoom)
|
|
|
|
farWallDistDirection :: Point2 -> World -> Maybe (Float, Float, Float, Float)
|
|
farWallDistDirection p w = boundPoints $ map f $ getViewpoints p (_cWorld w)
|
|
where
|
|
f q = (rotateV (negate (w ^. wCam . camRot)) . (-.- p)) (foldl' findPoint q (wls q))
|
|
wls q = filter wlIsOpaque . IM.elems $ wlsNearSeg p q w
|
|
findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine
|
|
|
|
findBoundDists :: Config -> World -> (Float, Float, Float, Float)
|
|
findBoundDists cfig w
|
|
| debugOn Bound_box_screen cfig = (hh, - hh, hw, - hw)
|
|
| otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. wCam . camViewFrom) w
|
|
where
|
|
hw = halfWidth cfig
|
|
hh = halfHeight cfig
|
|
|
|
-- this probably doesn't need to be updated every frame,
|
|
-- though I'm not sure how often it should be updated
|
|
updateBounds :: Config -> World -> World
|
|
updateBounds cfig w = case (w ^. cWorld . cClock) `mod` 5 of
|
|
0 ->
|
|
w
|
|
& wCam . camBoundDist .~ bdists
|
|
& wCam . camBoundBox
|
|
.~ map ((+.+ w ^. wCam . camCenter) . rotateV (w ^. wCam . camRot)) (rectNSWE n s w' e)
|
|
_ -> w
|
|
where
|
|
bdists@(n, s, e, w') = findBoundDists cfig w
|