module Graphics.Rendering.OpenGL.GLU.NURBS (
NURBSObj, withNURBSObj,
NURBSBeginCallback, withNURBSBeginCallback,
NURBSVertexCallback, withNURBSVertexCallback,
NURBSNormalCallback, withNURBSNormalCallback,
NURBSColorCallback, withNURBSColorCallback,
NURBSEndCallback, withNURBSEndCallback,
checkForNURBSError,
nurbsBeginEndCurve, nurbsCurve,
nurbsBeginEndSurface, nurbsSurface,
TrimmingPoint, nurbsBeginEndTrim, pwlCurve, trimmingCurve,
NURBSMode(..), setNURBSMode,
setNURBSCulling,
SamplingMethod(..), setSamplingMethod,
loadSamplingMatrices,
DisplayMode'(..), setDisplayMode'
) where
import Control.Monad
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
import Graphics.GLU hiding (
NURBSBeginCallback, NURBSVertexCallback, NURBSNormalCallback,
NURBSColorCallback, NURBSEndCallback )
import Graphics.Rendering.OpenGL.GL.Tensor
import Graphics.Rendering.OpenGL.GL.Capability
import Graphics.Rendering.OpenGL.GL.ControlPoint
import Graphics.Rendering.OpenGL.GL.CoordTrans
import Graphics.Rendering.OpenGL.GL.Exception
import Graphics.Rendering.OpenGL.GL.GLboolean
import Graphics.Rendering.OpenGL.GL.PrimitiveMode
import Graphics.Rendering.OpenGL.GL.PrimitiveModeInternal
import Graphics.Rendering.OpenGL.GL.VertexSpec
import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
import Graphics.GL
type NURBSObj = Ptr GLUnurbs
isNullNURBSObj :: NURBSObj -> Bool
isNullNURBSObj :: NURBSObj -> Bool
isNullNURBSObj = (NURBSObj
forall a. Ptr a
nullPtr NURBSObj -> NURBSObj -> Bool
forall a. Eq a => a -> a -> Bool
==)
withNURBSObj :: a -> (NURBSObj -> IO a) -> IO a
withNURBSObj :: a -> (NURBSObj -> IO a) -> IO a
withNURBSObj a
failureValue NURBSObj -> IO a
action =
IO NURBSObj -> (NURBSObj -> IO ()) -> (NURBSObj -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO NURBSObj
forall (m :: * -> *). MonadIO m => m NURBSObj
gluNewNurbsRenderer NURBSObj -> IO ()
safeDeleteNurbsRenderer
(\NURBSObj
nurbsObj -> if NURBSObj -> Bool
isNullNURBSObj NURBSObj
nurbsObj
then do IO ()
recordOutOfMemory
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
failureValue
else NURBSObj -> IO a
action NURBSObj
nurbsObj)
safeDeleteNurbsRenderer :: NURBSObj -> IO ()
safeDeleteNurbsRenderer :: NURBSObj -> IO ()
safeDeleteNurbsRenderer NURBSObj
nurbsObj =
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (NURBSObj -> Bool
isNullNURBSObj NURBSObj
nurbsObj) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ NURBSObj -> IO ()
forall (m :: * -> *). MonadIO m => NURBSObj -> m ()
gluDeleteNurbsRenderer NURBSObj
nurbsObj
type NURBSBeginCallback = PrimitiveMode -> IO ()
withNURBSBeginCallback :: NURBSObj -> NURBSBeginCallback -> IO a -> IO a
withNURBSBeginCallback :: NURBSObj -> NURBSBeginCallback -> IO a -> IO a
withNURBSBeginCallback NURBSObj
nurbsObj NURBSBeginCallback
beginCallback IO a
action =
IO (FunPtr NURBSBeginCallback)
-> (FunPtr NURBSBeginCallback -> IO ())
-> (FunPtr NURBSBeginCallback -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (NURBSBeginCallback -> IO (FunPtr NURBSBeginCallback)
makeNURBSBeginCallback (NURBSBeginCallback
beginCallback NURBSBeginCallback
-> (GLenum -> PrimitiveMode) -> NURBSBeginCallback
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLenum -> PrimitiveMode
unmarshalPrimitiveMode))
FunPtr NURBSBeginCallback -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr NURBSBeginCallback -> IO a) -> IO a)
-> (FunPtr NURBSBeginCallback -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FunPtr NURBSBeginCallback
callbackPtr -> do
NURBSObj -> GLenum -> FunPtr NURBSBeginCallback -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
NURBSObj -> GLenum -> FunPtr a -> m ()
gluNurbsCallback NURBSObj
nurbsObj GLenum
GLU_NURBS_BEGIN FunPtr NURBSBeginCallback
callbackPtr
IO a
action
type NURBSVertexCallback = Vertex3 GLfloat -> IO ()
withNURBSVertexCallback :: NURBSObj -> NURBSVertexCallback -> IO a -> IO a
withNURBSVertexCallback :: NURBSObj -> NURBSVertexCallback -> IO a -> IO a
withNURBSVertexCallback NURBSObj
nurbsObj NURBSVertexCallback
vertexCallback IO a
action =
IO (FunPtr NURBSVertexCallback)
-> (FunPtr NURBSVertexCallback -> IO ())
-> (FunPtr NURBSVertexCallback -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (NURBSVertexCallback -> IO (FunPtr NURBSVertexCallback)
makeNURBSVertexCallback (\Ptr GLfloat
p -> Ptr (Vertex3 GLfloat) -> IO (Vertex3 GLfloat)
forall a. Storable a => Ptr a -> IO a
peek (Ptr GLfloat -> Ptr (Vertex3 GLfloat)
forall a b. Ptr a -> Ptr b
castPtr Ptr GLfloat
p) IO (Vertex3 GLfloat) -> NURBSVertexCallback -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NURBSVertexCallback
vertexCallback))
FunPtr NURBSVertexCallback -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr NURBSVertexCallback -> IO a) -> IO a)
-> (FunPtr NURBSVertexCallback -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FunPtr NURBSVertexCallback
callbackPtr -> do
NURBSObj -> GLenum -> FunPtr NURBSVertexCallback -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
NURBSObj -> GLenum -> FunPtr a -> m ()
gluNurbsCallback NURBSObj
nurbsObj GLenum
GLU_NURBS_VERTEX FunPtr NURBSVertexCallback
callbackPtr
IO a
action
type NURBSNormalCallback = Normal3 GLfloat -> IO ()
withNURBSNormalCallback :: NURBSObj -> NURBSNormalCallback -> IO a -> IO a
withNURBSNormalCallback :: NURBSObj -> NURBSNormalCallback -> IO a -> IO a
withNURBSNormalCallback NURBSObj
nurbsObj NURBSNormalCallback
normalCallback IO a
action =
IO (FunPtr NURBSVertexCallback)
-> (FunPtr NURBSVertexCallback -> IO ())
-> (FunPtr NURBSVertexCallback -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (NURBSVertexCallback -> IO (FunPtr NURBSVertexCallback)
makeNURBSNormalCallback (\Ptr GLfloat
p -> Ptr (Normal3 GLfloat) -> IO (Normal3 GLfloat)
forall a. Storable a => Ptr a -> IO a
peek (Ptr GLfloat -> Ptr (Normal3 GLfloat)
forall a b. Ptr a -> Ptr b
castPtr Ptr GLfloat
p) IO (Normal3 GLfloat) -> NURBSNormalCallback -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NURBSNormalCallback
normalCallback))
FunPtr NURBSVertexCallback -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr NURBSVertexCallback -> IO a) -> IO a)
-> (FunPtr NURBSVertexCallback -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FunPtr NURBSVertexCallback
callbackPtr -> do
NURBSObj -> GLenum -> FunPtr NURBSVertexCallback -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
NURBSObj -> GLenum -> FunPtr a -> m ()
gluNurbsCallback NURBSObj
nurbsObj GLenum
GLU_NURBS_NORMAL FunPtr NURBSVertexCallback
callbackPtr
IO a
action
type NURBSColorCallback = Color4 GLfloat -> IO ()
withNURBSColorCallback :: NURBSObj -> NURBSColorCallback -> IO a -> IO a
withNURBSColorCallback :: NURBSObj -> NURBSColorCallback -> IO a -> IO a
withNURBSColorCallback NURBSObj
nurbsObj NURBSColorCallback
colorCallback IO a
action =
IO (FunPtr NURBSVertexCallback)
-> (FunPtr NURBSVertexCallback -> IO ())
-> (FunPtr NURBSVertexCallback -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (NURBSVertexCallback -> IO (FunPtr NURBSVertexCallback)
makeNURBSColorCallback (\Ptr GLfloat
p -> Ptr (Color4 GLfloat) -> IO (Color4 GLfloat)
forall a. Storable a => Ptr a -> IO a
peek (Ptr GLfloat -> Ptr (Color4 GLfloat)
forall a b. Ptr a -> Ptr b
castPtr Ptr GLfloat
p) IO (Color4 GLfloat) -> NURBSColorCallback -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NURBSColorCallback
colorCallback))
FunPtr NURBSVertexCallback -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr NURBSVertexCallback -> IO a) -> IO a)
-> (FunPtr NURBSVertexCallback -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FunPtr NURBSVertexCallback
callbackPtr -> do
NURBSObj -> GLenum -> FunPtr NURBSVertexCallback -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
NURBSObj -> GLenum -> FunPtr a -> m ()
gluNurbsCallback NURBSObj
nurbsObj GLenum
GLU_NURBS_COLOR FunPtr NURBSVertexCallback
callbackPtr
IO a
action
type NURBSEndCallback = IO ()
withNURBSEndCallback :: NURBSObj -> NURBSEndCallback -> IO a -> IO a
withNURBSEndCallback :: NURBSObj -> IO () -> IO a -> IO a
withNURBSEndCallback NURBSObj
nurbsObj IO ()
endCallback IO a
action =
IO (FunPtr (IO ()))
-> (FunPtr (IO ()) -> IO ()) -> (FunPtr (IO ()) -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (IO () -> IO (FunPtr (IO ()))
makeNURBSEndCallback IO ()
endCallback)
FunPtr (IO ()) -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr (IO ()) -> IO a) -> IO a)
-> (FunPtr (IO ()) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FunPtr (IO ())
callbackPtr -> do
NURBSObj -> GLenum -> FunPtr (IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
NURBSObj -> GLenum -> FunPtr a -> m ()
gluNurbsCallback NURBSObj
nurbsObj GLenum
GLU_NURBS_END FunPtr (IO ())
callbackPtr
IO a
action
type ErrorCallback = GLenum -> IO ()
withErrorCallback :: NURBSObj -> ErrorCallback -> IO a -> IO a
withErrorCallback :: NURBSObj -> NURBSBeginCallback -> IO a -> IO a
withErrorCallback NURBSObj
nurbsObj NURBSBeginCallback
errorCallback IO a
action =
IO (FunPtr NURBSBeginCallback)
-> (FunPtr NURBSBeginCallback -> IO ())
-> (FunPtr NURBSBeginCallback -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (NURBSBeginCallback -> IO (FunPtr NURBSBeginCallback)
makeNURBSErrorCallback NURBSBeginCallback
errorCallback)
FunPtr NURBSBeginCallback -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr NURBSBeginCallback -> IO a) -> IO a)
-> (FunPtr NURBSBeginCallback -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FunPtr NURBSBeginCallback
callbackPtr -> do
NURBSObj -> GLenum -> FunPtr NURBSBeginCallback -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
NURBSObj -> GLenum -> FunPtr a -> m ()
gluNurbsCallback NURBSObj
nurbsObj GLenum
GLU_NURBS_ERROR FunPtr NURBSBeginCallback
callbackPtr
IO a
action
checkForNURBSError :: NURBSObj -> IO a -> IO a
checkForNURBSError :: NURBSObj -> IO a -> IO a
checkForNURBSError NURBSObj
nurbsObj = NURBSObj -> NURBSBeginCallback -> IO a -> IO a
forall a. NURBSObj -> NURBSBeginCallback -> IO a -> IO a
withErrorCallback NURBSObj
nurbsObj NURBSBeginCallback
recordErrorCode
nurbsBeginEndCurve :: NURBSObj -> IO a -> IO a
nurbsBeginEndCurve :: NURBSObj -> IO a -> IO a
nurbsBeginEndCurve NURBSObj
nurbsObj =
IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (NURBSObj -> IO ()
forall (m :: * -> *). MonadIO m => NURBSObj -> m ()
gluBeginCurve NURBSObj
nurbsObj) (NURBSObj -> IO ()
forall (m :: * -> *). MonadIO m => NURBSObj -> m ()
gluEndCurve NURBSObj
nurbsObj)
nurbsCurve :: ControlPoint c => NURBSObj -> GLint -> Ptr GLfloat -> GLint -> Ptr (c GLfloat) -> GLint -> IO ()
nurbsCurve :: NURBSObj
-> GLint
-> Ptr GLfloat
-> GLint
-> Ptr (c GLfloat)
-> GLint
-> IO ()
nurbsCurve NURBSObj
nurbsObj GLint
knotCount Ptr GLfloat
knots GLint
stride Ptr (c GLfloat)
control GLint
order =
NURBSObj
-> GLint
-> Ptr GLfloat
-> GLint
-> Ptr GLfloat
-> GLint
-> NURBSBeginCallback
forall (m :: * -> *).
MonadIO m =>
NURBSObj
-> GLint
-> Ptr GLfloat
-> GLint
-> Ptr GLfloat
-> GLint
-> GLenum
-> m ()
gluNurbsCurve NURBSObj
nurbsObj GLint
knotCount Ptr GLfloat
knots GLint
stride (Ptr (c GLfloat) -> Ptr GLfloat
forall a b. Ptr a -> Ptr b
castPtr Ptr (c GLfloat)
control) GLint
order (c GLfloat -> GLenum
forall (c :: * -> *) d. (ControlPoint c, Domain d) => c d -> GLenum
map1Target (Ptr (c GLfloat) -> c GLfloat
forall (c :: * -> *). Ptr (c GLfloat) -> c GLfloat
pseudoPeek Ptr (c GLfloat)
control))
pseudoPeek :: Ptr (c GLfloat) -> c GLfloat
pseudoPeek :: Ptr (c GLfloat) -> c GLfloat
pseudoPeek Ptr (c GLfloat)
_ = c GLfloat
forall a. HasCallStack => a
undefined
nurbsBeginEndSurface :: NURBSObj -> IO a -> IO a
nurbsBeginEndSurface :: NURBSObj -> IO a -> IO a
nurbsBeginEndSurface NURBSObj
nurbsObj =
IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (NURBSObj -> IO ()
forall (m :: * -> *). MonadIO m => NURBSObj -> m ()
gluBeginSurface NURBSObj
nurbsObj) (NURBSObj -> IO ()
forall (m :: * -> *). MonadIO m => NURBSObj -> m ()
gluEndSurface NURBSObj
nurbsObj)
nurbsSurface :: ControlPoint c => NURBSObj -> GLint -> Ptr GLfloat -> GLint -> Ptr GLfloat -> GLint -> GLint -> Ptr (c GLfloat) -> GLint -> GLint -> IO ()
nurbsSurface :: NURBSObj
-> GLint
-> Ptr GLfloat
-> GLint
-> Ptr GLfloat
-> GLint
-> GLint
-> Ptr (c GLfloat)
-> GLint
-> GLint
-> IO ()
nurbsSurface NURBSObj
nurbsObj GLint
sKnotCount Ptr GLfloat
sKnots GLint
tKnotCount Ptr GLfloat
tKnots GLint
sStride GLint
tStride Ptr (c GLfloat)
control GLint
sOrder GLint
tOrder =
NURBSObj
-> GLint
-> Ptr GLfloat
-> GLint
-> Ptr GLfloat
-> GLint
-> GLint
-> Ptr GLfloat
-> GLint
-> GLint
-> NURBSBeginCallback
forall (m :: * -> *).
MonadIO m =>
NURBSObj
-> GLint
-> Ptr GLfloat
-> GLint
-> Ptr GLfloat
-> GLint
-> GLint
-> Ptr GLfloat
-> GLint
-> GLint
-> GLenum
-> m ()
gluNurbsSurface NURBSObj
nurbsObj GLint
sKnotCount Ptr GLfloat
sKnots GLint
tKnotCount Ptr GLfloat
tKnots GLint
sStride GLint
tStride (Ptr (c GLfloat) -> Ptr GLfloat
forall a b. Ptr a -> Ptr b
castPtr Ptr (c GLfloat)
control) GLint
sOrder GLint
tOrder (c GLfloat -> GLenum
forall (c :: * -> *) d. (ControlPoint c, Domain d) => c d -> GLenum
map2Target (Ptr (c GLfloat) -> c GLfloat
forall (c :: * -> *). Ptr (c GLfloat) -> c GLfloat
pseudoPeek Ptr (c GLfloat)
control))
class TrimmingPoint p where
trimmingTarget :: p GLfloat -> GLenum
instance TrimmingPoint Vertex2 where
trimmingTarget :: Vertex2 GLfloat -> GLenum
trimmingTarget = GLenum -> Vertex2 GLfloat -> GLenum
forall a b. a -> b -> a
const GLenum
GLU_MAP1_TRIM_2
instance TrimmingPoint Vertex3 where
trimmingTarget :: Vertex3 GLfloat -> GLenum
trimmingTarget = GLenum -> Vertex3 GLfloat -> GLenum
forall a b. a -> b -> a
const GLenum
GLU_MAP1_TRIM_3
nurbsBeginEndTrim :: NURBSObj -> IO a -> IO a
nurbsBeginEndTrim :: NURBSObj -> IO a -> IO a
nurbsBeginEndTrim NURBSObj
nurbsObj =
IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (NURBSObj -> IO ()
forall (m :: * -> *). MonadIO m => NURBSObj -> m ()
gluBeginTrim NURBSObj
nurbsObj) (NURBSObj -> IO ()
forall (m :: * -> *). MonadIO m => NURBSObj -> m ()
gluEndTrim NURBSObj
nurbsObj)
pwlCurve :: TrimmingPoint p => NURBSObj -> GLint -> Ptr (p GLfloat) -> GLint -> IO ()
pwlCurve :: NURBSObj -> GLint -> Ptr (p GLfloat) -> GLint -> IO ()
pwlCurve NURBSObj
nurbsObj GLint
count Ptr (p GLfloat)
points GLint
stride =
NURBSObj -> GLint -> Ptr GLfloat -> GLint -> NURBSBeginCallback
forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLint -> Ptr GLfloat -> GLint -> GLenum -> m ()
gluPwlCurve NURBSObj
nurbsObj GLint
count (Ptr (p GLfloat) -> Ptr GLfloat
forall a b. Ptr a -> Ptr b
castPtr Ptr (p GLfloat)
points) GLint
stride (p GLfloat -> GLenum
forall (p :: * -> *). TrimmingPoint p => p GLfloat -> GLenum
trimmingTarget (Ptr (p GLfloat) -> p GLfloat
forall (c :: * -> *). Ptr (c GLfloat) -> c GLfloat
pseudoPeek Ptr (p GLfloat)
points))
trimmingCurve :: TrimmingPoint c => NURBSObj -> GLint -> Ptr GLfloat -> GLint -> Ptr (c GLfloat) -> GLint -> IO ()
trimmingCurve :: NURBSObj
-> GLint
-> Ptr GLfloat
-> GLint
-> Ptr (c GLfloat)
-> GLint
-> IO ()
trimmingCurve NURBSObj
nurbsObj GLint
knotCount Ptr GLfloat
knots GLint
stride Ptr (c GLfloat)
control GLint
order =
NURBSObj
-> GLint
-> Ptr GLfloat
-> GLint
-> Ptr GLfloat
-> GLint
-> NURBSBeginCallback
forall (m :: * -> *).
MonadIO m =>
NURBSObj
-> GLint
-> Ptr GLfloat
-> GLint
-> Ptr GLfloat
-> GLint
-> GLenum
-> m ()
gluNurbsCurve NURBSObj
nurbsObj GLint
knotCount Ptr GLfloat
knots GLint
stride (Ptr (c GLfloat) -> Ptr GLfloat
forall a b. Ptr a -> Ptr b
castPtr Ptr (c GLfloat)
control) GLint
order (c GLfloat -> GLenum
forall (p :: * -> *). TrimmingPoint p => p GLfloat -> GLenum
trimmingTarget (Ptr (c GLfloat) -> c GLfloat
forall (c :: * -> *). Ptr (c GLfloat) -> c GLfloat
pseudoPeek Ptr (c GLfloat)
control))
data NURBSMode =
NURBSTessellator
| NURBSRenderer
deriving ( NURBSMode -> NURBSMode -> Bool
(NURBSMode -> NURBSMode -> Bool)
-> (NURBSMode -> NURBSMode -> Bool) -> Eq NURBSMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NURBSMode -> NURBSMode -> Bool
$c/= :: NURBSMode -> NURBSMode -> Bool
== :: NURBSMode -> NURBSMode -> Bool
$c== :: NURBSMode -> NURBSMode -> Bool
Eq, Eq NURBSMode
Eq NURBSMode
-> (NURBSMode -> NURBSMode -> Ordering)
-> (NURBSMode -> NURBSMode -> Bool)
-> (NURBSMode -> NURBSMode -> Bool)
-> (NURBSMode -> NURBSMode -> Bool)
-> (NURBSMode -> NURBSMode -> Bool)
-> (NURBSMode -> NURBSMode -> NURBSMode)
-> (NURBSMode -> NURBSMode -> NURBSMode)
-> Ord NURBSMode
NURBSMode -> NURBSMode -> Bool
NURBSMode -> NURBSMode -> Ordering
NURBSMode -> NURBSMode -> NURBSMode
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 :: NURBSMode -> NURBSMode -> NURBSMode
$cmin :: NURBSMode -> NURBSMode -> NURBSMode
max :: NURBSMode -> NURBSMode -> NURBSMode
$cmax :: NURBSMode -> NURBSMode -> NURBSMode
>= :: NURBSMode -> NURBSMode -> Bool
$c>= :: NURBSMode -> NURBSMode -> Bool
> :: NURBSMode -> NURBSMode -> Bool
$c> :: NURBSMode -> NURBSMode -> Bool
<= :: NURBSMode -> NURBSMode -> Bool
$c<= :: NURBSMode -> NURBSMode -> Bool
< :: NURBSMode -> NURBSMode -> Bool
$c< :: NURBSMode -> NURBSMode -> Bool
compare :: NURBSMode -> NURBSMode -> Ordering
$ccompare :: NURBSMode -> NURBSMode -> Ordering
$cp1Ord :: Eq NURBSMode
Ord, Int -> NURBSMode -> ShowS
[NURBSMode] -> ShowS
NURBSMode -> String
(Int -> NURBSMode -> ShowS)
-> (NURBSMode -> String)
-> ([NURBSMode] -> ShowS)
-> Show NURBSMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NURBSMode] -> ShowS
$cshowList :: [NURBSMode] -> ShowS
show :: NURBSMode -> String
$cshow :: NURBSMode -> String
showsPrec :: Int -> NURBSMode -> ShowS
$cshowsPrec :: Int -> NURBSMode -> ShowS
Show )
marshalNURBSMode :: NURBSMode -> GLfloat
marshalNURBSMode :: NURBSMode -> GLfloat
marshalNURBSMode NURBSMode
x = GLenum -> GLfloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum -> GLfloat) -> GLenum -> GLfloat
forall a b. (a -> b) -> a -> b
$ case NURBSMode
x of
NURBSMode
NURBSTessellator -> GLenum
GLU_NURBS_TESSELLATOR
NURBSMode
NURBSRenderer -> GLenum
GLU_NURBS_RENDERER
setNURBSMode :: NURBSObj -> NURBSMode -> IO ()
setNURBSMode :: NURBSObj -> NURBSMode -> IO ()
setNURBSMode NURBSObj
nurbsObj = NURBSObj -> GLenum -> GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLenum -> GLfloat -> m ()
gluNurbsProperty NURBSObj
nurbsObj GLenum
GLU_NURBS_MODE (GLfloat -> IO ()) -> (NURBSMode -> GLfloat) -> NURBSMode -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NURBSMode -> GLfloat
marshalNURBSMode
setNURBSCulling :: NURBSObj -> Capability -> IO ()
setNURBSCulling :: NURBSObj -> Capability -> IO ()
setNURBSCulling NURBSObj
nurbsObj = NURBSObj -> GLenum -> GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLenum -> GLfloat -> m ()
gluNurbsProperty NURBSObj
nurbsObj GLenum
GLU_CULLING (GLfloat -> IO ())
-> (Capability -> GLfloat) -> Capability -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLboolean -> GLfloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLboolean -> GLfloat)
-> (Capability -> GLboolean) -> Capability -> GLfloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capability -> GLboolean
marshalCapability
data SamplingMethod' =
PathLength'
| ParametricError'
| DomainDistance'
| ObjectPathLength'
| ObjectParametricError'
marshalSamplingMethod' :: SamplingMethod' -> GLfloat
marshalSamplingMethod' :: SamplingMethod' -> GLfloat
marshalSamplingMethod' SamplingMethod'
x = GLenum -> GLfloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum -> GLfloat) -> GLenum -> GLfloat
forall a b. (a -> b) -> a -> b
$ case SamplingMethod'
x of
SamplingMethod'
PathLength' -> GLenum
GLU_PATH_LENGTH
SamplingMethod'
ParametricError' -> GLenum
GLU_PARAMETRIC_TOLERANCE
SamplingMethod'
DomainDistance' -> GLenum
GLU_DOMAIN_DISTANCE
SamplingMethod'
ObjectPathLength' -> GLenum
GLU_OBJECT_PATH_LENGTH
SamplingMethod'
ObjectParametricError' -> GLenum
GLU_OBJECT_PARAMETRIC_ERROR
setSamplingMethod' :: NURBSObj -> SamplingMethod' -> IO ()
setSamplingMethod' :: NURBSObj -> SamplingMethod' -> IO ()
setSamplingMethod' NURBSObj
nurbsObj = NURBSObj -> GLenum -> GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLenum -> GLfloat -> m ()
gluNurbsProperty NURBSObj
nurbsObj GLenum
GLU_SAMPLING_METHOD (GLfloat -> IO ())
-> (SamplingMethod' -> GLfloat) -> SamplingMethod' -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SamplingMethod' -> GLfloat
marshalSamplingMethod'
data SamplingMethod =
PathLength GLfloat
| ParametricError GLfloat
| DomainDistance GLfloat GLfloat
| ObjectPathLength GLfloat
| ObjectParametricError GLfloat
deriving ( SamplingMethod -> SamplingMethod -> Bool
(SamplingMethod -> SamplingMethod -> Bool)
-> (SamplingMethod -> SamplingMethod -> Bool) -> Eq SamplingMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SamplingMethod -> SamplingMethod -> Bool
$c/= :: SamplingMethod -> SamplingMethod -> Bool
== :: SamplingMethod -> SamplingMethod -> Bool
$c== :: SamplingMethod -> SamplingMethod -> Bool
Eq, Eq SamplingMethod
Eq SamplingMethod
-> (SamplingMethod -> SamplingMethod -> Ordering)
-> (SamplingMethod -> SamplingMethod -> Bool)
-> (SamplingMethod -> SamplingMethod -> Bool)
-> (SamplingMethod -> SamplingMethod -> Bool)
-> (SamplingMethod -> SamplingMethod -> Bool)
-> (SamplingMethod -> SamplingMethod -> SamplingMethod)
-> (SamplingMethod -> SamplingMethod -> SamplingMethod)
-> Ord SamplingMethod
SamplingMethod -> SamplingMethod -> Bool
SamplingMethod -> SamplingMethod -> Ordering
SamplingMethod -> SamplingMethod -> SamplingMethod
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 :: SamplingMethod -> SamplingMethod -> SamplingMethod
$cmin :: SamplingMethod -> SamplingMethod -> SamplingMethod
max :: SamplingMethod -> SamplingMethod -> SamplingMethod
$cmax :: SamplingMethod -> SamplingMethod -> SamplingMethod
>= :: SamplingMethod -> SamplingMethod -> Bool
$c>= :: SamplingMethod -> SamplingMethod -> Bool
> :: SamplingMethod -> SamplingMethod -> Bool
$c> :: SamplingMethod -> SamplingMethod -> Bool
<= :: SamplingMethod -> SamplingMethod -> Bool
$c<= :: SamplingMethod -> SamplingMethod -> Bool
< :: SamplingMethod -> SamplingMethod -> Bool
$c< :: SamplingMethod -> SamplingMethod -> Bool
compare :: SamplingMethod -> SamplingMethod -> Ordering
$ccompare :: SamplingMethod -> SamplingMethod -> Ordering
$cp1Ord :: Eq SamplingMethod
Ord, Int -> SamplingMethod -> ShowS
[SamplingMethod] -> ShowS
SamplingMethod -> String
(Int -> SamplingMethod -> ShowS)
-> (SamplingMethod -> String)
-> ([SamplingMethod] -> ShowS)
-> Show SamplingMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SamplingMethod] -> ShowS
$cshowList :: [SamplingMethod] -> ShowS
show :: SamplingMethod -> String
$cshow :: SamplingMethod -> String
showsPrec :: Int -> SamplingMethod -> ShowS
$cshowsPrec :: Int -> SamplingMethod -> ShowS
Show )
setSamplingMethod :: NURBSObj -> SamplingMethod -> IO ()
setSamplingMethod :: NURBSObj -> SamplingMethod -> IO ()
setSamplingMethod NURBSObj
nurbsObj SamplingMethod
x = case SamplingMethod
x of
PathLength GLfloat
s -> do
NURBSObj -> GLenum -> GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLenum -> GLfloat -> m ()
gluNurbsProperty NURBSObj
nurbsObj GLenum
GLU_SAMPLING_TOLERANCE GLfloat
s
NURBSObj -> SamplingMethod' -> IO ()
setSamplingMethod' NURBSObj
nurbsObj SamplingMethod'
PathLength'
ParametricError GLfloat
p -> do
NURBSObj -> GLenum -> GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLenum -> GLfloat -> m ()
gluNurbsProperty NURBSObj
nurbsObj GLenum
GLU_PARAMETRIC_TOLERANCE GLfloat
p
NURBSObj -> SamplingMethod' -> IO ()
setSamplingMethod' NURBSObj
nurbsObj SamplingMethod'
ParametricError'
DomainDistance GLfloat
u GLfloat
v -> do
NURBSObj -> GLenum -> GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLenum -> GLfloat -> m ()
gluNurbsProperty NURBSObj
nurbsObj GLenum
GLU_U_STEP GLfloat
u
NURBSObj -> GLenum -> GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLenum -> GLfloat -> m ()
gluNurbsProperty NURBSObj
nurbsObj GLenum
GLU_V_STEP GLfloat
v
NURBSObj -> SamplingMethod' -> IO ()
setSamplingMethod' NURBSObj
nurbsObj SamplingMethod'
DomainDistance'
ObjectPathLength GLfloat
s -> do
NURBSObj -> GLenum -> GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLenum -> GLfloat -> m ()
gluNurbsProperty NURBSObj
nurbsObj GLenum
GLU_SAMPLING_TOLERANCE GLfloat
s
NURBSObj -> SamplingMethod' -> IO ()
setSamplingMethod' NURBSObj
nurbsObj SamplingMethod'
ObjectPathLength'
ObjectParametricError GLfloat
p -> do
NURBSObj -> GLenum -> GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLenum -> GLfloat -> m ()
gluNurbsProperty NURBSObj
nurbsObj GLenum
GLU_PARAMETRIC_TOLERANCE GLfloat
p
NURBSObj -> SamplingMethod' -> IO ()
setSamplingMethod' NURBSObj
nurbsObj SamplingMethod'
ObjectParametricError'
setAutoLoadMatrix :: NURBSObj -> Bool -> IO ()
setAutoLoadMatrix :: NURBSObj -> Bool -> IO ()
setAutoLoadMatrix NURBSObj
nurbsObj = NURBSObj -> GLenum -> GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLenum -> GLfloat -> m ()
gluNurbsProperty NURBSObj
nurbsObj GLenum
GLU_AUTO_LOAD_MATRIX (GLfloat -> IO ()) -> (Bool -> GLfloat) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> GLfloat
forall a. Num a => Bool -> a
marshalGLboolean
loadSamplingMatrices :: (Matrix m1, Matrix m2) => NURBSObj -> Maybe (m1 GLfloat, m2 GLfloat, (Position, Size)) -> IO ()
loadSamplingMatrices :: NURBSObj
-> Maybe (m1 GLfloat, m2 GLfloat, (Position, Size)) -> IO ()
loadSamplingMatrices NURBSObj
nurbsObj =
IO ()
-> ((m1 GLfloat, m2 GLfloat, (Position, Size)) -> IO ())
-> Maybe (m1 GLfloat, m2 GLfloat, (Position, Size))
-> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(NURBSObj -> Bool -> IO ()
setAutoLoadMatrix NURBSObj
nurbsObj Bool
True)
(\(m1 GLfloat
mv, m2 GLfloat
proj, (Position GLint
x GLint
y, Size GLint
w GLint
h)) -> do
m1 GLfloat -> NURBSVertexCallback -> IO ()
forall (m :: * -> *) c a.
(Matrix m, MatrixComponent c) =>
m c -> (Ptr c -> IO a) -> IO a
withMatrixColumnMajor m1 GLfloat
mv (NURBSVertexCallback -> IO ()) -> NURBSVertexCallback -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GLfloat
mvBuf ->
m2 GLfloat -> NURBSVertexCallback -> IO ()
forall (m :: * -> *) c a.
(Matrix m, MatrixComponent c) =>
m c -> (Ptr c -> IO a) -> IO a
withMatrixColumnMajor m2 GLfloat
proj (NURBSVertexCallback -> IO ()) -> NURBSVertexCallback -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GLfloat
projBuf ->
[GLint] -> (Ptr GLint -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLint
x, GLint
y, GLint -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
w, GLint -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
h] ((Ptr GLint -> IO ()) -> IO ()) -> (Ptr GLint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GLint
viewportBuf ->
NURBSObj -> Ptr GLfloat -> Ptr GLfloat -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
NURBSObj -> Ptr GLfloat -> Ptr GLfloat -> Ptr GLint -> m ()
gluLoadSamplingMatrices NURBSObj
nurbsObj Ptr GLfloat
mvBuf Ptr GLfloat
projBuf Ptr GLint
viewportBuf
NURBSObj -> Bool -> IO ()
setAutoLoadMatrix NURBSObj
nurbsObj Bool
False)
withMatrixColumnMajor :: (Matrix m, MatrixComponent c) => m c -> (Ptr c -> IO a) -> IO a
withMatrixColumnMajor :: m c -> (Ptr c -> IO a) -> IO a
withMatrixColumnMajor m c
mat Ptr c -> IO a
act =
m c -> (MatrixOrder -> Ptr c -> IO a) -> IO a
forall (m :: * -> *) c a.
(Matrix m, MatrixComponent c) =>
m c -> (MatrixOrder -> Ptr c -> IO a) -> IO a
withMatrix m c
mat ((MatrixOrder -> Ptr c -> IO a) -> IO a)
-> (MatrixOrder -> Ptr c -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \MatrixOrder
order Ptr c
p ->
if MatrixOrder
order MatrixOrder -> MatrixOrder -> Bool
forall a. Eq a => a -> a -> Bool
== MatrixOrder
ColumnMajor
then Ptr c -> IO a
act Ptr c
p
else do
[c]
elems <- (Int -> IO c) -> [Int] -> IO [c]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ptr c -> Int -> IO c
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr c
p) [ Int
0, Int
4, Int
8, Int
12,
Int
1, Int
5, Int
9, Int
13,
Int
2, Int
6, Int
10, Int
14,
Int
3, Int
7, Int
11, Int
15 ]
[c] -> (Ptr c -> IO a) -> IO a
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [c]
elems Ptr c -> IO a
act
data DisplayMode' =
Fill'
| OutlinePolygon
| OutlinePatch
deriving ( DisplayMode' -> DisplayMode' -> Bool
(DisplayMode' -> DisplayMode' -> Bool)
-> (DisplayMode' -> DisplayMode' -> Bool) -> Eq DisplayMode'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayMode' -> DisplayMode' -> Bool
$c/= :: DisplayMode' -> DisplayMode' -> Bool
== :: DisplayMode' -> DisplayMode' -> Bool
$c== :: DisplayMode' -> DisplayMode' -> Bool
Eq, Eq DisplayMode'
Eq DisplayMode'
-> (DisplayMode' -> DisplayMode' -> Ordering)
-> (DisplayMode' -> DisplayMode' -> Bool)
-> (DisplayMode' -> DisplayMode' -> Bool)
-> (DisplayMode' -> DisplayMode' -> Bool)
-> (DisplayMode' -> DisplayMode' -> Bool)
-> (DisplayMode' -> DisplayMode' -> DisplayMode')
-> (DisplayMode' -> DisplayMode' -> DisplayMode')
-> Ord DisplayMode'
DisplayMode' -> DisplayMode' -> Bool
DisplayMode' -> DisplayMode' -> Ordering
DisplayMode' -> DisplayMode' -> DisplayMode'
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 :: DisplayMode' -> DisplayMode' -> DisplayMode'
$cmin :: DisplayMode' -> DisplayMode' -> DisplayMode'
max :: DisplayMode' -> DisplayMode' -> DisplayMode'
$cmax :: DisplayMode' -> DisplayMode' -> DisplayMode'
>= :: DisplayMode' -> DisplayMode' -> Bool
$c>= :: DisplayMode' -> DisplayMode' -> Bool
> :: DisplayMode' -> DisplayMode' -> Bool
$c> :: DisplayMode' -> DisplayMode' -> Bool
<= :: DisplayMode' -> DisplayMode' -> Bool
$c<= :: DisplayMode' -> DisplayMode' -> Bool
< :: DisplayMode' -> DisplayMode' -> Bool
$c< :: DisplayMode' -> DisplayMode' -> Bool
compare :: DisplayMode' -> DisplayMode' -> Ordering
$ccompare :: DisplayMode' -> DisplayMode' -> Ordering
$cp1Ord :: Eq DisplayMode'
Ord, Int -> DisplayMode' -> ShowS
[DisplayMode'] -> ShowS
DisplayMode' -> String
(Int -> DisplayMode' -> ShowS)
-> (DisplayMode' -> String)
-> ([DisplayMode'] -> ShowS)
-> Show DisplayMode'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisplayMode'] -> ShowS
$cshowList :: [DisplayMode'] -> ShowS
show :: DisplayMode' -> String
$cshow :: DisplayMode' -> String
showsPrec :: Int -> DisplayMode' -> ShowS
$cshowsPrec :: Int -> DisplayMode' -> ShowS
Show )
marshalDisplayMode' :: DisplayMode' -> GLfloat
marshalDisplayMode' :: DisplayMode' -> GLfloat
marshalDisplayMode' DisplayMode'
x = GLenum -> GLfloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum -> GLfloat) -> GLenum -> GLfloat
forall a b. (a -> b) -> a -> b
$ case DisplayMode'
x of
DisplayMode'
Fill' -> GLenum
GLU_FILL
DisplayMode'
OutlinePolygon -> GLenum
GLU_OUTLINE_POLYGON
DisplayMode'
OutlinePatch -> GLenum
GLU_OUTLINE_PATCH
setDisplayMode' :: NURBSObj -> DisplayMode' -> IO ()
setDisplayMode' :: NURBSObj -> DisplayMode' -> IO ()
setDisplayMode' NURBSObj
nurbsObj = NURBSObj -> GLenum -> GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLenum -> GLfloat -> m ()
gluNurbsProperty NURBSObj
nurbsObj GLenum
GLU_DISPLAY_MODE (GLfloat -> IO ())
-> (DisplayMode' -> GLfloat) -> DisplayMode' -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisplayMode' -> GLfloat
marshalDisplayMode'