module GLX ( glxDriver
           ) where

import GLDriver
import Bindings.GLX

import Control.Monad (when, unless)

import Data.Bits ((.|.))

import Graphics.X11.Types
import Graphics.X11.Xlib.Display (defaultScreen, openDisplay, rootWindow)
import Graphics.X11.Xlib.Event (allocaXEvent, nextEvent, get_Window, get_EventType)
import Graphics.X11.Xlib.Types
import Graphics.X11.Xlib.Window (mapWindow)

import Foreign.Marshal.Utils (with)
import Foreign.Ptr
import Foreign.Storable



data GLX = GLX Bool

glxDriver :: GLX
glxDriver = GLX False


instance GLDriver GLX where
    initialized (GLX inited) = inited
    
    initGL (GLX inited) = do
      when (inited) $ fail "GLX already initialized"
      
      disp <- openDisplay ""
      fbconfigs <- chooseFBConfig disp (fromIntegral . defaultScreen $ disp)
                      [(glxRenderType, glxRgbaBit)
                       , (glxDrawableType, glxWindowBit)
                       , (glxXRenderable, glxTrue)
                       , (glxDepthSize, 1)
                       , (glxStencilSize, 1)
                     ]
      visualinfo <- getVisualFromFBConfig disp (head fbconfigs)
      rootwindow <- rootWindow disp (fromIntegral $ vi_screen visualinfo)
      cmap <- createColormap disp rootwindow (vi_visual visualinfo) allocNone
      
      let swa = nullSetWindowAttributes {swa_colormap = cmap, swa_event_mask = structureNotifyMask .|. keyPressMask .|. keyReleaseMask}
      
      wnd <- with swa $ \swaptr -> createWindow disp rootwindow 0 0 800 600 0 (fromIntegral $ vi_depth visualinfo) inputOutput (vi_visual visualinfo) (cWBorderPixel.|.cWColormap.|.cWEventMask) swaptr
      mapWindow disp wnd
      
      waitForMapNotify disp wnd
      
      ctx <- with visualinfo $ \vi -> glXCreateContext disp vi (GLXContext nullPtr) True
      glXMakeCurrent disp wnd ctx
      
      return (GLX True)
    
    deinitGL _ = return ()
    
    nextEvent _ = return Nothing


waitForMapNotify :: Display -> Window -> IO ()
waitForMapNotify disp wnd = allocaXEvent waitForMapNotify'
    where
      waitForMapNotify' event = do
        Graphics.X11.Xlib.Event.nextEvent disp event
        window <- get_Window event
        eventType <- get_EventType event
        unless (window == wnd && eventType == mapNotify) $
               waitForMapNotify' event