CoreModel.hs

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

{- | A 'CoreModel' is a model type from which many instance 'Model's can be
created.  For example, there could be a clown CoreModel and many
individual clown instances.  The CoreModel contains data shared
by its instances:

* A single skeleton

* One or more meshes, represented by 'MeshId's

* One or more animations, represented by 'AnimationId's

* One or more materials, represented by 'MaterialId's
 
Each of these may be loaded from a file by the
appropriate loader function, for example, 'loadCoreSkeleton'.

Materials of the CoreModel are organized by "sets" and "threads."
Within a material set, represented by a 'MaterialSetId', all materials
have the same appearance, such as metal or wood.  
Each material thread, represented by a 'MaterialThreadId',
is associated with a particular part of the model, such as head or arm.
Changing material sets of a model (instance) is a convenient way
of changing the character's costume or over-all look.
-}

module Graphics.Animation.Cal3D.CoreModel
    (newCoreModel, deleteCoreModel
    , loadCoreSkeleton
    , loadCoreAnimation
    , loadCoreMesh
    , loadCoreMaterial
    , createCoreMaterialThread
    , setCoreMaterialId
    )

where

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

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

-- | Create a CoreModel
newCoreModel :: String          -- ^ name
             -> IO CoreModel
newCoreModel name = withCString name c_newCoreModel

foreign import ccall safe "newCoreModel"
        c_newCoreModel :: CString -> IO CoreModel

-- | Destroy a CoreModel
foreign import ccall safe "deleteCoreModel"
        deleteCoreModel :: CoreModel -> IO ()

-- | Load a core skeleton from a file.
loadCoreSkeleton :: CoreModel -> FilePath -> LoadResult ()
loadCoreSkeleton coreModel path = 
  -- This is like loader, below, except that "bad" values are 0 
  -- instead of -1, and there's no wrapper (?)
  checkError (withCString path (c_loadCoreSkeleton coreModel))
             0
             ("loadCoreSkeleton: unable to load " ++ path)

foreign import ccall safe "loadCoreSkeleton" c_loadCoreSkeleton :: CLoader

-- loader c_load fname wrapper:
-- given a C function such as c_loadCoreMaterial, 
-- a String to name the load function, and
-- a wrapper function for the result such as MaterialId,
-- or id if you don't care to wrap,
-- returns a loader: that is, a function that takes a file path 
-- and returns a (LoadResult a).

loader :: CLoader -> String -> (CInt -> a) -> Loader a
loader c_load loaderName wrap =
    (\ coreModel path -> do
       {
         id <- withCString path (c_load coreModel)
       ; return (if id == (-1)
                 then Left $ loaderName ++ ": unable to load " ++ path
                 else Right (wrap id))
       }
    )


-- | Load a core animation from a file
loadCoreAnimation :: Loader AnimationId
loadCoreAnimation = loader c_loadCoreAnimation "loadCoreAnimation" AnimationId

foreign import ccall safe "loadCoreAnimation" c_loadCoreAnimation :: CLoader

-- | Load a core mesh from a file
loadCoreMesh :: Loader MeshId
loadCoreMesh = loader c_loadCoreMesh "loadCoreMesh" MeshId

foreign import ccall safe "loadCoreMesh" c_loadCoreMesh :: CLoader

-- | Load a core material from a file
loadCoreMaterial :: Loader MaterialId
loadCoreMaterial = loader c_loadCoreMaterial "loadCoreMaterial" MaterialId

foreign import ccall safe "loadCoreMaterial" c_loadCoreMaterial :: CLoader

-- | Create a core material thread.
   
createCoreMaterialThread :: CoreModel -> MaterialThreadId -> 
                            IO (Either String ())
createCoreMaterialThread coreModel (MaterialThreadId id) = 
    checkError (c_createCoreMaterialThread coreModel (fromIntegral id))
               0
               ("createCoreMaterialThread failed with id " ++ (show id))

foreign import ccall safe "createCoreMaterialThread"
        c_createCoreMaterialThread :: CoreModel -> CInt -> IO CInt

-- | Apply the material identified by a material thread and material set.
setCoreMaterialId :: CoreModel -> MaterialThreadId -> MaterialSetId ->
                     MaterialId -> IO (Either String ())

setCoreMaterialId coreModel 
                  (MaterialThreadId mthreadId)
                  (MaterialSetId msetId) 
                  (MaterialId matlId) = 
  checkError (c_setCoreMaterialId coreModel 
              (fromIntegral mthreadId)
              (fromIntegral msetId)
              (fromIntegral matlId))
             0
             ("setCoreMaterialId failed with ids " ++
              (show (mthreadId, msetId, matlId)))

foreign import ccall safe "setCoreMaterialId"
        c_setCoreMaterialId :: CoreModel -> CInt -> CInt -> CInt -> IO CInt