module Graphics.Rendering.OpenGL.GL.Polygons (
polygonSmooth, cullFace,
PolygonStipple(..), GLpolygonstipple, polygonStipple,
PolygonMode(..), polygonMode, polygonOffset,
polygonOffsetPoint, polygonOffsetLine, polygonOffsetFill
) where
import Control.Monad
import Data.StateVar
import Foreign.ForeignPtr
import Foreign.Marshal.Array
import Foreign.Ptr
import Graphics.Rendering.OpenGL.GL.Capability
import Graphics.Rendering.OpenGL.GL.Face
import Graphics.Rendering.OpenGL.GL.PixelRectangles
import Graphics.Rendering.OpenGL.GL.PolygonMode
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GL.SavingState
import Graphics.GL
polygonSmooth :: StateVar Capability
polygonSmooth :: StateVar Capability
polygonSmooth = EnableCap -> StateVar Capability
makeCapability EnableCap
CapPolygonSmooth
cullFace :: StateVar (Maybe Face)
cullFace :: StateVar (Maybe Face)
cullFace = IO EnableCap -> IO Face -> (Face -> IO ()) -> StateVar (Maybe Face)
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
CapCullFace)
((GLenum -> Face) -> PName1I -> IO Face
forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> Face
unmarshalFace PName1I
GetCullFaceMode)
(GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glCullFace (GLenum -> IO ()) -> (Face -> GLenum) -> Face -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Face -> GLenum
marshalFace)
numPolygonStippleBytes :: Int
numPolygonStippleBytes :: Int
numPolygonStippleBytes = Int
128
class PolygonStipple s where
withNewPolygonStipple :: (Ptr GLubyte -> IO ()) -> IO s
withPolygonStipple :: s -> (Ptr GLubyte -> IO a) -> IO a
newPolygonStipple :: [GLubyte] -> IO s
getPolygonStippleComponents :: s -> IO [GLubyte]
withNewPolygonStipple Ptr GLubyte -> IO ()
act =
Int -> (Ptr GLubyte -> IO s) -> IO s
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
numPolygonStippleBytes ((Ptr GLubyte -> IO s) -> IO s) -> (Ptr GLubyte -> IO s) -> IO s
forall a b. (a -> b) -> a -> b
$ \Ptr GLubyte
p -> do
Ptr GLubyte -> IO ()
act Ptr GLubyte
p
[GLubyte]
components <- Int -> Ptr GLubyte -> IO [GLubyte]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
numPolygonStippleBytes Ptr GLubyte
p
[GLubyte] -> IO s
forall s. PolygonStipple s => [GLubyte] -> IO s
newPolygonStipple [GLubyte]
components
withPolygonStipple s
s Ptr GLubyte -> IO a
act = do
[GLubyte]
components <- s -> IO [GLubyte]
forall s. PolygonStipple s => s -> IO [GLubyte]
getPolygonStippleComponents s
s
[GLubyte] -> (Ptr GLubyte -> IO a) -> IO a
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLubyte]
components Ptr GLubyte -> IO a
act
newPolygonStipple [GLubyte]
components =
(Ptr GLubyte -> IO ()) -> IO s
forall s. PolygonStipple s => (Ptr GLubyte -> IO ()) -> IO s
withNewPolygonStipple ((Ptr GLubyte -> IO ()) -> IO s) -> (Ptr GLubyte -> IO ()) -> IO s
forall a b. (a -> b) -> a -> b
$
(Ptr GLubyte -> [GLubyte] -> IO ())
-> [GLubyte] -> Ptr GLubyte -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr GLubyte -> [GLubyte] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray (Int -> [GLubyte] -> [GLubyte]
forall a. Int -> [a] -> [a]
take Int
numPolygonStippleBytes [GLubyte]
components)
getPolygonStippleComponents s
s =
s -> (Ptr GLubyte -> IO [GLubyte]) -> IO [GLubyte]
forall s a. PolygonStipple s => s -> (Ptr GLubyte -> IO a) -> IO a
withPolygonStipple s
s ((Ptr GLubyte -> IO [GLubyte]) -> IO [GLubyte])
-> (Ptr GLubyte -> IO [GLubyte]) -> IO [GLubyte]
forall a b. (a -> b) -> a -> b
$ Int -> Ptr GLubyte -> IO [GLubyte]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
numPolygonStippleBytes
data GLpolygonstipple = GLpolygonstipple (ForeignPtr GLubyte)
deriving ( GLpolygonstipple -> GLpolygonstipple -> Bool
(GLpolygonstipple -> GLpolygonstipple -> Bool)
-> (GLpolygonstipple -> GLpolygonstipple -> Bool)
-> Eq GLpolygonstipple
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GLpolygonstipple -> GLpolygonstipple -> Bool
$c/= :: GLpolygonstipple -> GLpolygonstipple -> Bool
== :: GLpolygonstipple -> GLpolygonstipple -> Bool
$c== :: GLpolygonstipple -> GLpolygonstipple -> Bool
Eq, Eq GLpolygonstipple
Eq GLpolygonstipple
-> (GLpolygonstipple -> GLpolygonstipple -> Ordering)
-> (GLpolygonstipple -> GLpolygonstipple -> Bool)
-> (GLpolygonstipple -> GLpolygonstipple -> Bool)
-> (GLpolygonstipple -> GLpolygonstipple -> Bool)
-> (GLpolygonstipple -> GLpolygonstipple -> Bool)
-> (GLpolygonstipple -> GLpolygonstipple -> GLpolygonstipple)
-> (GLpolygonstipple -> GLpolygonstipple -> GLpolygonstipple)
-> Ord GLpolygonstipple
GLpolygonstipple -> GLpolygonstipple -> Bool
GLpolygonstipple -> GLpolygonstipple -> Ordering
GLpolygonstipple -> GLpolygonstipple -> GLpolygonstipple
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 :: GLpolygonstipple -> GLpolygonstipple -> GLpolygonstipple
$cmin :: GLpolygonstipple -> GLpolygonstipple -> GLpolygonstipple
max :: GLpolygonstipple -> GLpolygonstipple -> GLpolygonstipple
$cmax :: GLpolygonstipple -> GLpolygonstipple -> GLpolygonstipple
>= :: GLpolygonstipple -> GLpolygonstipple -> Bool
$c>= :: GLpolygonstipple -> GLpolygonstipple -> Bool
> :: GLpolygonstipple -> GLpolygonstipple -> Bool
$c> :: GLpolygonstipple -> GLpolygonstipple -> Bool
<= :: GLpolygonstipple -> GLpolygonstipple -> Bool
$c<= :: GLpolygonstipple -> GLpolygonstipple -> Bool
< :: GLpolygonstipple -> GLpolygonstipple -> Bool
$c< :: GLpolygonstipple -> GLpolygonstipple -> Bool
compare :: GLpolygonstipple -> GLpolygonstipple -> Ordering
$ccompare :: GLpolygonstipple -> GLpolygonstipple -> Ordering
Ord, Int -> GLpolygonstipple -> ShowS
[GLpolygonstipple] -> ShowS
GLpolygonstipple -> String
(Int -> GLpolygonstipple -> ShowS)
-> (GLpolygonstipple -> String)
-> ([GLpolygonstipple] -> ShowS)
-> Show GLpolygonstipple
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GLpolygonstipple] -> ShowS
$cshowList :: [GLpolygonstipple] -> ShowS
show :: GLpolygonstipple -> String
$cshow :: GLpolygonstipple -> String
showsPrec :: Int -> GLpolygonstipple -> ShowS
$cshowsPrec :: Int -> GLpolygonstipple -> ShowS
Show )
instance PolygonStipple GLpolygonstipple where
withNewPolygonStipple :: (Ptr GLubyte -> IO ()) -> IO GLpolygonstipple
withNewPolygonStipple Ptr GLubyte -> IO ()
f = do
ForeignPtr GLubyte
fp <- Int -> IO (ForeignPtr GLubyte)
forall a. Storable a => Int -> IO (ForeignPtr a)
mallocForeignPtrArray Int
numPolygonStippleBytes
ForeignPtr GLubyte -> (Ptr GLubyte -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GLubyte
fp Ptr GLubyte -> IO ()
f
GLpolygonstipple -> IO GLpolygonstipple
forall (m :: * -> *) a. Monad m => a -> m a
return (GLpolygonstipple -> IO GLpolygonstipple)
-> GLpolygonstipple -> IO GLpolygonstipple
forall a b. (a -> b) -> a -> b
$ ForeignPtr GLubyte -> GLpolygonstipple
GLpolygonstipple ForeignPtr GLubyte
fp
withPolygonStipple :: forall a. GLpolygonstipple -> (Ptr GLubyte -> IO a) -> IO a
withPolygonStipple (GLpolygonstipple ForeignPtr GLubyte
fp) = ForeignPtr GLubyte -> (Ptr GLubyte -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GLubyte
fp
polygonStipple :: PolygonStipple s => StateVar (Maybe s)
polygonStipple :: forall s. PolygonStipple s => StateVar (Maybe s)
polygonStipple =
IO EnableCap -> IO s -> (s -> IO ()) -> StateVar (Maybe s)
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
CapPolygonStipple)
(PixelStoreDirection -> IO s -> IO s
forall a. PixelStoreDirection -> IO a -> IO a
withoutGaps PixelStoreDirection
Pack (IO s -> IO s) -> IO s -> IO s
forall a b. (a -> b) -> a -> b
$ (Ptr GLubyte -> IO ()) -> IO s
forall s. PolygonStipple s => (Ptr GLubyte -> IO ()) -> IO s
withNewPolygonStipple Ptr GLubyte -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLubyte -> m ()
glGetPolygonStipple)
(\s
s -> PixelStoreDirection -> IO () -> IO ()
forall a. PixelStoreDirection -> IO a -> IO a
withoutGaps PixelStoreDirection
Unpack (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ s -> (Ptr GLubyte -> IO ()) -> IO ()
forall s a. PolygonStipple s => s -> (Ptr GLubyte -> IO a) -> IO a
withPolygonStipple s
s Ptr GLubyte -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLubyte -> m ()
glPolygonStipple)
withoutGaps :: PixelStoreDirection -> IO a -> IO a
withoutGaps :: forall a. PixelStoreDirection -> IO a -> IO a
withoutGaps PixelStoreDirection
direction IO a
action =
[ClientAttributeGroup] -> IO a -> IO a
forall a. [ClientAttributeGroup] -> IO a -> IO a
preservingClientAttrib [ ClientAttributeGroup
PixelStoreAttributes ] (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
PixelStoreDirection -> StateVar GLint
rowLength PixelStoreDirection
direction StateVar GLint -> GLint -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= GLint
0
PixelStoreDirection -> StateVar GLint
skipRows PixelStoreDirection
direction StateVar GLint -> GLint -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= GLint
0
PixelStoreDirection -> StateVar GLint
skipPixels PixelStoreDirection
direction StateVar GLint -> GLint -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= GLint
0
IO a
action
polygonMode :: StateVar (PolygonMode, PolygonMode)
polygonMode :: StateVar (PolygonMode, PolygonMode)
polygonMode = IO (PolygonMode, PolygonMode)
-> ((PolygonMode, PolygonMode) -> IO ())
-> StateVar (PolygonMode, PolygonMode)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO (PolygonMode, PolygonMode)
getPolygonMode (PolygonMode, PolygonMode) -> IO ()
setPolygonMode
getPolygonMode :: IO (PolygonMode, PolygonMode)
getPolygonMode :: IO (PolygonMode, PolygonMode)
getPolygonMode = (GLint -> GLint -> (PolygonMode, PolygonMode))
-> PName2I -> IO (PolygonMode, PolygonMode)
forall p a. GetPName2I p => (GLint -> GLint -> a) -> p -> IO a
getInteger2 (\GLint
front GLint
back -> (GLint -> PolygonMode
un GLint
front, GLint -> PolygonMode
un GLint
back)) PName2I
GetPolygonMode
where un :: GLint -> PolygonMode
un = GLenum -> PolygonMode
unmarshalPolygonMode (GLenum -> PolygonMode)
-> (GLint -> GLenum) -> GLint -> PolygonMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLint -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral
setPolygonMode :: (PolygonMode, PolygonMode) -> IO ()
setPolygonMode :: (PolygonMode, PolygonMode) -> IO ()
setPolygonMode (PolygonMode
front, PolygonMode
back)
| PolygonMode
front PolygonMode -> PolygonMode -> Bool
forall a. Eq a => a -> a -> Bool
== PolygonMode
back = Face -> PolygonMode -> IO ()
forall {m :: * -> *}. MonadIO m => Face -> PolygonMode -> m ()
setPM Face
FrontAndBack PolygonMode
front
| Bool
otherwise = do Face -> PolygonMode -> IO ()
forall {m :: * -> *}. MonadIO m => Face -> PolygonMode -> m ()
setPM Face
Front PolygonMode
front; Face -> PolygonMode -> IO ()
forall {m :: * -> *}. MonadIO m => Face -> PolygonMode -> m ()
setPM Face
Back PolygonMode
back
where setPM :: Face -> PolygonMode -> m ()
setPM Face
f PolygonMode
m = GLenum -> GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glPolygonMode (Face -> GLenum
marshalFace Face
f) (PolygonMode -> GLenum
marshalPolygonMode PolygonMode
m)
polygonOffset :: StateVar (GLfloat, GLfloat)
polygonOffset :: StateVar (GLfloat, GLfloat)
polygonOffset =
IO (GLfloat, GLfloat)
-> ((GLfloat, GLfloat) -> IO ()) -> StateVar (GLfloat, GLfloat)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar ((GLfloat -> GLfloat -> (GLfloat, GLfloat))
-> IO GLfloat -> IO GLfloat -> IO (GLfloat, GLfloat)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) ((GLfloat -> GLfloat) -> PName1F -> IO GLfloat
forall p a. GetPName1F p => (GLfloat -> a) -> p -> IO a
getFloat1 GLfloat -> GLfloat
forall a. a -> a
id PName1F
GetPolygonOffsetFactor)
((GLfloat -> GLfloat) -> PName1F -> IO GLfloat
forall p a. GetPName1F p => (GLfloat -> a) -> p -> IO a
getFloat1 GLfloat -> GLfloat
forall a. a -> a
id PName1F
GetPolygonOffsetUnits))
((GLfloat -> GLfloat -> IO ()) -> (GLfloat, GLfloat) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry GLfloat -> GLfloat -> IO ()
forall (m :: * -> *). MonadIO m => GLfloat -> GLfloat -> m ()
glPolygonOffset)
polygonOffsetPoint :: StateVar Capability
polygonOffsetPoint :: StateVar Capability
polygonOffsetPoint = EnableCap -> StateVar Capability
makeCapability EnableCap
CapPolygonOffsetPoint
polygonOffsetLine :: StateVar Capability
polygonOffsetLine :: StateVar Capability
polygonOffsetLine = EnableCap -> StateVar Capability
makeCapability EnableCap
CapPolygonOffsetLine
polygonOffsetFill :: StateVar Capability
polygonOffsetFill :: StateVar Capability
polygonOffsetFill = EnableCap -> StateVar Capability
makeCapability EnableCap
CapPolygonOffsetFill