module Engine.Window.MouseButton
  ( Callback
  , callback

  , GLFW.MouseButton(..)
  , GLFW.MouseButtonState(..)
  , GLFW.ModifierKeys(..)

  , mkCallback

  , mouseButtonState
  , whenPressed
  , whenReleased

  , Collection(..)
  , collectionGlfw
  , atGlfw
  ) where

import RIO

import Graphics.UI.GLFW qualified as GLFW
import Resource.Collection (Generic1, Generically1(..))
import RIO.App (appEnv)
import UnliftIO.Resource (ReleaseKey)
import UnliftIO.Resource qualified as Resource

import Engine.Events.Sink (MonadSink)
import Engine.Types (GlobalHandles(..))

type Callback m = (GLFW.ModifierKeys, GLFW.MouseButtonState, GLFW.MouseButton) -> m ()

callback
  :: MonadSink rs m
  => Callback m
  -> m ReleaseKey
callback :: forall rs (m :: * -> *).
MonadSink rs m =>
Callback m -> m ReleaseKey
callback Callback m
handler = do
  Window
window <- (App GlobalHandles rs -> Window) -> m Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((App GlobalHandles rs -> Window) -> m Window)
-> (App GlobalHandles rs -> Window) -> m Window
forall a b. (a -> b) -> a -> b
$ GlobalHandles -> Window
ghWindow (GlobalHandles -> Window)
-> (App GlobalHandles rs -> GlobalHandles)
-> App GlobalHandles rs
-> Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App GlobalHandles rs -> GlobalHandles
forall env st. App env st -> env
appEnv
  (UnliftIO m -> IO ()) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(UnliftIO m -> IO a) -> m a
withUnliftIO \UnliftIO m
ul ->
    Window -> Maybe MouseButtonCallback -> IO ()
GLFW.setMouseButtonCallback Window
window (Maybe MouseButtonCallback -> IO ())
-> (MouseButtonCallback -> Maybe MouseButtonCallback)
-> MouseButtonCallback
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MouseButtonCallback -> Maybe MouseButtonCallback
forall a. a -> Maybe a
Just (MouseButtonCallback -> IO ()) -> MouseButtonCallback -> IO ()
forall a b. (a -> b) -> a -> b
$ UnliftIO m -> Callback m -> MouseButtonCallback
forall (m :: * -> *).
UnliftIO m -> Callback m -> MouseButtonCallback
mkCallback UnliftIO m
ul Callback m
handler
  IO () -> m ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
Resource.register (IO () -> m ReleaseKey) -> IO () -> m ReleaseKey
forall a b. (a -> b) -> a -> b
$
    Window -> Maybe MouseButtonCallback -> IO ()
GLFW.setMouseButtonCallback Window
window Maybe MouseButtonCallback
forall a. Maybe a
Nothing

mkCallback :: UnliftIO m -> Callback m -> GLFW.MouseButtonCallback
mkCallback :: forall (m :: * -> *).
UnliftIO m -> Callback m -> MouseButtonCallback
mkCallback (UnliftIO forall a. m a -> IO a
ul) Callback m
action =
  \Window
_window MouseButton
button MouseButtonState
buttonState ModifierKeys
mods ->
    m () -> IO ()
