--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.RasterPos
-- Copyright   :  (c) Sven Panne 2002-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This module corresponds to section 2.13 (Current Raster Position) of the
-- OpenGL 2.1 specs.
--
--------------------------------------------------------------------------------

{-# LANGUAGE TypeSynonymInstances #-}

module Graphics.Rendering.OpenGL.GL.RasterPos (
   currentRasterPosition, RasterPosComponent, RasterPos(..),
   WindowPosComponent, WindowPos(..),
   currentRasterDistance, currentRasterColor, currentRasterSecondaryColor,
   currentRasterIndex, currentRasterTexCoords, currentRasterPositionValid,
   rasterPositionUnclipped
) where

import Data.StateVar
import Foreign.Ptr
import Graphics.Rendering.OpenGL.GL.Capability
import Graphics.Rendering.OpenGL.GL.GLboolean
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GL.Tensor
import Graphics.Rendering.OpenGL.GL.VertexSpec
import Graphics.GL

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

currentRasterPosition :: StateVar (Vertex4 GLfloat)
currentRasterPosition :: StateVar (Vertex4 GLfloat)
currentRasterPosition =
   IO (Vertex4 GLfloat)
-> (Vertex4 GLfloat -> IO ()) -> StateVar (Vertex4 GLfloat)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar ((GLfloat -> GLfloat -> GLfloat -> GLfloat -> Vertex4 GLfloat)
-> PName4F -> IO (Vertex4 GLfloat)
forall p a.
GetPName4F p =>
(GLfloat -> GLfloat -> GLfloat -> GLfloat -> a) -> p -> IO a
getFloat4 GLfloat -> GLfloat -> GLfloat -> GLfloat -> Vertex4 GLfloat
forall a. a -> a -> a -> a -> Vertex4 a
Vertex4 PName4F
GetCurrentRasterPosition) Vertex4 GLfloat -> IO ()
forall a. RasterPos a => a -> IO ()
rasterPos

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

class RasterPosComponent a where
   rasterPos2 :: a -> a -> IO ()
   rasterPos3 :: a -> a -> a -> IO ()
   rasterPos4 :: a -> a -> a -> a -> IO ()

   rasterPos2v :: Ptr a -> IO ()
   rasterPos3v :: Ptr a -> IO ()
   rasterPos4v :: Ptr a -> IO ()

instance RasterPosComponent GLshort where
   rasterPos2 :: GLshort -> GLshort -> IO ()
rasterPos2 = GLshort -> GLshort -> IO ()
forall (m :: * -> *). MonadIO m => GLshort -> GLshort -> m ()
glRasterPos2s
   rasterPos3 :: GLshort -> GLshort -> GLshort -> IO ()
rasterPos3 = GLshort -> GLshort -> GLshort -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLshort -> GLshort -> GLshort -> m ()
glRasterPos3s
   rasterPos4 :: GLshort -> GLshort -> GLshort -> GLshort -> IO ()
rasterPos4 = GLshort -> GLshort -> GLshort -> GLshort -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLshort -> GLshort -> GLshort -> GLshort -> m ()
glRasterPos4s

   rasterPos2v :: Ptr GLshort -> IO ()
rasterPos2v = Ptr GLshort -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLshort -> m ()
glRasterPos2sv
   rasterPos3v :: Ptr GLshort -> IO ()
rasterPos3v = Ptr GLshort -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLshort -> m ()
glRasterPos3sv
   rasterPos4v :: Ptr GLshort -> IO ()
rasterPos4v = Ptr GLshort -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLshort -> m ()
glRasterPos4sv

instance RasterPosComponent GLint where
   rasterPos2 :: GLint -> GLint -> IO ()
rasterPos2 = GLint -> GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> GLint -> m ()
glRasterPos2i
   rasterPos3 :: GLint -> GLint -> GLint -> IO ()
rasterPos3 = GLint -> GLint -> GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> GLint -> GLint -> m ()
glRasterPos3i
   rasterPos4 :: GLint -> GLint -> GLint -> GLint -> IO ()
rasterPos4 = GLint -> GLint -> GLint -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLint -> GLint -> m ()
glRasterPos4i

   rasterPos2v :: Ptr GLint -> IO ()
rasterPos2v = Ptr GLint -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLint -> m ()
glRasterPos2iv
   rasterPos3v :: Ptr GLint -> IO ()
rasterPos3v = Ptr GLint -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLint -> m ()
glRasterPos3iv
   rasterPos4v :: Ptr GLint -> IO ()
rasterPos4v = Ptr GLint -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLint -> m ()
glRasterPos4iv

instance RasterPosComponent GLfloat where
   rasterPos2 :: GLfloat -> GLfloat -> IO ()
rasterPos2 = GLfloat -> GLfloat -> IO ()
forall (m :: * -> *). MonadIO m => GLfloat -> GLfloat -> m ()
glRasterPos2f
   rasterPos3 :: GLfloat -> GLfloat -> GLfloat -> IO ()
rasterPos3 = GLfloat -> GLfloat -> GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLfloat -> GLfloat -> GLfloat -> m ()
glRasterPos3f
   rasterPos4 :: GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()
rasterPos4 = GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLfloat -> GLfloat -> GLfloat -> GLfloat -> m ()
glRasterPos4f

   rasterPos2v :: Ptr GLfloat -> IO ()
rasterPos2v = Ptr GLfloat -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLfloat -> m ()
glRasterPos2fv
   rasterPos3v :: Ptr GLfloat -> IO ()
rasterPos3v = Ptr GLfloat -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLfloat -> m ()
glRasterPos3fv
   rasterPos4v :: Ptr GLfloat -> IO ()
rasterPos4v = Ptr GLfloat -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLfloat -> m ()
glRasterPos4fv

instance RasterPosComponent GLdouble where
   rasterPos2 :: GLdouble -> GLdouble -> IO ()
rasterPos2 = GLdouble -> GLdouble -> IO ()
forall (m :: * -> *). MonadIO m => GLdouble -> GLdouble -> m ()
glRasterPos2d
   rasterPos3 :: GLdouble -> GLdouble -> GLdouble -> IO ()
rasterPos3 = GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glRasterPos3d
   rasterPos4 :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()
rasterPos4 = GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> GLdouble -> m ()
glRasterPos4d

   rasterPos2v :: Ptr GLdouble -> IO ()
rasterPos2v = Ptr GLdouble -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLdouble -> m ()
glRasterPos2dv
   rasterPos3v :: Ptr GLdouble -> IO ()
rasterPos3v = Ptr GLdouble -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLdouble -> m ()
glRasterPos3dv
   rasterPos4v :: Ptr GLdouble -> IO ()
rasterPos4v = Ptr GLdouble -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLdouble -> m ()
glRasterPos4dv

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

class RasterPos a where
   rasterPos  ::     a -> IO ()
   rasterPosv :: Ptr a -> IO ()

instance RasterPosComponent a => RasterPos (Vertex2 a) where
   rasterPos :: Vertex2 a -> IO ()
rasterPos (Vertex2 x :: a
x y :: a
y) = a -> a -> IO ()
forall a. RasterPosComponent a => a -> a -> IO ()
rasterPos2 a
x a
y
   rasterPosv :: Ptr (Vertex2 a) -> IO ()
rasterPosv = Ptr a -> IO ()
forall a. RasterPosComponent a => Ptr a -> IO ()
rasterPos2v (Ptr a -> IO ())
-> (Ptr (Vertex2 a) -> Ptr a) -> Ptr (Vertex2 a) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b. Ptr (Vertex2 b) -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr :: Ptr (Vertex2 b) -> Ptr b)

