-- | Internal module wrapping calls to "Graphics.UI.GLFW"
--
-- The bulletpoints on each function are copied from the GLFW documentation.
module Graphics.GPipe.Context.GLFW.Calls where

-- stdlib
import qualified Control.Concurrent                 as Conc
import           Control.Monad                      (when)
import           Data.Maybe                         (fromMaybe)
import qualified Text.Printf                        as Text
-- thirdparty
import qualified Graphics.UI.GLFW                   as GLFW
-- local
import           Graphics.GPipe.Context.GLFW.Logger (LogLevel (..), Logger,
                                                     emitLog)

-- TODO: change from using explicit OnMain functions to passing a handle which implements the appropriate class (effect or fetch result)
-- TODO: maybe an OnMain monad would be good to reduce the number of RPCS? Not really necessary, since they can already be easily sequenced with IO

-- |
-- * This function may be called from any thread.
getCurrentContext :: IO (Maybe GLFW.Window)
getCurrentContext :: IO (Maybe Window)
getCurrentContext = IO (Maybe Window)
GLFW.getCurrentContext

-- |
-- * 2x This function may be called from any thread.
-- * Reading and writing of the internal timer offset is not atomic, so it needs to be externally synchronized with calls to glfwSetTime.
say :: Logger -> LogLevel -> String -> IO ()
say :: Logger -> LogLevel -> String -> IO ()
say Logger
logger LogLevel
lvl String
msg = do
    Maybe Double
t <- IO (Maybe Double)
GLFW.getTime
    ThreadId
tid <- IO ThreadId
Conc.myThreadId
    Maybe Window
c <- IO (Maybe Window)
getCurrentContext
    Logger -> LogLevel -> String -> IO ()
emitLog Logger
logger LogLevel
lvl (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> Double -> String -> String -> String -> String
forall r. PrintfType r => String -> r
Text.printf String
"[%03.3fs, %s has %s]: %s\n" (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (Double
0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0) Maybe Double
t) (ThreadId -> String
forall a. Show a => a -> String
show ThreadId
tid) (Maybe Window -> String
forall a. Show a => a -> String
show Maybe Window
c) String
msg

type OnMain a = IO a -> IO a
type EffectMain = IO () -> IO ()

-- |
-- * This function must only be called from the main thread.
init :: OnMain Bool -> IO Bool
init :: OnMain Bool -> IO Bool
init OnMain Bool
onMain = OnMain Bool
onMain IO Bool
GLFW.init

-- |
-- * This function may be called before glfwInit.
-- * The contexts of any remaining windows must not be current on any other thread when this function is called.
-- * ~~This function must not be called from a callback.~~
-- * This function must only be called from the main thread.
terminate :: EffectMain -> IO ()
terminate :: EffectMain -> IO ()
terminate EffectMain
onMain = EffectMain
onMain IO ()
GLFW.terminate

-- |
-- * This function may be called before glfwInit.
-- * This function must only be called from the main thread.
setErrorCallback :: EffectMain -> Maybe GLFW.ErrorCallback -> IO ()
setErrorCallback :: EffectMain -> Maybe ErrorCallback -> IO ()
setErrorCallback EffectMain
onMain Maybe ErrorCallback
callbackHuh = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ Maybe ErrorCallback -> IO ()
GLFW.setErrorCallback Maybe ErrorCallback
callbackHuh

-- |
-- * There are many caveats: http://www.glfw.org/docs/latest/group__window.html#ga5c336fddf2cbb5b92f65f10fb6043344
-- * ~~This function must not be called from a callback.~~
-- * This function must only be called from the main thread.
createWindow :: OnMain (Maybe GLFW.Window) -> Int -> Int -> String -> Maybe GLFW.Monitor -> [GLFW.WindowHint] -> Maybe GLFW.Window -> IO (Maybe GLFW.Window)
createWindow :: OnMain (Maybe Window)
-> Int
-> Int
-> String
-> Maybe Monitor
-> [WindowHint]
-> Maybe Window
-> IO (Maybe Window)
createWindow OnMain (Maybe Window)
onMain Int
width Int
height String
title Maybe Monitor
monitor [WindowHint]
hints Maybe Window
parent = OnMain (Maybe Window)
onMain OnMain (Maybe Window) -> OnMain (Maybe Window)
forall a b. (a -> b) -> a -> b
$ do
    IO ()
GLFW.defaultWindowHints -- This function must only be called from the main thread.
    (WindowHint -> IO ()) -> [WindowHint] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ WindowHint -> IO ()
GLFW.windowHint [WindowHint]
hints -- This function must only be called from the main thread.
    Int
-> Int
-> String
-> Maybe Monitor
-> Maybe Window
-> IO (Maybe Window)
GLFW.createWindow Int
width Int
height String
title Maybe Monitor
monitor Maybe Window
parent

-- |
-- * If the context of the specified window is current on the main thread, it is detached before being destroyed.
-- * The context of the specified window must not be current on any other thread when this function is called.
-- * ~~This function must not be called from a callback.~~
-- * This function must only be called from the main thread.
--
-- Seems like it's ok to delete any of the shared contexts any time, per:
-- https://khronos.org/registry/OpenGL/specs/gl/glspec45.core.pdf (Section 5.1.1)
destroyWindow :: EffectMain -> GLFW.Window -> IO ()
destroyWindow :: EffectMain -> Window -> IO ()
destroyWindow EffectMain
onMain Window
window = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ Window -> IO ()
GLFW.destroyWindow Window
window

-- |
-- * 2x This function must only be called from the main thread.
windowHints :: EffectMain -> [GLFW.WindowHint] -> IO ()
windowHints :: EffectMain -> [WindowHint] -> IO ()
windowHints EffectMain
onMain [WindowHint]
hints = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ IO ()
GLFW.defaultWindowHints IO () -> EffectMain
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (WindowHint -> IO ()) -> [WindowHint] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ WindowHint -> IO ()
GLFW.windowHint [WindowHint]
hints

-- |
-- * This function may be called from any thread.
makeContextCurrent :: Logger -> String -> Maybe GLFW.Window -> IO ()
makeContextCurrent :: Logger -> String -> Maybe Window -> IO ()
makeContextCurrent Logger
logger String
reason Maybe Window
windowHuh = do
    Maybe Window
ccHuh <- IO (Maybe Window)
getCurrentContext
    Bool -> EffectMain
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Window
ccHuh Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Window
windowHuh) EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ do
        Logger -> LogLevel -> String -> IO ()
