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

module Graphics.Animation.Cal3D.Model
    (newModel, deleteModel
    , attachMesh
    , setLodLevel
    , setMaterialSet
    , getMixer
    , update
    , getRenderer
    )

where

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

import Graphics.Animation.Cal3D.Types
import Graphics.Animation.Cal3D.CoreModel
import Graphics.Animation.Cal3D.Error

-- | Create a new Model instance from a CoreModel.
foreign import ccall safe "newModel"
        newModel :: CoreModel -> IO Model

-- | Destroy a Model.
foreign import ccall safe "deleteModel"
        deleteModel :: Model -> IO ()

-- | Attach a mesh to a Model.
attachMesh :: Model -> MeshId -> IO (Either String ())
attachMesh model (MeshId id) = 
    checkError (c_attachMesh model id) 0 "failed to attach mesh"

foreign import ccall safe "attachMesh"
        c_attachMesh :: Model -> CInt -> IO CInt

-- | Set the level of detail for a Model (between 0 and 1).
setLodLevel :: Model -> Float -> IO ()
setLodLevel model = c_setLodLevel model . realToFrac

foreign import ccall safe "setLodLevel"
        c_setLodLevel :: Model -> CFloat -> IO ()

-- | Apply a material set to a Model.
setMaterialSet :: Model -> MaterialSetId -> IO ()
setMaterialSet model (MaterialSetId id) = 
    c_setMaterialSet model (fromIntegral id)

foreign import ccall safe "setMaterialSet"
        c_setMaterialSet :: Model -> CInt -> IO ()

-- | Get a Mixer which can animate the Model.
foreign import ccall safe "getMixer"
        getMixer :: Model -> IO Mixer

-- | Let the current animations of a Model run for a specified time.
update :: Model 
       -> Float -- ^ elapsed time in seconds
       -> IO ()
update model deltaTime = c_update model (realToFrac deltaTime)

foreign import ccall safe "update"
        c_update :: Model -> CFloat -> IO ()

-- | Get a Renderer for the Model, which can provide information
-- needed for a graphics API.
foreign import ccall safe "getRenderer"
        getRenderer :: Model -> IO Renderer