151 lines
7.7 KiB
Haskell
151 lines
7.7 KiB
Haskell
module Dodge.Update.Camera where
|
|
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.Config.KeyConfig
|
|
import Geometry
|
|
|
|
import Control.Lens
|
|
import Control.Monad
|
|
import Data.Maybe
|
|
import qualified Data.Set as S
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified SDL as SDL
|
|
|
|
updateCamera :: World -> World
|
|
updateCamera = rotCam . moveCamera . updateScopeZoom
|
|
|
|
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
|
|
idealOffset = rotateV (_cameraRot w) (aimRangeFactor * aimingMult *.* _mousePos w)
|
|
currentOffset = currentPos -.- camCenter
|
|
idealPos = camCenter +.+ rotateV (_cameraRot w)
|
|
(aimRangeFactor * aimingMult *.* _mousePos w)
|
|
currentPos = _cameraCenter w
|
|
camCenter = ypos +.+ scope
|
|
isCam :: Bool
|
|
isCam = fromMaybe False $ yourItem w ^? itAttachment . _Just . scopeIsCamera
|
|
scope = fromMaybe (0,0) $ yourItem w ^? itAttachment . _Just . scopePos
|
|
sightFrom | isCam = 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 . _Just . scopeZoomChange -~ 2
|
|
| x > 0 -> zoomInLongGun
|
|
$ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment . _Just . scopeZoomChange -~ 1
|
|
| x < -9 -> zoomOutLongGun $ zoomOutLongGun
|
|
$ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment . _Just . scopeZoomChange +~ 2
|
|
| x < 0 -> zoomOutLongGun $ zoomOutLongGun
|
|
$ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment . _Just . scopeZoomChange +~ 1
|
|
| otherwise -> w
|
|
_ -> w
|
|
| otherwise = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment . _Just %~ updateScope
|
|
where scppoint = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment . _Just . scopeZoomChange
|
|
updateScope (ItScope _ _ _ bl) = ItScope (0,0) 0 1 bl
|
|
updateScope otherAtt = otherAtt
|
|
|
|
zoomSpeed = 39/40
|
|
|
|
zoomInLongGun :: World -> World
|
|
zoomInLongGun w | currentZoom < 8 = over (wpPointer . itAttachment . _Just . scopePos)
|
|
(\p -> p +.+ (4-(4*zoomSpeed)) / currentZoom *.* mousep)
|
|
$ over (wpPointer . itAttachment . _Just . scopeZoom) (\z -> z / 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 . _Just . scopeZoom
|
|
mousep = rotateV (_cameraRot w) $ _mousePos w
|
|
|
|
zoomOutLongGun :: World -> World
|
|
zoomOutLongGun w | currentZoom > 0.5 = over (wpPointer . itAttachment . _Just . scopePos)
|
|
-- (\p -> p -.- 2/(2 * currentZoom) *.* _mousePos w)
|
|
-- (\p -> p -.- 2*zoomSpeed/currentZoom *.* p)
|
|
(\p -> p)
|
|
$ over (wpPointer . itAttachment . _Just . scopeZoom) (\z -> z * 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 . _Just . scopeZoom
|
|
currentCursorDisplacement = fromJust $ _itAttachment wp
|
|
|
|
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 . _Just . 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 . _Just . 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
|
|
|
|
autoZoomCam :: World -> World
|
|
autoZoomCam w = over cameraZoom changeZoom w
|
|
where maxViewDistance = 800
|
|
camPos = _cameraViewFrom w
|
|
camRot = _cameraRot w
|
|
wallZoom = min (halfWidth w / (horizontalMax+50) )
|
|
(halfHeight w / (verticalMax+50) )
|
|
idealZoom | SDL.ButtonRight `S.member` _mouseButtons w
|
|
= scZoom *
|
|
(
|
|
min (fromMaybe 20 $ yourItem w ^? itZoom . itAimZoomMax)
|
|
$ max (fromMaybe 0.2 $ yourItem w ^? itZoom . itAimZoomMin)
|
|
(wallZoom * fromMaybe 1 (yourItem w ^? itZoom . itAimZoomFac))
|
|
)
|
|
| otherwise
|
|
= min (fromMaybe 20 $ yourItem w ^? itZoom . itZoomMax)
|
|
$ max (fromMaybe 0.2 (yourItem w ^? itZoom . itZoomMin))
|
|
(wallZoom * fromMaybe 1 (yourItem w ^? itZoom . itZoomFac))
|
|
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
|
|
zs = take 9 [-maxViewDistance,0 - 0.8*maxViewDistance..]
|
|
rRays = rotF [( maxViewDistance,y) | y <- zs]
|
|
lRays = rotF [(-maxViewDistance,y) | y <- zs]
|
|
tRays = rotF [(y, maxViewDistance) | y <- zs]
|
|
bRays = rotF [(y,-maxViewDistance) | y <- zs]
|
|
rotF = map (h . (+.+) camPos . rotateV (_cameraRot w))
|
|
h p = fromMaybe p $ collidePointIndirect camPos p $ wallsAlongLine camPos p w
|
|
h' x p = dotV (rotateV camRot x) (p -.- camPos)
|
|
horizontalMax = maximum $ map (h' (1,0)) rRays ++ map (h' (-1,0)) lRays
|
|
verticalMax = maximum $ map (h' (0,1)) tRays ++ map (h' (0,-1)) bRays
|
|
scZoom = fromMaybe 1 $ yourItem w ^? itAttachment . _Just . scopeZoom
|
|
|
|
dirRays :: Float -> [Point2]
|
|
dirRays dir = take 11 $ iterate (rotateV (0.5 * pi / 10)) $ rotateV (dir-pi*0.25) (600,0)
|