201 lines
7.6 KiB
Haskell
201 lines
7.6 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.Base.Window
|
|
import Dodge.Base.Collide
|
|
--import Dodge.Config.KeyConfig
|
|
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 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 = rotateCamera cfig . autoZoomCamera cfig . moveCamera . updateScopeZoom
|
|
{- Updte the center of the screen camera center and where your avatar's view is from in world. -}
|
|
moveCamera :: World -> World
|
|
moveCamera w = w
|
|
& cameraCenter .~ idealPos
|
|
& cameraViewFrom .~ sightFrom
|
|
where
|
|
aimRangeFactor
|
|
| _cameraZoom w == 0 = 0
|
|
| otherwise = fromMaybe 0 (yourItem w ^? itUse . useAim . aimRange) / _cameraZoom w
|
|
aimingMult
|
|
| SDL.ButtonRight `S.member` _mouseButtons w = 1
|
|
| otherwise = 0
|
|
ypos = _crPos $ you w
|
|
idealPos = camCenter
|
|
+.+ rotateV (_cameraRot w) (aimRangeFactor * aimingMult *.* _mousePos w)
|
|
camCenter = ypos +.+ scopeOffset
|
|
scopeOffset = fromMaybe (V2 0 0) $ yourItem w ^? itAttachment . scopePos
|
|
sightFrom
|
|
| fromMaybe False $ yourItem w ^? itAttachment . scopeIsCamera
|
|
= camCenter
|
|
| otherwise = ypos
|
|
|
|
updateScopeZoom :: World -> World
|
|
updateScopeZoom w
|
|
| SDL.ButtonRight `S.member` _mouseButtons w
|
|
= case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment . 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))
|
|
. itAttachment %~ updateScope
|
|
where
|
|
updateScope (ItScope _ _ _ bl) = ItScope (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 . itAttachment . scopePos)
|
|
(\p -> p +.+ (4-(4*zoomSpeed)) / currentZoom *.* mousep)
|
|
$ over (wpPointer . itAttachment . scopeZoom) (/ zoomSpeed)
|
|
$ decreaseScopeZoomChange
|
|
w
|
|
| otherwise = decreaseScopeZoomChange w
|
|
where
|
|
decreaseScopeZoomChange = wpPointer . itAttachment . 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 ^? itAttachment . scopeZoom
|
|
mousep = rotateV (_cameraRot w) $ _mousePos w
|
|
|
|
zoomOutLongGun :: World -> World
|
|
zoomOutLongGun w
|
|
| currentZoom > 0.5 = over (wpPointer . itAttachment . scopeZoom) (* zoomSpeed)
|
|
$ increaseScopeZoomChange w
|
|
| otherwise = increaseScopeZoomChange w
|
|
where
|
|
increaseScopeZoomChange = wpPointer . itAttachment . 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 ^? itAttachment . scopeZoom
|
|
|
|
ifConfigWallRotate :: Configuration -> World -> World
|
|
ifConfigWallRotate cfig w
|
|
| _rotate_to_wall cfig && not (SDL.ButtonRight `S.member` _mouseButtons w)
|
|
= rotateToOverlappingWall w
|
|
| otherwise = w
|
|
|
|
rotateToOverlappingWall :: World -> World
|
|
rotateToOverlappingWall w = maybe w dowallrotate theWall
|
|
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
|
|
theWall = overlapCircWallsReturnWall p (_crRad cr + 5) (IM.filter _wlRotateTo $ wallsNearPoint p w)
|
|
|
|
|
|
rotateCameraBy :: Float -> World -> World
|
|
rotateCameraBy x w = w
|
|
& cameraRot +~ x
|
|
& creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment . 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
|
|
keyr = SDL.ScancodeE `S.member` _keys w
|
|
|
|
--zoomCamBy :: Float -> World -> World
|
|
--zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01}
|
|
|
|
zoomFromItem
|
|
:: ItZoom
|
|
-> Float -- ^ Furthest viewable distance
|
|
-> Float
|
|
zoomFromItem ItZoom {_itZoomMax = zMax, _itZoomMin = zMin, _itZoomFac = zFac}
|
|
= min zMax . max zMin . (zFac *)
|
|
zoomNoItem
|
|
:: Float -- ^ Furthest viewable distance
|
|
-> Float
|
|
zoomNoItem = 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 zoomNoItem zoomFromItem (yourItem w ^? itUse . useAim . aimZoom) wallZoom
|
|
| otherwise = zoomNoItem wallZoom
|
|
-- = maybe zoomNoItem 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 ^? itAttachment . scopeZoom
|
|
|
|
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 *.* safeNormalizeV (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
|