instance RasterPosComponent a => RasterPos (Vertex3 a) where
   rasterPos :: Vertex3 a -> IO ()
rasterPos (Vertex3 x :: a
x y :: a
y z :: a
z) = a -> a -> a -> IO ()
forall a. RasterPosComponent a => a -> a -> a -> IO ()
rasterPos3 a
x a
y a
z
   rasterPosv :: Ptr (Vertex3 a) -> IO ()
rasterPosv = Ptr a -> IO ()
forall a. RasterPosComponent a => Ptr a -> IO ()
rasterPos3v (Ptr a -> IO ())
-> (Ptr (Vertex3 a) -> Ptr a) -> Ptr (Vertex3 a) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b. Ptr (Vertex3 b) -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr :: Ptr (Vertex3 b) -> Ptr b)

instance RasterPosComponent a => RasterPos (Vertex4 a) where
   rasterPos :: Vertex4 a -> IO ()
rasterPos (Vertex4 x :: a
x y :: a
y z :: a
z w :: a
w) = a -> a -> a -> a -> IO ()
forall a. RasterPosComponent a => a -> a -> a -> a -> IO ()
rasterPos4 a
x a
y a
z a
w
   rasterPosv :: Ptr (Vertex4 a) -> IO ()
rasterPosv = Ptr a -> IO ()
forall a. RasterPosComponent a => Ptr a -> IO ()
rasterPos4v (Ptr a -> IO ())
-> (Ptr (Vertex4 a) -> Ptr a) -> Ptr (Vertex4 a) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b. Ptr (Vertex4 b) -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr :: Ptr (Vertex4 b) -> Ptr b)

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

