Add general smooth scrolling, move camera into world
This commit is contained in:
+26
-21
@@ -5,6 +5,7 @@ module Dodge.Update.Camera (
|
||||
updateCamera,
|
||||
) where
|
||||
|
||||
import Dodge.SmoothScroll
|
||||
import SDL (MouseButton (..))
|
||||
import Dodge.Base.Coordinate
|
||||
import Dodge.InputFocus
|
||||
@@ -28,7 +29,7 @@ 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 ^. cWorld . cwCam . camControl of
|
||||
updateCamera cfig w = case w ^. wCam . camControl of
|
||||
CamInGame -> updateInGameCamera cfig w
|
||||
CamFloat -> updateFloatingCamera cfig w
|
||||
CamPan -> w
|
||||
@@ -36,9 +37,9 @@ updateCamera cfig w = case w ^. cWorld . cwCam . camControl of
|
||||
updateFloatingCamera :: Configuration -> World -> World
|
||||
updateFloatingCamera cfig w = w
|
||||
& updateBounds cfig
|
||||
& cWorld . cwCam %~ setViewDistance cfig
|
||||
& cWorld . cwCam %~ translateFloatingCamera theinput
|
||||
& cWorld . cwCam %~ zoomFloatingCamera theinput
|
||||
& wCam %~ setViewDistance cfig
|
||||
& wCam %~ translateFloatingCamera theinput
|
||||
& wCam %~ zoomFloatingCamera theinput
|
||||
where
|
||||
theinput = w ^. input
|
||||
|
||||
@@ -54,14 +55,18 @@ translateFloatingCamera theinput cam = fromMaybe cam $ do
|
||||
return $ cam & camCenter +~ thetran
|
||||
& camViewFrom +~ thetran
|
||||
|
||||
zoomFloatingCamera :: Input -> Camera -> Camera
|
||||
zoomFloatingCamera theinput cam = cam
|
||||
& camZoom *~ (zoomSpeed ^^ negate (getSmoothScrollValue theinput))
|
||||
-- & camZoom *~ (zoomSpeed ^^ negate (theinput ^. smoothScrollAmount))
|
||||
|
||||
|
||||
updateInGameCamera :: Configuration -> World -> World
|
||||
updateInGameCamera cfig w =
|
||||
w
|
||||
& updateBounds cfig
|
||||
& over (cWorld . cwCam) (setViewDistance cfig)
|
||||
& cWorld . cwCam %~ moveZoomCamera cfig (w ^. input) (you w)
|
||||
& over (wCam) (setViewDistance cfig)
|
||||
& wCam %~ moveZoomCamera cfig (w ^. input) (you w)
|
||||
& updateScopeZoom
|
||||
& rotateCamera cfig
|
||||
|
||||
@@ -129,7 +134,7 @@ updateScopeZoom' i w
|
||||
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 . cwCam . camRot) $ _mousePos (_input w)
|
||||
mp = rotateV (w ^. wCam . camRot) $ _mousePos (_input w)
|
||||
|
||||
doScopeZoom :: Point2 -> Scope -> Scope
|
||||
doScopeZoom mp sc = case sc ^? scopeZoomChange of
|
||||
@@ -194,25 +199,25 @@ rotateToOverlappingWall w =
|
||||
p = _crPos (you w)
|
||||
|
||||
doWallRotate :: Wall -> World -> World
|
||||
doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. cWorld . cwCam . camRot)
|
||||
doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. wCam . camRot)
|
||||
where
|
||||
rotateUsing a
|
||||
| b - b' > 0.01 = w & cWorld . cwCam . camRot +~ 0.01
|
||||
| b - b' < negate 0.01 = w & cWorld . cwCam . camRot -~ 0.01
|
||||
| b - b' > 0.01 = w & wCam . camRot +~ 0.01
|
||||
| b - b' < negate 0.01 = w & wCam . camRot -~ 0.01
|
||||
| otherwise = w
|
||||
where
|
||||
--b = a * (2 / pi)
|
||||
b = a * (4 / pi)
|
||||
b' = fromIntegral (round b :: Int)
|
||||
|
||||
rotateCameraBy :: Float -> CWorld -> CWorld
|
||||
rotateCameraBy :: Float -> World -> World
|
||||
rotateCameraBy x w =
|
||||
w
|
||||
& cwCam . camRot +~ x
|
||||
& rotateanyscope
|
||||
& wCam . camRot +~ x
|
||||
& cWorld %~ rotateanyscope
|
||||
where
|
||||
rotateanyscope = fromMaybe id $ do
|
||||
i <- w ^? lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem
|
||||
i <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem
|
||||
return $ lWorld . creatures . ix 0 . crInv . ix i
|
||||
. itScope
|
||||
. scopePos
|
||||
@@ -221,8 +226,8 @@ rotateCameraBy x w =
|
||||
rotateCamera :: Configuration -> World -> World
|
||||
rotateCamera cfig w
|
||||
| keydown SDL.ScancodeQ && keydown SDL.ScancodeE = w
|
||||
| keydown SDL.ScancodeQ = over cWorld (rotateCameraBy 0.025) w
|
||||
| keydown SDL.ScancodeE = over cWorld (rotateCameraBy (-0.025)) 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)
|
||||
@@ -249,7 +254,7 @@ farWallDistDirection p w =
|
||||
boundPoints $
|
||||
map f $ getViewpoints p (_cWorld w)
|
||||
where
|
||||
f q = (rotateV (negate (w ^. cWorld . cwCam . camRot)) . (-.- p)) (foldl' findPoint q (wls q))
|
||||
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
|
||||
|
||||
@@ -257,7 +262,7 @@ 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 . cwCam . camViewFrom) w
|
||||
| otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. wCam . camViewFrom) w
|
||||
where
|
||||
hw = halfWidth cfig
|
||||
hh = halfHeight cfig
|
||||
@@ -265,8 +270,8 @@ findBoundDists cfig w
|
||||
updateBounds :: Configuration -> World -> World
|
||||
updateBounds cfig w =
|
||||
w
|
||||
& cWorld . cwCam . camBoundDist .~ bdists
|
||||
& cWorld . cwCam . camBoundBox
|
||||
.~ map ((+.+ w ^. cWorld . cwCam . camCenter) . rotateV (w ^. cWorld . cwCam . camRot)) (rectNSWE n s w' e)
|
||||
& 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
|
||||
|
||||
@@ -30,7 +30,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
|
||||
(_, EquipOptions{}) -> w & rbOptions %~ scrollRBOption yi
|
||||
(Nothing, _) -> closeObjScrollDir y w
|
||||
(Just f, _) -> doHeldScroll f y (you w) w
|
||||
| lbDown -> w & cWorld . cwCam . camZoom +~ y
|
||||
| lbDown -> w & wCam . camZoom +~ y
|
||||
| invKeyDown -> changeSwapSel yi w
|
||||
| otherwise -> stopSoundFrom (CrReloadSound 0) $ scrollAugInvSel yi w
|
||||
DisplayInventory {_subInventory = ExamineInventory mi}
|
||||
|
||||
Reference in New Issue
Block a user