module Engine.Camera.Event.Handler ( handler ) where import RIO import Engine.Camera qualified as Camera import Engine.Camera.Controls qualified as Controls import Engine.Camera.Event.Type (Event) import Engine.Camera.Event.Type qualified as Event import Engine.Worker qualified as Worker handler :: MonadIO m => m Controls.ViewProcess -> m Controls.ControlsProcess -> Event -> m () handler :: m ViewProcess -> m ControlsProcess -> Event -> m () handler m ViewProcess getViewP m ControlsProcess getCameraControls = \case Event.Zoom Float delta -> do ViewProcess cameraView <- m ViewProcess getViewP ViewProcess -> (GetInput ViewProcess -> GetInput ViewProcess) -> m () forall (m :: * -> *) var. (MonadIO m, HasInput var) => var -> (GetInput var -> GetInput var) -> m () Worker.pushInput ViewProcess cameraView \GetInput ViewProcess voi -> GetInput ViewProcess ViewOrbitalInput voi { $sel:orbitDistance:ViewOrbitalInput :: Float Camera.orbitDistance = Float -> Float -> Float forall a. Ord a => a -> a -> a max Float 0.5 (Float -> Float) -> Float -> Float forall a b. (a -> b) -> a -> b $ ViewOrbitalInput -> Float Camera.orbitDistance GetInput ViewProcess ViewOrbitalInput voi Float -> Float -> Float forall a. Num a => a -> a -> a - Float delta Float -> Float -> Float forall a. Num a => a -> a -> a * Float 0.5 } Event.Pan Vec3 delta -> do ViewProcess cameraView <- m ViewProcess getViewP ViewProcess -> Vec3 -> m () forall (m :: * -> *). MonadIO m => ViewProcess -> Vec3 -> m () Controls.panInstant ViewProcess cameraView Vec3 delta Event.PanHorizontal Float delta -> do ControlsProcess controls <- m ControlsProcess getCameraControls Timed Float () -> (GetConfig (Timed Float ()) -> GetConfig (Timed Float ())) -> m () forall (m :: * -> *) var. (MonadIO m, HasConfig var) => var -> (GetConfig var -> GetConfig var) -> m () Worker.modifyConfig (ControlsProcess -> Timed Float () forall a. Controls a -> a Controls.panHorizontal ControlsProcess controls) ((GetConfig (Timed Float ()) -> GetConfig (Timed Float ())) -> m ()) -> (GetConfig (Timed Float ()) -> GetConfig (Timed Float ())) -> m () forall a b. (a -> b) -> a -> b $ Float -> Float -> Float forall a b. a -> b -> a const Float delta Event.PanVertical Float delta -> do ControlsProcess controls <- m ControlsProcess getCameraControls Timed Float () -> (GetConfig (Timed Float ()) -> GetConfig (Timed Float ())) -> m () forall (m :: * -> *) var. (MonadIO m, HasConfig var) => var -> (GetConfig var -> GetConfig var) -> m () Worker.modifyConfig (ControlsProcess -> Timed Float () forall a. Controls a -> a Controls.panVertical ControlsProcess controls) ((GetConfig (Timed Float ()) -> GetConfig (Timed Float ())) -> m ()) -> (GetConfig (Timed Float ()) -> GetConfig (Timed Float ())) -> m () forall a b. (a -> b) -> a -> b $ Float -> Float -> Float forall a b. a -> b -> a const Float delta Event.TurnAzimuth Float delta -> do ControlsProcess controls <- m ControlsProcess getCameraControls Timed Float () -> (GetConfig (Timed Float ()) -> GetConfig (Timed Float ())) -> m () forall (m :: * -> *) var. (MonadIO m, HasConfig var) => var -> (GetConfig var -> GetConfig var) -> m () Worker.modifyConfig (ControlsProcess -> Timed Float () forall a. Controls a -> a Controls.turnAzimuth ControlsProcess controls) ((GetConfig (Timed Float ()) -> GetConfig (Timed Float ())) -> m ()) -> (GetConfig (Timed Float ()) -> GetConfig (Timed Float ())) -> m () forall a b. (a -> b) -> a -> b $ Float -> Float -> Float forall a b. a -> b -> a const Float delta Event.TurnInclination Float delta -> do ControlsProcess controls <- m ControlsProcess getCameraControls Timed Float () -> (GetConfig (Timed Float ()) -> GetConfig (Timed Float ())) -> m () forall (m :: * -> *) var. (MonadIO m, HasConfig var) => var -> (GetConfig var -> GetConfig var) -> m () Worker.modifyConfig (ControlsProcess -> Timed Float () forall a. Controls a -> a Controls.turnInclination ControlsProcess controls) ((GetConfig (Timed Float ()) -> GetConfig (Timed Float ())) -> m ()) -> (GetConfig (Timed Float ()) -> GetConfig (Timed Float ())) -> m () forall a b. (a -> b) -> a -> b $ Float -> Float -> Float forall a b. a -> b -> a const Float delta