{-# LANGUAGE TypeSynonymInstances #-}
module Graphics.Rendering.OpenGL.GL.Rectangles (
Rect(..)
) where
import Foreign.Ptr
import Graphics.Rendering.OpenGL.GL.Tensor
import Graphics.GL
class Rect a where
rect :: Vertex2 a -> Vertex2 a -> IO ()
rectv :: Ptr a -> Ptr a -> IO ()
instance Rect GLshort where
rect :: Vertex2 GLshort -> Vertex2 GLshort -> IO ()
rect (Vertex2 x1 :: GLshort
x1 y1 :: GLshort
y1) (Vertex2 x2 :: GLshort
x2 y2 :: GLshort
y2) = GLshort -> GLshort -> GLshort -> GLshort -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLshort -> GLshort -> GLshort -> GLshort -> m ()
glRects GLshort
x1 GLshort
y1 GLshort
x2 GLshort
y2
rectv :: Ptr GLshort -> Ptr GLshort -> IO ()
rectv ptr1 :: Ptr GLshort
ptr1 ptr2 :: Ptr GLshort
ptr2 = Ptr GLshort -> Ptr GLshort -> IO ()
forall (m :: * -> *).
MonadIO m =>
Ptr GLshort -> Ptr GLshort -> m ()
glRectsv Ptr GLshort
ptr1 Ptr GLshort
ptr2
instance Rect GLint where
rect :: Vertex2 GLint -> Vertex2 GLint -> IO ()
rect (Vertex2 x1 :: GLint
x1 y1 :: GLint
y1) (Vertex2 x2 :: GLint
x2 y2 :: GLint
y2) = GLint -> GLint -> GLint -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLint -> GLint -> m ()
glRecti GLint
x1 GLint
y1 GLint
x2 GLint
y2
rectv :: Ptr GLint -> Ptr GLint -> IO ()
rectv ptr1 :: Ptr GLint
ptr1 ptr2 :: Ptr GLint
ptr2 = Ptr GLint -> Ptr GLint -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLint -> Ptr GLint -> m ()
glRectiv Ptr GLint
ptr1 Ptr GLint
ptr2
instance Rect GLfloat where
rect :: Vertex2 GLfloat -> Vertex2 GLfloat -> IO ()
rect (Vertex2 x1 :: GLfloat
x1 y1 :: GLfloat
y1) (Vertex2 x2 :: GLfloat
x2 y2 :: GLfloat
y2) = GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLfloat -> GLfloat -> GLfloat -> GLfloat -> m ()
glRectf GLfloat
x1 GLfloat
y1 GLfloat
x2 GLfloat
y2
rectv :: Ptr GLfloat -> Ptr GLfloat -> IO ()
rectv ptr1 :: Ptr GLfloat
ptr1 ptr2 :: Ptr GLfloat
ptr2 = Ptr GLfloat -> Ptr GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
Ptr GLfloat -> Ptr GLfloat -> m ()
glRectfv Ptr GLfloat
ptr1 Ptr GLfloat
ptr2
instance Rect GLdouble where
rect :: Vertex2 GLdouble -> Vertex2 GLdouble -> IO ()
rect (Vertex2 x1 :: GLdouble
x1 y1 :: GLdouble
y1) (Vertex2 x2 :: GLdouble
x2 y2 :: GLdouble
y2) = GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> GLdouble -> m ()
glRectd GLdouble
x1 GLdouble
y1 GLdouble
x2 GLdouble
y2
rectv :: Ptr GLdouble -> Ptr GLdouble -> IO ()
rectv ptr1 :: Ptr GLdouble
ptr1 ptr2 :: Ptr GLdouble
ptr2 = Ptr GLdouble -> Ptr GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
Ptr GLdouble -> Ptr GLdouble -> m ()
glRectdv Ptr GLdouble
ptr1 Ptr GLdouble
ptr2