Entity.hs

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module Graphics.LambdaCube.Entity where

import Data.Maybe

--import Graphics.LambdaCube.AnimationState
import Graphics.LambdaCube.GpuProgram
import Graphics.LambdaCube.HardwareIndexBuffer
import Graphics.LambdaCube.HardwareVertexBuffer
import Graphics.LambdaCube.Material
import Graphics.LambdaCube.Mesh
import Graphics.LambdaCube.RenderOperation
import Graphics.LambdaCube.RenderSystem
import Graphics.LambdaCube.Technique
import Graphics.LambdaCube.Texture
import Graphics.LambdaCube.Types

-- | The sub-parts of an Entity. Its primary function is to provide
-- the link between the Material which the SubEntity uses (which may
-- be the default Material for the SubMesh or may have been changed
-- for this object) and the SubMesh data.
data (HardwareVertexBuffer vb, HardwareIndexBuffer ib, Texture t, LinkedGpuProgram lp) => SubEntity vb ib t lp
    = SubEntity
    { seMaterial :: Material t lp  -- ^ Cached pointer to material.
    , seSubMesh  :: SubMesh vb ib  -- ^ Pointer to the SubMesh defining geometry.
    }

data VertexDataBindChoice
    = BIND_ORIGINAL
    | BIND_SOFTWARE_SKELETAL
    | BIND_SOFTWARE_MORPH
    | BIND_HARDWARE_MORPH

data (HardwareVertexBuffer vb, HardwareIndexBuffer ib, Texture t, LinkedGpuProgram lp) => Entity vb ib t lp
    = Entity
    { enName          :: String
    , enRenderQueue   :: Int
    , enMesh          :: Mesh vb ib
    , enSubEntityList :: [SubEntity vb ib t lp]
    }

instance (HardwareVertexBuffer vb, HardwareIndexBuffer ib, Texture t, LinkedGpuProgram lp) => Renderable (Entity vb ib t lp) vb ib t lp where
    prepare = prepareEntity

prepareEntity :: (HardwareIndexBuffer ib, HardwareVertexBuffer vb, Texture t, LinkedGpuProgram lp) => Proj4 -> Entity vb ib t lp -> [RenderEntity vb ib t lp]
prepareEntity m ent = map mkRenderEntity (enSubEntityList ent)
  where
    boundRadius = msBoundRadius $ enMesh ent
    mkRenderEntity e = RenderEntity
        { rePassList    = fromMaybe [] (fmap (tchPasses . head) (mtSupportedTechniques (seMaterial e)))
        , reOperation   = mkOperation . seSubMesh $ e
        , reMatrix      = m
        , reBoundRadius = boundRadius
        }

    mkOperation sm = RenderOperation
        { roVertexData      = case smVertexData sm of
                                Just vd -> vd
                                Nothing -> fromMaybe (error "fromJust 11") . msSharedVertexData . enMesh $ ent
        , roOperationType   = smOperationType sm
        , roIndexData       = smIndexData sm
        }