emitLog Logger
logger LogLevel
DEBUG (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
Text.printf String
"attaching %s, reason: %s" (Maybe Window -> String
forall a. Show a => a -> String
show Maybe Window
windowHuh) String
reason
        Maybe Window -> IO ()
GLFW.makeContextCurrent Maybe Window
windowHuh

-- |
-- * A context must be current on the calling thread. Calling this function without a current context will cause a GLFW_NO_CURRENT_CONTEXT error.
-- * This function is not called during context creation, leaving the swap interval set to whatever is the default on that platform. This is done because some swap interval extensions used by GLFW do not allow the swap interval to be reset to zero once it has been set to a non-zero value.
-- * This function may be called from any thread.
swapInterval :: Int -> IO ()
swapInterval :: Int -> IO ()
swapInterval = Int -> IO ()
GLFW.swapInterval

-- |
-- * EGL: The context of the specified window must be current on the calling thread.
-- * This function may be called from any thread.
swapBuffers :: GLFW.Window -> IO ()
swapBuffers :: Window -> IO ()
swapBuffers = Window -> IO ()
GLFW.swapBuffers

-- | This function puts the calling thread to sleep until at least one event is available in the event queue.
-- * ~~This function must not be called from a callback.~~
-- * This function must only be called from the main thread.
waitEvents :: EffectMain -> IO ()
waitEvents :: EffectMain -> IO ()
waitEvents EffectMain
onMain = EffectMain
onMain IO ()
GLFW.waitEvents

-- | This function puts the calling thread to sleep until at least one event is available in the event queue.
-- * ~~This function must not be called from a callback.~~
-- * This function must only be called from the main thread.
waitEventsTimeout :: EffectMain -> Double -> IO ()
waitEventsTimeout :: EffectMain -> Double -> IO ()
waitEventsTimeout EffectMain
onMain Double
timeout = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ Double -> IO ()
GLFW.waitEventsTimeout Double
timeout

-- | This function processes only those events that are already in the event queue and then returns immediately.
-- * ~~This function must not be called from a callback.~~
-- * This function must only be called from the main thread.
pollEvents :: EffectMain -> IO ()
pollEvents :: EffectMain -> IO ()
pollEvents EffectMain
onMain = EffectMain
onMain IO ()
GLFW.pollEvents

-- | This function posts an empty event from the current thread to the event queue, causing glfwWaitEvents or glfwWaitEventsTimeout to return.
-- * This function may be called from any thread.
postEmptyEvent :: IO ()
postEmptyEvent :: IO ()
postEmptyEvent = IO ()
GLFW.postEmptyEvent

-- |
-- * This function may be called from any thread. Access is not synchronized.
windowShouldClose :: GLFW.Window -> IO Bool
windowShouldClose :: Window -> IO Bool
windowShouldClose = Window -> IO Bool
GLFW.windowShouldClose

-- |
-- * This function may be called from any thread. Access is not synchronized.
setWindowShouldClose :: GLFW.Window -> Bool -> IO ()
setWindowShouldClose :: Window -> Bool -> IO ()
setWindowShouldClose = Window -> Bool -> IO ()
GLFW.setWindowShouldClose

-- |
-- * This function must only be called from the main thread.
setWindowCloseCallback :: EffectMain -> GLFW.Window -> Maybe GLFW.WindowCloseCallback -> IO ()
setWindowCloseCallback :: EffectMain -> Window -> Maybe (Window -> IO ()) -> IO ()
setWindowCloseCallback EffectMain
onMain Window
window Maybe (Window -> IO ())
cb = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ Window -> Maybe (Window -> IO ()) -> IO ()
GLFW.setWindowCloseCallback Window
window Maybe (Window -> IO ())
cb

-- |
-- * This function must only be called from the main thread.
getFramebufferSize :: OnMain (Int, Int) -> GLFW.Window -> IO (Int, Int)
getFramebufferSize :: OnMain (Int, Int) -> Window -> IO (Int, Int)
getFramebufferSize OnMain (Int, Int)
onMain Window
window = OnMain (Int, Int)
onMain OnMain (Int, Int) -> OnMain (Int, Int)
forall a b. (a -> b) -> a -> b
$ Window -> IO (Int, Int)
GLFW.getFramebufferSize Window
window

-- |
-- * This function must only be called from the main thread.
setKeyCallback :: EffectMain -> GLFW.Window -> Maybe GLFW.KeyCallback -> IO ()
setKeyCallback :: EffectMain -> Window -> Maybe KeyCallback -> IO ()
setKeyCallback EffectMain
onMain Window
window Maybe KeyCallback
cb = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ Window -> Maybe KeyCallback -> IO ()
GLFW.setKeyCallback Window
window Maybe KeyCallback
cb

-- |
-- * Do not use this function to implement text input.
-- * This function must only be called from the main thread.
getKey :: OnMain GLFW.KeyState -> GLFW.Window -> GLFW.Key -> IO GLFW.KeyState
getKey :: OnMain KeyState -> Window -> Key -> IO KeyState
getKey OnMain KeyState
onMain Window
window Key
key = OnMain KeyState
onMain OnMain KeyState -> OnMain KeyState
forall a b. (a -> b) -> a -> b
$ Window -> Key -> IO KeyState
GLFW.getKey Window
window Key
key

-- | Implemented with glfwSetInputMode
-- * This function must only be called from the main thread.
setStickyKeysInputMode :: EffectMain -> GLFW.Window -> GLFW.StickyKeysInputMode -> IO ()
setStickyKeysInputMode :: EffectMain -> Window -> StickyKeysInputMode -> IO ()
setStickyKeysInputMode EffectMain
onMain Window
window StickyKeysInputMode
mode = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ Window -> StickyKeysInputMode -> IO ()
GLFW.setStickyKeysInputMode Window
window StickyKeysInputMode
mode

-- | Implemented with glfwGetInputMode
-- * This function must only be called from the main thread.
getStickyKeysInputMode :: OnMain GLFW.StickyKeysInputMode -> GLFW.Window -> IO GLFW.StickyKeysInputMode
getStickyKeysInputMode :: OnMain StickyKeysInputMode -> Window -> IO StickyKeysInputMode
getStickyKeysInputMode OnMain StickyKeysInputMode
onMain Window
window = OnMain StickyKeysInputMode
onMain OnMain StickyKeysInputMode -> OnMain StickyKeysInputMode
forall a b. (a -> b) -> a -> b
$ Window -> IO StickyKeysInputMode
GLFW.getStickyKeysInputMode Window
window

-- |
-- * This function must only be called from the main thread.
setCharCallback :: EffectMain -> GLFW.Window -> Maybe GLFW.CharCallback -> IO ()
setCharCallback :: EffectMain -> Window -> Maybe CharCallback -> IO ()
setCharCallback EffectMain
onMain Window
window Maybe CharCallback
cb = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ Window -> Maybe CharCallback -> IO ()
GLFW.setCharCallback Window
window Maybe CharCallback
cb

-- |
-- * This function must only be called from the main thread.
setCursorPosCallback :: EffectMain -> GLFW.Window -> Maybe GLFW.CursorPosCallback -> IO ()
setCursorPosCallback :: EffectMain -> Window -> Maybe CursorPosCallback -> IO ()
setCursorPosCallback EffectMain
onMain Window
window Maybe CursorPosCallback
cb = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ Window -> Maybe CursorPosCallback -> IO ()
GLFW.setCursorPosCallback Window
window Maybe CursorPosCallback
cb

-- |
-- * This function must only be called from the main thread.
getCursorPos :: OnMain (Double, Double) -> GLFW.Window -> IO (Double, Double)
getCursorPos :: OnMain (Double, Double) -> Window -> IO (Double, Double)
getCursorPos OnMain (Double, Double)
onMain Window
window = OnMain (Double, Double)
onMain OnMain (Double, Double) -> OnMain (Double, Double)
forall a b. (a -> b) -> a -> b
$ Window -> IO (Double, Double)
GLFW.getCursorPos Window
window

-- | Implemented with glfwSetInputMode
-- * This function must only be called from the main thread.
setCursorInputMode :: EffectMain -> GLFW.Window -> GLFW.CursorInputMode -> IO ()
setCursorInputMode :: EffectMain -> Window -> CursorInputMode -> IO ()
setCursorInputMode EffectMain
onMain Window
window CursorInputMode
mode = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ Window -> CursorInputMode -> IO ()
GLFW.setCursorInputMode Window
window CursorInputMode
mode

-- | Implemented with glfwGetInputMode
-- * This function must only be called from the main thread.
getCursorInputMode :: OnMain GLFW.CursorInputMode -> GLFW.Window -> IO GLFW.CursorInputMode
getCursorInputMode :: OnMain CursorInputMode -> Window -> IO CursorInputMode
getCursorInputMode OnMain CursorInputMode
onMain Window
window = OnMain CursorInputMode
onMain OnMain CursorInputMode -> OnMain CursorInputMode
forall a b. (a -> b) -> a -> b
$ Window -> IO CursorInputMode
GLFW.getCursorInputMode Window
window

-- |
-- * This function must only be called from the main thread.
setCursor :: EffectMain -> GLFW.Window -> GLFW.Cursor -> IO ()
setCursor :: EffectMain -> Window -> Cursor -> IO ()
setCursor EffectMain
onMain Window
window Cursor
cursor = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ Window -> Cursor -> IO ()
GLFW.setCursor Window
window Cursor
cursor

-- |
-- * This function must only be called from the main thread.
setCursorEnterCallback :: EffectMain -> GLFW.Window -> Maybe GLFW.CursorEnterCallback -> IO ()
setCursorEnterCallback :: EffectMain -> Window -> Maybe CursorEnterCallback -> IO ()
setCursorEnterCallback EffectMain
onMain Window
window Maybe CursorEnterCallback
cb = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ Window -> Maybe CursorEnterCallback -> IO ()
GLFW.setCursorEnterCallback Window
window Maybe CursorEnterCallback
cb

-- |
-- * This function must only be called from the main thread.
setMouseButtonCallback :: EffectMain -> GLFW.Window -> Maybe GLFW.MouseButtonCallback -> IO ()
setMouseButtonCallback :: EffectMain -> Window -> Maybe MouseButtonCallback -> IO ()
setMouseButtonCallback EffectMain
onMain Window
window Maybe MouseButtonCallback
cb = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ Window -> Maybe MouseButtonCallback -> IO ()
GLFW.setMouseButtonCallback Window
window Maybe MouseButtonCallback
cb

-- |
-- * This function must only be called from the main thread.
getMouseButton :: OnMain GLFW.MouseButtonState -> GLFW.Window -> GLFW.MouseButton -> IO GLFW.MouseButtonState
getMouseButton :: OnMain MouseButtonState
-> Window -> MouseButton -> IO MouseButtonState
getMouseButton OnMain MouseButtonState
onMain Window
window MouseButton
button = OnMain MouseButtonState
onMain OnMain MouseButtonState -> OnMain MouseButtonState
forall a b. (a -> b) -> a -> b
$ Window -> MouseButton -> IO MouseButtonState
GLFW.getMouseButton Window
window MouseButton
button

-- | Implemented with glfwSetInputMode
-- * This function must only be called from the main thread.
setStickyMouseButtonsInputMode :: EffectMain -> GLFW.Window -> GLFW.StickyMouseButtonsInputMode -> IO ()
setStickyMouseButtonsInputMode :: EffectMain -> Window -> StickyMouseButtonsInputMode -> IO ()
setStickyMouseButtonsInputMode EffectMain
onMain Window
window StickyMouseButtonsInputMode
mode = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ Window -> StickyMouseButtonsInputMode -> IO ()
GLFW.setStickyMouseButtonsInputMode Window
window StickyMouseButtonsInputMode
mode

-- | Implemented with glfwGetInputMode
-- * This function must only be called from the main thread.
getStickyMouseButtonsInputMode :: OnMain GLFW.StickyMouseButtonsInputMode -> GLFW.Window -> IO GLFW.StickyMouseButtonsInputMode
getStickyMouseButtonsInputMode :: OnMain StickyMouseButtonsInputMode
-> Window -> IO StickyMouseButtonsInputMode
getStickyMouseButtonsInputMode OnMain StickyMouseButtonsInputMode
onMain Window
window = OnMain StickyMouseButtonsInputMode
onMain OnMain StickyMouseButtonsInputMode
-> OnMain StickyMouseButtonsInputMode
forall a b. (a -> b) -> a -> b
$ Window -> IO StickyMouseButtonsInputMode
GLFW.getStickyMouseButtonsInputMode Window
window

-- |
-- * This function must only be called from the main thread.
setScrollCallback :: EffectMain -> GLFW.Window -> Maybe GLFW.ScrollCallback -> IO ()
setScrollCallback :: EffectMain -> Window -> Maybe CursorPosCallback -> IO ()
setScrollCallback EffectMain
onMain Window
window Maybe CursorPosCallback
cb = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ Window -> Maybe CursorPosCallback -> IO ()
GLFW.setScrollCallback Window
window Maybe CursorPosCallback
cb

-- |
-- * This function must only be called from the main thread.
getClipboardString :: OnMain (Maybe String) -> GLFW.Window -> IO (Maybe String)
getClipboardString :: OnMain (Maybe String) -> Window -> IO (Maybe String)
getClipboardString OnMain (Maybe String)
onMain Window
window = OnMain (Maybe String)
onMain OnMain (Maybe String) -> OnMain (Maybe String)
forall a b. (a -> b) -> a -> b
$ Window -> IO (Maybe String)
GLFW.getClipboardString Window
window

-- |
-- * This function must only be called from the main thread.
setClipboardString :: EffectMain -> GLFW.Window -> String -> IO ()
setClipboardString :: EffectMain -> Window -> String -> IO ()
setClipboardString EffectMain
onMain Window
window String
s = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ Window -> String -> IO ()
GLFW.setClipboardString Window
window String
s

-- |
-- * This function must only be called from the main thread.
setDropCallback :: EffectMain -> GLFW.Window -> Maybe GLFW.DropCallback -> IO ()
setDropCallback :: EffectMain -> Window -> Maybe DropCallback -> IO ()
setDropCallback EffectMain
onMain Window
window Maybe DropCallback
cb = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ Window -> Maybe DropCallback -> IO ()
GLFW.setDropCallback Window
window Maybe DropCallback
cb

-- |
-- * This function must only be called from the main thread.
getWindowSize :: OnMain (Int, Int) -> GLFW.Window -> IO (Int, Int )
getWindowSize :: OnMain (Int, Int) -> Window -> IO (Int, Int)
getWindowSize OnMain (Int, Int)
onMain Window
window = OnMain (Int, Int)
onMain OnMain (Int, Int) -> OnMain (Int, Int)
forall a b. (a -> b) -> a -> b
$ Window -> IO (Int, Int)
GLFW.getWindowSize Window
window

-- |
-- * This function must only be called from the main thread.
setWindowSizeCallback :: EffectMain -> GLFW.Window -> Maybe GLFW.WindowSizeCallback -> IO ()
setWindowSizeCallback :: EffectMain -> Window -> Maybe WindowSizeCallback -> IO ()
setWindowSizeCallback EffectMain
onMain Window
window Maybe WindowSizeCallback
cb = EffectMain
onMain EffectMain -> EffectMain
forall a b. (a -> b) -> a -> b
$ Window -> Maybe WindowSizeCallback -> IO ()
GLFW.setWindowSizeCallback Window
window Maybe WindowSizeCallback
cb