{- 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