lambdacube-bullet-0.1.1: src/BulletUtils.hs

module BulletUtils where

import Data.Maybe
import Foreign
import Foreign.C.Types
import Control.Monad

import qualified Data.IntMap as IntMap

import Physics.Bullet

import Graphics.LambdaCube

--mkTriangleMeshInterface :: Mesh -> IO PlMeshInterfaceHandle
mkTriangleMeshInterface mesh = do
    mi <- plNewMeshInterface
    --  add triangles to mesh interface
    forM_ (msSubMeshList mesh) $ \ sm -> when (isJust $ smIndexData sm) $ case (smOperationType sm) of
        { OT_TRIANGLE_LIST  -> do
            -- get pointer to position vertex attribute container array
            let Just vd = if isNothing (smVertexData sm) then msSharedVertexData mesh else smVertexData sm
                posve   = head $ filter ((VES_POSITION ==) . veSemantic) $ vdElementList $ vdVertexDeclaration vd
                vb      = (vbbBindingMap $ vdVertexBufferBinding vd) IntMap.! (veSource posve)
                id      = fromJust $ smIndexData sm
                ib      = idIndexBuffer id
            -- lock vb and ib for reading
                offs    = veOffset posve
                stride  = getVertexSize vb
                numtris = getNumIndexes ib `div` 3
                idxsize = getIndexSize ib
            pb <- lock vb offs (getSizeInBytes vb - offs) HBL_READ_ONLY
            idxb <- lock ib 0 (getSizeInBytes ib) HBL_READ_ONLY
            let getIndex i = case getIndexType ib of
                    { IT_16BIT  -> do
                        let p :: Ptr Word16
                            p = castPtr idxb
                        v <- peekElemOff p i
                        return $ fromIntegral v
                    ; IT_32BIT  -> do
                        let p :: Ptr Word32
                            p = castPtr idxb
                        v <- peekElemOff p i
                        return $ fromIntegral v
                    }
                getVertex i = do
                    let p :: Ptr CFloat
                        p = plusPtr pb $ i * stride
                    [x,y,z] <- peekArray 3 p
                    return (x,y,z)
            -- pass through buffer and process triangles
            forM_ [0..(numtris-1)] $ \ ioffs -> do
                v0 <- getVertex =<< getIndex (3 * ioffs)
                v1 <- getVertex =<< getIndex (3 * ioffs + 1)
                v2 <- getVertex =<< getIndex (3 * ioffs + 2)
                plAddTriangle mi v0 v1 v2 True
            unlock vb
            unlock ib
        -- TODO: OT_TRIANGLE_STRIP, OT_TRIANGLE_FAN
        ; _ -> return ()
        }
    return mi        

mkStaticTriangleMeshShape mesh = do
    plNewStaticTriangleMeshShape =<< mkTriangleMeshInterface mesh

mkGimpactTriangleMeshShape mesh = do
    plNewGimpactTriangleMeshShape =<< mkTriangleMeshInterface mesh

mkConvexTriangleMeshShape mesh = do
    plNewConvexTriangleMeshShape =<< mkTriangleMeshInterface mesh