-- 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/Cursor.chs" #-}
-- | This is client-side code for loading cursor themes. Provided for convenience only.
module Graphics.Wayland.Internal.Cursor (
  CursorTheme, CursorImage, Cursor,
  cursorImageSize, cursorImageHotspot, cursorImageDelay,
  cursorName, cursorImages,

  cursorThemeLoad, cursorThemeDestroy, cursorThemeGetCursor, cursorImageGetBuffer, cursorFrame
  ) where

import Control.Monad (liftM)
import Foreign
import Foreign.C.Types
import Foreign.C.String
import System.IO.Unsafe (unsafePerformIO)

import Graphics.Wayland.Internal.SpliceClientTypes (Shm(..), Buffer(..))




{-# LINE 20 "./Graphics/Wayland/Internal/Cursor.chs" #-}



-- | struct wl_cursor_theme;
newtype CursorTheme = CursorTheme (Ptr (CursorTheme))
{-# LINE 24 "./Graphics/Wayland/Internal/Cursor.chs" #-}



-- | struct wl_cursor_image {
-- 	uint32_t width;		/* actual width */
-- 	uint32_t height;	/* actual height */
-- 	uint32_t hotspot_x;	/* hot spot x (must be inside image) */
-- 	uint32_t hotspot_y;	/* hot spot y (must be inside image) */
-- 	uint32_t delay;		/* animation delay to next frame (ms) */
-- };
newtype CursorImage = CursorImage (Ptr (CursorImage))
{-# LINE 34 "./Graphics/Wayland/Internal/Cursor.chs" #-}


cursorImageSize :: CursorImage -> (Word, Word)
cursorImageSize (CursorImage ci) = unsafePerformIO $ do -- CursorImages are immutable
  width <- (\ptr -> do {peekByteOff ptr 0 ::IO CUInt}) ci
  height <- (\ptr -> do {peekByteOff ptr 4 ::IO CUInt}) ci
  return (fromIntegral width, fromIntegral height)

cursorImageHotspot :: CursorImage -> (Word, Word)
cursorImageHotspot (CursorImage ci) = unsafePerformIO $ do -- CursorImages are immutable
  x <- (\ptr -> do {peekByteOff ptr 8 ::IO CUInt}) ci
  y <- (\ptr -> do {peekByteOff ptr 12 ::IO CUInt}) ci
  return (fromIntegral x, fromIntegral y)

cursorImageDelay :: CursorImage -> Word
cursorImageDelay (CursorImage ci) = unsafePerformIO $ liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 16 ::IO CUInt}) ci -- CursorImages are immutable

-- | struct wl_cursor {
-- 	unsigned int image_count;
-- 	struct wl_cursor_image **images;
-- 	char *name;
-- };
newtype Cursor = Cursor (Ptr (Cursor))
{-# LINE 56 "./Graphics/Wayland/Internal/Cursor.chs" #-}

cursorName :: Cursor -> String
cursorName (Cursor c) = unsafePerformIO $ do
  cstr <- (\ptr -> do {peekByteOff ptr 16 ::IO (Ptr CChar)}) c
  peekCString cstr

cursorImages :: Cursor -> [CursorImage]
cursorImages (Cursor c) = unsafePerformIO $ do
  imagesPtr <- (\ ptr -> (peekByteOff ptr (8) :: IO (Ptr (Ptr CursorImage)))) c
  count <- (\ptr -> do {peekByteOff ptr 0 ::IO CUInt}) c
  return imagesPtr
  ptrs <- peekArray (fromIntegral count) imagesPtr
  return $ map CursorImage ptrs

-- struct wl_shm;

{-# LINE 71 "./Graphics/Wayland/Internal/Cursor.chs" #-}


-- | struct wl_cursor_theme *
-- wl_cursor_theme_load(const char *name, int size, struct wl_shm *shm);
cursorThemeLoad :: (String) -> (Int) -> (Shm) -> IO ((CursorTheme))
cursorThemeLoad a1 a2 a3 =
  withCString a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  let {a3' = id a3} in 
  cursorThemeLoad'_ a1' a2' a3' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 75 "./Graphics/Wayland/Internal/Cursor.chs" #-}


-- | void
-- wl_cursor_theme_destroy(struct wl_cursor_theme *theme);
cursorThemeDestroy :: (CursorTheme) -> IO ()
cursorThemeDestroy a1 =
  let {a1' = id a1} in 
  cursorThemeDestroy'_ a1' >>
  return ()

{-# LINE 79 "./Graphics/Wayland/Internal/Cursor.chs" #-}


-- | struct wl_cursor *
-- wl_cursor_theme_get_cursor(struct wl_cursor_theme *theme,
-- 			   const char *name);
cursorThemeGetCursor :: (CursorTheme) -> (String) -> IO ((Cursor))
cursorThemeGetCursor a1 a2 =
  let {a1' = id a1} in 
  withCString a2 $ \a2' -> 
  cursorThemeGetCursor'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 84 "./Graphics/Wayland/Internal/Cursor.chs" #-}



{-# LINE 86 "./Graphics/Wayland/Internal/Cursor.chs" #-}

-- | struct wl_buffer *
-- wl_cursor_image_get_buffer(struct wl_cursor_image *image);
--
-- From the wayland docs: do not destroy the returned buffer.
cursorImageGetBuffer :: (CursorImage) -> IO ((Buffer))
cursorImageGetBuffer a1 =
  let {a1' = id a1} in 
  cursorImageGetBuffer'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 91 "./Graphics/Wayland/Internal/Cursor.chs" #-}


-- | int
-- wl_cursor_frame(struct wl_cursor *cursor, uint32_t time);
cursorFrame :: (Cursor) -> (Int) -> IO ((Int))
cursorFrame a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  cursorFrame'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 95 "./Graphics/Wayland/Internal/Cursor.chs" #-}


foreign import ccall unsafe "Graphics/Wayland/Internal/Cursor.chs.h wl_cursor_theme_load"
  cursorThemeLoad'_ :: ((Ptr CChar) -> (CInt -> ((Shm) -> (IO (CursorTheme)))))

foreign import ccall unsafe "Graphics/Wayland/Internal/Cursor.chs.h wl_cursor_theme_destroy"
  cursorThemeDestroy'_ :: ((CursorTheme) -> (IO ()))

foreign import ccall unsafe "Graphics/Wayland/Internal/Cursor.chs.h wl_cursor_theme_get_cursor"
  cursorThemeGetCursor'_ :: ((CursorTheme) -> ((Ptr CChar) -> (IO (Cursor))))

foreign import ccall unsafe "Graphics/Wayland/Internal/Cursor.chs.h wl_cursor_image_get_buffer"
  cursorImageGetBuffer'_ :: ((CursorImage) -> (IO (Buffer)))

foreign import ccall unsafe "Graphics/Wayland/Internal/Cursor.chs.h wl_cursor_frame"
  cursorFrame'_ :: ((Cursor) -> (CUInt -> (IO CInt)))