{-# LINE 1 "src/Bindings/WLC/Render.hsc" #-}

{-# LINE 2 "src/Bindings/WLC/Render.hsc" #-}

{-# LINE 3 "src/Bindings/WLC/Render.hsc" #-}

{-|
Module      : Bindings.WLC.WLCRender
Description : WLC Render
Copyright   : (c) Ashley Towns 2016
License     : BSD3
Maintainer  : mail@ashleytowns.id.au
Stability   : experimental
Portability : POSIX

The functions in this file provide some basic rendering capabilities.
*_render(), *_read(), *_write() functions should only be called during post/pre render callbacks.
wlc_output_schedule_render() is exception and may be used to force wlc to render new frame (causing callbacks to trigger).

For more advanced drawing you should directly use GLES2.
This is not documented as it's currently relying on the implementation details of wlc.
-}
module Bindings.WLC.Render where
import Foreign.Ptr (Ptr,FunPtr,plusPtr)
import Foreign.Ptr (wordPtrToPtr,castPtrToFunPtr)
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String (CString,CStringLen,CWString,CWStringLen)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray,pokeArray)
import Data.Int
import Data.Word

{-# LINE 22 "src/Bindings/WLC/Render.hsc" #-}

import Bindings.WLC.Defines
import Bindings.WLC.Geometry
import Bindings.WLC.Wayland

-- |Allowed pixel formats.
type C'wlc_pixel_format = CUInt

{-# LINE 29 "src/Bindings/WLC/Render.hsc" #-}
c'WLC_RGBA8888 = 0
c'WLC_RGBA8888 :: (Num a) => a

{-# LINE 30 "src/Bindings/WLC/Render.hsc" #-}

-- |Write pixel data with the specific format to output's framebuffer.
-- If the geometry is out of bounds, it will be automaticall clamped.
foreign import ccall "wlc_pixels_write" c'wlc_pixels_write
  :: C'wlc_pixel_format -> Ptr C'wlc_geometry -> Ptr () -> IO ()
foreign import ccall "&wlc_pixels_write" p'wlc_pixels_write
  :: FunPtr (C'wlc_pixel_format -> Ptr C'wlc_geometry -> Ptr () -> IO ())

{-# LINE 34 "src/Bindings/WLC/Render.hsc" #-}

-- |Read pixel data from output's framebuffer.
-- If the geometry is out of bounds, it will be automatically clamped.
-- Potentially clamped geometry will be stored in out_geometry, to indicate width / height of the returned data.
foreign import ccall "wlc_pixels_read" c'wlc_pixels_read
  :: C'wlc_pixel_format -> Ptr C'wlc_geometry -> Ptr C'wlc_geometry -> Ptr () -> IO ()
foreign import ccall "&wlc_pixels_read" p'wlc_pixels_read
  :: FunPtr (C'wlc_pixel_format -> Ptr C'wlc_geometry -> Ptr C'wlc_geometry -> Ptr () -> IO ())

{-# LINE 39 "src/Bindings/WLC/Render.hsc" #-}

-- |Renders surface.
foreign import ccall "wlc_surface_render" c'wlc_surface_render
  :: C'wlc_resource -> Ptr C'wlc_geometry -> IO ()
foreign import ccall "&wlc_surface_render" p'wlc_surface_render
  :: FunPtr (C'wlc_resource -> Ptr C'wlc_geometry -> IO ())

{-# LINE 42 "src/Bindings/WLC/Render.hsc" #-}

-- |Schedules output for rendering next frame. If output was already scheduled this is no-op,
-- if output is currently rendering, it will render immediately after.
foreign import ccall "wlc_output_schedule_render" c'wlc_output_schedule_render
  :: C'wlc_handle -> IO ()
foreign import ccall "&wlc_output_schedule_render" p'wlc_output_schedule_render
  :: FunPtr (C'wlc_handle -> IO ())

{-# LINE 46 "src/Bindings/WLC/Render.hsc" #-}

-- |Adds frame callbacks of the given surface for the next output frame.
-- It applies recursively to all subsurfaces.
-- Useful when the compositor creates custom animations which require disabling internal rendering,
-- but still need to update the surface textures (for ex. video players).
foreign import ccall "wlc_surface_flush_frame_callbacks" c'wlc_surface_flush_frame_callbacks
  :: C'wlc_resource -> IO ()
foreign import ccall "&wlc_surface_flush_frame_callbacks" p'wlc_surface_flush_frame_callbacks
  :: FunPtr (C'wlc_resource -> IO ())

{-# LINE 52 "src/Bindings/WLC/Render.hsc" #-}

-- |Enabled renderers
type C'wlc_renderer = CUInt

{-# LINE 55 "src/Bindings/WLC/Render.hsc" #-}
c'WLC_RENDERER_GLES2 = 0
c'WLC_RENDERER_GLES2 :: (Num a) => a

{-# LINE 56 "src/Bindings/WLC/Render.hsc" #-}
c'WLC_NO_RENDERER = 1
c'WLC_NO_RENDERER :: (Num a) => a

{-# LINE 57 "src/Bindings/WLC/Render.hsc" #-}

-- |Returns currently active renderer on the given output
foreign import ccall "wlc_output_get_renderer" c'wlc_output_get_renderer
  :: C'wlc_handle -> IO C'wlc_renderer
foreign import ccall "&wlc_output_get_renderer" p'wlc_output_get_renderer
  :: FunPtr (C'wlc_handle -> IO C'wlc_renderer)

{-# LINE 60 "src/Bindings/WLC/Render.hsc" #-}

type C'wlc_surface_format = CUInt

{-# LINE 62 "src/Bindings/WLC/Render.hsc" #-}
c'SURFACE_RGB = 0
c'SURFACE_RGB :: (Num a) => a

{-# LINE 63 "src/Bindings/WLC/Render.hsc" #-}
c'SURFACE_RGBA = 1
c'SURFACE_RGBA :: (Num a) => a

{-# LINE 64 "src/Bindings/WLC/Render.hsc" #-}
c'SURFACE_EGL = 2
c'SURFACE_EGL :: (Num a) => a

{-# LINE 65 "src/Bindings/WLC/Render.hsc" #-}
c'SURFACE_Y_UV = 3
c'SURFACE_Y_UV :: (Num a) => a

{-# LINE 66 "src/Bindings/WLC/Render.hsc" #-}
c'SURFACE_Y_U_V = 4
c'SURFACE_Y_U_V :: (Num a) => a

{-# LINE 67 "src/Bindings/WLC/Render.hsc" #-}
c'SURFACE_Y_XUXV = 5
c'SURFACE_Y_XUXV :: (Num a) => a

{-# LINE 68 "src/Bindings/WLC/Render.hsc" #-}