GPipe-GLFW4-2.0.0: GLFW OpenGL context creation for GPipe
Safe HaskellNone
LanguageHaskell2010

Graphics.GPipe.Context.GLFW

Description

Non interactive applications only need to pass configuration defined here into GPipe's runContextT and newWindow.

Interactive applications will need Graphics.GPipe.Context.GLFW.Input.

Synopsis

GPipe context handler for GLFW

data Handle Source #

Opaque handle representing the initialized GLFW library.

To get started quickly try defaultHandleConfig and defaultWindowConfig.

     import Graphics.GPipe
     import qualified Graphics.GPipe.Context.GLFW as GLFW

     runContextT GLFW.defaultHandleConfig $ do
         win <- newWindow (WindowFormatColorDepth RGB8 Depth16) (GLFW.defaultWindowConfig "OpenGL Graphics")
         -- Do GPipe things here

data GLFWWindow Source #

Opaque handle representing a, possibly closed, internal Context. You'll typically deal with GPipe's Window instead of this one.

Configuration

Default configs

defaultHandleConfig :: ContextHandlerParameters Handle Source #

Default GLFW handle configuration.

  • Print any errors that GLFW emits.
  • Automatically process GLFW events after every buffer swap.
  • Log only context handling activity which represents undesired conditions.

defaultWindowConfig :: String -> WindowConfig Source #

Default window configuration for a small window on any monitor with the given title.

Custom configs

data family ContextHandlerParameters ctx #

Implementation specific context handler parameters, eg error handling and event processing policies

Configuration for the GLFW handle.

HandleConfig
Constructor
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.

data WindowConfig Source #

Configuration for a new GLFW window and associated OpenGL context.

Instances

Instances details
Show WindowConfig Source # 
Instance details

Defined in Graphics.GPipe.Context.GLFW.Resource

data WindowHint #

Lets you set various window hints before creating a Window. See Window Hints, particularly Supported and Default Values.

Instances

Instances details
Eq WindowHint 
Instance details

Defined in Graphics.UI.GLFW.Types

Data WindowHint 
Instance details

Defined in Graphics.UI.GLFW.Types

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> WindowHint -> c WindowHint #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c WindowHint #

toConstr :: WindowHint -> Constr #

dataTypeOf :: WindowHint -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c WindowHint) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WindowHint) #

gmapT :: (forall b. Data b => b -> b) -> WindowHint -> WindowHint #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> WindowHint -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> WindowHint -> r #

gmapQ :: (forall d. Data d => d -> u) -> WindowHint -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> WindowHint -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> WindowHint -> m WindowHint #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> WindowHint -> m WindowHint #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> WindowHint -> m WindowHint #

Ord WindowHint 
Instance details

Defined in Graphics.UI.GLFW.Types

Read WindowHint 
Instance details

Defined in Graphics.UI.GLFW.Types

Show WindowHint 
Instance details

Defined in Graphics.UI.GLFW.Types

Generic WindowHint 
Instance details

Defined in Graphics.UI.GLFW.Types

Associated Types

type Rep WindowHint :: Type -> Type #

NFData WindowHint 
Instance details

Defined in Graphics.UI.GLFW.Types

Methods

rnf :: WindowHint -> () #

type Rep WindowHint 
Instance details

Defined in Graphics.UI.GLFW.Types

