loop/src/Dodge/Update/Camera.hs

{-# LANGUAGE LambdaCase #-}
{- 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 Linear.V3
import Dodge.Creature.Radius
import Bound
import Control.Monad
import Data.Foldable
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Base
import Dodge.Creature.Test
import Dodge.Data.Config
import Dodge.Data.World
import Dodge.SmoothScroll
import Dodge.Viewpoints
import Dodge.WASD
import Dodge.Zoning.Wall
import Geometry
import LensHelp
import SDL (MouseButton (..))

{- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers;
update where your avatar's view is from.  -}
updateCamera :: Config -> World -> World
updateCamera cfig w = case w ^. wCam . camControl of
    CamInGame{} -> updateInGameCamera cfig w
    CamFloat -> updateFloatingCamera cfig w

updateFloatingCamera :: Config -> World -> World
updateFloatingCamera cfig w =
    w
        & updateBounds cfig
        & wCam %~ setViewDistance cfig
        & wCam %~ translateFloatingCamera theinput
        & wCam %~ translateFloatingCameraKeys theinput
        & wCam %~ zoomFloatingCamera theinput
  where
    theinput = w ^. input

translateFloatingCamera :: Input -> Camera -> Camera
translateFloatingCamera theinput cam = fromMaybe cam $ do
    lpresstime <- theinput ^. mouseButtons . at ButtonLeft
    rpresstime <- theinput ^. mouseButtons . at ButtonRight
    if lpresstime > rpresstime
        then do
            hpos <- theinput ^? heldPos . ix ButtonLeft
            let thetran =
                    screenToWorldPos cam hpos
                        -.- screenToWorldPos cam (theinput ^. mousePos)
            return $
                cam & camCenter +~ thetran
                    & camViewFrom +~ thetran
        else do
            a <- theinput ^. heldPos . at SDL.ButtonRight
            return $ cam & camRot -~ angleBetween (theinput ^. mousePos) a

translateFloatingCameraKeys :: Input -> Camera -> Camera
translateFloatingCameraKeys theinput cam =
    cam
        & camCenter -~ thetran
        & camViewFrom -~ thetran
  where
    thetran = rotateV (cam ^. camRot) $ negate 10 *.* wasdDir theinput

zoomFloatingCamera :: Input -> Camera -> Camera
zoomFloatingCamera theinput
    | ButtonRight `M.member` (theinput ^. mouseButtons) =
        camZoom *~ ((39 / 40) ^^ negate (getSmoothScrollValue theinput))
    | otherwise = id

-- the 39/40 is taken from zoomSpeed

updateInGameCamera :: Config -> World -> World
updateInGameCamera cfig w =
    w
        & updateBounds cfig
        & wCam %~ moveZoomCamera cfig (w ^. input) (you w) w
        & rotateCamera cfig
        & over wCam (setViewDistance cfig) -- I think this should be updated after the zoom?

moveZoomCamera :: Config -> Input -> Creature -> World -> Camera -> Camera
moveZoomCamera cfig theinput cr w campos =
    campos
        & camCenter .~ fromMaybe (_crPos cr +.+ offset) mremotepos
        & camViewFrom .~ fromMaybe (_crPos cr) mremotepos
        & camZoom .~ newzoom
        & camDefaultZoom .~ newDefaultZoom
        & camItemZoom .~ newItemZoom
  where
    mremotepos = do
        i <- cr ^? crManipulation . manObject . imSelectedItem
        itid <- cr ^? crInv . ix i
        j <- w ^? cWorld . lWorld . items . ix itid . itUse . uaParams . apProjectiles . ix 0
        guard $ Just REMOTESCREEN == w ^? cWorld . lWorld . items . ix itid . itType . ibtAttach
        w ^? cWorld . lWorld . projectiles . ix j . pjPos . _xy
    docamrot = rotateV (campos ^. camRot)
    offset = fromMaybe noscopeoffset $ do
        guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
        i <- cr ^? crManipulation . manObject . imSelectedItem
        itid <- cr ^? crInv . ix i
        fmap docamrot (w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticPos)
    noscopeoffset =
        docamrot $
            ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
    newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do
        i <- cr ^? crManipulation . manObject . imSelectedItem
        itid <- cr ^? crInv . ix i
        w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom
    idealDefaultZoom = clipZoom wallZoom
    newDefaultZoom = fromMaybe (changeZoom (campos ^. camDefaultZoom) idealDefaultZoom) $ do
        i <- cr ^? crManipulation . manObject . imSelectedItem
        itid <- cr ^? crInv . ix i
        w ^? cWorld . lWorld . items . ix itid . itUse . uScope . opticZoom
    idealItemZoom = fromMaybe 1 $ do
        guard $ crIsAiming cr
        i <- cr ^? crManipulation . manObject . imSelectedItem
        itid <- cr ^? crInv . ix i
        getAimZoom <$> (w ^? cWorld . lWorld . items . ix itid)
    newItemZoom = changeZoom (campos ^. camItemZoom) 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 = min4 (f (campos ^. camBoundDist))
    f (a,b,c,d) = (a+bordersize,b-bordersize,c+bordersize,d-bordersize)
    bordersize = 20
    min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)]
    maxd = max distFromEqmnt
    distFromEqmnt = viewDistanceFromItems cr
    --distFromEqmnt = foldl' max 1 $ IM.mapMaybe (_eeViewDist . _uequipEffect . _itUse) $ getCrEquipment cr
    hw = halfWidth cfig
    hh = halfHeight cfig
    -- these speeds are inverted, larger means slower
    zoomInSpeed = 25
    zoomOutSpeed = 15

getAimZoom :: Item -> Float
getAimZoom itm = case itm ^. itType of
    HELD hit -> heldAimZoom hit
    LASER ->  1.5
    _ -> 1

heldAimZoom :: HeldItemType -> Float
heldAimZoom = \case
    BANGSTICK{} -> 1
    REWINDER -> 1
    TIMESTOPPER -> 1
    TIMESCROLLER -> 1
    PISTOL -> 1
    MACHINEPISTOL -> 1
    AUTOPISTOL -> 1
    SMG -> 1
    BANGCONE -> 1
    BLUNDERBUSS -> 1.5
    GRAPECANNON{} ->  1.5
    MINIGUNX{} ->  1.5
    VOLLEYGUN{} ->  1.5
    RIFLE ->  1.5
    ALTERIFLE ->  1.5
    AUTORIFLE ->  1.5
    BURSTRIFLE ->  1.5
    BANGROD ->  1.5
    ELEPHANTGUN ->  1.5
    AMR ->  1.5
    AUTOAMR ->  1.5
    SNIPERRIFLE ->  0.5
    FLAMESPITTER -> 1
    FLAMETHROWER ->  1.5
    FLAMETORRENT -> 1
    FLAMEWALL -> 1
    BLOWTORCH -> 1
    SPARKGUN -> 1
    TESLAGUN ->  1.5
    TRACTORGUN ->  1.5
    RLAUNCHER ->  1.5
    RLAUNCHERX{} ->  1.5
    GLAUNCHER ->  1.5
    POISONSPRAYER -> 1
    SHATTERGUN -> 1
    TORCH -> 1
    FLATSHIELD -> 1
    KEYCARD {} -> 1
    BLINKER -> 1
    BLINKERUNSAFE -> 1

-- for example, this should be 400 or so when you have an unsafe blink gun
-- capable of firing, should be expanded when you have a radar of some sort, etc
viewDistanceFromItems :: Creature -> Float
viewDistanceFromItems _ = 1

rotateCamera :: Config -> World -> World
rotateCamera cfig w
    | MouseGameRotate <- w ^. input . mouseContext
      , Just rotation <-
            angleBetween (w ^. input . mousePos)
                <$> (w ^. input . heldPos . at SDL.ButtonRight) =
        w & wCam . camRot -~ rotation
    | _gameplay_rotate_to_wall cfig
      , isNothing $ w ^? input . mouseButtons . ix SDL.ButtonRight =
        rotateToOverlappingWall w
    | otherwise = w

rotateToOverlappingWall :: World -> World
rotateToOverlappingWall w =
    maybe
        id
        (doWallRotate . snd)
        (overlapCircWallsClosest p (crRad (cr ^. crType) + 10) (filter _wlRotateTo $ wlsNearPoint p w))
        w
  where
    cr = you w
    p = _crPos (you w)

doWallRotate :: Wall -> World -> World
doWallRotate wl w
    | b - b' > 0.01 = w & wCam . camRot +~ 0.01
    | b - b' < negate 0.01 = w & wCam . camRot -~ 0.01
    | otherwise = w
  where
    a = argV (uncurry (-.-) $ _wlLine wl) - w ^. wCam . camRot
    b = a * (4 / pi) -- for 8 way cardinal orientation wrt wall
    b' = fromIntegral (round b :: Int)

clipZoom ::
    -- | Furthest viewable distance
    Float ->
    Float
clipZoom = min 20 . max 0.2

setViewDistance :: Config -> Camera -> Camera
setViewDistance cfig w =
    w & camViewDistance
        .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. camZoom)

farWallDistDirection :: Point2 -> World -> Maybe (Float, Float, Float, Float)
farWallDistDirection p w = boundPoints $ map f $ getViewpoints p (_cWorld w)
  where
    f q = (rotateV (negate (w ^. wCam . camRot)) . (-.- p)) (foldl' findPoint q (wls q))
    wls q = filter wlIsOpaque $ wlsNearSeg p q w
    findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine

findBoundDists :: Config -> World -> (Float, Float, Float, Float)
findBoundDists cfig w
    | debugOn Bound_box_screen cfig = (hh, - hh, hw, - hw)
    | otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. wCam . camViewFrom) w
  where
    hw = halfWidth cfig
    hh = halfHeight cfig

-- this probably doesn't need to be updated every frame,
-- though I'm not sure how often it should be updated
updateBounds :: Config -> World -> World
updateBounds cfig w = case (w ^. cWorld . cClock) `mod` 5 of
    0 ->
        w
            & wCam . camBoundDist .~ bdists
            & wCam . camBoundBox
                .~ map ((+.+ w ^. wCam . camCenter) . rotateV (w ^. wCam . camRot)) (rectNSWE n s w' e)
    _ -> w
  where
    bdists@(n, s, e, w') = findBoundDists cfig w