{-# LANGUAGE ForeignFunctionInterface #-}
{-# INCLUDE "cal3d_c.h" #-}

{- |Most (possibly all) data type declarations are collected
   here, in order to avoid mutually recursive modules,
   like where module Model needs data 'Mixer' from module Mixer,
   and module Mixer needs data 'Model' from module Model.
-}

module Graphics.Animation.Cal3D.Types
    (
     CoreModel
    , LoadResult, Loader, CLoader
    , AnimationId(AnimationId)
    , MeshId(MeshId)
    , MaterialId(MaterialId)
    , MaterialThreadId(..)
    , MaterialSetId(..)
    , Model
    , Mixer
    , Renderer
    )

where

import Foreign
import Foreign.C.Types
import Foreign.C.String

{- | A CoreModel is a type which may have multiple 
instances ('Model's).  See "Graphics.Animation.Cal3D.Model". -}
newtype CoreModel = CoreModel (Ptr CoreModel)

type CLoader = CoreModel -> CString -> IO CInt

-- | A function that loads something from a file.
type Loader a = CoreModel -> FilePath -> LoadResult a

-- | LoadResult is (Left error_message) or (Right thing_loaded_from_file)  
type LoadResult a = IO (Either String a)

-- | Identifies an animation.
newtype AnimationId = AnimationId CInt

-- | Identifies a mesh.
newtype MeshId = MeshId CInt
    deriving (Show, Eq)

-- | Identifies a material.
newtype MaterialId = MaterialId CInt

-- | Identifies a material thread.
data MaterialThreadId = MaterialThreadId Int

-- | Identifies a material set.
data MaterialSetId = MaterialSetId Int

{- | A Model is an \"instance\" of a 'CoreModel'.  
See "Graphics.Animation.Cal3D.Model". -}
newtype Model = Model (Ptr Model)

{- | A Mixer can blend simultaneous animations and play them.
See "Graphics.Animation.Cal3D.Mixer". -}
newtype Mixer = Mixer (Ptr Mixer)

{- | A Renderer provides data needed for graphics rendering.
Cal3D does no rendering itself; the Renderer simply provides
the needed information for a graphics API such as OpenGL.
See "Graphics.Animation.Cal3D.Renderer"; 
also see the cal3d-opengl package. -}
newtype Renderer = Renderer (Ptr Renderer)