{-# LINE 2 "./Graphics/UI/Gtk/Gdk/GLContext.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) GLContext
--
-- Author : Chris Mennie
--
-- Created: 23 April 2016
--
-- Copyright (C) 2016 Chis Mennie
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- OpenGL context
--
module Graphics.UI.Gtk.Gdk.GLContext (
-- * Detail
--
-- | GLContext is an object representing the platform-specific OpenGL drawing context.
--
-- GLContexts are created for a GdkWindow, and the context will match the GdkVisual of the window.
--
-- A 'GLContext' is not tied to any particular normal framebuffer. For instance, it cannot draw to
-- the Window back buffer. The GDK repaint system is in full control of the painting to that.
-- GDK will handle the integration of your rendering with that of other widgets.
--
-- Support for 'GLContext' is platform-specific, context creation can fail, returning NULL context.
--
-- A 'GLContext' has to be made "current" in order to start using it, otherwise any OpenGL call will
-- be ignored.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'GLContext'
-- @
--

-- * Types

  GLContext,
  GLContextClass,
  castToGLContext, gTypeGLContext,


-- * Methods

    glContextGetDisplay,
    glContextGetWindow,
    glContextGetSharedContext,
    glContextGetVersion,
    glContextSetRequiredVersion,
    glContextGetRequiredVersion,
    glContextSetDebugEnabled,
    glContextGetDebugEnabled,
    glContextSetForwardCompatible,
    glContextGetForwardCompatible,
    glContextRealize,


    glContextIsLegacy,


    glContextMakeCurrent,
    glContextGetCurrent,
    glContextClearCurrent

  ) where

import Control.Monad (liftM)
import Data.Maybe (fromMaybe)

import System.Glib.FFI
import System.Glib.Flags (toFlags)
import Graphics.UI.Gtk.Types
{-# LINE 89 "./Graphics/UI/Gtk/Gdk/GLContext.chs" #-}
import Graphics.UI.Gtk.Gdk.Enums
{-# LINE 90 "./Graphics/UI/Gtk/Gdk/GLContext.chs" #-}
import Graphics.UI.Gtk.Gdk.Cursor
{-# LINE 91 "./Graphics/UI/Gtk/Gdk/GLContext.chs" #-}
import Graphics.UI.Gtk.General.Structs
import System.Glib.GError (propagateGError)
import System.Glib.Attributes


{-# LINE 96 "./Graphics/UI/Gtk/Gdk/GLContext.chs" #-}


--------------------
-- Methods


-- | Retrieves the 'Graphics.UI.Gtk.Gdk.Display.Display' the context is created for.
--
glContextGetDisplay :: GLContextClass self => self -> IO (Maybe Display)
glContextGetDisplay :: forall self. GLContextClass self => self -> IO (Maybe Display)
glContextGetDisplay self
self = do
    (IO (Ptr Display) -> IO Display)
-> IO (Ptr Display) -> IO (Maybe Display)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr Display -> Display, FinalizerPtr Display)
-> IO (Ptr Display) -> IO Display
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Display -> Display, FinalizerPtr Display)
forall {a}. (ForeignPtr Display -> Display, FinalizerPtr a)
mkDisplay) (IO (Ptr Display) -> IO (Maybe Display))
-> IO (Ptr Display) -> IO (Maybe Display)
forall a b. (a -> b) -> a -> b
$
        (\(GLContext ForeignPtr GLContext
arg1) -> ForeignPtr GLContext
-> (Ptr GLContext -> IO (Ptr Display)) -> IO (Ptr Display)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GLContext
arg1 ((Ptr GLContext -> IO (Ptr Display)) -> IO (Ptr Display))
-> (Ptr GLContext -> IO (Ptr Display)) -> IO (Ptr Display)
forall a b. (a -> b) -> a -> b
$ \Ptr GLContext
argPtr1 ->Ptr GLContext -> IO (Ptr Display)
gdk_gl_context_get_display Ptr GLContext
argPtr1) (self -> GLContext
forall o. GLContextClass o => o -> GLContext
toGLContext self
self)


-- | Retrieves the 'Graphics.UI.Gtk.Gdk.DrawWindow.DrawWindow' used by the context.
--
glContextGetWindow :: GLContextClass self => self -> IO (Maybe DrawWindow)
glContextGetWindow :: forall self. GLContextClass self => self -> IO (Maybe DrawWindow)
glContextGetWindow self
self = do
    (IO (Ptr DrawWindow) -> IO DrawWindow)
-> IO (Ptr DrawWindow) -> IO (Maybe DrawWindow)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
-> IO (Ptr DrawWindow) -> IO DrawWindow
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
forall {a}. (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr a)
mkDrawWindow) (IO (Ptr DrawWindow) -> IO (Maybe DrawWindow))
-> IO (Ptr DrawWindow) -> IO (Maybe DrawWindow)
forall a b. (a -> b) -> a -> b
$
        (\(GLContext ForeignPtr GLContext
arg1) -> ForeignPtr GLContext
-> (Ptr GLContext -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GLContext
arg1 ((Ptr GLContext -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow))
-> (Ptr GLContext -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow)
forall a b. (a -> b) -> a -> b
$ \Ptr GLContext
argPtr1 ->Ptr GLContext -> IO (Ptr DrawWindow)
gdk_gl_context_get_window Ptr GLContext
argPtr1) (self -> GLContext
forall o. GLContextClass o => o -> GLContext
toGLContext self
self)


-- | Retrieves the 'GLContext' that this context share data with.
--
glContextGetSharedContext :: GLContextClass self => self -> IO (Maybe GLContext)
glContextGetSharedContext :: forall self. GLContextClass self => self -> IO (Maybe GLContext)
glContextGetSharedContext self
self = do
    (IO (Ptr GLContext) -> IO GLContext)
-> IO (Ptr GLContext) -> IO (Maybe GLContext)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr GLContext -> GLContext, FinalizerPtr GLContext)
-> IO (Ptr GLContext) -> IO GLContext
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr GLContext -> GLContext, FinalizerPtr GLContext)
forall {a}. (ForeignPtr GLContext -> GLContext, FinalizerPtr a)
mkGLContext) (IO (Ptr GLContext) -> IO (Maybe GLContext))
-> IO (Ptr GLContext) -> IO (Maybe GLContext)
forall a b. (a -> b) -> a -> b
$
        (\(GLContext ForeignPtr GLContext
arg1) -> ForeignPtr GLContext
-> (Ptr GLContext -> IO (Ptr GLContext)) -> IO (Ptr GLContext)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GLContext
arg1 ((Ptr GLContext -> IO (Ptr GLContext)) -> IO (Ptr GLContext))
-> (Ptr GLContext -> IO (Ptr GLContext)) -> IO (Ptr GLContext)
forall a b. (a -> b) -> a -> b
$ \Ptr GLContext
argPtr1 ->Ptr GLContext -> IO (Ptr GLContext)
gdk_gl_context_get_shared_context Ptr GLContext
argPtr1) (self -> GLContext
forall o. GLContextClass o => o -> GLContext
toGLContext self
self)


