--------------------------------------------------------------------------------
-- |
-- 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
(ClipPlaneName -> ClipPlaneName -> Bool)
-> (ClipPlaneName -> ClipPlaneName -> Bool) -> Eq ClipPlaneName
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
Eq ClipPlaneName =>
(ClipPlaneName -> ClipPlaneName -> Ordering)
-> (ClipPlaneName -> ClipPlaneName -> Bool)
-> (ClipPlaneName -> ClipPlaneName -> Bool)
-> (ClipPlaneName -> ClipPlaneName -> Bool)
-> (ClipPlaneName -> ClipPlaneName -> Bool)
-> (ClipPlaneName -> ClipPlaneName -> ClipPlaneName)
-> (ClipPlaneName -> ClipPlaneName -> ClipPlaneName)
-> Ord 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
$cp1Ord :: Eq ClipPlaneName
Ord, Int -> ClipPlaneName -> ShowS
[ClipPlaneName] -> ShowS
ClipPlaneName -> String
(Int -> ClipPlaneName -> ShowS)
-> (ClipPlaneName -> String)
-> ([ClipPlaneName] -> ShowS)
-> Show ClipPlaneName
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 name :: ClipPlaneName
name =
   IO EnableCap
-> IO (Plane GLdouble)
-> (Plane GLdouble -> IO ())
-> StateVar (Maybe (Plane GLdouble))
forall a.
IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)
makeStateVarMaybe
      (EnableCap -> IO EnableCap
forall (m :: * -> *) a. Monad m => a -> m a
return (EnableCap -> IO EnableCap) -> EnableCap -> IO EnableCap
forall a b. (a -> b) -> a -> b
$ ClipPlaneName -> EnableCap
nameToCap ClipPlaneName
name)
      ((Ptr (Plane GLdouble) -> IO (Plane GLdouble))
-> IO (Plane GLdouble)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Plane GLdouble) -> IO (Plane GLdouble))
 -> IO (Plane GLdouble))
-> (Ptr (Plane GLdouble) -> IO (Plane GLdouble))
-> IO (Plane GLdouble)
forall a b. (a -> b) -> a -> b
$ \buf :: Ptr (Plane GLdouble)
buf -> do
          ClipPlaneName -> (GLenum -> IO ()) -> IO ()
clipPlaneAction ClipPlaneName
name ((GLenum -> IO ()) -> IO ()) -> (GLenum -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ (GLenum -> Ptr GLdouble -> IO ())
-> Ptr GLdouble -> GLenum -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip GLenum -> Ptr GLdouble -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> Ptr GLdouble -> m ()
glGetClipPlane (Ptr GLdouble -> GLenum -> IO ())
-> Ptr GLdouble -> GLenum -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Plane GLdouble) -> Ptr GLdouble
forall a b. Ptr a -> Ptr b
castPtr Ptr (Plane GLdouble)
buf
          Ptr (Plane GLdouble) -> IO (Plane GLdouble)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Plane GLdouble)
buf)
      (\plane :: Plane GLdouble
plane -> Plane GLdouble -> (Ptr (Plane GLdouble) -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Plane GLdouble
plane ((Ptr (Plane GLdouble) -> IO ()) -> IO ())
-> (Ptr (Plane GLdouble) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ClipPlaneName -> (GLenum -> IO ()) -> IO ()
clipPlaneAction ClipPlaneName
name ((GLenum -> IO ()) -> IO ())
-> (Ptr (Plane GLdouble) -> GLenum -> IO ())
-> Ptr (Plane GLdouble)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GLenum -> Ptr GLdouble -> IO ())
-> Ptr GLdouble -> GLenum -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip GLenum -> Ptr GLdouble -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> Ptr GLdouble -> m ()
glClipPlane (Ptr GLdouble -> GLenum -> IO ())
-> (Ptr (Plane GLdouble) -> Ptr GLdouble)
-> Ptr (Plane GLdouble)
-> GLenum
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (Plane GLdouble) -> Ptr GLdouble
forall a b. Ptr a -> Ptr b
castPtr)

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

clipPlaneAction :: ClipPlaneName -> (GLenum -> IO ()) -> IO ()
clipPlaneAction :: ClipPlaneName -> (GLenum -> IO ()) -> IO ()
clipPlaneAction (ClipPlaneName i :: GLsizei
i) act :: GLenum -> IO ()
act =
   IO () -> (GLenum -> IO ()) -> Maybe GLenum -> IO ()
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 = GettableStateVar GLsizei -> GettableStateVar GLsizei
forall a. IO a -> IO a
makeGettableStateVar ((GLsizei -> GLsizei) -> PName1I -> GettableStateVar GLsizei
forall p a. GetPName1I p => (GLsizei -> a) -> p -> IO a
getSizei1 GLsizei -> GLsizei
forall a. a -> a
id PName1I
GetMaxClipPlanes)