-------------------------------------------------------------------------------- -- | -- Module : Graphics.UI.GLUT.Objects -- Copyright : (c) Sven Panne 2002-2005 -- License : BSD-style (see the file libraries/GLUT/LICENSE) -- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable -- -- GLUT includes a number of routines for generating easily recognizable 3D -- geometric objects. These routines reflect functionality available in the -- @aux@ toolkit described in the /OpenGL Programmer\'s Guide/ and are included -- in GLUT to allow the construction of simple GLUT programs that render -- recognizable objects. These routines can be implemented as pure OpenGL -- rendering routines. The routines do not generate display lists for the -- objects they create. The routines generate normals appropriate for lighting -- but do not generate texture coordinates (except for the teapot). -- -------------------------------------------------------------------------------- module Graphics.UI.GLUT.Objects ( -- * Rendering flavour Flavour(..), -- * Object description Object(..), -- * Type synonyms Sides, Rings, NumLevels, -- * Rendering renderObject ) where import Foreign.C.Types ( CInt ) import Foreign.Marshal.Utils ( with ) import Foreign.Ptr ( Ptr ) import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLint, GLdouble ) import Graphics.Rendering.OpenGL.GL.VertexSpec ( Vertex3(..) ) import Graphics.Rendering.OpenGL.GLU.Quadrics ( Radius, Height, Slices, Stacks ) import Graphics.UI.GLUT.Extensions -------------------------------------------------------------------------------- #include "HsGLUTExt.h" -------------------------------------------------------------------------------- -- | Flavour of object rendering data Flavour = -- | Object is rendered as a solid with shading and surface normals. Solid | -- | Object is rendered as a wireframe without surface normals. Wireframe deriving ( Eq, Ord, Show ) -------------------------------------------------------------------------------- -- | GLUT offers five types of objects: -- -- * The five Platonic solids, see -- . -- -- * A rhombic dodecahedron, see -- . -- -- * Approximations to rounded objects. -- -- * The classic teapot modeled by Martin Newell in 1975. Both surface normals -- and texture coordinates for the teapot are generated. The teapot is -- generated with OpenGL evaluators. -- -- * A Sierpinski sponge, see -- . data Object = -- | A cube centered at the modeling coordinates origin with sides of the -- given length. Cube Height | -- | A dodecahedron (12-sided regular solid) centered at the modeling -- coordinates origin with a radius of @sqrt 3@. Dodecahedron | -- | A icosahedron (20-sided regular solid) centered at the modeling -- coordinates origin with a radius of 1.0. Icosahedron | -- | Render a solid octahedron (8-sided regular solid) centered at the -- modeling coordinates origin with a radius of 1.0. Octahedron | -- | Render a solid tetrahedron (4-sided regular solid) centered at the -- modeling coordinates origin with a radius of @sqrt 3@. Tetrahedron | -- | (/freeglut only/) A rhombic dodecahedron whose corners are at most a -- distance of one from the origin. The rhombic dodecahedron has faces -- which are identical rhombi, but which have some vertices at which three -- faces meet and some vertices at which four faces meet. The length of -- each side is @(sqrt 3)\/2@. Vertices at which four faces meet are found -- at @(0, 0, +\/-1)@ and @(+\/-(sqrt 2)\/2, +\/-(sqrt 2)\/2, 0)@. RhombicDodecahedron | -- | A sphere centered at the modeling coordinates origin of the specified -- radius. The sphere is subdivided around the Z axis into slices -- (similar to lines of longitude) and along the Z axis into stacks -- (similar to lines of latitude). Sphere' Radius Slices Stacks | -- | A cone oriented along the Z axis. The base of the cone is placed at Z -- = 0, and the top at Z = the given height. The cone is subdivided -- around the Z axis into slices, and along the Z axis into stacks. Cone Radius Height Slices Stacks | -- |(/freeglut only/) A cylinder oriented along the Z axis. The base of the -- cylinder is placed at Z = 0, and the top at Z = the given height. The -- cylinder is subdivided around the Z axis into slices, and along the Z -- axis into stacks. Cylinder' Radius Height Slices Stacks | -- | A torus (doughnut) centered at the modeling coordinates origin -- whose axis is aligned with the Z axis. The torus is described by its -- inner and outer radius, the number of sides for each radial section, -- and the number of radial divisions (rings). Torus Radius Radius Sides Rings | -- | A teapot with a given relative size. Teapot Height | -- |(/freeglut only/) A Sierpinski sponge of a given level, where a level -- 0 sponge is the same as a 'Tetrahedron'. SierpinskiSponge NumLevels deriving ( Eq, Ord, Show ) -------------------------------------------------------------------------------- type Sides = GLint type Rings = GLint type NumLevels = GLint -------------------------------------------------------------------------------- -- | Render an object in the given flavour. renderObject :: Flavour -> Object -> IO () renderObject Solid (Cube h) = solidCube h renderObject Wireframe (Cube h) = wireCube h renderObject Solid Dodecahedron = solidDodecahedron renderObject Wireframe Dodecahedron = wireDodecahedron renderObject Solid Icosahedron = solidIcosahedron renderObject Wireframe Icosahedron = wireIcosahedron renderObject Solid Octahedron = solidOctahedron renderObject Wireframe Octahedron = wireOctahedron renderObject Solid Tetrahedron = solidTetrahedron renderObject Wireframe Tetrahedron = wireTetrahedron renderObject Solid RhombicDodecahedron = glutSolidRhombicDodecahedron renderObject Wireframe RhombicDodecahedron = glutWireRhombicDodecahedron renderObject Solid (Sphere' r s t) = solidSphere r s t renderObject Wireframe (Sphere' r s t) = wireSphere r s t renderObject Solid (Cone r h s t) = solidCone r h s t renderObject Wireframe (Cone r h s t) = wireCone r h s t renderObject Solid (Cylinder' r h s t) = glutSolidCylinder r h s t renderObject Wireframe (Cylinder' r h s t) = glutWireCylinder r h s t renderObject Solid (Torus i o s r) = solidTorus i o s r renderObject Wireframe (Torus i o s r) = wireTorus i o s r renderObject Solid (Teapot h) = solidTeapot h renderObject Wireframe (Teapot h) = wireTeapot h renderObject Solid (SierpinskiSponge n) = solidSierpinskiSponge n renderObject Wireframe (SierpinskiSponge n) = wireSierpinskiSponge n -------------------------------------------------------------------------------- -- | Render a solid cube centered at the modeling coordinates origin with sides -- of the given length. foreign import CALLCONV unsafe "glutSolidCube" solidCube :: Height -- ^ Length of the cube sides -> IO () -- | Render a wireframe cube centered at the modeling coordinates origin with -- sides of the given length. foreign import CALLCONV unsafe "glutWireCube" wireCube :: Height -- ^ Length of the cube sides -> IO () -------------------------------------------------------------------------------- -- | Render a solid dodecahedron (12-sided regular solid) centered at the -- modeling coordinates origin with a radius of @sqrt 3@. foreign import CALLCONV unsafe "glutSolidDodecahedron" solidDodecahedron :: IO () -- | Render a wireframe dodecahedron (12-sided regular solid) centered at the -- modeling coordinates origin with a radius of @sqrt 3@. foreign import CALLCONV unsafe "glutWireDodecahedron" wireDodecahedron :: IO () -------------------------------------------------------------------------------- -- | Render a solid icosahedron (20-sided regular solid) centered at the -- modeling coordinates origin with a radius of 1.0. foreign import CALLCONV unsafe "glutWireIcosahedron" wireIcosahedron :: IO () -- | Render a wireframe icosahedron (20-sided regular solid) centered at the -- modeling coordinates origin with a radius of 1.0. foreign import CALLCONV unsafe "glutSolidIcosahedron" solidIcosahedron :: IO () -------------------------------------------------------------------------------- -- | Render a solid octahedron (8-sided regular solid) centered at the modeling -- coordinates origin with a radius of 1.0. foreign import CALLCONV unsafe "glutSolidOctahedron" solidOctahedron :: IO () -- | Render a wireframe octahedron (8-sided regular solid) centered at the -- modeling coordinates origin with a radius of 1.0. foreign import CALLCONV unsafe "glutWireOctahedron" wireOctahedron :: IO () -------------------------------------------------------------------------------- -- | Render a solid tetrahedron (4-sided regular solid) centered at the modeling -- coordinates origin with a radius of @sqrt 3@. foreign import CALLCONV unsafe "glutWireTetrahedron" wireTetrahedron :: IO () -- | Render a wireframe tetrahedron (4-sided regular solid) centered at the -- modeling coordinates origin with a radius of @sqrt 3@. foreign import CALLCONV unsafe "glutSolidTetrahedron" solidTetrahedron :: IO () -------------------------------------------------------------------------------- EXTENSION_ENTRY(unsafe,"freeglut",glutSolidRhombicDodecahedron,IO ()) EXTENSION_ENTRY(unsafe,"freeglut",glutWireRhombicDodecahedron,IO ()) -------------------------------------------------------------------------------- -- | Render a solid sphere centered at the modeling coordinates origin of the -- specified radius. The sphere is subdivided around the Z axis into slices -- and along the Z axis into stacks. foreign import CALLCONV unsafe "glutSolidSphere" solidSphere :: Radius -- ^ Radius of the sphere. -> Slices -- ^ Number of subdivisions (slices) around the Z axis, similar -- to lines of longitude. -> Stacks -- ^ The number of subdivisions (stacks) along the Z axis, -- similar to lines of latitude. -> IO () -- | Render a wireframe sphere centered at the modeling coordinates origin of -- the specified radius. The sphere is subdivided around the Z axis into slices -- and along the Z axis into stacks. foreign import CALLCONV unsafe "glutWireSphere" wireSphere :: Radius -- ^ Radius of the sphere. -> Slices -- ^ Number of subdivisions (slices) around the Z axis, similar -- to lines of longitude. -> Stacks -- ^ The number of subdivisions (stacks) along the Z axis, -- similar to lines of latitude. -> IO () -------------------------------------------------------------------------------- -- | Render a solid cone oriented along the Z axis. The base of the cone is -- placed at Z = 0, and the top at Z = height. The cone is subdivided around the -- Z axis into slices, and along the Z axis into stacks. foreign import CALLCONV unsafe "glutSolidCone" solidCone :: Radius -- ^ Radius of the base of the cone. -> Height -- ^ Height of the cone. -> Slices -- ^ Number of subdivisions around the Z axis. -> Stacks -- ^ The number of subdivisions along the Z axis. -> IO () -- | Render a wireframe cone oriented along the Z axis. The base of the cone is -- placed at Z = 0, and the top at Z = height. The cone is subdivided around the -- Z axis into slices, and along the Z axis into stacks. foreign import CALLCONV unsafe "glutWireCone" wireCone :: Radius -- ^ Radius of the base of the cone. -> Height -- ^ Height of the cone. -> Slices -- ^ Number of subdivisions around the Z axis. -> Stacks -- ^ The number of subdivisions along the Z axis. -> IO () -------------------------------------------------------------------------------- EXTENSION_ENTRY(unsafe,"freeglut",glutSolidCylinder,Radius -> Height -> Slices -> Stacks -> IO ()) EXTENSION_ENTRY(unsafe,"freeglut",glutWireCylinder,Radius -> Height -> Slices -> Stacks -> IO ()) -------------------------------------------------------------------------------- -- | Render a solid torus (doughnut) centered at the modeling coordinates origin -- whose axis is aligned with the Z axis. foreign import CALLCONV unsafe "glutSolidTorus" solidTorus :: Radius -- ^ Inner radius of the torus. -> Radius -- ^ Outer radius of the torus. -> Slices -- ^ Number of sides for each radial section. -> Stacks -- ^ Number of radial divisions for the torus. -> IO () -- | Render a wireframe torus (doughnut) centered at the modeling coordinates -- origin whose axis is aligned with the Z axis. foreign import CALLCONV unsafe "glutWireTorus" wireTorus :: Radius -- ^ Inner radius of the torus. -> Radius -- ^ Outer radius of the torus. -> Slices -- ^ Number of sides for each radial section. -> Stacks -- ^ Number of radial divisions for the torus. -> IO () -------------------------------------------------------------------------------- -- | Render a solid teapot. foreign import CALLCONV unsafe "glutSolidTeapot" solidTeapot :: Height -- ^ Relative size of the teapot -> IO () -- | Render a wireframe teapot. foreign import CALLCONV unsafe "glutWireTeapot" wireTeapot :: Height -- ^ Relative size of the teapot -> IO () -------------------------------------------------------------------------------- solidSierpinskiSponge :: NumLevels -> IO () solidSierpinskiSponge = sierpinskiSponge glutSolidSierpinskiSponge EXTENSION_ENTRY(unsafe,"freeglut",glutSolidSierpinskiSponge,CInt -> Ptr (Vertex3 GLdouble) -> Height -> IO ()) wireSierpinskiSponge :: NumLevels -> IO () wireSierpinskiSponge = sierpinskiSponge glutWireSierpinskiSponge EXTENSION_ENTRY(unsafe,"freeglut",glutWireSierpinskiSponge,CInt -> Ptr (Vertex3 GLdouble) -> Height -> IO ()) -- for consistency, we hide the offset and scale on the Haskell side sierpinskiSponge :: (CInt -> Ptr (Vertex3 GLdouble) -> Height -> IO ()) -> NumLevels -> IO () sierpinskiSponge f n = with (Vertex3 0 0 0) $ \offsetBuf -> f (fromIntegral n) offsetBuf 1