277 lines
9.9 KiB
Haskell
277 lines
9.9 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.Applicative
|
|
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 *~ (zoomSpeed ^^ negate (getSmoothScrollValue theinput))
|
|
| otherwise = id
|
|
|
|
updateInGameCamera :: Configuration -> World -> World
|
|
updateInGameCamera cfig w =
|
|
w
|
|
& updateBounds cfig
|
|
& over wCam (setViewDistance cfig)
|
|
& wCam %~ moveZoomCamera cfig (w ^. input) (you w)
|
|
-- & updateScopeZoom
|
|
& rotateCamera cfig
|
|
|
|
moveZoomCamera :: Configuration -> Input -> Creature -> Camera -> Camera
|
|
moveZoomCamera cfig theinput cr campos =
|
|
campos
|
|
& camCenter .~ newcen
|
|
& camViewFrom .~ newvf
|
|
& camZoom .~ newzoom
|
|
& camDefaultZoom .~ newDefaultZoom
|
|
& camItemZoom .~ newItemZoom
|
|
where
|
|
cpos = _crPos cr
|
|
mitm = do
|
|
i <- cr ^? crManipulation . manObject . inInventory . ispItem
|
|
cr ^? crInv . ix i
|
|
newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset
|
|
vfoffset = do
|
|
guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
|
|
mitm ^? _Just . itScope . remotePos
|
|
mscopeoffset = do
|
|
guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
|
|
i <- cr ^? crManipulation . manObject . inInventory . ispItem
|
|
(cr ^? crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams . opticPos)
|
|
<|> (mitm ^? _Just . itScope . remotePos)
|
|
newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset
|
|
offset =
|
|
rotateV (campos ^. camRot) $
|
|
((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
|
|
newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do
|
|
i <- cr ^? crManipulation . manObject . inInventory . ispItem
|
|
(cr ^? crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams . opticZoom)
|
|
-- 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
|
|
-- 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 . crManipulation . manObject . inInventory . ispItem
|
|
return $ updateScopeZoom' i w
|
|
|
|
updateScopeZoom' :: Int -> World -> World
|
|
updateScopeZoom' i w
|
|
| SDL.ButtonRight `M.member` _mouseButtons (_input w) =
|
|
w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) mp
|
|
| otherwise = w & wppointer %~ resetscope
|
|
where
|
|
wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams
|
|
resetscope (ZoomScrollParams _ _ defz) = ZoomScrollParams (V2 0 0) defz defz
|
|
resetscope otherAtt = otherAtt
|
|
mp = rotateV (w ^. wCam . camRot) $ _mousePos (_input w)
|
|
|
|
doScopeZoom :: Int -> Point2 -> ScrollAttachParams -> ScrollAttachParams
|
|
doScopeZoom scrollamount mp sc = case scrollamount of
|
|
x
|
|
| x > 10 -> (zoomInLongGun mp . zoomInLongGun mp . zoomInLongGun mp) sc
|
|
| x > 5 -> (zoomInLongGun mp . zoomInLongGun mp) sc
|
|
| x > 0 -> zoomInLongGun mp sc
|
|
| x < -10 -> (zoomOutLongGun . zoomOutLongGun . zoomOutLongGun) sc
|
|
| x < -5 -> (zoomOutLongGun . zoomOutLongGun) sc
|
|
| x < 0 -> zoomOutLongGun sc
|
|
| otherwise -> sc
|
|
|
|
zoomSpeed :: Float
|
|
zoomSpeed = 39 / 40
|
|
|
|
zoomInLongGun :: Point2 -> ScrollAttachParams -> ScrollAttachParams
|
|
zoomInLongGun mousep sc = fromMaybe sc $ do
|
|
curzoom <- sc ^? opticZoom
|
|
guard $ curzoom < 8
|
|
return $
|
|
sc & opticPos .+.+~ (1 - zoomSpeed) * zoomSpeed / curzoom *.* mousep
|
|
& opticZoom %~ (/ zoomSpeed)
|
|
|
|
zoomOutLongGun :: ScrollAttachParams -> ScrollAttachParams
|
|
zoomOutLongGun sc = fromMaybe sc $ do
|
|
curzoom <- sc ^? opticZoom
|
|
guard $ curzoom > 0.5
|
|
return $
|
|
sc & opticPos %~ (\p -> p +.+ (zoomSpeed - 1) / curzoom *.* p)
|
|
& opticZoom *~ 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 ^. 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 w =
|
|
w
|
|
& wCam . camRot +~ x
|
|
& cWorld %~ rotateanyscope
|
|
where
|
|
rotateanyscope = fromMaybe id $ do
|
|
i <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem
|
|
return $
|
|
lWorld . creatures . ix 0 . crInv . ix (i - 1)
|
|
. itUse
|
|
. attachParams
|
|
. scrollAttachParams
|
|
. opticPos
|
|
%~ rotateV 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
|
|
where
|
|
keydown scode = scode `M.member` _pressedKeys (_input w) && not (inInputFocus 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
|
|
|
|
updateBounds :: Configuration -> World -> World
|
|
updateBounds cfig w =
|
|
w
|
|
& wCam . camBoundDist .~ bdists
|
|
& wCam . camBoundBox
|
|
.~ map ((+.+ w ^. wCam . camCenter) . rotateV (w ^. wCam . camRot)) (rectNSWE n s w' e)
|
|
where
|
|
bdists@(n, s, e, w') = findBoundDists cfig w
|