-- GENERATED by C->Haskell Compiler, version 0.17.2 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Graphics/Wayland/Internal/EGL.chs" #-}
-- | Client-side
module Graphics.Wayland.Internal.EGL (
  EGLWindow, eglWindowCreate, eglWindowDestroy, eglWindowResize, eglWindowGetAttachedSize
  ) where


import Control.Monad
import Foreign
import Foreign.C.Types
import Foreign.C.String

import Graphics.Wayland.Internal.SpliceClientTypes (Surface(..))




{-# LINE 16 "./Graphics/Wayland/Internal/EGL.chs" #-}



-- lol this is 100% unused.
-- #define WL_EGL_PLATFORM 1


{-# LINE 22 "./Graphics/Wayland/Internal/EGL.chs" #-}


-- struct wl_egl_window;
newtype EGLWindow = EGLWindow (Ptr (EGLWindow))
{-# LINE 25 "./Graphics/Wayland/Internal/EGL.chs" #-}


-- struct wl_egl_window *
-- wl_egl_window_create(struct wl_surface *surface,
-- 		     int width, int height);
eglWindowCreate :: (Surface) -> (Int) -> (Int) -> IO ((EGLWindow))
eglWindowCreate a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  eglWindowCreate'_ a1' a2' a3' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 30 "./Graphics/Wayland/Internal/EGL.chs" #-}


-- void
-- wl_egl_window_destroy(struct wl_egl_window *egl_window);
eglWindowDestroy :: (EGLWindow) -> IO ()
eglWindowDestroy a1 =
  let {a1' = id a1} in 
  eglWindowDestroy'_ a1' >>
  return ()

{-# LINE 34 "./Graphics/Wayland/Internal/EGL.chs" #-}


-- void
-- wl_egl_window_resize(struct wl_egl_window *egl_window,
-- 		     int width, int height,
-- 		     int dx, int dy);
eglWindowResize :: (EGLWindow) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ()
eglWindowResize a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  let {a5' = fromIntegral a5} in 
  eglWindowResize'_ a1' a2' a3' a4' a5' >>
  return ()

{-# LINE 40 "./Graphics/Wayland/Internal/EGL.chs" #-}



-- void
-- wl_egl_window_get_attached_size(struct wl_egl_window *egl_window,
-- 				int *width, int *height);
-- withInt = with.fromIntegral 0
peekInt = liftM fromIntegral . peek
eglWindowGetAttachedSize :: (EGLWindow) -> IO ((Int), (Int))
eglWindowGetAttachedSize a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  eglWindowGetAttachedSize'_ a1' a2' a3' >>
  peekInt  a2'>>= \a2'' -> 
  peekInt  a3'>>= \a3'' -> 
  return (a2'', a3'')

{-# LINE 48 "./Graphics/Wayland/Internal/EGL.chs" #-}


foreign import ccall unsafe "Graphics/Wayland/Internal/EGL.chs.h wl_egl_window_create"
  eglWindowCreate'_ :: ((Surface) -> (CInt -> (CInt -> (IO (EGLWindow)))))

foreign import ccall unsafe "Graphics/Wayland/Internal/EGL.chs.h wl_egl_window_destroy"
  eglWindowDestroy'_ :: ((EGLWindow) -> (IO ()))

foreign import ccall unsafe "Graphics/Wayland/Internal/EGL.chs.h wl_egl_window_resize"
  eglWindowResize'_ :: ((EGLWindow) -> (CInt -> (CInt -> (CInt -> (CInt -> (IO ()))))))

foreign import ccall unsafe "Graphics/Wayland/Internal/EGL.chs.h wl_egl_window_get_attached_size"
  eglWindowGetAttachedSize'_ :: ((EGLWindow) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO ()))))