Cleanup
This commit is contained in:
+39
-37
@@ -5,13 +5,7 @@ module Dodge.Update.Camera (
|
||||
updateCamera,
|
||||
) where
|
||||
|
||||
import Dodge.WASD
|
||||
import Dodge.SmoothScroll
|
||||
import SDL (MouseButton (..))
|
||||
import Dodge.Base.Coordinate
|
||||
import Dodge.InputFocus
|
||||
import Bound
|
||||
import Dodge.Viewpoints
|
||||
import Control.Monad
|
||||
import Data.Foldable
|
||||
import qualified Data.Map.Strict as M
|
||||
@@ -21,10 +15,15 @@ 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;
|
||||
@@ -35,12 +34,13 @@ updateCamera cfig w = case w ^. wCam . camControl of
|
||||
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
|
||||
updateFloatingCamera cfig w =
|
||||
w
|
||||
& updateBounds cfig
|
||||
& wCam %~ setViewDistance cfig
|
||||
& wCam %~ translateFloatingCamera theinput
|
||||
& wCam %~ translateFloatingCameraKeys theinput
|
||||
& wCam %~ zoomFloatingCamera theinput
|
||||
where
|
||||
theinput = w ^. input
|
||||
|
||||
@@ -49,24 +49,25 @@ translateFloatingCamera theinput cam = fromMaybe cam $ do
|
||||
presstime <- theinput ^. mouseButtons . at ButtonLeft
|
||||
guard $ presstime > 0
|
||||
hpos <- theinput ^? heldPos . ix ButtonLeft
|
||||
let thetran =
|
||||
let thetran =
|
||||
screenToWorldPos cam hpos
|
||||
-.-
|
||||
screenToWorldPos cam (theinput ^. mousePos)
|
||||
return $ cam & camCenter +~ thetran
|
||||
& camViewFrom +~ thetran
|
||||
-.- screenToWorldPos cam (theinput ^. mousePos)
|
||||
return $
|
||||
cam & camCenter +~ thetran
|
||||
& camViewFrom +~ thetran
|
||||
|
||||
translateFloatingCameraKeys :: Input -> Camera -> Camera
|
||||
translateFloatingCameraKeys theinput = (camCenter -~ thetran)
|
||||
translateFloatingCameraKeys theinput =
|
||||
(camCenter -~ thetran)
|
||||
. (camViewFrom -~ thetran)
|
||||
where
|
||||
thetran = 10 *.* wasdDir theinput
|
||||
|
||||
zoomFloatingCamera :: Input -> Camera -> Camera
|
||||
zoomFloatingCamera theinput cam
|
||||
| ButtonRight `M.member` (theinput ^. mouseButtons) = cam
|
||||
& camZoom *~ (zoomSpeed ^^ negate (getSmoothScrollValue theinput))
|
||||
| otherwise = cam
|
||||
zoomFloatingCamera theinput
|
||||
| ButtonRight `M.member` (theinput ^. mouseButtons) =
|
||||
camZoom *~ (zoomSpeed ^^ negate (getSmoothScrollValue theinput))
|
||||
| otherwise = id
|
||||
|
||||
updateInGameCamera :: Configuration -> World -> World
|
||||
updateInGameCamera cfig w =
|
||||
@@ -100,8 +101,9 @@ moveZoomCamera cfig theinput cr campos =
|
||||
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
|
||||
offset =
|
||||
rotateV (campos ^. camRot) $
|
||||
((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
|
||||
newzoom = case mitm ^? _Just . itScope of
|
||||
Just zs@ZoomScope{} -> _scopeZoom zs
|
||||
_ -> newDefaultZoom * newItemZoom
|
||||
@@ -123,7 +125,6 @@ moveZoomCamera cfig theinput cr campos =
|
||||
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
|
||||
@@ -135,8 +136,8 @@ updateScopeZoom w = fromMaybe w $ do
|
||||
|
||||
updateScopeZoom' :: Int -> World -> World
|
||||
updateScopeZoom' i w
|
||||
| SDL.ButtonRight `M.member` _mouseButtons (_input w)
|
||||
= w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) mp
|
||||
| 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 . itScope
|
||||
@@ -152,7 +153,7 @@ doScopeZoom scrollamount mp sc = case scrollamount of
|
||||
| x > 0 -> zoomInLongGun mp sc
|
||||
| x < -10 -> (zoomOutLongGun . zoomOutLongGun . zoomOutLongGun) sc
|
||||
| x < -5 -> (zoomOutLongGun . zoomOutLongGun) sc
|
||||
| x < 0 -> zoomOutLongGun sc
|
||||
| x < 0 -> zoomOutLongGun sc
|
||||
| otherwise -> sc
|
||||
|
||||
zoomSpeed :: Float
|
||||
@@ -160,17 +161,19 @@ zoomSpeed = 39 / 40
|
||||
|
||||
zoomInLongGun :: Point2 -> Scope -> Scope
|
||||
zoomInLongGun mousep sc = fromMaybe sc $ do
|
||||
curzoom <- sc ^? scopeZoom
|
||||
curzoom <- sc ^? scopeZoom
|
||||
guard $ curzoom < 8
|
||||
return $ sc & scopePos .+.+~ (1 - zoomSpeed)*zoomSpeed/curzoom *.* mousep
|
||||
& scopeZoom %~ (/ zoomSpeed)
|
||||
return $
|
||||
sc & scopePos .+.+~ (1 - zoomSpeed) * zoomSpeed / curzoom *.* mousep
|
||||
& scopeZoom %~ (/ zoomSpeed)
|
||||
|
||||
zoomOutLongGun :: Scope -> Scope
|
||||
zoomOutLongGun sc = fromMaybe sc $ do
|
||||
curzoom <- sc ^? scopeZoom
|
||||
guard $ curzoom > 0.5
|
||||
return $ sc & scopePos %~ (\p -> p +.+ (zoomSpeed - 1) / curzoom *.* p)
|
||||
& scopeZoom *~ zoomSpeed
|
||||
return $
|
||||
sc & scopePos %~ (\p -> p +.+ (zoomSpeed - 1) / curzoom *.* p)
|
||||
& scopeZoom *~ zoomSpeed
|
||||
|
||||
ifConfigWallRotate :: Configuration -> World -> World
|
||||
ifConfigWallRotate cfig w
|
||||
@@ -197,7 +200,6 @@ doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. wC
|
||||
| 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)
|
||||
|
||||
@@ -208,8 +210,9 @@ rotateCameraBy x w =
|
||||
& 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
|
||||
i <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem
|
||||
return $
|
||||
lWorld . creatures . ix 0 . crInv . ix i
|
||||
. itScope
|
||||
. scopePos
|
||||
%~ rotateV x
|
||||
@@ -252,7 +255,6 @@ farWallDistDirection p w =
|
||||
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 ^. wCam . camViewFrom) w
|
||||
where
|
||||
hw = halfWidth cfig
|
||||
|
||||
Reference in New Issue
Block a user