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 import UnliftIO.Resource (MonadResource) spawnViewOrbital :: ( MonadResource m , MonadUnliftIO m ) => Camera.ViewOrbitalInput -> m 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 :: ( MonadResource m , MonadUnliftIO m ) => Camera.ViewProcess -> m 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