GPipe-GLFW 1.4.0 → 1.4.1

raw patch · 9 files changed

+133/−71 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• GPipe-GLFW.cabal +4/−3
• src/Graphics/GPipe/Context/GLFW.hs +8/−8
• src/Graphics/GPipe/Context/GLFW/Calls.hs +12/−2
• src/Graphics/GPipe/Context/GLFW/Format.hs +1/−1
• src/Graphics/GPipe/Context/GLFW/Handler.hs +40/−37
• src/Graphics/GPipe/Context/GLFW/Input.hs +0/−1
• src/Graphics/GPipe/Context/GLFW/Misc.hs +15/−0
• src/Graphics/GPipe/Context/GLFW/Window.hs +53/−0
• src/Graphics/GPipe/Context/GLFW/Wrapped.hs +0/−19

@@ -1,5 +1,5 @@ name:           GPipe-GLFW-version:        1.4.0+version:        1.4.1 cabal-version:  >=1.10 build-type:     Simple author:         Patrick Redmond@@ -29,7 +29,8 @@   default-language:    Haskell2010   exposed-modules:     Graphics.GPipe.Context.GLFW                        Graphics.GPipe.Context.GLFW.Input-                       Graphics.GPipe.Context.GLFW.Wrapped+                       Graphics.GPipe.Context.GLFW.Window+                       Graphics.GPipe.Context.GLFW.Misc   other-modules:       Graphics.GPipe.Context.GLFW.Calls                        Graphics.GPipe.Context.GLFW.Resource                        Graphics.GPipe.Context.GLFW.Wrappers@@ -46,4 +47,4 @@   type:     git   location: https://github.com/plredmond/GPipe-GLFW.git   subdir:   GPipe-GLFW-  tag:      v1.4.0+  tag:      v1.4.1

@@ -1,24 +1,22 @@ -- | Non interactive applications only need to pass configuration defined here -- into GPipe's 'runContextT' and 'newWindow'. ----- For user input, see "Graphics.GPipe.Context.GLFW.Input". All other GLFW--- functionality is being incrementally exposed in--- "Graphics.GPipe.Context.GLFW.Wrapped".+-- Interactive applications will need "Graphics.GPipe.Context.GLFW.Input". module Graphics.GPipe.Context.GLFW ( -- * GPipe context handler for GLFW Handle(), GLFWWindow(), -- ** Configuration--- *** Defaults+-- *** Default configs defaultHandleConfig, defaultWindowConfig,--- *** Details+-- *** Custom configs ContextHandlerParameters(HandleConfig, configErrorCallback, configEventPolicy), -- | Configuration for the GLFW handle. -- -- [@'HandleConfig'@] Constructor ----- [@'configErrorCallback' :: ErrorCallback@] Specify a callback to handle errors captured by GLFW.+-- [@'configErrorCallback' ::  'Error' -> String -> IO () @] Specify a callback to handle errors emitted by GLFW. -- -- [@'configEventPolicy' :: Maybe 'EventPolicy'@] Specify the 'EventPolicy' to use for automatic GLFW event processing. If 'Nothing' then automatic event processing is disabled and you'll need to call 'mainloop' or 'mainstep' somewhere. WindowConfig(..),@@ -32,7 +30,8 @@ mainstep, -- ** Reexports module Graphics.GPipe.Context.GLFW.Input,-module Graphics.GPipe.Context.GLFW.Wrapped+module Graphics.GPipe.Context.GLFW.Window,+module Graphics.GPipe.Context.GLFW.Misc ) where  -- internal@@ -41,4 +40,5 @@ import Graphics.GPipe.Context.GLFW.Handler -- reexports import Graphics.GPipe.Context.GLFW.Input-import Graphics.GPipe.Context.GLFW.Wrapped+import Graphics.GPipe.Context.GLFW.Window+import Graphics.GPipe.Context.GLFW.Misc

