Controls.hs

module Engine.Camera.Controls
  ( Camera.ProjectionProcess
  , Camera.ViewProcess
  , spawnViewOrbital

  , Controls(..)
  , ControlsProcess
  , spawnControls

  , panInstant
  ) where

import RIO

import Engine.Camera qualified as Camera
import Engine.Worker qualified as Worker
import Geomancy (Vec3, vec3)
import Geomancy.Quaternion qualified as Quaternion

spawnViewOrbital :: Camera.ViewOrbitalInput -> RIO env Camera.ViewProcess
spawnViewOrbital = Worker.spawnCell Camera.mkViewOrbital_

data Controls a = Controls
  { panHorizontal   :: a
  , panVertical     :: a
  , turnAzimuth     :: a
  , turnInclination :: a
  }
  deriving (Functor, Foldable, Traversable)

type ControlsProcess = Controls (Worker.Timed Float ())

spawnControls :: Camera.ViewProcess -> RIO env ControlsProcess
spawnControls vp =
  traverse mkUpdater Controls
    { panHorizontal   = panTargetHorizontal
    , panVertical     = panTargetVertical
    , turnAzimuth     = orbitAzimuthTurn
    , turnInclination = orbitAscentTurn
    }
  where
    vpInput = Worker.getInput vp

    dtI = 1e3
    dt = fromIntegral dtI / 1e6

    mkUpdater updater =
      Worker.spawnTimed
        True
        (Left dtI)
        (\_delta -> pure ((), 0.0))
        (\acceleration delta -> do
            when (delta /= 0) $
              Worker.pushInput vpInput $
                updater (1 + acceleration) (delta * dt)
            pure
              ( Nothing
              , if delta == 0 then
                  if acceleration < 1/128 then
                    acceleration
                  else
                    acceleration * 0.97
                else
                  acceleration + 0.01
              )
        )
        0

    panTargetHorizontal acceleration delta voi = voi
      { Camera.orbitTarget = Camera.orbitTarget voi + pan
      }
      where
        pan = Quaternion.rotate
          (Quaternion.axisAngle up azimuth)
          (vec3 (delta * acceleration) 0 0)
        up = Camera.orbitUp voi
        azimuth = Camera.orbitAzimuth voi

    panTargetVertical acceleration delta voi = voi
      { Camera.orbitTarget = Camera.orbitTarget voi + pan
      }
      where
        pan =
          Quaternion.rotate
            (Quaternion.axisAngle up azimuth)
            (vec3 0 0 (delta * acceleration))

        up = Camera.orbitUp voi
        azimuth = Camera.orbitAzimuth voi

    orbitAzimuthTurn _acceleration delta voi = voi
      { Camera.orbitAzimuth = azimuth
      }
      where
        azimuth
          | azimuth' < (-τ) = azimuth' + (2 * τ)
          | azimuth' > τ = azimuth' - (2 * τ)
          | otherwise = azimuth'

        azimuth' = Camera.orbitAzimuth voi + delta

    orbitAscentTurn _acceleration delta voi = voi
      { Camera.orbitAscent = ascent
      }
      where
        ascent =
          max (-limit) . min limit $
            Camera.orbitAscent voi + delta

        limit = τ/4 - 1/512

panInstant :: MonadIO m => Camera.ViewProcess -> Vec3 -> m ()
panInstant vp delta3 = do
  Worker.pushInput vp \voi@Camera.ViewOrbitalInput{..} ->
    let
      pan azimuth = Quaternion.rotate
        (Quaternion.axisAngle orbitUp azimuth)
        delta3 * 0.01
    in
      voi
        { Camera.orbitTarget =
            Camera.orbitTarget voi + pan orbitAzimuth
        }

τ :: Float
τ = 2 * pi