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 :: forall (m :: * -> *). (MonadResource m, MonadUnliftIO m) => ViewOrbitalInput -> m ViewProcess spawnViewOrbital = forall (m :: * -> *) input output. (MonadUnliftIO m, MonadResource m) => (input -> output) -> input -> m (Cell input output) Worker.spawnCell ViewOrbitalInput -> View Camera.mkViewOrbital_ data Controls a = Controls { forall a. Controls a -> a panHorizontal :: a , forall a. Controls a -> a panVertical :: a , forall a. Controls a -> a turnAzimuth :: a , forall a. Controls a -> a turnInclination :: a } deriving (forall a b. a -> Controls b -> Controls a forall a b. (a -> b) -> Controls a -> Controls b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: forall a b. a -> Controls b -> Controls a $c<$ :: forall a b. a -> Controls b -> Controls a fmap :: forall a b. (a -> b) -> Controls a -> Controls b $cfmap :: forall a b. (a -> b) -> Controls a -> Controls b Functor, forall a. Eq a => a -> Controls a -> Bool forall a. Num a => Controls a -> a forall a. Ord a => Controls a -> a forall m. Monoid m => Controls m -> m forall a. Controls a -> Bool forall a. Controls a -> Int forall a. Controls a -> [a] forall a. (a -> a -> a) -> Controls a -> a forall m a. Monoid m => (a -> m) -> Controls a -> m forall b a. (b -> a -> b) -> b -> Controls a -> b forall a b. (a -> b -> b) -> b -> Controls a -> b forall (t :: * -> *). (forall m. Monoid m => t m -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. t a -> [a]) -> (forall a. t a -> Bool) -> (forall a. t a -> Int) -> (forall a. Eq a => a -> t a -> Bool) -> (forall a. Ord a => t a -> a) -> (forall a. Ord a => t a -> a) -> (forall a. Num a => t a -> a) -> (forall a. Num a => t a -> a) -> Foldable t product :: forall a. Num a => Controls a -> a $cproduct :: forall a. Num a => Controls a -> a sum :: forall a. Num a => Controls a -> a $csum :: forall a. Num a => Controls a -> a minimum :: forall a. Ord a => Controls a -> a $cminimum :: forall a. Ord a => Controls a -> a maximum :: forall a. Ord a => Controls a -> a $cmaximum :: forall a. Ord a => Controls a -> a elem :: forall a. Eq a => a -> Controls a -> Bool $celem :: forall a. Eq a => a -> Controls a -> Bool length :: forall a. Controls a -> Int $clength :: forall a. Controls a -> Int null :: forall a. Controls a -> Bool $cnull :: forall a. Controls a -> Bool toList :: forall a. Controls a -> [a] $ctoList :: forall a. Controls a -> [a] foldl1 :: forall a. (a -> a -> a) -> Controls a -> a $cfoldl1 :: forall a. (a -> a -> a) -> Controls a -> a foldr1 :: forall a. (a -> a -> a) -> Controls a -> a $cfoldr1 :: forall a. (a -> a -> a) -> Controls a -> a foldl' :: forall b a. (b -> a -> b) -> b -> Controls a -> b $cfoldl' :: forall b a. (b -> a -> b) -> b -> Controls a -> b foldl :: forall b a. (b -> a -> b) -> b -> Controls a -> b $cfoldl :: forall b a. (b -> a -> b) -> b -> Controls a -> b foldr' :: forall a b. (a -> b -> b) -> b -> Controls a -> b $cfoldr' :: forall a b. (a -> b -> b) -> b -> Controls a -> b foldr :: forall a b. (a -> b -> b) -> b -> Controls a -> b $cfoldr :: forall a b. (a -> b -> b) -> b -> Controls a -> b foldMap' :: forall m a. Monoid m => (a -> m) -> Controls a -> m $cfoldMap' :: forall m a. Monoid m => (a -> m) -> Controls a -> m foldMap :: forall m a. Monoid m => (a -> m) -> Controls a -> m $cfoldMap :: forall m a. Monoid m => (a -> m) -> Controls a -> m fold :: forall m. Monoid m => Controls m -> m $cfold :: forall m. Monoid m => Controls m -> m Foldable, Functor Controls Foldable Controls forall (t :: * -> *). Functor t -> Foldable t -> (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> t a -> f (t b)) -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)) -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a)) -> Traversable t forall (m :: * -> *) a. Monad m => Controls (m a) -> m (Controls a) forall (f :: * -> *) a. Applicative f => Controls (f a) -> f (Controls a) forall (m :: * -> *) a b. Monad m => (a -> m b) -> Controls a -> m (Controls b) forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Controls a -> f (Controls b) sequence :: forall (m :: * -> *) a. Monad m => Controls (m a) -> m (Controls a) $csequence :: forall (m :: * -> *) a. Monad m => Controls (m a) -> m (Controls a) mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> Controls a -> m (Controls b) $cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> Controls a -> m (Controls b) sequenceA :: forall (f :: * -> *) a. Applicative f => Controls (f a) -> f (Controls a) $csequenceA :: forall (f :: * -> *) a. Applicative f => Controls (f a) -> f (Controls a) traverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Controls a -> f (Controls b) $ctraverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Controls a -> f (Controls b) Traversable) type ControlsProcess = Controls (Worker.Timed Float ()) spawnControls :: ( MonadResource m , MonadUnliftIO m ) => Camera.ViewProcess -> m ControlsProcess spawnControls :: forall (m :: * -> *). (MonadResource m, MonadUnliftIO m) => ViewProcess -> m ControlsProcess spawnControls ViewProcess vp = forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse (Float -> Float -> ViewOrbitalInput -> ViewOrbitalInput) -> m (Timed Float ()) mkUpdater Controls { $sel:panHorizontal:Controls :: Float -> Float -> ViewOrbitalInput -> ViewOrbitalInput panHorizontal = Float -> Float -> ViewOrbitalInput -> ViewOrbitalInput panTargetHorizontal , $sel:panVertical:Controls :: Float -> Float -> ViewOrbitalInput -> ViewOrbitalInput panVertical = Float -> Float -> ViewOrbitalInput -> ViewOrbitalInput panTargetVertical , $sel:turnAzimuth:Controls :: Float -> Float -> ViewOrbitalInput -> ViewOrbitalInput turnAzimuth = forall {p}. p -> Float -> ViewOrbitalInput -> ViewOrbitalInput orbitAzimuthTurn , $sel:turnInclination:Controls :: Float -> Float -> ViewOrbitalInput -> ViewOrbitalInput turnInclination = forall {p}. p -> Float -> ViewOrbitalInput -> ViewOrbitalInput orbitAscentTurn } where vpInput :: Var (GetInput ViewProcess) vpInput = forall a. HasInput a => a -> Var (GetInput a) Worker.getInput ViewProcess vp dtI :: Int dtI = Int 1e3 dt :: Float dt = forall a b. (Integral a, Num b) => a -> b fromIntegral Int dtI forall a. Fractional a => a -> a -> a / Float 1e6 mkUpdater :: (Float -> Float -> ViewOrbitalInput -> ViewOrbitalInput) -> m (Timed Float ()) mkUpdater Float -> Float -> ViewOrbitalInput -> ViewOrbitalInput updater = forall (m :: * -> *) config output state. (MonadUnliftIO m, MonadResource m) => Bool -> Either Int (config -> Int) -> (config -> m (output, state)) -> (state -> config -> m (Maybe output, state)) -> config -> m (Timed config output) Worker.spawnTimed Bool True (forall a b. a -> Either a b Left Int dtI) (\Float _delta -> forall (f :: * -> *) a. Applicative f => a -> f a pure ((), Float 0.0)) (\Float acceleration Float delta -> do forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (Float delta forall a. Eq a => a -> a -> Bool /= Float 0) forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) var. (MonadIO m, HasInput var) => var -> (GetInput var -> GetInput var) -> m () Worker.pushInput Var (GetInput ViewProcess) vpInput forall a b. (a -> b) -> a -> b $ Float -> Float -> ViewOrbitalInput -> ViewOrbitalInput updater (Float 1 forall a. Num a => a -> a -> a + Float acceleration) (Float delta forall a. Num a => a -> a -> a * Float dt) pure ( forall a. Maybe a Nothing , if Float delta forall a. Eq a => a -> a -> Bool == Float 0 then if Float acceleration forall a. Ord a => a -> a -> Bool < Float 1forall a. Fractional a => a -> a -> a /Float 128 then Float acceleration else Float acceleration forall a. Num a => a -> a -> a * Float 0.97 else Float acceleration forall a. Num a => a -> a -> a + Float 0.01 ) ) Float 0 panTargetHorizontal :: Float -> Float -> ViewOrbitalInput -> ViewOrbitalInput panTargetHorizontal Float acceleration Float delta ViewOrbitalInput voi = ViewOrbitalInput voi { $sel:orbitTarget:ViewOrbitalInput :: Vec3 Camera.orbitTarget = ViewOrbitalInput -> Vec3 Camera.orbitTarget ViewOrbitalInput voi forall a. Num a => a -> a -> a + Vec3 pan } where pan :: Vec3 pan = Quaternion -> Vec3 -> Vec3 Quaternion.rotate (Vec3 -> Float -> Quaternion Quaternion.axisAngle Vec3 up Float azimuth) (Float -> Float -> Float -> Vec3 vec3 (Float delta forall a. Num a => a -> a -> a * Float acceleration) Float 0 Float 0) up :: Vec3 up = ViewOrbitalInput -> Vec3 Camera.orbitUp ViewOrbitalInput voi azimuth :: Float azimuth = ViewOrbitalInput -> Float Camera.orbitAzimuth ViewOrbitalInput voi panTargetVertical :: Float -> Float -> ViewOrbitalInput -> ViewOrbitalInput panTargetVertical Float acceleration Float delta ViewOrbitalInput voi = ViewOrbitalInput voi { $sel:orbitTarget:ViewOrbitalInput :: Vec3 Camera.orbitTarget = ViewOrbitalInput -> Vec3 Camera.orbitTarget ViewOrbitalInput voi forall a. Num a => a -> a -> a + Vec3 pan } where pan :: Vec3 pan = Quaternion -> Vec3 -> Vec3 Quaternion.rotate (Vec3 -> Float -> Quaternion Quaternion.axisAngle Vec3 up Float azimuth) (Float -> Float -> Float -> Vec3 vec3 Float 0 Float 0 (Float delta forall a. Num a => a -> a -> a * Float acceleration)) up :: Vec3 up = ViewOrbitalInput -> Vec3 Camera.orbitUp ViewOrbitalInput voi azimuth :: Float azimuth = ViewOrbitalInput -> Float Camera.orbitAzimuth ViewOrbitalInput voi orbitAzimuthTurn :: p -> Float -> ViewOrbitalInput -> ViewOrbitalInput orbitAzimuthTurn p _acceleration Float delta ViewOrbitalInput voi = ViewOrbitalInput voi { $sel:orbitAzimuth:ViewOrbitalInput :: Float Camera.orbitAzimuth = Float azimuth } where azimuth :: Float azimuth | Float azimuth' forall a. Ord a => a -> a -> Bool < (-Float τ) = Float azimuth' forall a. Num a => a -> a -> a + (Float 2 forall a. Num a => a -> a -> a * Float τ) | Float azimuth' forall a. Ord a => a -> a -> Bool > Float τ = Float azimuth' forall a. Num a => a -> a -> a - (Float 2 forall a. Num a => a -> a -> a * Float τ) | Bool otherwise = Float azimuth' azimuth' :: Float azimuth' = ViewOrbitalInput -> Float Camera.orbitAzimuth ViewOrbitalInput voi forall a. Num a => a -> a -> a + Float delta orbitAscentTurn :: p -> Float -> ViewOrbitalInput -> ViewOrbitalInput orbitAscentTurn p _acceleration Float delta ViewOrbitalInput voi = ViewOrbitalInput voi { $sel:orbitAscent:ViewOrbitalInput :: Float Camera.orbitAscent = Float ascent } where ascent :: Float ascent = forall a. Ord a => a -> a -> a max (-Float limit) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Ord a => a -> a -> a min Float limit forall a b. (a -> b) -> a -> b $ ViewOrbitalInput -> Float Camera.orbitAscent ViewOrbitalInput voi forall a. Num a => a -> a -> a + Float delta limit :: Float limit = Float τforall a. Fractional a => a -> a -> a /Float 4 forall a. Num a => a -> a -> a - Float 1forall a. Fractional a => a -> a -> a /Float 512 panInstant :: MonadIO m => Camera.ViewProcess -> Vec3 -> m () panInstant :: forall (m :: * -> *). MonadIO m => ViewProcess -> Vec3 -> m () panInstant ViewProcess vp Vec3 delta3 = do forall (m :: * -> *) var. (MonadIO m, HasInput var) => var -> (GetInput var -> GetInput var) -> m () Worker.pushInput ViewProcess vp \voi :: GetInput ViewProcess voi@Camera.ViewOrbitalInput{Float Vec3 $sel:orbitRight:ViewOrbitalInput :: ViewOrbitalInput -> Vec3 $sel:orbitScale:ViewOrbitalInput :: ViewOrbitalInput -> Float $sel:orbitDistance:ViewOrbitalInput :: ViewOrbitalInput -> Float orbitRight :: Vec3 orbitUp :: Vec3 orbitTarget :: Vec3 orbitScale :: Float orbitDistance :: Float orbitAscent :: Float orbitAzimuth :: Float $sel:orbitAscent:ViewOrbitalInput :: ViewOrbitalInput -> Float $sel:orbitAzimuth:ViewOrbitalInput :: ViewOrbitalInput -> Float $sel:orbitUp:ViewOrbitalInput :: ViewOrbitalInput -> Vec3 $sel:orbitTarget:ViewOrbitalInput :: ViewOrbitalInput -> Vec3 ..} -> let pan :: Float -> Vec3 pan Float azimuth = Quaternion -> Vec3 -> Vec3 Quaternion.rotate (Vec3 -> Float -> Quaternion Quaternion.axisAngle Vec3 orbitUp Float azimuth) Vec3 delta3 forall a. Num a => a -> a -> a * Vec3 0.01 in GetInput ViewProcess voi { $sel:orbitTarget:ViewOrbitalInput :: Vec3 Camera.orbitTarget = ViewOrbitalInput -> Vec3 Camera.orbitTarget GetInput ViewProcess voi forall a. Num a => a -> a -> a + Float -> Vec3 pan Float orbitAzimuth } τ :: Float τ :: Float τ = Float 2 forall a. Num a => a -> a -> a * forall a. Floating a => a pi