{-# LANGUAGE RankNTypes #-}

module Brillo.Internals.Interface.Event (
  Event (..),
  keyMouseEvent,
  motionEvent,
  dropEvent,
  pickEvent,
)
where

import Brillo.Internals.Interface.Backend
import Data.IORef


-- | Possible input events.
data Event
  = EventKey Key KeyState Modifiers (Float, Float)
  | EventMotion (Float, Float)
  | EventResize (Int, Int)
  | EventDrop [FilePath]
  | EventPick [FilePath]
  deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
/= :: Event -> Event -> Bool
Eq, Int -> Event -> ShowS
[Event] -> ShowS
Event -> FilePath
(Int -> Event -> ShowS)
-> (Event -> FilePath) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Event -> ShowS
showsPrec :: Int -> Event -> ShowS
$cshow :: Event -> FilePath
show :: Event -> FilePath
$cshowList :: [Event] -> ShowS
showList :: [Event] -> ShowS
Show)


keyMouseEvent ::
  forall a.
  (Backend a) =>
  IORef a ->
  Key ->
  KeyState ->
  Modifiers ->
  (Int, Int) ->
  IO Event
keyMouseEvent :: forall a.
Backend a =>
IORef a -> Key -> KeyState -> Modifiers -> (Int, Int) -> IO Event
keyMouseEvent IORef a
backendRef Key
key KeyState
keyState Modifiers
modifiers (Int, Int)
pos =
  Key -> KeyState -> Modifiers -> (Float, Float) -> Event
EventKey Key
key KeyState
keyState Modifiers
modifiers ((Float, Float) -> Event) -> IO (Float, Float) -> IO Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef a -> (Int, Int) -> IO (Float, Float)
forall a. Backend a => IORef a -> (Int, Int) -> IO (Float, Float)
convertPoint IORef a
backendRef (Int, Int)
pos


motionEvent ::
  forall a.
  (Backend a) =>
  IORef a ->
  (Int, Int) ->
  IO Event
motionEvent :: forall a. Backend a => IORef a -> (Int, Int) -> IO Event
motionEvent IORef a
backendRef (Int, Int)
pos =
  (Float, Float) -> Event
EventMotion ((Float, Float) -> Event) -> IO (Float, Float) -> IO Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef a -> (Int, Int) -> IO (Float, Float)
forall a. Backend a => IORef a -> (Int, Int) -> IO (Float, Float)
convertPoint IORef a
backendRef (Int, Int)
pos


dropEvent ::
  forall a.
  (Backend a) =>
  IORef a ->
  [FilePath] ->
  IO Event
dropEvent :: forall a. Backend a => IORef a -> [FilePath] -> IO Event
dropEvent IORef a
_backendRef [FilePath]
paths =
  Event -> IO Event
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Event -> IO Event) -> Event -> IO Event
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Event
EventDrop [FilePath]
paths


pickEvent ::
  forall a.
  (Backend a) =>
  IORef a ->
  [FilePath] ->
  IO Event
pickEvent :: forall a. Backend a => IORef a -> [FilePath] -> IO Event
pickEvent IORef a
_backendRef [FilePath]
paths =
  Event -> IO Event
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Event -> IO Event) -> Event -> IO Event
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Event
EventPick [FilePath]
paths


convertPoint ::
  forall a.
  (Backend a) =>
  IORef a ->
  (Int, Int) ->
  IO (Float, Float)
convertPoint :: forall a. Backend a => IORef a -> (Int, Int) -> IO (Float, Float)
convertPoint IORef a
backendRef (Int, Int)
pos =
  do
    (Int
sizeX_, Int
sizeY_) <- IORef a -> IO (Int, Int)
forall a. Backend a => IORef a -> IO (Int, Int)
getWindowDimensions IORef a
backendRef
    let (Float
sizeX, Float
sizeY) = (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeX_, Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeY_)

    let (Int
px_, Int
py_) = (Int, Int)
pos
    let px :: Float
px = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
px_
    let py :: Float
py = Float
sizeY Float -> Float -> Float
forall a. Num a => a -> a -> a
- Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
py_

    let px' :: Float
px' = Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
sizeX Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
    let py' :: Float
py' = Float
py Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
sizeY Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
    let pos' :: (Float, Float)
pos' = (Float
px', Float
py')
    (Float, Float) -> IO (Float, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Float, Float)
pos'