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 = (forall a. Ptr a
nullPtr forall a. Eq a => a -> a -> Bool
==)
withNURBSObj :: a -> (NURBSObj -> IO a) -> IO a
withNURBSObj :: forall a. a -> (NURBSObj -> IO a) -> IO a
withNURBSObj a
failureValue NURBSObj -> IO a
action =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket forall (m :: * -> *). MonadIO m => m NURBSObj
gluNewNurbsRenderer NURBSObj -> IO ()
safeDeleteNurbsRenderer
(\NURBSObj
nurbsObj -> if NURBSObj -> Bool
isNullNURBSObj NURBSObj
nurbsObj
then do IO ()
recordOutOfMemory
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 =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (NURBSObj -> Bool
isNullNURBSObj NURBSObj
nurbsObj) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => NURBSObj -> m ()
gluDeleteNurbsRenderer NURBSObj
nurbsObj
type NURBSBeginCallback = PrimitiveMode -> IO ()
withNURBSBeginCallback :: NURBSObj -> NURBSBeginCallback -> IO a -> IO a
withNURBSBeginCallback :: forall a. NURBSObj -> NURBSBeginCallback -> IO a -> IO a
withNURBSBeginCallback NURBSObj
nurbsObj NURBSBeginCallback
beginCallback IO a
action =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (NURBSBeginCallback -> IO (FunPtr NURBSBeginCallback)
makeNURBSBeginCallback (NURBSBeginCallback
beginCallback forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLenum -> PrimitiveMode
unmarshalPrimitiveMode))
forall a. FunPtr a -> IO ()
freeHaskellFunPtr forall a b. (a -> b) -> a -> b
$ \FunPtr NURBSBeginCallback
callbackPtr -> do
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 :: forall a. NURBSObj -> NURBSVertexCallback -> IO a -> IO a
withNURBSVertexCallback NURBSObj
nurbsObj NURBSVertexCallback
vertexCallback IO a
action =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (NURBSVertexCallback -> IO (FunPtr NURBSVertexCallback)
makeNURBSVertexCallback (\Ptr GLfloat
p -> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr GLfloat
p) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NURBSVertexCallback
vertexCallback))
forall a. FunPtr a -> IO ()
freeHaskellFunPtr forall a b. (a -> b) -> a -> b
$ \FunPtr NURBSVertexCallback
callbackPtr -> do
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 :: forall a. NURBSObj -> NURBSNormalCallback -> IO a -> IO a
withNURBSNormalCallback NURBSObj
nurbsObj NURBSNormalCallback
normalCallback IO a
action =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (NURBSVertexCallback -> IO (FunPtr NURBSVertexCallback)
makeNURBSNormalCallback (\Ptr GLfloat
p -> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr GLfloat
p) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NURBSNormalCallback
normalCallback))
forall a. FunPtr a -> IO ()
freeHaskellFunPtr forall a b. (a -> b) -> a -> b
$ \FunPtr NURBSVertexCallback
callbackPtr -> do
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 :: forall a. NURBSObj -> NURBSColorCallback -> IO a -> IO a
withNURBSColorCallback NURBSObj
nurbsObj NURBSColorCallback
colorCallback IO a
action =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (NURBSVertexCallback -> IO (FunPtr NURBSVertexCallback)
makeNURBSColorCallback (\Ptr GLfloat
p -> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr GLfloat
p) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NURBSColorCallback
colorCallback))
forall a. FunPtr a -> IO ()
freeHaskellFunPtr forall a b. (a -> b) -> a -> b
$ \FunPtr NURBSVertexCallback
callbackPtr -> do
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 :: forall a. NURBSObj -> IO () -> IO a -> IO a
withNURBSEndCallback NURBSObj
nurbsObj IO ()
endCallback IO a
action =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (IO () -> IO (FunPtr (IO ()))
makeNURBSEndCallback IO ()
endCallback)
forall a. FunPtr a -> IO ()
freeHaskellFunPtr forall a b. (a -> b) -> a -> b
$ \FunPtr (IO ())
callbackPtr -> do
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 :: forall a. NURBSObj -> NURBSBeginCallback -> IO a -> IO a
withErrorCallback NURBSObj
nurbsObj NURBSBeginCallback
errorCallback IO a
action =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (NURBSBeginCallback -> IO (FunPtr NURBSBeginCallback)
makeNURBSErrorCallback NURBSBeginCallback
errorCallback)
forall a. FunPtr a -> IO ()
freeHaskellFunPtr forall a b. (a -> b) -> a -> b
$ \FunPtr NURBSBeginCallback
callbackPtr -> do
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 :: forall a. NURBSObj -> IO a -> IO a
checkForNURBSError NURBSObj
nurbsObj = forall a. NURBSObj -> NURBSBeginCallback -> IO a -> IO a
withErrorCallback NURBSObj
nurbsObj NURBSBeginCallback
recordErrorCode
nurbsBeginEndCurve :: NURBSObj -> IO a -> IO a
nurbsBeginEndCurve :: forall a. NURBSObj -> IO a -> IO a
nurbsBeginEndCurve NURBSObj
nurbsObj =
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (forall (m :: * -> *). MonadIO m => NURBSObj -> m ()
gluBeginCurve NURBSObj
nurbsObj) (forall (m :: * -> *). MonadIO m => NURBSObj -> m ()
gluEndCurve NURBSObj
nurbsObj)
nurbsCurve :: ControlPoint c => NURBSObj -> GLint -> Ptr GLfloat -> GLint -> Ptr (c GLfloat) -> GLint -> IO ()
nurbsCurve :: forall (c :: * -> *).
ControlPoint c =>
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 =
forall (m :: * -> *).
MonadIO m =>
NURBSObj
-> GLint
-> Ptr GLfloat
-> GLint
-> Ptr GLfloat
-> GLint
-> GLenum
-> m ()
gluNurbsCurve NURBSObj
nurbsObj GLint
knotCount Ptr GLfloat
knots GLint
stride (forall a b. Ptr a -> Ptr b
castPtr Ptr (c GLfloat)
control) GLint
order (forall (c :: * -> *) d. (ControlPoint c, Domain d) => c d -> GLenum
map1Target (forall (c :: * -> *). Ptr (c GLfloat) -> c GLfloat
pseudoPeek Ptr (c GLfloat)
control))
pseudoPeek :: Ptr (c GLfloat) -> c GLfloat
pseudoPeek :: forall (c :: * -> *). Ptr (c GLfloat) -> c GLfloat
pseudoPeek Ptr (c GLfloat)
_ = forall a. HasCallStack => a
undefined
nurbsBeginEndSurface :: NURBSObj -> IO a -> IO a
nurbsBeginEndSurface :: forall a. NURBSObj -> IO a -> IO a
nurbsBeginEndSurface NURBSObj
nurbsObj =
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (forall (m :: * -> *). MonadIO m => NURBSObj -> m ()
gluBeginSurface NURBSObj
nurbsObj) (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 :: forall (c :: * -> *).
ControlPoint c =>
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 =
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 (forall a b. Ptr a -> Ptr b
castPtr Ptr (c GLfloat)
control) GLint
sOrder GLint
tOrder (forall (c :: * -> *) d. (ControlPoint c, Domain d) => c d -> GLenum
map2Target (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 = forall a b. a -> b -> a
const GLenum
GLU_MAP1_TRIM_2
instance TrimmingPoint Vertex3 where
trimmingTarget :: Vertex3 GLfloat -> GLenum
trimmingTarget = forall a b. a -> b -> a
const GLenum
GLU_MAP1_TRIM_3
nurbsBeginEndTrim :: NURBSObj -> IO a -> IO a
nurbsBeginEndTrim :: forall a. NURBSObj -> IO a -> IO a
nurbsBeginEndTrim NURBSObj
nurbsObj =
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (forall (m :: * -> *). MonadIO m => NURBSObj -> m ()
gluBeginTrim NURBSObj
nurbsObj) (forall (m :: * -> *). MonadIO m => NURBSObj -> m ()
gluEndTrim NURBSObj
nurbsObj)
pwlCurve :: TrimmingPoint p => NURBSObj -> GLint -> Ptr (p GLfloat) -> GLint -> IO ()
pwlCurve :: forall (p :: * -> *).
TrimmingPoint p =>
NURBSObj -> GLint -> Ptr (p GLfloat) -> GLint -> IO ()
pwlCurve NURBSObj
nurbsObj GLint
count Ptr (p GLfloat)
points GLint
stride =
forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLint -> Ptr GLfloat -> GLint -> GLenum -> m ()
gluPwlCurve NURBSObj
nurbsObj GLint
count (forall a b. Ptr a -> Ptr b
castPtr Ptr (p GLfloat)
points) GLint
stride (forall (p :: * -> *). TrimmingPoint p => p GLfloat -> GLenum
trimmingTarget (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 :: forall (c :: * -> *).
TrimmingPoint c =>
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 =
forall (m :: * -> *).
MonadIO m =>
NURBSObj
-> GLint
-> Ptr GLfloat
-> GLint
-> Ptr GLfloat
-> GLint
-> GLenum
-> m ()
gluNurbsCurve NURBSObj
nurbsObj GLint
knotCount Ptr GLfloat
knots GLint
stride (forall a b. Ptr a -> Ptr b
castPtr Ptr (c GLfloat)
control) GLint
order (forall (p :: * -> *). TrimmingPoint p => p GLfloat -> GLenum
trimmingTarget (forall (c :: * -> *). Ptr (c GLfloat) -> c GLfloat
pseudoPeek Ptr (c GLfloat)
control))
data NURBSMode =
NURBSTessellator
| NURBSRenderer
deriving ( NURBSMode -> NURBSMode -> Bool
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
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
Ord, Int -> NURBSMode -> ShowS
[NURBSMode] -> ShowS
NURBSMode -> String
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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 = forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLenum -> GLfloat -> m ()
gluNurbsProperty NURBSObj
nurbsObj GLenum
GLU_NURBS_MODE forall b c a. (b -> c) -> (a -> b) -> a -> c
. NURBSMode -> GLfloat
marshalNURBSMode
setNURBSCulling :: NURBSObj -> Capability -> IO ()
setNURBSCulling :: NURBSObj -> Capability -> IO ()
setNURBSCulling NURBSObj
nurbsObj = forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLenum -> GLfloat -> m ()
gluNurbsProperty NURBSObj
nurbsObj GLenum
GLU_CULLING forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 = forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLenum -> GLfloat -> m ()
gluNurbsProperty NURBSObj
nurbsObj GLenum
GLU_SAMPLING_METHOD 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
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
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
Ord, Int -> SamplingMethod -> ShowS
[SamplingMethod] -> ShowS
SamplingMethod -> String
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
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
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
forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLenum -> GLfloat -> m ()
gluNurbsProperty NURBSObj
nurbsObj GLenum
GLU_U_STEP GLfloat
u
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
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
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 = forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLenum -> GLfloat -> m ()
gluNurbsProperty NURBSObj
nurbsObj GLenum
GLU_AUTO_LOAD_MATRIX forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Bool -> a
marshalGLboolean
loadSamplingMatrices :: (Matrix m1, Matrix m2) => NURBSObj -> Maybe (m1 GLfloat, m2 GLfloat, (Position, Size)) -> IO ()
loadSamplingMatrices :: forall (m1 :: * -> *) (m2 :: * -> *).
(Matrix m1, Matrix m2) =>
NURBSObj
-> Maybe (m1 GLfloat, m2 GLfloat, (Position, Size)) -> IO ()
loadSamplingMatrices NURBSObj
nurbsObj =
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
forall (m :: * -> *) c a.
(Matrix m, MatrixComponent c) =>
m c -> (Ptr c -> IO a) -> IO a
withMatrixColumnMajor m1 GLfloat
mv forall a b. (a -> b) -> a -> b
$ \Ptr GLfloat
mvBuf ->
forall (m :: * -> *) c a.
(Matrix m, MatrixComponent c) =>
m c -> (Ptr c -> IO a) -> IO a
withMatrixColumnMajor m2 GLfloat
proj forall a b. (a -> b) -> a -> b
$ \Ptr GLfloat
projBuf ->
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLint
x, GLint
y, forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
w, forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
h] forall a b. (a -> b) -> a -> b
$ \Ptr GLint
viewportBuf ->
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 :: forall (m :: * -> *) c a.
(Matrix m, MatrixComponent c) =>
m c -> (Ptr c -> IO a) -> IO a
withMatrixColumnMajor m c
mat Ptr c -> IO a
act =
forall (m :: * -> *) c a.
(Matrix m, MatrixComponent c) =>
m c -> (MatrixOrder -> Ptr c -> IO a) -> IO a
withMatrix m c
mat forall a b. (a -> b) -> a -> b
$ \MatrixOrder
order Ptr c
p ->
if MatrixOrder
order forall a. Eq a => a -> a -> Bool
== MatrixOrder
ColumnMajor
then Ptr c -> IO a
act Ptr c
p
else do
[c]
elems <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 ]
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
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'
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
Ord, Int -> DisplayMode' -> ShowS
[DisplayMode'] -> ShowS
DisplayMode' -> String
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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 = forall (m :: * -> *).
MonadIO m =>
NURBSObj -> GLenum -> GLfloat -> m ()
gluNurbsProperty NURBSObj
nurbsObj GLenum
GLU_DISPLAY_MODE forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisplayMode' -> GLfloat
marshalDisplayMode'