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 failureValue :: a
failureValue action :: 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
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
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
nurbsObj beginCallback :: NURBSBeginCallback
beginCallback action :: 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
$ \callbackPtr :: 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
nurbsObj vertexCallback :: NURBSVertexCallback
vertexCallback action :: 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 (\p :: 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
$ \callbackPtr :: 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
nurbsObj normalCallback :: NURBSNormalCallback
normalCallback action :: 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 (\p :: 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
$ \callbackPtr :: 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
nurbsObj colorCallback :: NURBSColorCallback
colorCallback action :: 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 (\p :: 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
$ \callbackPtr :: 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
nurbsObj endCallback :: IO ()
endCallback action :: 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
$ \callbackPtr :: 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
nurbsObj errorCallback :: NURBSBeginCallback
errorCallback action :: 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
$ \callbackPtr :: 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 = 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
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
nurbsObj knotCount :: GLint
knotCount knots :: Ptr GLfloat
knots stride :: GLint
stride control :: Ptr (c GLfloat)
control order :: 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 _ = c GLfloat
forall a. HasCallStack => a
undefined
nurbsBeginEndSurface :: NURBSObj -> IO a -> IO a
nurbsBeginEndSurface :: NURBSObj -> IO a -> IO a
nurbsBeginEndSurface nurbsObj :: 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
nurbsObj sKnotCount :: GLint
sKnotCount sKnots :: Ptr GLfloat
sKnots tKnotCount :: GLint
tKnotCount tKnots :: Ptr GLfloat
tKnots sStride :: GLint
sStride tStride :: GLint
tStride control :: Ptr (c GLfloat)
control sOrder :: GLint
sOrder tOrder :: 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
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
nurbsObj count :: GLint
count points :: Ptr (p GLfloat)
points stride :: 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
nurbsObj knotCount :: GLint
knotCount knots :: Ptr GLfloat
knots stride :: GLint
stride control :: Ptr (c GLfloat)
control order :: 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 x :: 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
NURBSTessellator -> GLenum
GLU_NURBS_TESSELLATOR
NURBSRenderer -> GLenum
GLU_NURBS_RENDERER
setNURBSMode :: NURBSObj -> NURBSMode -> IO ()
setNURBSMode :: NURBSObj -> NURBSMode -> IO ()
setNURBSMode nurbsObj :: 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 = 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' x :: 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
PathLength' -> GLenum
GLU_PATH_LENGTH
ParametricError' -> GLenum
GLU_PARAMETRIC_TOLERANCE
DomainDistance' -> GLenum
GLU_DOMAIN_DISTANCE
ObjectPathLength' -> GLenum
GLU_OBJECT_PATH_LENGTH
ObjectParametricError' -> GLenum
GLU_OBJECT_PARAMETRIC_ERROR
setSamplingMethod' :: NURBSObj -> SamplingMethod' -> IO ()
setSamplingMethod' :: NURBSObj -> SamplingMethod' -> IO ()
setSamplingMethod' nurbsObj :: 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
nurbsObj x :: SamplingMethod
x = case SamplingMethod
x of
PathLength s :: 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 p :: 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 u :: GLfloat
u v :: 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 s :: 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 p :: 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 = 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
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)
(\(mv :: m1 GLfloat
mv, proj :: m2 GLfloat
proj, (Position x :: GLint
x y :: GLint
y, Size w :: GLint
w h :: 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
$ \mvBuf :: 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
$ \projBuf :: 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
$ \viewportBuf :: 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 mat :: m c
mat act :: 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
$ \order :: MatrixOrder
order p :: 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) [ 0, 4, 8, 12,
1, 5, 9, 13,
2, 6, 10, 14,
3, 7, 11, 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' x :: 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
Fill' -> GLenum
GLU_FILL
OutlinePolygon -> GLenum
GLU_OUTLINE_POLYGON
OutlinePatch -> GLenum
GLU_OUTLINE_PATCH
setDisplayMode' :: NURBSObj -> DisplayMode' -> IO ()
setDisplayMode' :: NURBSObj -> DisplayMode' -> IO ()
setDisplayMode' nurbsObj :: 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'