247 lines
8.8 KiB
Haskell
247 lines
8.8 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,
|
|
) where
|
|
|
|
import Bound
|
|
import Dodge.Viewpoints
|
|
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.Equipment
|
|
import Dodge.Zoning.Wall
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import LensHelp
|
|
import qualified SDL
|
|
|
|
{- 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 w =
|
|
w
|
|
& updateBounds cfig
|
|
& over (cWorld . camPos) (setViewDistance cfig)
|
|
& cWorld . camPos %~ moveZoomCamera cfig (w ^. input) (you w)
|
|
& updateScopeZoom
|
|
& rotateCamera cfig
|
|
|
|
moveZoomCamera :: Configuration -> Input -> Creature -> CamPos -> CamPos
|
|
moveZoomCamera cfig theinput cr campos =
|
|
campos
|
|
& camCenter .~ newcen
|
|
& camViewFrom .~ newvf
|
|
& camZoom .~ newzoom
|
|
& camDefaultZoom .~ newDefaultZoom
|
|
& camItemZoom .~ newItemZoom
|
|
where
|
|
cpos = _crPos cr
|
|
mitm = do
|
|
i <- cr ^? crInvSel . isel . ispItem
|
|
cr ^? crInv . ix i
|
|
newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset
|
|
vfoffset = do
|
|
iscam <- mitm ^? _Just . itScope . scopeIsCamera
|
|
guard iscam
|
|
guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
|
|
mitm ^? _Just . itScope . scopePos
|
|
mscopeoffset = do
|
|
guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
|
|
mitm ^? _Just . itScope . scopePos
|
|
newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset
|
|
offset = rotateV (campos ^. camRot)
|
|
$ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
|
|
newzoom = case mitm ^? _Just . itScope of
|
|
Just zs@ZoomScope{} -> _scopeZoom zs
|
|
_ -> newDefaultZoom * newItemZoom
|
|
idealDefaultZoom = clipZoom wallZoom
|
|
newDefaultZoom = case mitm ^? _Just . itScope of
|
|
Just zs@ZoomScope{} -> _scopeZoom zs
|
|
_ -> changeZoom (campos ^. camDefaultZoom) idealDefaultZoom
|
|
idealItemZoom = fromMaybe 1 $ do
|
|
guard $ crIsAiming cr
|
|
zoomFromItem <$> (mitm ^? _Just . itUse . heldAim . aimZoom)
|
|
newItemZoom = changeZoom (campos ^. camItemZoom) 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 = min4 (campos ^. camBoundDist)
|
|
min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)]
|
|
maxd = max distFromEqmnt
|
|
distFromEqmnt = foldl' max 1 $ IM.mapMaybe (_eeViewDist . _equipEffect . _itUse) $ getCrEquipment cr
|
|
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 = fromMaybe w $ do
|
|
i <- w ^? cWorld . lWorld . creatures . ix 0 . crInvSel . isel . ispItem
|
|
return $ updateScopeZoom' i w
|
|
|
|
updateScopeZoom' :: Int -> World -> World
|
|
updateScopeZoom' i w
|
|
| SDL.ButtonRight `M.member` _mouseButtons (_input w) = w & wppointer %~ doScopeZoom mp
|
|
| otherwise = w & wppointer %~ resetscope
|
|
where
|
|
wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itScope
|
|
resetscope (ZoomScope _ _ _ defz bl) = ZoomScope (V2 0 0) 0 defz defz bl
|
|
resetscope otherAtt = otherAtt
|
|
mp = rotateV (w ^. cWorld . camPos . camRot) $ _mousePos (_input w)
|
|
|
|
doScopeZoom :: Point2 -> Scope -> Scope
|
|
doScopeZoom mp sc = case sc ^? scopeZoomChange of
|
|
Just x
|
|
| x > 10 -> (zoomInLongGun mp . zoomInLongGun mp . zoomInLongGun mp) $ sc
|
|
& scopeZoomChange -~ 2
|
|
| x > 5 -> (zoomInLongGun mp . zoomInLongGun mp) $ sc
|
|
& scopeZoomChange -~ 1
|
|
| x > 0 -> zoomInLongGun mp $ sc
|
|
& scopeZoomChange -~ 1
|
|
| x < -10 -> (zoomOutLongGun . zoomOutLongGun . zoomOutLongGun) $ sc
|
|
& scopeZoomChange +~ 2
|
|
| x < -5 -> (zoomOutLongGun . zoomOutLongGun) $ sc
|
|
& scopeZoomChange +~ 1
|
|
| x < 0 -> zoomOutLongGun $ sc
|
|
& scopeZoomChange +~ 1
|
|
| otherwise -> sc
|
|
_ -> sc
|
|
|
|
zoomSpeed :: Float
|
|
zoomSpeed = 39 / 40
|
|
|
|
zoomInLongGun :: Point2 -> Scope -> Scope
|
|
zoomInLongGun mousep sc
|
|
| currentZoom < 8 =
|
|
sc
|
|
& scopePos .+.+~ (1 - zoomSpeed) / newzoom *.* mousep
|
|
& scopeZoom %~ (/ zoomSpeed)
|
|
| otherwise = sc & scopeZoomChange .~ 0
|
|
where
|
|
Just currentZoom = sc ^? scopeZoom
|
|
newzoom = (sc ^?! scopeZoom) / zoomSpeed
|
|
|
|
zoomOutLongGun :: Scope -> Scope
|
|
zoomOutLongGun sc
|
|
| currentzoom > 0.5 =
|
|
sc
|
|
& scopePos %~ (\p -> p +.+ (zoomSpeed-1) / currentzoom *.* p)
|
|
-- & scopePos .*.*~ 1 - ((newzoom * 2) ** zoomSpeed)
|
|
& scopeZoom *~ zoomSpeed
|
|
| otherwise = sc & scopeZoomChange .~ 0
|
|
& scopePos .~ V2 0 0
|
|
where
|
|
Just currentzoom = sc ^? scopeZoom
|
|
--newzoom = (sc ^?! scopeZoom) / zoomSpeed
|
|
|
|
ifConfigWallRotate :: Configuration -> World -> World
|
|
ifConfigWallRotate cfig w
|
|
| _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `M.member` _mouseButtons (_input 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
|
|
where
|
|
cr = you w
|
|
p = _crPos (you w)
|
|
|
|
doWallRotate :: Wall -> World -> World
|
|
doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. cWorld . camPos . camRot)
|
|
where
|
|
rotateUsing a
|
|
| b - b' > 0.01 = w & cWorld . camPos . camRot +~ 0.01
|
|
| b - b' < negate 0.01 = w & cWorld . camPos . camRot -~ 0.01
|
|
| otherwise = w
|
|
where
|
|
--b = a * (2 / pi)
|
|
b = a * (4 / pi)
|
|
b' = fromIntegral (round b :: Int)
|
|
|
|
rotateCameraBy :: Float -> CWorld -> CWorld
|
|
rotateCameraBy x w =
|
|
w
|
|
& camPos . camRot +~ x
|
|
& fromMaybe id (do
|
|
i <- w ^? lWorld . creatures . ix 0 . crInvSel . isel . ispItem
|
|
return $ lWorld . creatures . ix 0 . crInv . ix i
|
|
. itScope
|
|
. scopePos
|
|
%~ rotateV x
|
|
)
|
|
|
|
rotateCamera :: Configuration -> World -> World
|
|
rotateCamera cfig w
|
|
| keyl && keyr = w
|
|
| keyl = over cWorld (rotateCameraBy 0.025) w
|
|
| keyr = over cWorld (rotateCameraBy (-0.025)) w
|
|
| otherwise = ifConfigWallRotate cfig w
|
|
where
|
|
keyl = SDL.ScancodeQ `M.member` _pressedKeys (_input w) && notAtTerminal w
|
|
keyr = SDL.ScancodeE `M.member` _pressedKeys (_input 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{_izMax = zMax, _izMin = zMin, _izFac = zFac} =
|
|
min zMax $ max zMin zFac
|
|
|
|
clipZoom ::
|
|
-- | Furthest viewable distance
|
|
Float ->
|
|
Float
|
|
clipZoom = min 20 . max 0.2
|
|
|
|
setViewDistance :: Configuration -> CamPos -> CamPos
|
|
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 ^. cWorld . camPos . camRot)) . (-.- p)) (foldl' findPoint q (wls q))
|
|
wls q = filter wlIsOpaque $ wlsNearSeg p q w
|
|
findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine
|
|
|
|
findBoundDists :: Configuration -> 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 ^. cWorld . camPos . camCenter) w
|
|
| otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . camPos . camViewFrom) w
|
|
where
|
|
hw = halfWidth cfig
|
|
hh = halfHeight cfig
|
|
|
|
updateBounds :: Configuration -> World -> World
|
|
updateBounds cfig w =
|
|
w
|
|
& cWorld . camPos . camBoundDist .~ bdists
|
|
& cWorld . camPos . camBoundBox
|
|
.~ map ((+.+ w ^. cWorld . camPos . camCenter) . rotateV (w ^. cWorld . camPos . camRot)) (rectNSWE n s w' e)
|
|
where
|
|
bdists@(n, s, e, w') = findBoundDists cfig w
|