type Rep WindowHint = D1 ('MetaData "WindowHint" "Graphics.UI.GLFW.Types" "GLFW-b-3.3.0.0-72a4a62ce9344b1d477911be5428439a7f0dde4015e86b2f16bc27b1f4e0b616" 'False) (((((C1 ('MetaCons "WindowHint'Resizable" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)) :+: C1 ('MetaCons "WindowHint'Visible" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool))) :+: (C1 ('MetaCons "WindowHint'Decorated" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)) :+: (C1 ('MetaCons "WindowHint'RedBits" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int))) :+: C1 ('MetaCons "WindowHint'GreenBits" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int)))))) :+: ((C1 ('MetaCons "WindowHint'BlueBits" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int))) :+: C1 ('MetaCons "WindowHint'AlphaBits" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int)))) :+: (C1 ('MetaCons "WindowHint'DepthBits" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int))) :+: (C1 ('MetaCons "WindowHint'StencilBits" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int))) :+: C1 ('MetaCons "WindowHint'AccumRedBits" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int))))))) :+: (((C1 ('MetaCons "WindowHint'AccumGreenBits" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int))) :+: C1 ('MetaCons "WindowHint'AccumBlueBits" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int)))) :+: (C1 ('MetaCons "WindowHint'AccumAlphaBits" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int))) :+: (C1 ('MetaCons "WindowHint'AuxBuffers" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int))) :+: C1 ('MetaCons "WindowHint'Samples" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int)))))) :+: ((C1 ('MetaCons "WindowHint'RefreshRate" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int))) :+: (C1 ('MetaCons "WindowHint'DoubleBuffer" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)) :+: C1 ('MetaCons "WindowHint'Stereo" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)))) :+: (C1 ('MetaCons "WindowHint'sRGBCapable" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)) :+: (C1 ('MetaCons "WindowHint'Floating" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)) :+: C1 ('MetaCons "WindowHint'Focused" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool))))))) :+: ((((C1 ('MetaCons "WindowHint'Maximized" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)) :+: C1 ('MetaCons "WindowHint'AutoIconify" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool))) :+: (C1 ('MetaCons "WindowHint'ClientAPI" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ClientAPI)) :+: (C1 ('MetaCons "WindowHint'ContextCreationAPI" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ContextCreationAPI)) :+: C1 ('MetaCons "WindowHint'ContextVersionMajor" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'SourceUnpack 'SourceStrict 'DecidedUnpack) (Rec0 Int))))) :+: ((C1 ('MetaCons "WindowHint'ContextVersionMinor" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'SourceUnpack 'SourceStrict 'DecidedUnpack) (Rec0 Int)) :+: C1 ('MetaCons "WindowHint'ContextRobustness" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ContextRobustness))) :+: (C1 ('MetaCons "WindowHint'ContextReleaseBehavior" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ContextReleaseBehavior)) :+: (C1 ('MetaCons "WindowHint'ContextNoError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)) :+: C1 ('MetaCons "WindowHint'OpenGLForwardCompat" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)))))) :+: (((C1 ('MetaCons "WindowHint'OpenGLDebugContext" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)) :+: C1 ('MetaCons "WindowHint'OpenGLProfile" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 OpenGLProfile))) :+: (C1 ('MetaCons "WindowHint'TransparentFramebuffer" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)) :+: (C1 ('MetaCons "WindowHint'CenterCursor" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)) :+: C1 ('MetaCons "WindowHint'FocusOnShow" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool))))) :+: ((C1 ('MetaCons "WindowHint'ScaleToMonitor" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)) :+: (C1 ('MetaCons "WindowHint'CocoaRetinaFramebuffer" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)) :+: C1 ('MetaCons "WindowHint'CocoaGraphicsSwitching" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)))) :+: (C1 ('MetaCons "WindowHint'CocoaFrameName" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 String)) :+: (C1 ('MetaCons "WindowHint'X11ClassName" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 String)) :+: C1 ('MetaCons "WindowHint'X11InstanceName" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 String))))))))

data EventPolicy Source #

Type to describe the waiting or polling style of event processing supported by GLFW.

Constructors

Poll 
Wait 
WaitTimeout Double 

Instances

Instances details
Show EventPolicy Source # 
Instance details

Defined in Graphics.GPipe.Context.GLFW.Handler

Exceptions

data InitException Source #

IO exception thrown when GLFW library initialization fails.

Constructors

InitException 

Mainthread hooks

mainloop Source #

Arguments

:: MonadIO m 
=> Window os c ds 
-> EventPolicy

A Poll loop runs continuously while a Wait loop sleeps until events or user input occur.

-> ContextT Handle os m (Maybe ()) 

Process GLFW and GPipe events according to the given EventPolicy in a loop.

Use case: Call mainloop in multithreaded applications which do GPipe rendering off of the main thread, but which do not otherwise need additional control over the main thread. For less complex applications use automatic event processing configured via HandleConfig.

  • Must be called on the main thread.
  • The loop will run until windowShouldClose is true for the all Windows created by the same ContextHandler, or all the Windows have been deleted.
  • To indicate a window should close use setWindowShouldClose in Graphics.GPipe.Context.GLFW.Wrapped.

mainstep Source #

Arguments

:: MonadIO m 
=> Window os c ds 
-> EventPolicy

Poll will process events and return immediately while Wait will sleep until events are received.

-> ContextT Handle os m (Maybe ()) 

Process GLFW and GPipe events according to the given EventPolicy.

Use case: Call mainstep as part of a custom engine loop in multithreaded applications which do GPipe rendering off of the main thread. Use mainloop for less complex applications.

  • Must be called on the main thread.
  • Can be called with any window you've created and not yet deleted.
  • If GPipe can't find the window you passed in, returns Nothing.

Reexports