class WindowPosComponent a where
   windowPos2 :: a -> a -> IO ()
   windowPos3 :: a -> a -> a -> IO ()

   windowPos2v :: Ptr a -> IO ()
   windowPos3v :: Ptr a -> IO ()

instance WindowPosComponent GLshort where
   windowPos2 :: GLshort -> GLshort -> IO ()
windowPos2 = GLshort -> GLshort -> IO ()
forall (m :: * -> *). MonadIO m => GLshort -> GLshort -> m ()
glWindowPos2s
   windowPos3 :: GLshort -> GLshort -> GLshort -> IO ()
windowPos3 = GLshort -> GLshort -> GLshort -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLshort -> GLshort -> GLshort -> m ()
glWindowPos3s

   windowPos2v :: Ptr GLshort -> IO ()
windowPos2v = Ptr GLshort -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLshort -> m ()
glWindowPos2sv
   windowPos3v :: Ptr GLshort -> IO ()
windowPos3v = Ptr GLshort -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLshort -> m ()
glWindowPos3sv

instance WindowPosComponent GLint where
   windowPos2 :: GLint -> GLint -> IO ()
windowPos2 = GLint -> GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> GLint -> m ()
glWindowPos2i
   windowPos3 :: GLint -> GLint -> GLint -> IO ()
windowPos3 = GLint -> GLint -> GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> GLint -> GLint -> m ()
glWindowPos3i

   windowPos2v :: Ptr GLint -> IO ()
windowPos2v = Ptr GLint -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLint -> m ()
glWindowPos2iv
   windowPos3v :: Ptr GLint -> IO ()
windowPos3v = Ptr GLint -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLint -> m ()
glWindowPos3iv

instance WindowPosComponent GLfloat where
   windowPos2 :: GLfloat -> GLfloat -> IO ()
windowPos2 = GLfloat -> GLfloat -> IO ()
forall (m :: * -> *). MonadIO m => GLfloat -> GLfloat -> m ()
glWindowPos2f
   windowPos3 :: GLfloat -> GLfloat -> GLfloat -> IO ()
windowPos3 = GLfloat -> GLfloat -> GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLfloat -> GLfloat -> GLfloat -> m ()
glWindowPos3f

   windowPos2v :: Ptr GLfloat -> IO ()
windowPos2v = Ptr GLfloat -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLfloat -> m ()
glWindowPos2fv
   windowPos3v :: Ptr GLfloat -> IO ()
windowPos3v = Ptr GLfloat -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLfloat -> m ()
glWindowPos3fv

instance WindowPosComponent GLdouble where
   windowPos2 :: GLdouble -> GLdouble -> IO ()
windowPos2 = GLdouble -> GLdouble -> IO ()
forall (m :: * -> *). MonadIO m => GLdouble -> GLdouble -> m ()
glWindowPos2d
   windowPos3 :: GLdouble -> GLdouble -> GLdouble -> IO ()
windowPos3 = GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glWindowPos3d

   windowPos2v :: Ptr GLdouble -> IO ()
windowPos2v = Ptr GLdouble -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLdouble -> m ()
glWindowPos2dv
   windowPos3v :: Ptr GLdouble -> IO ()
windowPos3v = Ptr GLdouble -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLdouble -> m ()
glWindowPos3dv

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

class WindowPos a where
   windowPos  ::     a -> IO ()
   windowPosv :: Ptr a -> IO ()

instance WindowPosComponent a => WindowPos (Vertex2 a) where
   windowPos :: Vertex2 a -> IO ()
windowPos (Vertex2 x :: a
x y :: a
y) = a -> a -> IO ()
forall a. WindowPosComponent a => a -> a -> IO ()
windowPos2 a
x a
y
   windowPosv :: Ptr (Vertex2 a) -> IO ()
windowPosv = Ptr a -> IO ()
forall a. WindowPosComponent a => Ptr a -> IO ()
windowPos2v (Ptr a -> IO ())
-> (Ptr (Vertex2 a) -> Ptr a) -> Ptr (Vertex2 a) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b. Ptr (Vertex2 b) -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr :: Ptr (Vertex2 b) -> Ptr b)

instance WindowPosComponent a => WindowPos (Vertex3 a) where
   windowPos :: Vertex3 a -> IO ()
windowPos (Vertex3 x :: a
x y :: a
y z :: a
z) = a -> a -> a -> IO ()
forall a. WindowPosComponent a => a -> a -> a -> IO ()
windowPos3 a
x a
y a
z
   windowPosv :: Ptr (Vertex3 a) -> IO ()
windowPosv = Ptr a -> IO ()
forall a. WindowPosComponent a => Ptr a -> IO ()
windowPos3v (Ptr a -> IO ())
-> (Ptr (Vertex3 a) -> Ptr a) -> Ptr (Vertex3 a) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b. Ptr (Vertex3 b) -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr :: Ptr (Vertex3 b) -> Ptr b)

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

