GLUT-2.7.0.13: src/Graphics/UI/GLUT/Objects.hs
--------------------------------------------------------------------------------
-- |
-- Module : Graphics.UI.GLUT.Objects
-- Copyright : (c) Sven Panne 2002-2018
-- License : BSD3
--
-- Maintainer : Sven Panne <svenpanne@gmail.com>
-- 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 solid teapot, teacup
-- and teaspoon). If VBOs should be used instead of the fixed function pipeline,
-- specify at least one of the attribute locations
-- 'Graphics.UI.GLUT.State.vertexAttribCoord3' or
-- 'Graphics.UI.GLUT.State.vertexAttribNormal'.
--
--------------------------------------------------------------------------------
module Graphics.UI.GLUT.Objects (
-- * Rendering flavour
Flavour(..),
-- * Object description
Object(..),
-- * Type synonyms
Sides, Rings, NumLevels,
-- * Rendering
renderObject
) where
import Control.Monad.IO.Class ( MonadIO(..) )
import Foreign.C.Types ( CInt )
import Foreign.Marshal.Utils ( with )
import Foreign.Ptr ( Ptr, castPtr )
import Graphics.Rendering.OpenGL (
Height, Radius, Slices, Stacks, Vertex3(..), GLdouble, GLint )
import Graphics.UI.GLUT.Raw
--------------------------------------------------------------------------------
-- | 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
-- <http://mathworld.wolfram.com/PlatonicSolid.html>.
--
-- * A rhombic dodecahedron, see
-- <http://mathworld.wolfram.com/RhombicDodecahedron.html>.
--
-- * Approximations to rounded objects.
--
-- * The classic teaset modeled by Martin Newell in 1975. Both surface normals
-- and texture coordinates for the teaset are generated.
--
-- * A Sierpinski sponge, see
-- <http://mathworld.wolfram.com/Tetrix.html>.
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 teacup with a given relative size.
Teacup Height
| -- |(/freeglut only/) A teaspoon with a given relative size.
Teaspoon 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 :: MonadIO m => Flavour -> Object -> m ()
renderObject Solid (Cube h) = glutSolidCube h
renderObject Wireframe (Cube h) = glutWireCube h
renderObject Solid Dodecahedron = glutSolidDodecahedron
renderObject Wireframe Dodecahedron = glutWireDodecahedron
renderObject Solid Icosahedron = glutSolidIcosahedron
renderObject Wireframe Icosahedron = glutWireIcosahedron
renderObject Solid Octahedron = glutSolidOctahedron
renderObject Wireframe Octahedron = glutWireOctahedron
renderObject Solid Tetrahedron = glutSolidTetrahedron
renderObject Wireframe Tetrahedron = glutWireTetrahedron
renderObject Solid RhombicDodecahedron = glutSolidRhombicDodecahedron
renderObject Wireframe RhombicDodecahedron = glutWireRhombicDodecahedron
renderObject Solid (Sphere' r s t) = glutSolidSphere r s t
renderObject Wireframe (Sphere' r s t) = glutWireSphere r s t
renderObject Solid (Cone r h s t) = glutSolidCone r h s t
renderObject Wireframe (Cone r h s t) = glutWireCone 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) = glutSolidTorus i o s r
renderObject Wireframe (Torus i o s r) = glutWireTorus i o s r
renderObject Solid (Teapot h) = glutSolidTeapot h
renderObject Wireframe (Teapot h) = glutWireTeapot h
renderObject Solid (Teacup h) = glutSolidTeacup h
renderObject Wireframe (Teacup h) = glutWireTeacup h
renderObject Solid (Teaspoon h) = glutSolidTeaspoon h
renderObject Wireframe (Teaspoon h) = glutWireTeaspoon h
renderObject Solid (SierpinskiSponge n) = solidSierpinskiSponge n
renderObject Wireframe (SierpinskiSponge n) = wireSierpinskiSponge n
--------------------------------------------------------------------------------
solidSierpinskiSponge :: MonadIO m => NumLevels -> m ()
solidSierpinskiSponge = sierpinskiSponge glutSolidSierpinskiSponge
wireSierpinskiSponge :: MonadIO m => NumLevels -> m ()
wireSierpinskiSponge = sierpinskiSponge glutWireSierpinskiSponge
-- for consistency, we hide the offset and scale on the Haskell side
sierpinskiSponge :: MonadIO m => (CInt -> Ptr GLdouble -> Height -> IO ()) -> NumLevels -> m ()
sierpinskiSponge f n = liftIO $
with (Vertex3 0 0 0) $ \offsetBuf ->
f (fromIntegral n) ((castPtr :: Ptr (Vertex3 GLdouble) -> Ptr GLdouble) offsetBuf) 1