@@ -14,13 +14,18 @@ -- 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 = 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. debug :: String -> IO () debug msg = do     t <- GLFW.getTime     tid <- Conc.myThreadId-    c <- GLFW.getCurrentContext+    c <- getCurrentContext     Text.printf "[%03.3fs, %s has %s]: %s\n" (maybe (0/0) id t) (show tid) (show c) msg  type OnMain a = IO a -> IO a@@ -75,7 +80,7 @@ -- * This function may be called from any thread. makeContextCurrent :: String -> Maybe GLFW.Window -> IO () makeContextCurrent reason windowHuh = do-    ccHuh <- GLFW.getCurrentContext+    ccHuh <- getCurrentContext     when (ccHuh /= windowHuh) $ do         debug $ Text.printf "attaching %s, reason: %s" (show windowHuh) reason         GLFW.makeContextCurrent windowHuh@@ -119,6 +124,11 @@ -- * This function may be called from any thread. Access is not synchronized. setWindowShouldClose :: GLFW.Window -> Bool -> IO () setWindowShouldClose window bool = GLFW.setWindowShouldClose window bool++-- |+-- * This function must only be called from the main thread.+setWindowCloseCallback :: EffectMain -> GLFW.Window -> Maybe GLFW.WindowCloseCallback -> IO ()+setWindowCloseCallback onMain window cb = onMain $ GLFW.setWindowCloseCallback window cb  -- | -- * This function must only be called from the main thread.

@@ -21,8 +21,8 @@ instance Exception [WindowHint]  allowedHint :: WindowHint -> Bool-allowedHint (WindowHint'sRGBCapable _) = False allowedHint (WindowHint'Visible _) = False+allowedHint (WindowHint'sRGBCapable _) = False allowedHint (WindowHint'RedBits _) = False allowedHint (WindowHint'GreenBits _) = False allowedHint (WindowHint'BlueBits _) = False

