256 lines
9.9 KiB
Haskell
256 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
|
|
, farWallPoints
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.Zone
|
|
import Dodge.Creature.Test
|
|
import Geometry
|
|
--import Geometry.ConvexPoly
|
|
import Dodge.GameRoom
|
|
|
|
--import qualified Data.List.NonEmpty as NEL
|
|
import Control.Lens
|
|
--import Control.Applicative
|
|
import Data.Maybe
|
|
import Control.Monad
|
|
import qualified Data.Set as S
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified SDL
|
|
--import Data.Monoid
|
|
--import Data.Semigroup
|
|
--import qualified Control.Foldl as L
|
|
{- 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 = setViewDistance cfig
|
|
. moveZoomCamera cfig
|
|
. updateScopeZoom
|
|
. rotateCamera cfig
|
|
|
|
moveZoomCamera :: Configuration -> World -> World
|
|
moveZoomCamera cfig w = w
|
|
& cameraCenter .~ newcen
|
|
& cameraViewFrom .~ newvf
|
|
& cameraZoom .~ newzoom
|
|
& defaultZoom .~ newDefaultZoom
|
|
& itemZoom .~ newItemZoom
|
|
where
|
|
newvf = _crPos (you w) +.+ fromMaybe (V2 0 0) mscopeoffset
|
|
mscopeoffset = do
|
|
guard (SDL.ButtonRight `S.member` _mouseButtons w)
|
|
yourItem w ^? _Just . itScope . scopePos
|
|
newcen = newvf +.+ offset
|
|
offset = rotateV (_cameraRot w) $ ((newzoom - newDefaultZoom)/(newDefaultZoom*newzoom)) *.* _mousePos w
|
|
--newzoom = changeZoom (_cameraZoom w) idealZoom'
|
|
newzoom = newDefaultZoom * newItemZoom
|
|
idealDefaultZoom = clipZoom wallZoom
|
|
newDefaultZoom = changeZoom (_defaultZoom w) idealDefaultZoom
|
|
idealItemZoom
|
|
| crIsAiming (you w)
|
|
= fromMaybe 1 $ fmap zoomFromItem' (yourItem w ^? _Just . itUse . useAim . aimZoom)
|
|
| otherwise = 1
|
|
newItemZoom = changeZoom (_itemZoom w) 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 = farWallDist newvf cfig w
|
|
idealZoom'
|
|
| SDL.ButtonRight `S.member` _mouseButtons w
|
|
= theScopeZoom * maybe clipZoom zoomFromItem (yourItem w ^? _Just . itUse . useAim . aimZoom) newDefaultZoom
|
|
| otherwise = newDefaultZoom
|
|
-- = maybe clipZoom zoomFromItem (yourItem w ^? itZoom) wallZoom
|
|
-- these speeds are inverted, larger means slower
|
|
zoomInSpeed = 25
|
|
zoomOutSpeed = 15
|
|
theScopeZoom = fromMaybe 1 $ yourItem w ^? _Just . itScope . scopeZoom
|
|
|
|
{- Updte the center of the screen camera center and where your avatar's view is from in world. -}
|
|
moveCamera :: Configuration -> World -> World
|
|
moveCamera cfig w = w
|
|
& cameraCenter .~ idealPos
|
|
& cameraViewFrom .~ camCenter
|
|
where
|
|
camPos = _cameraViewFrom w
|
|
wallZoom = farWallDist camPos cfig w
|
|
basezoom = clipZoom wallZoom
|
|
aimRangeFactor
|
|
| _cameraZoom w == 0 = 0
|
|
| otherwise = fromMaybe 0 (yourItem w ^? _Just . itUse . useAim . aimRange) / _cameraZoom w
|
|
aimingMult
|
|
| SDL.ButtonRight `S.member` _mouseButtons w = 1
|
|
| otherwise = 0
|
|
ypos = _crPos $ you w
|
|
idealPos = camCenter +.+ aimoffset
|
|
aimoffset = rotateV (_cameraRot w) (0.5 * aimRangeFactor * aimingMult *.* _mousePos w)
|
|
camCenter = ypos +.+ scopeOffset
|
|
scopeOffset = fromMaybe (V2 0 0) $ yourItem w ^? _Just . itScope . scopePos
|
|
sightFrom = case yourItem w ^? _Just . itScope . scopeIsCamera of
|
|
Just True -> camCenter
|
|
_ -> ypos
|
|
|
|
updateScopeZoom :: World -> World
|
|
updateScopeZoom w
|
|
| SDL.ButtonRight `S.member` _mouseButtons w
|
|
= case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itScope . scopeZoomChange of
|
|
Just x
|
|
| x > 9 -> zoomInLongGun $ zoomInLongGun w
|
|
| x > 0 -> zoomInLongGun w
|
|
| x < -9 -> zoomOutLongGun $ zoomOutLongGun w
|
|
| x < 0 -> zoomOutLongGun w
|
|
| otherwise -> w
|
|
_ -> w
|
|
| otherwise = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itScope %~ updateScope
|
|
where
|
|
updateScope (ZoomScope _ _ _ bl) = ZoomScope (V2 0 0) 0 1 bl
|
|
updateScope otherAtt = otherAtt
|
|
|
|
zoomSpeed :: Float
|
|
zoomSpeed = 39/40
|
|
-- TODO unify zoom in and out, use scroll speed
|
|
zoomInLongGun :: World -> World
|
|
zoomInLongGun w
|
|
| currentZoom < 8 = over (wpPointer . itScope . scopePos)
|
|
(\p -> p +.+ (4-(4*zoomSpeed)) / currentZoom *.* mousep)
|
|
$ over (wpPointer . itScope . scopeZoom) (/ zoomSpeed)
|
|
$ decreaseScopeZoomChange
|
|
w
|
|
| otherwise = decreaseScopeZoomChange w
|
|
where
|
|
decreaseScopeZoomChange = wpPointer . itScope . scopeZoomChange -~ 1
|
|
wpPointer = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
wp = _crInv (_creatures w IM.! 0) IM.! _crInvSel (_creatures w IM.! 0)
|
|
Just currentZoom = wp ^? itScope . scopeZoom
|
|
mousep = rotateV (_cameraRot w) $ _mousePos w
|
|
|
|
zoomOutLongGun :: World -> World
|
|
zoomOutLongGun w
|
|
| currentZoom > 0.5 = over (wpPointer . itScope . scopeZoom) (* zoomSpeed)
|
|
$ increaseScopeZoomChange w
|
|
| otherwise = increaseScopeZoomChange w
|
|
where
|
|
increaseScopeZoomChange = wpPointer . itScope . scopeZoomChange +~ 1
|
|
wpPointer = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
wp = _crInv (_creatures w IM.! 0) IM.! _crInvSel (_creatures w IM.! 0)
|
|
Just currentZoom = wp ^? itScope . scopeZoom
|
|
|
|
ifConfigWallRotate :: Configuration -> World -> World
|
|
ifConfigWallRotate cfig w
|
|
| _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `S.member` _mouseButtons w)
|
|
= rotateToOverlappingWall w
|
|
| otherwise = w
|
|
|
|
rotateToOverlappingWall :: World -> World
|
|
rotateToOverlappingWall w = maybe w dowallrotate
|
|
$ overlapCircWallsReturnWall p (_crRad cr + 5) (IM.filter _wlRotateTo $ wallsNearPoint p w)
|
|
where
|
|
dowallrotate wl' = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - _cameraRot w
|
|
rotateUsing a
|
|
| b - b' > 0.01 = w & cameraRot +~ 0.01
|
|
| b - b' < negate 0.01 = w & cameraRot -~ 0.01
|
|
| otherwise = w
|
|
where
|
|
--b = a * (2 / pi)
|
|
b = a * (4 / pi)
|
|
b' = fromIntegral (round b :: Int)
|
|
cr = you w
|
|
p = _crPos cr
|
|
|
|
|
|
rotateCameraBy :: Float -> World -> World
|
|
rotateCameraBy x w = w
|
|
& cameraRot +~ x
|
|
& creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itScope . scopePos %~ rotateV x
|
|
|
|
rotateCamera :: Configuration -> World -> World
|
|
rotateCamera cfig w
|
|
| keyl && keyr = w
|
|
| keyl = rotateCameraBy 0.025 w
|
|
| keyr = rotateCameraBy (-0.025) w
|
|
| otherwise = ifConfigWallRotate cfig w
|
|
where
|
|
keyl = SDL.ScancodeQ `S.member` _keys w && notAtTerminal w
|
|
keyr = SDL.ScancodeE `S.member` _keys w && notAtTerminal w
|
|
|
|
notAtTerminal :: World -> Bool
|
|
notAtTerminal w = isNothing $ w ^? hud . hudElement . subInventory . termParams . termInput . _Just
|
|
|
|
--zoomCamBy :: Float -> World -> World
|
|
--zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01}
|
|
zoomFromItem'
|
|
:: ItZoom
|
|
-> Float
|
|
zoomFromItem' ItZoom {_itZoomMax = zMax, _itZoomMin = zMin, _itZoomFac = zFac}
|
|
= min zMax $ max zMin zFac
|
|
|
|
zoomFromItem
|
|
:: ItZoom
|
|
-> Float -- ^ Furthest viewable distance
|
|
-> Float
|
|
zoomFromItem ItZoom {_itZoomMax = zMax, _itZoomMin = zMin, _itZoomFac = zFac}
|
|
= min zMax . max zMin . (zFac *)
|
|
clipZoom
|
|
:: Float -- ^ Furthest viewable distance
|
|
-> Float
|
|
clipZoom = min 20 . max 0.2
|
|
{- Automatically sets the zoom of the camera according to the surrounding walls. -}
|
|
autoZoomCamera :: Configuration -> World -> World
|
|
autoZoomCamera cfig w = w & cameraZoom %~ changeZoom
|
|
where
|
|
camPos = _cameraViewFrom w
|
|
wallZoom = farWallDist camPos cfig w
|
|
idealZoom
|
|
| SDL.ButtonRight `S.member` _mouseButtons w
|
|
= theScopeZoom * maybe clipZoom zoomFromItem (yourItem w ^? _Just . itUse . useAim . aimZoom) wallZoom
|
|
| otherwise = clipZoom wallZoom
|
|
-- = maybe clipZoom zoomFromItem (yourItem w ^? itZoom) wallZoom
|
|
changeZoom curZoom
|
|
| curZoom > idealZoom + 0.01 = ((zoomOutSpeed-1)*curZoom + idealZoom) / zoomOutSpeed
|
|
| curZoom < idealZoom - 0.01 = ((zoomInSpeed -1)*curZoom + idealZoom) / zoomInSpeed
|
|
| otherwise = idealZoom
|
|
-- these speeds are inverted, larger means slower
|
|
zoomInSpeed = 25
|
|
zoomOutSpeed = 15
|
|
theScopeZoom = fromMaybe 1 $ yourItem w ^? _Just . itScope . scopeZoom
|
|
|
|
setViewDistance :: Configuration -> World -> World
|
|
setViewDistance cfig w = w & viewDistance
|
|
.~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / _cameraZoom w
|
|
|
|
-- TODO consider adding visible/nearby creatures as view points
|
|
farWallDist :: Point2 -> Configuration -> World -> Float
|
|
farWallDist p cfig w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) findMax 1 vps
|
|
where
|
|
findMax curMax pout = max curMax $ dist p $ collidePointUpToIndirectMinDist p pout curMax wos
|
|
hw = halfWidth cfig
|
|
hh = halfHeight cfig
|
|
winFac = min hw hh
|
|
vps = concatMap _grViewpoints grs ++ extendedViewPoints p grs
|
|
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
|
|
wos = wallsOnScreen cfig w
|
|
|
|
extendedViewPoints :: Point2 -> [GameRoom] -> [Point2]
|
|
extendedViewPoints p grs = map extend
|
|
(concatMap _grViewpointsEx grs
|
|
++ map addDir (concatMap _grLinkDirs grs)
|
|
)
|
|
where
|
|
extend outp = p +.+ maxViewDistance *.* squashNormalizeV (outp -.- p)
|
|
addDir a = p +.+ unitVectorAtAngle a
|
|
|
|
farWallPoints :: Point2 -> World -> [Point2]
|
|
farWallPoints p w = concatMap _grViewpoints grs ++ extendedViewPoints p grs
|
|
where
|
|
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
|
|
|
|
maxViewDistance :: Float
|
|
maxViewDistance = 800
|