--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.Clipping
-- Copyright   :  (c) Sven Panne 2002-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This module corresponds to section 13.5 (Primitive Clipping) of the OpenGL
-- 4.4 specs.
--
--------------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GL.Clipping (
   ClipPlaneName(..), clipPlane, maxClipPlanes
) where

import Data.StateVar
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import Foreign.Ptr
import Foreign.Storable
import Graphics.Rendering.OpenGL.GL.Capability
import Graphics.Rendering.OpenGL.GL.CoordTrans
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
import Graphics.GL

--------------------------------------------------------------------------------

newtype ClipPlaneName = ClipPlaneName GLsizei
   deriving ( ClipPlaneName -> ClipPlaneName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClipPlaneName -> ClipPlaneName -> Bool
$c/= :: ClipPlaneName -> ClipPlaneName -> Bool
== :: ClipPlaneName -> ClipPlaneName -> Bool
$c== :: ClipPlaneName -> ClipPlaneName -> Bool
Eq, Eq ClipPlaneName
ClipPlaneName -> ClipPlaneName -> Bool
ClipPlaneName -> ClipPlaneName -> Ordering
ClipPlaneName -> ClipPlaneName -> ClipPlaneName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ClipPlaneName -> ClipPlaneName -> ClipPlaneName
$cmin :: ClipPlaneName -> ClipPlaneName -> ClipPlaneName
max :: ClipPlaneName -> ClipPlaneName -> ClipPlaneName
$cmax :: ClipPlaneName -> ClipPlaneName -> ClipPlaneName
>= :: ClipPlaneName -> ClipPlaneName -> Bool
$c>= :: ClipPlaneName -> ClipPlaneName -> Bool
> :: ClipPlaneName -> ClipPlaneName -> Bool
$c> :: ClipPlaneName -> ClipPlaneName -> Bool
<= :: ClipPlaneName -> ClipPlaneName -> Bool
$c<= :: ClipPlaneName -> ClipPlaneName -> Bool
< :: ClipPlaneName -> ClipPlaneName -> Bool
$c< :: ClipPlaneName -> ClipPlaneName -> Bool
compare :: ClipPlaneName -> ClipPlaneName -> Ordering
$ccompare :: ClipPlaneName -> ClipPlaneName -> Ordering
Ord, Int -> ClipPlaneName -> ShowS
[ClipPlaneName] -> ShowS
ClipPlaneName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClipPlaneName] -> ShowS
$cshowList :: [ClipPlaneName] -> ShowS
show :: ClipPlaneName -> String
$cshow :: ClipPlaneName -> String
showsPrec :: Int -> ClipPlaneName -> ShowS
$cshowsPrec :: Int -> ClipPlaneName -> ShowS
Show )

--------------------------------------------------------------------------------

clipPlane :: ClipPlaneName -> StateVar (Maybe (Plane GLdouble))
clipPlane :: ClipPlaneName -> StateVar (Maybe (Plane GLdouble))
clipPlane ClipPlaneName
name =
   forall a.
IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)
makeStateVarMaybe
      (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ClipPlaneName -> EnableCap
nameToCap ClipPlaneName
name)
      (forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Plane GLdouble)
buf -> do
          ClipPlaneName -> (GLenum -> IO ()) -> IO ()
clipPlaneAction ClipPlaneName
name forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *). MonadIO m => GLenum -> Ptr GLdouble -> m ()
glGetClipPlane forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr (Plane GLdouble)
buf
          forall a. Storable a => Ptr a -> IO a
peek Ptr (Plane GLdouble)
buf)
      (\Plane GLdouble
plane -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Plane GLdouble
plane forall a b. (a -> b) -> a -> b
$ ClipPlaneName -> (GLenum -> IO ()) -> IO ()
clipPlaneAction ClipPlaneName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *). MonadIO m => GLenum -> Ptr GLdouble -> m ()
glClipPlane forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr)

nameToCap :: ClipPlaneName -> EnableCap
nameToCap :: ClipPlaneName -> EnableCap
nameToCap (ClipPlaneName GLsizei
i) = GLsizei -> EnableCap
CapClipPlane GLsizei
i

clipPlaneAction :: ClipPlaneName -> (GLenum -> IO ()) -> IO ()
clipPlaneAction :: ClipPlaneName -> (GLenum -> IO ()) -> IO ()
clipPlaneAction (ClipPlaneName GLsizei
i) GLenum -> IO ()
act =
   forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ()
recordInvalidEnum GLenum -> IO ()
act (GLsizei -> Maybe GLenum
clipPlaneIndexToEnum GLsizei
i)

--------------------------------------------------------------------------------

maxClipPlanes :: GettableStateVar GLsizei
maxClipPlanes :: GettableStateVar GLsizei
maxClipPlanes = forall a. IO a -> IO a
makeGettableStateVar (forall p a. GetPName1I p => (GLsizei -> a) -> p -> IO a
getSizei1 forall a. a -> a
id PName1I
GetMaxClipPlanes)