209 lines
8.2 KiB
Haskell
209 lines
8.2 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 Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.Base.Zone
|
|
import Dodge.Base.Window
|
|
import Dodge.Base.Collide
|
|
import Dodge.Config.KeyConfig
|
|
import Dodge.Item.Attachment.Data
|
|
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 :: World -> World
|
|
updateCamera = rotCam . 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 ^? itAimingRange) / _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 ^? scppoint of
|
|
Just x
|
|
| x > 9 -> zoomInLongGun $ zoomInLongGun
|
|
$ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment . scopeZoomChange -~ 2
|
|
| x > 0 -> zoomInLongGun
|
|
$ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment . scopeZoomChange -~ 1
|
|
| x < -9 -> zoomOutLongGun $ zoomOutLongGun
|
|
$ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment . scopeZoomChange +~ 2
|
|
| x < 0 -> zoomOutLongGun $ zoomOutLongGun
|
|
$ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment . scopeZoomChange +~ 1
|
|
| otherwise -> w
|
|
_ -> w
|
|
| otherwise = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment %~ updateScope
|
|
where
|
|
scppoint = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment . scopeZoomChange
|
|
updateScope (ItScope _ _ _ bl) = ItScope (V2 0 0) 0 1 bl
|
|
updateScope otherAtt = otherAtt
|
|
|
|
zoomSpeed :: Float
|
|
zoomSpeed = 39/40
|
|
|
|
zoomInLongGun :: World -> World
|
|
zoomInLongGun w
|
|
| currentZoom < 8 = over (wpPointer . itAttachment . scopePos)
|
|
(\p -> p +.+ (4-(4*zoomSpeed)) / currentZoom *.* mousep)
|
|
$ over (wpPointer . itAttachment . scopeZoom) (/ zoomSpeed)
|
|
w
|
|
| otherwise = w
|
|
where
|
|
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) w
|
|
| otherwise = w
|
|
where
|
|
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
|
|
|
|
rotCam :: World -> World
|
|
rotCam = rotateCameraL
|
|
. rotateCameraR
|
|
. zoomCamIn . zoomCamOut
|
|
. autoZoomCam
|
|
|
|
rotateCameraL :: World -> World
|
|
rotateCameraL w
|
|
| rotateCameraPlusKey (_keyConfig w) `S.member` _keys w
|
|
= w & cameraRot +~ 0.015
|
|
& creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment . scopePos %~ rotateV 0.015
|
|
| otherwise = w
|
|
rotateCameraR :: World -> World
|
|
rotateCameraR w | rotateCameraMinusKey (_keyConfig w) `S.member` _keys w
|
|
= w & cameraRot -~ 0.015
|
|
& creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment . scopePos %~ rotateV (-0.015)
|
|
| otherwise = w
|
|
zoomCamIn :: World -> World
|
|
zoomCamIn w | zoomInKey (_keyConfig w) `S.member` _keys w
|
|
= w {_cameraZoom = _cameraZoom w + 0.01}
|
|
| otherwise = w
|
|
zoomCamOut :: World -> World
|
|
zoomCamOut w | zoomOutKey (_keyConfig w) `S.member` _keys w
|
|
= w {_cameraZoom = max (_cameraZoom w - 0.01) 0.01}
|
|
| otherwise = w
|
|
|
|
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. -}
|
|
autoZoomCam :: World -> World
|
|
autoZoomCam w = over cameraZoom changeZoom w
|
|
where
|
|
camPos = _cameraViewFrom w
|
|
wallZoom = farWallDist' camPos w
|
|
idealZoom
|
|
| SDL.ButtonRight `S.member` _mouseButtons w
|
|
= theScopeZoom * maybe zoomNoItem zoomFromItem (yourItem w ^? itAimZoom) wallZoom
|
|
| otherwise
|
|
= 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 -> World -> Float
|
|
farWallDist' p w = (winFac /) $ fromMaybe maxViewDistance $ L.fold L.maximum vdists
|
|
where
|
|
hw = halfWidth w
|
|
hh = halfHeight w
|
|
winFac = min hw hh
|
|
vdists = map (flip (collideDirectionIndirect maxViewDistance p) wos)
|
|
vps
|
|
vps = concatMap _grViewpoints grs
|
|
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
|
|
wos = wallsOnScreen w
|
|
---- | Find the furthest viewable distance from a given point in the world
|
|
--farWallDist :: Point2 -> World -> Float
|
|
----{-# INLINE farWallDist #-}
|
|
--farWallDist cpos w
|
|
-- = getMin
|
|
-- . uncurry (<>)
|
|
-- $ bimap (toScale hw) (toScale hh)
|
|
-- $ sconcat
|
|
-- $ NEL.map distsMaybeTo viewTestValues
|
|
-- where
|
|
-- wos = wallsOnScreen w
|
|
-- camRot = _cameraRot w
|
|
-- hw = halfWidth w
|
|
-- hh = halfHeight w
|
|
-- toScale x = Min . (x /) . (+ 50) . maybe maxViewDistance getMax . getAp
|
|
-- distsMaybeTo x = (valueAtWidth x,valueAtHeight x)
|
|
-- valueAtHeight h = cpiv (cpos +.+ x) <> cpiv (cpos -.- x)
|
|
-- where
|
|
-- x = rotateV camRot $ V2 maxViewDistance h
|
|
-- cpiv p = Ap $ Max . horSize <$> collidePointIndirect cpos p wos
|
|
-- horSize = abs . dotV rv . (-.- cpos)
|
|
-- rv = rotateV camRot (V2 1 0)
|
|
-- valueAtWidth h = cpih (cpos +.+ x) <> cpih (cpos -.- x)
|
|
-- where
|
|
-- x = rotateV camRot $ V2 h maxViewDistance
|
|
-- cpih p = Ap $ Max . verSize <$> collidePointIndirect cpos p wos
|
|
-- verSize = abs . dotV rh . (-.- cpos)
|
|
-- rh = rotateV camRot (V2 0 1)
|
|
--viewTestValues :: NEL.NonEmpty Float
|
|
--viewTestValues = NEL.fromList [-maxViewDistance,negate $ 0.75*maxViewDistance..maxViewDistance]
|
|
|
|
maxViewDistance :: Float
|
|
maxViewDistance = 800
|