    --------------------------------------------------------------------------------
    -- |
    -- 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 ( Flavour -> Flavour -> Bool
    (Flavour -> Flavour -> Bool)
    -> (Flavour -> Flavour -> Bool) -> Eq Flavour
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Flavour -> Flavour -> Bool
    == :: Flavour -> Flavour -> Bool
    $c/= :: Flavour -> Flavour -> Bool
    /= :: Flavour -> Flavour -> Bool
    Eq, Eq Flavour
    Eq Flavour
    -> (Flavour -> Flavour -> Ordering)
    -> (Flavour -> Flavour -> Bool)
    -> (Flavour -> Flavour -> Bool)
    -> (Flavour -> Flavour -> Bool)
    -> (Flavour -> Flavour -> Bool)
    -> (Flavour -> Flavour -> Flavour)
    -> (Flavour -> Flavour -> Flavour)
    -> Ord Flavour
    Flavour -> Flavour -> Bool
    Flavour -> Flavour -> Ordering
    Flavour -> Flavour -> Flavour
    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
    $ccompare :: Flavour -> Flavour -> Ordering
    compare :: Flavour -> Flavour -> Ordering
    $c< :: Flavour -> Flavour -> Bool
    < :: Flavour -> Flavour -> Bool
    $c<= :: Flavour -> Flavour -> Bool
    <= :: Flavour -> Flavour -> Bool
    $c> :: Flavour -> Flavour -> Bool
    > :: Flavour -> Flavour -> Bool
    $c>= :: Flavour -> Flavour -> Bool
    >= :: Flavour -> Flavour -> Bool
    $cmax :: Flavour -> Flavour -> Flavour
    max :: Flavour -> Flavour -> Flavour
    $cmin :: Flavour -> Flavour -> Flavour
    min :: Flavour -> Flavour -> Flavour
    Ord, Int -> Flavour -> ShowS
    [Flavour] -> ShowS
    Flavour -> String
    (Int -> Flavour -> ShowS)
    -> (Flavour -> String) -> ([Flavour] -> ShowS) -> Show Flavour
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Flavour -> ShowS
    showsPrec :: Int -> Flavour -> ShowS
    $cshow :: Flavour -> String
    show :: Flavour -> String
    $cshowList :: [Flavour] -> ShowS
    showList :: [Flavour] -> ShowS
    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 ( Object -> Object -> Bool
    (Object -> Object -> Bool)
    -> (Object -> Object -> Bool) -> Eq Object
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Object -> Object -> Bool
    == :: Object -> Object -> Bool
    $c/= :: Object -> Object -> Bool
    /= :: Object -> Object -> Bool
    Eq, Eq Object
    Eq Object
    -> (Object -> Object -> Ordering)
    -> (Object -> Object -> Bool)
    -> (Object -> Object -> Bool)
    -> (Object -> Object -> Bool)
    -> (Object -> Object -> Bool)
    -> (Object -> Object -> Object)
    -> (Object -> Object -> Object)
    -> Ord Object
    Object -> Object -> Bool
    Object -> Object -> Ordering
    Object -> Object -> Object
    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
    $ccompare :: Object -> Object -> Ordering
    compare :: Object -> Object -> Ordering
    $c< :: Object -> Object -> Bool
    < :: Object -> Object -> Bool
    $c<= :: Object -> Object -> Bool
    <= :: Object -> Object -> Bool
    $c> :: Object -> Object -> Bool
    > :: Object -> Object -> Bool
    $c>= :: Object -> Object -> Bool
    >= :: Object -> Object -> Bool
    $cmax :: Object -> Object -> Object
    max :: Object -> Object -> Object
    $cmin :: Object -> Object -> Object
    min :: Object -> Object -> Object
    Ord, Int -> Object -> ShowS
    [Object] -> ShowS
    Object -> String
    (Int -> Object -> ShowS)
    -> (Object -> String) -> ([Object] -> ShowS) -> Show Object
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Object -> ShowS
    showsPrec :: Int -> Object -> ShowS
    $cshow :: Object -> String
    show :: Object -> String
    $cshowList :: [Object] -> ShowS
    showList :: [Object] -> ShowS
    Show )

    --------------------------------------------------------------------------------

    type Sides     = GLint
    type Rings     = GLint
    type NumLevels = GLint

    --------------------------------------------------------------------------------

    -- | Render an object in the given flavour.

    renderObject :: MonadIO m => Flavour -> Object -> m ()
    renderObject :: forall (m :: * -> *). MonadIO m => Flavour -> Object -> m ()
    renderObject Flavour
    Solid     (Cube Height
    h)             = Height -> m ()
    forall (m :: * -> *). MonadIO m => Height -> m ()
    glutSolidCube Height
    h
    renderObject Flavour
    Wireframe (Cube Height
    h)             = Height -> m ()
    forall (m :: * -> *). MonadIO m => Height -> m ()
    glutWireCube  Height
    h
    renderObject Flavour
    Solid     Object
    Dodecahedron         = m ()
    forall (m :: * -> *). MonadIO m => m ()
    glutSolidDodecahedron
    renderObject Flavour
    Wireframe Object
    Dodecahedron         = m ()
    forall (m :: * -> *). MonadIO m => m ()
    glutWireDodecahedron
    renderObject Flavour
    Solid     Object
    Icosahedron          = m ()
    forall (m :: * -> *). MonadIO m => m ()
    glutSolidIcosahedron
    renderObject Flavour
    Wireframe Object
    Icosahedron          = m ()
    forall (m :: * -> *). MonadIO m => m ()
    glutWireIcosahedron
    renderObject Flavour
    Solid     Object
    Octahedron           = m ()
    forall (m :: * -> *). MonadIO m => m ()
    glutSolidOctahedron
    renderObject Flavour
    Wireframe Object
    Octahedron           = m ()
    forall (m :: * -> *). MonadIO m => m ()
    glutWireOctahedron
    renderObject Flavour
    Solid     Object
    Tetrahedron          = m ()
    forall (m :: * -> *). MonadIO m => m ()
    glutSolidTetrahedron
    renderObject Flavour
    Wireframe Object
    Tetrahedron          = m ()
    forall (m :: * -> *). MonadIO m => m ()
    glutWireTetrahedron
    renderObject Flavour
    Solid     Object
    RhombicDodecahedron  = m ()
    forall (m :: * -> *). MonadIO m => m ()
    glutSolidRhombicDodecahedron
    renderObject Flavour
    Wireframe Object
    RhombicDodecahedron  = m ()
    forall (m :: * -> *). MonadIO m => m ()
    glutWireRhombicDodecahedron
    renderObject Flavour
    Solid     (Sphere' Height
    r Slices
    s Slices
    t)      = Height -> Slices -> Slices -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    Height -> Slices -> Slices -> m ()
    glutSolidSphere Height
    r Slices
    s Slices
    t
    renderObject Flavour
    Wireframe (Sphere' Height
    r Slices
    s Slices
    t)      = Height -> Slices -> Slices -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    Height -> Slices -> Slices -> m ()
    glutWireSphere  Height
    r Slices
    s Slices
    t
    renderObject Flavour
    Solid     (Cone Height
    r Height
    h Slices
    s Slices
    t)       = Height -> Height -> Slices -> Slices -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    Height -> Height -> Slices -> Slices -> m ()
    glutSolidCone Height
    r Height
    h Slices
    s Slices
    t
    renderObject Flavour
    Wireframe (Cone Height
    r Height
    h Slices
    s Slices
    t)       = Height -> Height -> Slices -> Slices -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    Height -> Height -> Slices -> Slices -> m ()
    glutWireCone  Height
    r Height
    h Slices
    s Slices
    t
    renderObject Flavour
    Solid     (Cylinder' Height
    r Height
    h Slices
    s Slices
    t)  = Height -> Height -> Slices -> Slices -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    Height -> Height -> Slices -> Slices -> m ()
    glutSolidCylinder Height
    r Height
    h Slices
    s Slices
    t
    renderObject Flavour
    Wireframe (Cylinder' Height
    r Height
    h Slices
    s Slices
    t)  = Height -> Height -> Slices -> Slices -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    Height -> Height -> Slices -> Slices -> m ()
    glutWireCylinder Height
    r Height
    h Slices
    s Slices
    t
    renderObject Flavour
    Solid     (Torus Height
    i Height
    o Slices
    s Slices
    r)      = Height -> Height -> Slices -> Slices -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    Height -> Height -> Slices -> Slices -> m ()
    glutSolidTorus Height
    i Height
    o Slices
    s Slices
    r
    renderObject Flavour
    Wireframe (Torus Height
    i Height
    o Slices
    s Slices
    r)      = Height -> Height -> Slices -> Slices -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    Height -> Height -> Slices -> Slices -> m ()
    glutWireTorus  Height
    i Height
    o Slices
    s Slices
    r
    renderObject Flavour
    Solid     (Teapot Height
    h)           = Height -> m ()
    forall (m :: * -> *). MonadIO m => Height -> m ()
    glutSolidTeapot Height
    h
    renderObject Flavour
    Wireframe (Teapot Height
    h)           = Height -> m ()
    forall (m :: * -> *). MonadIO m => Height -> m ()
    glutWireTeapot  Height
    h
    renderObject Flavour
    Solid     (Teacup Height
    h)           = Height -> m ()
    forall (m :: * -> *). MonadIO m => Height -> m ()
    glutSolidTeacup Height
    h
    renderObject Flavour
    Wireframe (Teacup Height
    h)           = Height -> m ()
    forall (m :: * -> *). MonadIO m => Height -> m ()
    glutWireTeacup  Height
    h
    renderObject Flavour
    Solid     (Teaspoon Height
    h)         = Height -> m ()
    forall (m :: * -> *). MonadIO m => Height -> m ()
    glutSolidTeaspoon Height
    h
    renderObject Flavour
    Wireframe (Teaspoon Height
    h)         = Height -> m ()
    forall (m :: * -> *). MonadIO m => Height -> m ()
    glutWireTeaspoon  Height
    h
    renderObject Flavour
    Solid     (SierpinskiSponge Slices
    n) = Slices -> m ()
    forall (m :: * -> *). MonadIO m => Slices -> m ()
    solidSierpinskiSponge Slices
    n
    renderObject Flavour
    Wireframe (SierpinskiSponge Slices
    n) = Slices -> m ()
    forall (m :: * -> *). MonadIO m => Slices -> m ()
    wireSierpinskiSponge Slices
    n

    --------------------------------------------------------------------------------

    solidSierpinskiSponge :: MonadIO m => NumLevels -> m ()
    solidSierpinskiSponge :: forall (m :: * -> *). MonadIO m => Slices -> m ()
    solidSierpinskiSponge = (CInt -> Ptr Height -> Height -> IO ()) -> Slices -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    (CInt -> Ptr Height -> Height -> IO ()) -> Slices -> m ()
    sierpinskiSponge CInt -> Ptr Height -> Height -> IO ()
    forall (m :: * -> *).
    MonadIO m =>
    CInt -> Ptr Height -> Height -> m ()
    glutSolidSierpinskiSponge

    wireSierpinskiSponge :: MonadIO m => NumLevels -> m ()
    wireSierpinskiSponge :: forall (m :: * -> *). MonadIO m => Slices -> m ()
    wireSierpinskiSponge = (CInt -> Ptr Height -> Height -> IO ()) -> Slices -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    (CInt -> Ptr Height -> Height -> IO ()) -> Slices -> m ()
    sierpinskiSponge CInt -> Ptr Height -> Height -> IO ()
    forall (m :: * -> *).
    MonadIO m =>
    CInt -> Ptr Height -> Height -> m ()
    glutWireSierpinskiSponge

    -- for consistency, we hide the offset and scale on the Haskell side
    sierpinskiSponge :: MonadIO m => (CInt -> Ptr GLdouble -> Height -> IO ()) -> NumLevels -> m ()
    sierpinskiSponge :: forall (m :: * -> *).
    MonadIO m =>
    (CInt -> Ptr Height -> Height -> IO ()) -> Slices -> m ()
    sierpinskiSponge CInt -> Ptr Height -> Height -> IO ()
    f Slices
    n = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $
       Vertex3 Height -> (Ptr (Vertex3 Height) -> IO ()) -> IO ()
    forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
    with (Height -> Height -> Height -> Vertex3 Height
    forall a. a -> a -> a -> Vertex3 a
    Vertex3 Height
    0 Height
    0 Height
    0) ((Ptr (Vertex3 Height) -> IO ()) -> IO ())
    -> (Ptr (Vertex3 Height) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr (Vertex3 Height)
    offsetBuf ->
          CInt -> Ptr Height -> Height -> IO ()
    f (Slices -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Slices
    n) ((Ptr (Vertex3 Height) -> Ptr Height
    forall a b. Ptr a -> Ptr b
    castPtr :: Ptr (Vertex3 GLdouble) -> Ptr GLdouble) Ptr (Vertex3 Height)
    offsetBuf) Height
    1