{-# LANGUAGE RankNTypes #-}

module Brillo.Internals.Interface.Event (
  Event (..),
  keyMouseEvent,
  motionEvent,
)
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)
  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 -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Event -> ShowS
showsPrec :: Int -> Event -> ShowS
$cshow :: Event -> String
show :: Event -> String
$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


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'