215 lines
8.0 KiB
Haskell
215 lines
8.0 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 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.InputFocus
|
|
import Dodge.SmoothScroll
|
|
import Dodge.Viewpoints
|
|
import Dodge.WASD
|
|
import Dodge.Zoning.Wall
|
|
import Geometry
|
|
--import qualified IntMapHelp as IM
|
|
import LensHelp
|
|
import SDL (MouseButton (..))
|
|
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 = case w ^. wCam . camControl of
|
|
CamInGame {} -> updateInGameCamera cfig w
|
|
CamFloat -> updateFloatingCamera cfig w
|
|
|
|
updateFloatingCamera :: Configuration -> World -> World
|
|
updateFloatingCamera cfig w =
|
|
w
|
|
& updateBounds cfig
|
|
& wCam %~ setViewDistance cfig
|
|
& wCam %~ translateFloatingCamera theinput
|
|
& wCam %~ translateFloatingCameraKeys theinput
|
|
& wCam %~ zoomFloatingCamera theinput
|
|
where
|
|
theinput = w ^. input
|
|
|
|
translateFloatingCamera :: Input -> Camera -> Camera
|
|
translateFloatingCamera theinput cam = fromMaybe cam $ do
|
|
presstime <- theinput ^. mouseButtons . at ButtonLeft
|
|
guard $ presstime > 0
|
|
hpos <- theinput ^? heldPos . ix ButtonLeft
|
|
let thetran =
|
|
screenToWorldPos cam hpos
|
|
-.- screenToWorldPos cam (theinput ^. mousePos)
|
|
return $
|
|
cam & camCenter +~ thetran
|
|
& camViewFrom +~ thetran
|
|
|
|
translateFloatingCameraKeys :: Input -> Camera -> Camera
|
|
translateFloatingCameraKeys theinput = (camCenter -~ thetran) . (camViewFrom -~ thetran)
|
|
where
|
|
thetran = 10 *.* wasdDir theinput
|
|
|
|
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 :: Configuration -> World -> World
|
|
updateInGameCamera cfig w =
|
|
w
|
|
& updateBounds cfig
|
|
& wCam %~ moveZoomCamera cfig (w ^. input) (you w) w
|
|
-- & updateScopeZoom
|
|
& rotateCamera cfig
|
|
& over wCam (setViewDistance cfig) -- I think this should be updated after the zoom?
|
|
|
|
moveZoomCamera :: Configuration -> Input -> Creature -> World -> Camera -> Camera
|
|
moveZoomCamera cfig theinput cr w campos =
|
|
campos
|
|
& camCenter .~ fromMaybe (_crPos cr +.+ offset ) mremotepos
|
|
& camViewFrom .~ fromMaybe (_crPos cr) mremotepos
|
|
& camZoom .~ newzoom
|
|
& camDefaultZoom .~ newDefaultZoom
|
|
& camItemZoom .~ newItemZoom
|
|
where
|
|
mremotepos = do
|
|
i <- cr ^? crManipulation . manObject . imSelectedItem
|
|
j <- cr ^? crInv . ix i . itUse . uaParams . apLinkedProjectile . _Just
|
|
w ^? cWorld . lWorld . projectiles . ix j . prjPos
|
|
docamrot = rotateV (campos ^. camRot)
|
|
offset = fromMaybe noscopeoffset $ do
|
|
guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
|
|
i <- cr ^? crManipulation . manObject . imSelectedItem
|
|
fmap docamrot (cr ^? crInv . ix i . itUse . uScope . opticPos)
|
|
noscopeoffset = docamrot $
|
|
((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
|
|
newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do
|
|
i <- cr ^? crManipulation . manObject . imSelectedItem
|
|
cr ^? crInv . ix i . itUse . uScope . opticZoom
|
|
idealDefaultZoom = clipZoom wallZoom
|
|
newDefaultZoom = fromMaybe (changeZoom (campos ^. camDefaultZoom) idealDefaultZoom) $ do
|
|
i <- cr ^? crManipulation . manObject . imSelectedItem
|
|
cr ^? crInv . ix i . itUse . uScope . opticZoom
|
|
idealItemZoom = fromMaybe 1 $ do
|
|
guard $ crIsAiming cr
|
|
i <- cr ^? crManipulation . manObject . imSelectedItem
|
|
zoomFromItem <$> (cr ^? crInv . ix i . 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 = 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
|
|
|
|
-- 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
|
|
|
|
ifConfigWallRotate :: Configuration -> M.Map MouseButton Int -> World -> World
|
|
ifConfigWallRotate cfig mbs
|
|
| _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `M.member` mbs) =
|
|
rotateToOverlappingWall
|
|
| otherwise = id
|
|
|
|
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 ^. wCam . camRot)
|
|
where
|
|
rotateUsing a
|
|
| b - b' > 0.01 = w & wCam . camRot +~ 0.01
|
|
| b - b' < negate 0.01 = w & wCam . camRot -~ 0.01
|
|
| otherwise = w
|
|
where
|
|
b = a * (4 / pi)
|
|
b' = fromIntegral (round b :: Int)
|
|
|
|
rotateCameraBy :: Float -> World -> World
|
|
rotateCameraBy x = wCam . camRot +~ x
|
|
|
|
rotateCamera :: Configuration -> World -> World
|
|
rotateCamera cfig w
|
|
| keydown SDL.ScancodeQ && keydown SDL.ScancodeE = w
|
|
| keydown SDL.ScancodeQ = rotateCameraBy 0.025 w
|
|
| keydown SDL.ScancodeE = rotateCameraBy (-0.025) w
|
|
| otherwise = ifConfigWallRotate cfig (w ^. input . mouseButtons) w
|
|
where
|
|
keydown scode = scode `M.member` _pressedKeys (_input w) && not (inTextInputFocus w)
|
|
|
|
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 -> 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 $ 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 ^. 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 :: Configuration -> 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
|