forall a. m a -> IO a
ul (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Callback m
action (ModifierKeys
mods, MouseButtonState
buttonState, MouseButton
button)

{-# INLINE mouseButtonState #-}
mouseButtonState :: a -> a -> GLFW.MouseButtonState -> a
mouseButtonState :: forall a. a -> a -> MouseButtonState -> a
mouseButtonState a
pressed a
released = \case
  MouseButtonState
GLFW.MouseButtonState'Pressed  -> a
pressed
  MouseButtonState
GLFW.MouseButtonState'Released -> a
released

{-# INLINE whenPressed #-}
whenPressed :: Applicative f => GLFW.MouseButtonState -> f () -> f ()
whenPressed :: forall (f :: * -> *).
Applicative f =>
MouseButtonState -> f () -> f ()
whenPressed MouseButtonState
mbs f ()
action = f () -> f () -> MouseButtonState -> f ()
forall a. a -> a -> MouseButtonState -> a
mouseButtonState f ()
action (() -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) MouseButtonState
mbs

{-# INLINE whenReleased #-}
whenReleased :: Applicative f => GLFW.MouseButtonState -> f () -> f ()
whenReleased :: forall (f :: * -> *).
Applicative f =>
MouseButtonState -> f () -> f ()
whenReleased MouseButtonState
mbs f ()
action = f () -> f () -> MouseButtonState -> f ()
forall a. a -> a -> MouseButtonState -> a
mouseButtonState (() -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) f ()
action MouseButtonState
mbs

data Collection a = Collection
  { forall a. Collection a -> a
mb1, forall a. Collection a -> a
mb2, forall a. Collection a -> a
mb3, forall a. Collection a -> a
mb4, forall a. Collection a -> a
mb5, forall a. Collection a -> a
mb6, forall a. Collection a -> a
mb7, forall a. Collection a -> a
mb8 :: a }
  deriving (Collection a -> Collection a -> Bool
(Collection a -> Collection a -> Bool)
-> (Collection a -> Collection a -> Bool) -> Eq (Collection a)
forall a. Eq a => Collection a -> Collection a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Collection a -> Collection a -> Bool
== :: Collection a -> Collection a -> Bool
$c/= :: forall a. Eq a => Collection a -> Collection a -> Bool
/= :: Collection a -> Collection a -> Bool
Eq, Eq (Collection a)
Eq (Collection a)
-> (Collection a -> Collection a -> Ordering)
-> (Collection a -> Collection a -> Bool)
-> (Collection a -> Collection a -> Bool)
-> (Collection a -> Collection a -> Bool)
-> (Collection a -> Collection a -> Bool)
-> (Collection a -> Collection a -> Collection a)
-> (Collection a -> Collection a -> Collection a)
-> Ord (Collection a)
Collection a -> Collection a -> Bool
Collection a -> Collection a -> Ordering
Collection a -> Collection a -> Collection a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Collection a)
forall a. Ord a => Collection a -> Collection a -> Bool
forall a. Ord a => Collection a -> Collection a -> Ordering
forall a. Ord a => Collection a -> Collection a -> Collection a
$ccompare :: forall a. Ord a => Collection a -> Collection a -> Ordering
compare :: Collection a -> Collection a -> Ordering
$c< :: forall a. Ord a => Collection a -> Collection a -> Bool
< :: Collection a -> Collection a -> Bool
$c<= :: forall a. Ord a => Collection a -> Collection a -> Bool
<= :: Collection a -> Collection a -> Bool
$c> :: forall a. Ord a => Collection a -> Collection a -> Bool
> :: Collection a -> Collection a -> Bool
$c>= :: forall a. Ord a => Collection a -> Collection a -> Bool
>= :: Collection a -> Collection a -> Bool
$cmax :: forall a. Ord a => Collection a -> Collection a -> Collection a
max :: Collection a -> Collection a -> Collection a
$cmin :: forall a. Ord a => Collection a -> Collection a -> Collection a
min :: Collection a -> Collection a -> Collection a
Ord, Int -> Collection a -> ShowS
[Collection a] -> ShowS
Collection a -> String
(Int -> Collection a -> ShowS)
-> (Collection a -> String)
-> ([Collection a] -> ShowS)
-> Show (Collection a)
forall a. Show a => Int -> Collection a -> ShowS
forall a. Show a => [Collection a] -> ShowS
forall a. Show a => Collection a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Collection a -> ShowS
showsPrec :: Int -> Collection a -> ShowS
$cshow :: forall a. Show a => Collection a -> String
show :: Collection a -> String
$cshowList :: forall a. Show a => [Collection a] -> ShowS
showList :: [Collection a] -> ShowS
Show, (forall a. Collection a -> Rep1 Collection a)
-> (forall a. Rep1 Collection a -> Collection a)
-> Generic1 Collection
forall a. Rep1 Collection a -> Collection a
forall a. Collection a -> Rep1 Collection a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cfrom1 :: forall a. Collection a -> Rep1 Collection a
from1 :: forall a. Collection a -> Rep1 Collection a
$cto1 :: forall a. Rep1 Collection a -> Collection a
to1 :: forall a. Rep1 Collection a -> Collection a
Generic1, (forall a b. (a -> b) -> Collection a -> Collection b)
-> (forall a b. a -> Collection b -> Collection a)
-> Functor Collection
forall a b. a -> Collection b -> Collection a
forall a b. (a -> b) -> Collection a -> Collection b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Collection a -> Collection b
fmap :: forall a b. (a -> b) -> Collection a -> Collection b
$c<$ :: forall a b. a -> Collection b -> Collection a
<$ :: forall a b. a -> Collection b -> Collection a
Functor, (forall m. Monoid m => Collection m -> m)
-> (forall m a. Monoid m => (a -> m) -> Collection a -> m)
-> (forall m a. Monoid m => (a -> m) -> Collection a -> m)
-> (forall a b. (a -> b -> b) -> b -> Collection a -> b)
-> (forall a b. (a -> b -> b) -> b -> Collection a -> b)
-> (forall b a. (b -> a -> b) -> b -> Collection a -> b)
-> (forall b a. (b -> a -> b) -> b -> Collection a -> b)
-> (forall a. (a -> a -> a) -> Collection a -> a)
-> (forall a. (a -> a -> a) -> Collection a -> a)
-> (forall a. Collection a -> [a])
-> (forall a. Collection a -> Bool)
-> (forall a. Collection a -> Int)
-> (forall a. Eq a => a -> Collection a -> Bool)
-> (forall a. Ord a => Collection a -> a)
-> (forall a. Ord a => Collection a -> a)
-> (forall a. Num a => Collection a -> a)
-> (forall a. Num a => Collection a -> a)
-> Foldable Collection
forall a. Eq a => a -> Collection a -> Bool
forall a. Num a => Collection a -> a
forall a. Ord a => Collection a -> a
forall m. Monoid m => Collection m -> m
forall a. Collection a -> Bool
forall a. Collection a -> Int
forall a. Collection a -> [a]
forall a. (a -> a -> a) -> Collection a -> a
forall m a. Monoid m => (a -> m) -> Collection a -> m
forall b a. (b -> a -> b) -> b -> Collection a -> b
forall a b. (a -> b -> b) -> b -> Collection 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
$cfold :: forall m. Monoid m => Collection m -> m
fold :: forall m. Monoid m => Collection m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Collection a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Collection a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Collection a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Collection a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Collection a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Collection a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Collection a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Collection a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Collection a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Collection a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Collection a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Collection a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Collection a -> a
foldr1 :: forall a. (a -> a -> a) -> Collection a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Collection a -> a
foldl1 :: forall a. (a -> a -> a) -> Collection a -> a
$ctoList :: forall a. Collection a -> [a]
toList :: forall a. Collection a -> [a]
$cnull :: forall a. Collection a -> Bool
null :: forall a. Collection a -> Bool
$clength :: forall a. Collection a -> Int
length :: forall a. Collection a -> Int
$celem :: forall a. Eq a => a -> Collection a -> Bool
elem :: forall a. Eq a => a -> Collection a -> Bool
$cmaximum :: forall a. Ord a => Collection a -> a
maximum :: forall a. Ord a => Collection a -> a
$cminimum :: forall a. Ord a => Collection a -> a
minimum :: forall a. Ord a => Collection a -> a
$csum :: forall a. Num a => Collection a -> a
sum :: forall a. Num a => Collection a -> a
$cproduct :: forall a. Num a => Collection a -> a
product :: forall a. Num a => Collection a -> a
Foldable, Functor Collection
Foldable Collection
Functor Collection
-> Foldable Collection
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Collection a -> f (Collection b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Collection (f a) -> f (Collection a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Collection a -> m (Collection b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Collection (m a) -> m (Collection a))
-> Traversable Collection
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 =>
Collection (m a) -> m (Collection a)
forall (f :: * -> *) a.
Applicative f =>
Collection (f a) -> f (Collection a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Collection a -> m (Collection b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Collection a -> f (Collection b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Collection a -> f (Collection b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Collection a -> f (Collection b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Collection (f a) -> f (Collection a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Collection (f a) -> f (Collection a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Collection a -> m (Collection b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Collection a -> m (Collection b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Collection (m a) -> m (Collection a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Collection (m a) -> m (Collection a)
Traversable)
  deriving Functor Collection
Functor Collection
-> (forall a. a -> Collection a)
-> (forall a b.
    Collection (a -> b) -> Collection a -> Collection b)
-> (forall a b c.
    (a -> b -> c) -> Collection a -> Collection b -> Collection c)
-> (forall a b. Collection a -> Collection b -> Collection b)
-> (forall a b. Collection a -> Collection b -> Collection a)
-> Applicative Collection
forall a. a -> Collection a
forall a b. Collection a -> Collection b -> Collection a
forall a b. Collection a -> Collection b -> Collection b
forall a b. Collection (a -> b) -> Collection a -> Collection b
forall a b c.
(a -> b -> c) -> Collection a -> Collection b -> Collection c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Collection a
pure :: forall a. a -> Collection a
$c<*> :: forall a b. Collection (a -> b) -> Collection a -> Collection b
<*> :: forall a b. Collection (a -> b) -> Collection a -> Collection b
$cliftA2 :: forall a b c.
(a -> b -> c) -> Collection a -> Collection b -> Collection c
liftA2 :: forall a b c.
(a -> b -> c) -> Collection a -> Collection b -> Collection c
$c*> :: forall a b. Collection a -> Collection b -> Collection b
*> :: forall a b. Collection a -> Collection b -> Collection b
$c<* :: forall a b. Collection a -> Collection b -> Collection a
<* :: forall a b. Collection a -> Collection b -> Collection a
Applicative via Generically1 Collection

collectionGlfw :: Collection GLFW.MouseButton
collectionGlfw :: Collection MouseButton
collectionGlfw = MouseButton
-> MouseButton
-> MouseButton
-> MouseButton
-> MouseButton
-> MouseButton
-> MouseButton
-> MouseButton
-> Collection MouseButton
forall a. a -> a -> a -> a -> a -> a -> a -> a -> Collection a
Collection
  MouseButton
GLFW.MouseButton'1
  MouseButton
GLFW.MouseButton'2
  MouseButton
GLFW.MouseButton'3
  MouseButton
GLFW.MouseButton'4
  MouseButton
GLFW.MouseButton'5
  MouseButton
GLFW.MouseButton'6
  MouseButton
GLFW.MouseButton'7
  MouseButton
GLFW.MouseButton'8

{-# INLINE atGlfw #-}
atGlfw :: Collection a -> GLFW.MouseButton -> a
atGlfw :: forall a. Collection a -> MouseButton -> a
atGlfw Collection{a
$sel:mb1:Collection :: forall a. Collection a -> a
$sel:mb2:Collection :: forall a. Collection a -> a
$sel:mb3:Collection :: forall a. Collection a -> a
$sel:mb4:Collection :: forall a. Collection a -> a
$sel:mb5:Collection :: forall a. Collection a -> a
$sel:mb6:Collection :: forall a. Collection a -> a
$sel:mb7:Collection :: forall a. Collection a -> a
$sel:mb8:Collection :: forall a. Collection a -> a
mb1 :: a
mb2 :: a
mb3 :: a
mb4 :: a
mb5 :: a
mb6 :: a
mb7 :: a
mb8 :: a
..} = \case
  MouseButton
GLFW.MouseButton'1 -> a
mb1
  MouseButton
GLFW.MouseButton'2 -> a
mb2
  MouseButton
GLFW.MouseButton'3 -> a
mb3
  MouseButton
GLFW.MouseButton'4 -> a
mb4
  MouseButton
GLFW.MouseButton'5 -> a
mb5
  MouseButton
GLFW.MouseButton'6 -> a
mb6
  MouseButton
GLFW.MouseButton'7 -> a
mb7
  MouseButton
GLFW.MouseButton'8 -> a
mb8