-- | Retrieves the OpenGL version of the context.
--
-- The context must be realized prior to calling this function.
--
glContextGetVersion :: GLContextClass self => self -> IO (Int, Int)
glContextGetVersion :: forall self. GLContextClass self => self -> IO (Int, Int)
glContextGetVersion self
self = do
    (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
majorPtr -> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
minorPtr -> do
        (\(GLContext ForeignPtr GLContext
arg1) Ptr CInt
arg2 Ptr CInt
arg3 -> ForeignPtr GLContext -> (Ptr GLContext -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GLContext
arg1 ((Ptr GLContext -> IO ()) -> IO ())
-> (Ptr GLContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GLContext
argPtr1 ->Ptr GLContext -> Ptr CInt -> Ptr CInt -> IO ()
gdk_gl_context_get_version Ptr GLContext
argPtr1 Ptr CInt
arg2 Ptr CInt
arg3) (self -> GLContext
forall o. GLContextClass o => o -> GLContext
toGLContext self
self) Ptr CInt
majorPtr Ptr CInt
minorPtr
        CInt
major <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
majorPtr
        CInt
minor <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
minorPtr
        (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
major, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
minor)


-- | Sets the major and minor version of OpenGL to request.
--
-- Setting major and minor to zero will use the default values.
--
-- The 'GLContext' must not be realized or made current prior to calling this function.
--
glContextSetRequiredVersion :: GLContextClass self => self -> Int -> Int -> IO ()
glContextSetRequiredVersion :: forall self. GLContextClass self => self -> Int -> Int -> IO ()
glContextSetRequiredVersion self
self Int
major Int
minor =
    (\(GLContext ForeignPtr GLContext
arg1) CInt
arg2 CInt
arg3 -> ForeignPtr GLContext -> (Ptr GLContext -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GLContext
arg1 ((Ptr GLContext -> IO ()) -> IO ())
-> (Ptr GLContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GLContext
argPtr1 ->Ptr GLContext -> CInt -> CInt -> IO ()
gdk_gl_context_set_required_version Ptr GLContext
argPtr1 CInt
arg2 CInt
arg3)
{-# LINE 148 "./Graphics/UI/Gtk/Gdk/GLContext.chs" #-}
        (self -> GLContext
forall o. GLContextClass o => o -> GLContext
toGLContext self
self) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
major) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minor)


-- | Retrieves the major and minor version requested by calling 'glContextSetRequiredVersion'.
--
glContextGetRequiredVersion :: GLContextClass self => self -> IO (Int, Int)
glContextGetRequiredVersion :: forall self. GLContextClass self => self -> IO (Int, Int)
glContextGetRequiredVersion self
self = do
    (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
majorPtr -> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
minorPtr -> do
        (\(GLContext ForeignPtr GLContext
arg1) Ptr CInt
arg2 Ptr CInt
arg3 -> ForeignPtr GLContext -> (Ptr GLContext -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GLContext
arg1 ((Ptr GLContext -> IO ()) -> IO ())
-> (Ptr GLContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GLContext
argPtr1 ->Ptr GLContext -> Ptr CInt -> Ptr CInt -> IO ()
gdk_gl_context_get_required_version Ptr GLContext
argPtr1 Ptr CInt
arg2 Ptr CInt
arg3) (self -> GLContext
forall o. GLContextClass o => o -> GLContext
toGLContext self
self) Ptr CInt
majorPtr Ptr CInt
minorPtr
        CInt
major <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
majorPtr
        CInt
minor <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
minorPtr
        (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
major, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
minor)


-- | Sets whether the 'GLContext' should perform extra validations and run time checking. This is
-- useful during development, but has additional overhead.
--
-- The 'GLContext' must not be realized or made current prior to calling this function.
--
glContextSetDebugEnabled :: GLContextClass self => self -> Bool -> IO ()
glContextSetDebugEnabled :: forall self. GLContextClass self => self -> Bool -> IO ()
glContextSetDebugEnabled self
self Bool
enabled = do
    (\(GLContext ForeignPtr GLContext
arg1) CInt
arg2 -> ForeignPtr GLContext -> (Ptr GLContext -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GLContext
arg1 ((Ptr GLContext -> IO ()) -> IO ())
-> (Ptr GLContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GLContext
argPtr1 ->Ptr GLContext -> CInt -> IO ()
gdk_gl_context_set_debug_enabled Ptr GLContext
argPtr1 CInt
arg2) (self -> GLContext
forall o. GLContextClass o => o -> GLContext
toGLContext self
self) (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
enabled)


-- | Retrieves the value set using glContextSetDebugEnabled.
--
glContextGetDebugEnabled :: GLContextClass self => self -> IO Bool
glContextGetDebugEnabled :: forall self. GLContextClass self => self -> IO Bool
glContextGetDebugEnabled self
self = do
    (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ (\(GLContext ForeignPtr GLContext
arg1) -> ForeignPtr GLContext -> (Ptr GLContext -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GLContext
arg1 ((Ptr GLContext -> IO CInt) -> IO CInt)
-> (Ptr GLContext -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr GLContext
argPtr1 ->Ptr GLContext -> IO CInt
gdk_gl_context_get_debug_enabled Ptr GLContext
argPtr1) (self -> GLContext
forall o. GLContextClass o => o -> GLContext
toGLContext self
self)


-- | Sets whether the 'GLContext' should be forward compatible.
--
-- Forward compatible contexts must not support OpenGL functionality that has been marked as
-- deprecated in the requested version; non-forward compatible contexts, on the other hand, must
-- support both deprecated and non deprecated functionality.
--
-- The 'GLContext' must not be realized or made current prior to calling this function.
--
glContextSetForwardCompatible :: GLContextClass self => self -> Bool -> IO ()
glContextSetForwardCompatible :: forall self. GLContextClass self => self -> Bool -> IO ()
glContextSetForwardCompatible self
self Bool
compatible = do
    (\(GLContext ForeignPtr GLContext
arg1) CInt
arg2 -> ForeignPtr GLContext -> (Ptr GLContext -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GLContext
arg1 ((Ptr GLContext -> IO ()) -> IO ())
-> (Ptr GLContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GLContext
argPtr1 ->Ptr GLContext -> CInt -> IO ()
gdk_gl_context_set_forward_compatible Ptr GLContext
argPtr1 CInt
arg2) (self -> GLContext
forall o. GLContextClass o => o -> GLContext
toGLContext self
self) (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
compatible)


-- | Retrieves the value set using glContextSetForwardCompatible.
--
glContextGetForwardCompatible :: GLContextClass self => self -> IO Bool
glContextGetForwardCompatible :: forall self. GLContextClass self => self -> IO Bool
glContextGetForwardCompatible self
self = do
    (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ (\(GLContext ForeignPtr GLContext
arg1) -> ForeignPtr GLContext -> (Ptr GLContext -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GLContext
arg1 ((Ptr GLContext -> IO CInt) -> IO CInt)
-> (Ptr GLContext -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr GLContext
argPtr1 ->Ptr GLContext -> IO CInt
gdk_gl_context_get_forward_compatible Ptr GLContext
argPtr1) (self -> GLContext
forall o. GLContextClass o => o -> GLContext
toGLContext self
self)




-- | Whether the 'GLContext' is in legacy mode or not.
--
-- The 'GLContext' must be realized before calling this function.
--
-- When realizing a GL context, GDK will try to use the OpenGL 3.2 core profile; this profile
-- removes all the OpenGL API that was deprecated prior to the 3.2 version of the specification.
-- If the realization is successful, this function will return False.
--
-- If the underlying OpenGL implementation does not support core profiles, GDK will fall back to
-- a pre-3.2 compatibility profile, and this function will return True.
--
-- You can use the value returned by this function to decide which kind of OpenGL API to use, or
-- whether to do extension discovery, or what kind of shader programs to load.
--
glContextIsLegacy :: GLContextClass self => self -> IO Bool
glContextIsLegacy :: forall self. GLContextClass self => self -> IO Bool
glContextIsLegacy self
self = do
    (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ (\(GLContext ForeignPtr GLContext
arg1) -> ForeignPtr GLContext -> (Ptr GLContext -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GLContext
arg1 ((Ptr GLContext -> IO CInt) -> IO CInt)
-> (Ptr GLContext -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr GLContext
argPtr1 ->Ptr GLContext -> IO CInt
gdk_gl_context_is_legacy Ptr GLContext
argPtr1) (self -> GLContext
forall o. GLContextClass o => o -> GLContext
toGLContext self
self)




-- | Realizes the given 'GLContext'.
--
-- It is safe to call this function on a realized 'GLContext'.
--
glContextRealize :: GLContextClass self => self -> IO Bool
glContextRealize :: forall self. GLContextClass self => self -> IO Bool
glContextRealize self
self =
    (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
        (Ptr (Ptr ()) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr ()) -> IO a) -> IO a
propagateGError ((Ptr (Ptr ()) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr ()) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
errPtr ->
            (\(GLContext ForeignPtr GLContext
arg1) Ptr (Ptr ())
arg2 -> ForeignPtr GLContext -> (Ptr GLContext -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GLContext
arg1 ((Ptr GLContext -> IO CInt) -> IO CInt)
-> (Ptr GLContext -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr GLContext
argPtr1 ->Ptr GLContext -> Ptr (Ptr ()) -> IO CInt
gdk_gl_context_realize Ptr GLContext
argPtr1 Ptr (Ptr ())
arg2) (self -> GLContext
forall o. GLContextClass o => o -> GLContext
toGLContext self
self) Ptr (Ptr ())
errPtr


-- | Makes the context the current one.
--
glContextMakeCurrent :: GLContextClass self => self -> IO ()
glContextMakeCurrent :: forall self. GLContextClass self => self -> IO ()
glContextMakeCurrent self
self = do
    (\(GLContext ForeignPtr GLContext
arg1) -> ForeignPtr GLContext -> (Ptr GLContext -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GLContext
arg1 ((Ptr GLContext -> IO ()) -> IO ())
-> (Ptr GLContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GLContext
argPtr1 ->Ptr GLContext -> IO ()
gdk_gl_context_make_current Ptr GLContext
argPtr1) (self -> GLContext
forall o. GLContextClass o => o -> GLContext
toGLContext self
self)


-- | Retrieves the current 'GLContext'.
--
glContextGetCurrent :: IO (Maybe GLContext)
glContextGetCurrent :: IO (Maybe GLContext)
glContextGetCurrent = do
    (IO (Ptr GLContext) -> IO GLContext)
-> IO (Ptr GLContext) -> IO (Maybe GLContext)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr GLContext -> GLContext, FinalizerPtr GLContext)
-> IO (Ptr GLContext) -> IO GLContext
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr GLContext -> GLContext, FinalizerPtr GLContext)
forall {a}. (ForeignPtr GLContext -> GLContext, FinalizerPtr a)
mkGLContext) (IO (Ptr GLContext) -> IO (Maybe GLContext))
-> IO (Ptr GLContext) -> IO (Maybe GLContext)
forall a b. (a -> b) -> a -> b
$
        IO (Ptr GLContext)
gdk_gl_context_get_current
{-# LINE 246 "./Graphics/UI/Gtk/Gdk/GLContext.chs" #-}


-- | Clears the current 'GLContext'.
--
-- Any OpenGL call after this function returns will be ignored until glContextMakeCurrent
-- is called.
--
glContextClearCurrent :: IO ()
glContextClearCurrent :: IO ()
glContextClearCurrent = do
    IO ()
gdk_gl_context_clear_current
{-# LINE 256 "./Graphics/UI/Gtk/Gdk/GLContext.chs" #-}

foreign import ccall safe "gdk_gl_context_get_display"
  gdk_gl_context_get_display :: ((Ptr GLContext) -> (IO (Ptr Display)))

foreign import ccall safe "gdk_gl_context_get_window"
  gdk_gl_context_get_window :: ((Ptr GLContext) -> (IO (Ptr DrawWindow)))

foreign import ccall safe "gdk_gl_context_get_shared_context"
  gdk_gl_context_get_shared_context :: ((Ptr GLContext) -> (IO (Ptr GLContext)))

foreign import ccall safe "gdk_gl_context_get_version"
  gdk_gl_context_get_version :: ((Ptr GLContext) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO ()))))

foreign import ccall safe "gdk_gl_context_set_required_version"
  gdk_gl_context_set_required_version :: ((Ptr GLContext) -> (CInt -> (CInt -> (IO ()))))

foreign import ccall safe "gdk_gl_context_get_required_version"
  gdk_gl_context_get_required_version :: ((Ptr GLContext) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO ()))))

foreign import ccall safe "gdk_gl_context_set_debug_enabled"
  gdk_gl_context_set_debug_enabled :: ((Ptr GLContext) -> (CInt -> (IO ())))

foreign import ccall safe "gdk_gl_context_get_debug_enabled"
  gdk_gl_context_get_debug_enabled :: ((Ptr GLContext) -> (IO CInt))

foreign import ccall safe "gdk_gl_context_set_forward_compatible"
  gdk_gl_context_set_forward_compatible :: ((Ptr GLContext) -> (CInt -> (IO ())))

foreign import ccall safe "gdk_gl_context_get_forward_compatible"
  gdk_gl_context_get_forward_compatible :: ((Ptr GLContext) -> (IO CInt))

foreign import ccall safe "gdk_gl_context_is_legacy"
  gdk_gl_context_is_legacy :: ((Ptr GLContext) -> (IO CInt))

foreign import ccall safe "gdk_gl_context_realize"
  gdk_gl_context_realize :: ((Ptr GLContext) -> ((Ptr (Ptr ())) -> (IO CInt)))

foreign import ccall safe "gdk_gl_context_make_current"
  gdk_gl_context_make_current :: ((Ptr GLContext) -> (IO ()))

foreign import ccall safe "gdk_gl_context_get_current"
  gdk_gl_context_get_current :: (IO (Ptr GLContext))

foreign import ccall safe "gdk_gl_context_clear_current"
  gdk_gl_context_clear_current :: (IO ())