@@ -23,8 +23,8 @@     , ThreadId, myThreadId     ) -- thirdparty-import qualified Graphics.GPipe.Context as GPipe (ContextHandler(..), Window(), ContextT(), withContextWindow)-import qualified Graphics.UI.GLFW as GLFW (Window, ErrorCallback)+import qualified Graphics.GPipe as GPipe (ContextHandler(..), Window(), ContextT(), WindowBits, withContextWindow)+import qualified Graphics.UI.GLFW as GLFW (Window, Error) -- local import qualified Graphics.GPipe.Context.GLFW.Calls as Call import qualified Graphics.GPipe.Context.GLFW.Format as Format@@ -59,6 +59,7 @@ data Handle = Handle     { handleTid :: ThreadId     , handleComm :: RPC.Handle+    , handleRaw :: GLFW.Window     , handleCtxs :: TVar [MMContext]     , handleEventPolicy :: Maybe EventPolicy     }@@ -74,14 +75,6 @@         go Nothing = Call.debug (printf "%s: GPipe-GLFW context already closed" callerTag) >> return Nothing         go (Just context) = pure <$> action context --- FIXME: May cause crashes in windows (os) because windows (os) requires parent contexts to be uncurrent; easy fix--- | Run the action. If any open context is avaiable, take it and pass it into the action.-withAnyContext :: Handle -> (Maybe Context -> IO a) -> IO a-withAnyContext handle action = readTVarIO (handleCtxs handle) >>= go-    where-        go (mmContext:ctxs) = withContext "withAnyContext" mmContext (action . pure) >>= maybe (go ctxs) return-        go [] = action Nothing- -- | Template for "Run the action with XYZ /if the gpipe window still exists and ABC/." unwrappingGPipeWindow :: MonadIO m     => (String -> action -> Handle -> MMContext -> IO (Maybe a)) -- ^ Specialize use of unwrappingGPipeWindow@@ -127,8 +120,8 @@      -- | Configuration for the GLFW handle.     data ContextHandlerParameters Handle = HandleConfig-        { -- | Specify a callback to handle errors captured by GLFW.-          configErrorCallback :: GLFW.ErrorCallback+        { -- | Specify a callback to handle errors emitted by GLFW.+          configErrorCallback :: GLFW.Error -> String -> IO ()           -- | Specify the 'EventPolicy' to use for automatic GLFW event           -- processing. Set to 'Nothing' to disable automatic event processing           -- (you'll need to call 'mainloop' or 'mainstep').@@ -143,30 +136,10 @@     -- Create a context which shares objects with the contexts created by this     -- handle, if any.     createContext handle settings = do-        unless (null disallowedHints) $-            throwIO $ Format.UnsafeWindowHintsException disallowedHints-        -- make a context-        window <- withAnyContext handle $ \parent -> do-            windowHuh <- Call.createWindow (onMain handle) width height title monitor hints (contextRaw <$> parent)-            Call.debug $ printf "contextCreate made %s -> parent %s" (show windowHuh) (show $ contextRaw <$> parent)-            case (windowHuh, parent) of-                (Just w, _) -> return w-                (Nothing, Just _) -> throwIO . CreateSharedWindowException . show $ config {Resource.configHints = hints}-                (Nothing, Nothing) -> throwIO . CreateWindowException . show $ config {Resource.configHints = hints}-        -- set up context-        forM_ intervalHuh $ \interval -> do-            Call.makeContextCurrent "apply vsync setting" $ pure window-            Call.swapInterval interval-        -- wrap up context+        window <- createWindow (Just $ handleRaw handle) settings         mmContext <- newMVar . pure $ Context window         atomically $ modifyTVar (handleCtxs handle) (mmContext :)         return $ WWindow (mmContext, handle)-        where-            config = fromMaybe (defaultWindowConfig "") (snd <$> settings)-            Resource.WindowConfig {Resource.configWidth=width, Resource.configHeight=height} = config-            Resource.WindowConfig _ _ title monitor _ intervalHuh = config-            (userHints, disallowedHints) = partition Format.allowedHint $ Resource.configHints config-            hints = userHints ++ Format.bitsToHints (fst <$> settings) ++ Format.unconditionalHints      -- Threading assumption: any thread     --@@ -175,11 +148,17 @@     --     -- XXX: If there's a lot of context swapping, change this to RPC to a     -- context-private thread running a mainloop.-    contextDoAsync _ Nothing _action = do-        Call.debug "TODO: contextDoAsync called w/o context; ensure any context is current"+    contextDoAsync handle Nothing action = RPC.sendEffect (handleComm handle) $ do+        -- (on main thread) Make the ancestor current if nothing else already is+        -- FIXME: these two bodies could be combined, perhaps.. the RPC is only necessary if the current thread lacks a context+        ccHuh <- Call.getCurrentContext+        maybe (Call.makeContextCurrent "contextDoAsync required some context" . pure . handleRaw $ handle)+            (const $ return ())+            ccHuh+        action     contextDoAsync _ (Just (WWindow (mmContext, _))) action =         void $ withContext "contextDoAsync" mmContext $ \context -> do-            Call.makeContextCurrent "contextDoAsync required it" . pure . contextRaw $ context+            Call.makeContextCurrent "contextDoAsync required a specific context" . pure . contextRaw $ context             action      -- Threading assumption: main thread@@ -231,7 +210,8 @@         ok <- Call.init id -- id RPC because contextHandlerCreate is called only on mainthread         unless ok $ throwIO InitException         -- wrap up handle-        return $ Handle tid comm ctxs eventPolicy+        ancestor <- createWindow Nothing Nothing+        return $ Handle tid comm ancestor ctxs eventPolicy         where             HandleConfig errorHandler eventPolicy = config @@ -244,6 +224,29 @@         -- all resources are released         Call.terminate id -- id RPC because contextHandlerDelete is called only on mainthread         Call.setErrorCallback id Nothing -- id RPC because contextHandlerDelete is called only on mainthread++-- Create a raw GLFW window for use by contextHandlerCreate & createContext+createWindow :: Maybe GLFW.Window -> Maybe (GPipe.WindowBits, Resource.WindowConfig) -> IO GLFW.Window+createWindow parentHuh settings = do+    unless (null disallowedHints) $+        throwIO $ Format.UnsafeWindowHintsException disallowedHints+    -- make a context+    windowHuh <- Call.createWindow id width height title monitor hints parentHuh -- id RPC because contextHandlerCreate & createContext are called only on mainthread+    Call.debug $ printf "made context %s -> parent %s" (show windowHuh) (show parentHuh)+    window <- maybe exc return windowHuh+    -- set up context+    forM_ intervalHuh $ \interval -> do+        Call.makeContextCurrent "apply vsync setting" $ pure window+        Call.swapInterval interval+    -- done+    return window+    where+        config = fromMaybe (defaultWindowConfig "") (snd <$> settings)+        Resource.WindowConfig {Resource.configWidth=width, Resource.configHeight=height} = config+        Resource.WindowConfig _ _ title monitor _ intervalHuh = config+        (userHints, disallowedHints) = partition Format.allowedHint $ Resource.configHints config+        hints = userHints ++ Format.bitsToHints (fst <$> settings) ++ Format.unconditionalHints+        exc = throwIO . CreateSharedWindowException . show $ config {Resource.configHints = hints}  -- | Type to describe the waiting or polling style of event processing -- supported by GLFW.

@@ -1,6 +1,5 @@ -- | User input functions covering much of the GLFW __Input guide__: -- <http://www.glfw.org/docs/latest/input_guide.html>.--- For additional functionality see "Graphics.GPipe.Context.GLFW.Wrapped". -- -- Actions are in the GPipe 'GPipe.ContextT' monad when a window handle is required, -- otherwise they are bare reexported IO actions which can be lifted into the 'GPipe.ContextT' monad.

@@ -0,0 +1,15 @@+-- | Miscellaneous wrapped calls to GLFW-b for application programmer use.+--+-- Actions are in the GPipe 'GPipe.ContextT' monad when a window handle is required,+-- otherwise they are bare reexported IO actions which can be lifted into the 'GPipe.ContextT' monad.+-- The 'Window' taken by many of these functions is the window resource from GPipe.+module Graphics.GPipe.Context.GLFW.Misc (+-- * Error handling+-- | Learn more: http://www.glfw.org/docs/latest/intro_guide.html#error_handling++-- | To set a custom error callback use 'HandleConfig' in "Graphics.GPipe.Context.GLFW".+Error(..),+) where++-- thirdparty+import Graphics.UI.GLFW (Error(..))

@@ -0,0 +1,53 @@+-- | Window manipulation functions covering much of the GLFW __Window guide__:+-- <http://www.glfw.org/docs/latest/window_guide.html>.+-- Notably absent are the window creation functions. These are handled automatically by GPipe-GLFW.+--+-- Actions are in the GPipe 'GPipe.ContextT' monad when a window handle is required,+-- otherwise they are bare reexported IO actions which can be lifted into the 'GPipe.ContextT' monad.+-- The 'Window' taken by many of these functions is the window resource from GPipe.++module Graphics.GPipe.Context.GLFW.Window (+-- * Window objects+-- | Learn more: http://www.glfw.org/docs/latest/window_guide.html#window_object++-- * Window event processing+-- | GLFW event processing is performed by 'GPipe-GLFW' after each call to the 'GPipe' @swapBuffers@.+-- No further action is required, but additional controls are available for complex applications in+-- "Graphics.GPipe.Context.GLFW".++-- * Window properties and events+-- | Learn more: http://www.glfw.org/docs/latest/window_guide.html#window_properties++-- ** Window closing and close flag+windowShouldClose,+setWindowShouldClose,+setWindowCloseCallback,++-- * Buffer swapping+-- | Buffer swapping is initiated via the 'GPipe' @swapBuffers@ function.++-- * Not supported+-- | Some GLFW functionality isn't currently exposed by "Graphics.UI.GLFW".+--+--      * `glfwSetWindowUserPointer`, `glfwGetWindowUserPointer`+) where++-- stdlib+import Control.Monad.IO.Class (MonadIO)+--thirdparty+import qualified Graphics.GPipe.Context as GPipe (ContextT, Window())+--local+import Graphics.GPipe.Context.GLFW.Handler (Handle(..))+import qualified Graphics.GPipe.Context.GLFW.Calls as Call+import qualified Graphics.GPipe.Context.GLFW.Wrappers as Wrappers++-- TODO: function docstrings++windowShouldClose :: MonadIO m => GPipe.Window os c ds -> GPipe.ContextT Handle os m (Maybe Bool)+windowShouldClose = Wrappers.withWindow Call.windowShouldClose++setWindowShouldClose :: MonadIO m => GPipe.Window os c ds -> Bool -> GPipe.ContextT Handle os m (Maybe ())+setWindowShouldClose w b = Wrappers.withWindow (flip Call.setWindowShouldClose b) w++setWindowCloseCallback :: MonadIO m => GPipe.Window os c ds -> Maybe (IO ()) -> GPipe.ContextT Handle os m (Maybe ())+setWindowCloseCallback = Wrappers.wrapCallbackSetter Call.setWindowCloseCallback

@@ -1,19 +0,0 @@--- | Wrapped calls to GLFW-b for application programmer use. For user input see--- "Graphics.GPipe.Context.GLFW.Input".------ Actions are in the GPipe 'GPipe.ContextT' monad when a window handle is required,--- otherwise they are bare reexported IO actions which can be lifted into the 'GPipe.ContextT' monad.--- The 'Window' taken by many of these functions is the window resource from GPipe.-module Graphics.GPipe.Context.GLFW.Wrapped where---- stdlib-import Control.Monad.IO.Class (MonadIO)--- thirdparty-import qualified Graphics.GPipe.Context as GPipe (ContextT, Window())--- local-import Graphics.GPipe.Context.GLFW.Handler (Handle(..))-import qualified Graphics.GPipe.Context.GLFW.Calls as Call-import qualified Graphics.GPipe.Context.GLFW.Wrappers as Wrappers--windowShouldClose :: MonadIO m => GPipe.Window os c ds -> GPipe.ContextT Handle os m (Maybe Bool)-windowShouldClose = Wrappers.withWindow Call.windowShouldClose