currentRasterDistance :: GettableStateVar GLfloat
currentRasterDistance :: GettableStateVar GLfloat
currentRasterDistance =
   GettableStateVar GLfloat -> GettableStateVar GLfloat
forall a. IO a -> IO a
makeGettableStateVar ((GLfloat -> GLfloat) -> PName1F -> GettableStateVar GLfloat
forall p a. GetPName1F p => (GLfloat -> a) -> p -> IO a
getFloat1 GLfloat -> GLfloat
forall a. a -> a
id PName1F
GetCurrentRasterDistance)

currentRasterColor :: GettableStateVar (Color4 GLfloat)
currentRasterColor :: GettableStateVar (Color4 GLfloat)
currentRasterColor =
   GettableStateVar (Color4 GLfloat)
-> GettableStateVar (Color4 GLfloat)
forall a. IO a -> IO a
makeGettableStateVar ((GLfloat -> GLfloat -> GLfloat -> GLfloat -> Color4 GLfloat)
-> PName4F -> GettableStateVar (Color4 GLfloat)
forall p a.
GetPName4F p =>
(GLfloat -> GLfloat -> GLfloat -> GLfloat -> a) -> p -> IO a
getFloat4 GLfloat -> GLfloat -> GLfloat -> GLfloat -> Color4 GLfloat
forall a. a -> a -> a -> a -> Color4 a
Color4 PName4F
GetCurrentRasterColor)

currentRasterSecondaryColor :: GettableStateVar (Color4 GLfloat)
currentRasterSecondaryColor :: GettableStateVar (Color4 GLfloat)
currentRasterSecondaryColor =
   GettableStateVar (Color4 GLfloat)
-> GettableStateVar (Color4 GLfloat)
forall a. IO a -> IO a
makeGettableStateVar ((GLfloat -> GLfloat -> GLfloat -> GLfloat -> Color4 GLfloat)
-> PName4F -> GettableStateVar (Color4 GLfloat)
forall p a.
GetPName4F p =>
(GLfloat -> GLfloat -> GLfloat -> GLfloat -> a) -> p -> IO a
getFloat4 GLfloat -> GLfloat -> GLfloat -> GLfloat -> Color4 GLfloat
forall a. a -> a -> a -> a -> Color4 a
Color4 PName4F
GetCurrentRasterSecondaryColor)

currentRasterIndex :: GettableStateVar (Index1 GLint)
currentRasterIndex :: GettableStateVar (Index1 GLint)
currentRasterIndex =
   GettableStateVar (Index1 GLint) -> GettableStateVar (Index1 GLint)
forall a. IO a -> IO a
makeGettableStateVar ((GLint -> Index1 GLint)
-> PName1I -> GettableStateVar (Index1 GLint)
forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
getInteger1 GLint -> Index1 GLint
forall a. a -> Index1 a
Index1 PName1I
GetCurrentRasterIndex)

currentRasterTexCoords :: GettableStateVar (TexCoord4 GLfloat)
currentRasterTexCoords :: GettableStateVar (TexCoord4 GLfloat)
currentRasterTexCoords =
   GettableStateVar (TexCoord4 GLfloat)
-> GettableStateVar (TexCoord4 GLfloat)
forall a. IO a -> IO a
makeGettableStateVar ((GLfloat -> GLfloat -> GLfloat -> GLfloat -> TexCoord4 GLfloat)
-> PName4F -> GettableStateVar (TexCoord4 GLfloat)
forall p a.
GetPName4F p =>
(GLfloat -> GLfloat -> GLfloat -> GLfloat -> a) -> p -> IO a
getFloat4 GLfloat -> GLfloat -> GLfloat -> GLfloat -> TexCoord4 GLfloat
forall a. a -> a -> a -> a -> TexCoord4 a
TexCoord4 PName4F
GetCurrentRasterTextureCoords)

currentRasterPositionValid :: GettableStateVar Bool
currentRasterPositionValid :: GettableStateVar Bool
currentRasterPositionValid =
   GettableStateVar Bool -> GettableStateVar Bool
forall a. IO a -> IO a
makeGettableStateVar
      ((GLboolean -> Bool) -> PName1I -> GettableStateVar Bool
forall p a. GetPName1I p => (GLboolean -> a) -> p -> IO a
getBoolean1 GLboolean -> Bool
forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean PName1I
GetCurrentRasterPositionValid)

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

rasterPositionUnclipped :: StateVar Capability
rasterPositionUnclipped :: StateVar Capability
rasterPositionUnclipped = EnableCap -> StateVar Capability
makeCapability EnableCap
CapRasterPositionUnclipped