module Engine.Events.CursorPos where
import RIO
import Geomancy (Vec2, vec2, pattern WithVec2)
import GHC.Float (double2Float)
import UnliftIO.Resource (MonadResource, ReleaseKey)
import Vulkan.Core10 qualified as Vk
import Vulkan.NamedType ((:::))
import Engine.Events.Sink (MonadSink, Sink)
import Engine.Types (askScreenVar)
import Engine.Window.CursorPos qualified as CursorPos
import Engine.Worker qualified as Worker
callback
:: ( MonadSink rs m
, Worker.HasInput cursor
, Worker.GetInput cursor ~ Vec2
)
=> cursor
-> Sink e st
-> m ReleaseKey
callback :: forall rs (m :: * -> *) cursor e st.
(MonadSink rs m, HasInput cursor, GetInput cursor ~ Vec2) =>
cursor -> Sink e st -> m ReleaseKey
callback cursor
cursorVar = forall rs (m :: * -> *).
MonadSink rs m =>
Callback m -> m ReleaseKey
CursorPos.callback forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) cursor e st.
(MonadResource m, HasInput cursor, GetInput cursor ~ Vec2) =>
cursor -> Sink e st -> Callback m
handler cursor
cursorVar
handler
:: ( MonadResource m
, Worker.HasInput cursor
, Worker.GetInput cursor ~ Vec2
)
=> cursor
-> Sink e st
-> CursorPos.Callback m
handler :: forall (m :: * -> *) cursor e st.
(MonadResource m, HasInput cursor, GetInput cursor ~ Vec2) =>
cursor -> Sink e st -> Callback m
handler cursor
cursorVar Sink e st
_sink Double
windowX Double
windowY = do
forall (m :: * -> *) var.
(MonadIO m, HasInput var) =>
var -> (GetInput var -> GetInput var) -> m ()
Worker.pushInput cursor
cursorVar \GetInput cursor
_old ->
Float -> Float -> Vec2
vec2 (Double -> Float
double2Float Double
windowX) (Double -> Float
double2Float Double
windowY)
type Process = Worker.Cell ("window" ::: Vec2) ("centered" ::: Vec2)
spawn
:: MonadSink rs m
=> m Process
spawn :: forall rs (m :: * -> *). MonadSink rs m => m Process
spawn = do
Var Extent2D
screen <- forall st (m :: * -> *).
MonadReader (App GlobalHandles st) m =>
m (Var Extent2D)
askScreenVar
Var Vec2
cursorWindow <- forall (m :: * -> *) a. MonadUnliftIO m => a -> m (Var a)
Worker.newVar Vec2
0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Var Vec2
cursorWindow,) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) i1 i2 o.
(MonadUnliftIO m, MonadResource m, HasOutput i1, HasOutput i2) =>
(GetOutput i1 -> GetOutput i2 -> o) -> i1 -> i2 -> m (Merge o)
Worker.spawnMerge2
(\Vk.Extent2D{Word32
$sel:width:Extent2D :: Extent2D -> Word32
width :: Word32
width, Word32
$sel:height:Extent2D :: Extent2D -> Word32
height :: Word32
height} (WithVec2 Float
windowX Float
windowY) ->
Float -> Float -> Vec2
vec2
(Float
windowX forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
width forall a. Fractional a => a -> a -> a
/ Float
2)
(Float
windowY forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
height forall a. Fractional a => a -> a -> a
/ Float
2)
)
Var Extent2D
screen
Var Vec2
cursorWindow