{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} module Graphics.LambdaCube.Entity where import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe --import qualified Data.Set as Set import Graphics.LambdaCube.Types import Graphics.LambdaCube.Mesh import Graphics.LambdaCube.AnimationState import Graphics.LambdaCube.VertexIndexData import Graphics.LambdaCube.Material import Graphics.LambdaCube.RenderQueue import Graphics.LambdaCube.RenderSystem import Graphics.LambdaCube.RenderOperation import Graphics.LambdaCube.Technique import Graphics.LambdaCube.HardwareVertexBuffer import Graphics.LambdaCube.HardwareIndexBuffer import Graphics.LambdaCube.Texture import Graphics.LambdaCube.GpuProgram {-| Utility class which defines the sub-parts of an Entity. @remarks Just as meshes are split into submeshes, an Entity is made up of potentially multiple SubMeshes. These are mainly here 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. @par The SubEntity also allows the application some flexibility in the material properties for this section of a particular instance of this Mesh, e.g. tinting the windows on a car model. @par SubEntity instances are never created manually. They are created at the same time as their parent Entity by the SceneManager method createEntity. -} 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. -- , seVisible :: Bool -- ^ Is this SubEntity visible? -- , seMaterialLodIndex :: Int -- ^ The LOD number of the material to use, calculated by Entity::_notifyCurrentCamera -- , seSkelAnimVertexData :: VertexData -- ^ blend buffer details for dedicated geometry -- | Quick lookup of buffers -- TODO: TempBlendedBufferInfo mTempSkelAnimInfo; -- | Temp buffer details for software Vertex anim geometry -- TODO: TempBlendedBufferInfo mTempVertexAnimInfo; -- , seSoftwareVertexAnimVertexData :: VertexData -- ^ Vertex data details for software Vertex anim of shared geometry {-| Vertex data details for hardware Vertex anim of shared geometry - separate since we need to s/w anim for shadows whilst still altering the vertex data for hardware morphing (pos2 binding) -} -- , seHardwareVertexAnimVertexData :: VertexData -- , seVertexAnimationAppliedThisFrame :: Bool -- ^ Have we applied any vertex animation to geometry? -- , seHardwarePoseCount :: Int -- ^ Number of hardware blended poses supported by material -- | Cached distance to last camera for getSquaredViewDepth -- TODO: , seCachedCameraDist :: FloatType -- | The camera for which the cached distance is valid -- TODO: , seCachedCamera :: Camera } {-| Defines an instance of a discrete, movable object based on a Mesh. @remarks Ogre generally divides renderable objects into 2 groups, discrete (separate) and relatively small objects which move around the world, and large, sprawling geometry which makes up generally immovable scenery, aka 'level geometry'. @par The Mesh and SubMesh classes deal with the definition of the geometry used by discrete movable objects. Entities are actual instances of objects based on this geometry in the world. Therefore there is usually a single set Mesh for a car, but there may be multiple entities based on it in the world. Entities are able to override aspects of the Mesh it is defined by, such as changing material properties per instance (so you can have many cars using the same geometry but different textures for example). Because a Mesh is split into SubMeshes for this purpose, the Entity class is a grouping class (much like the Mesh class) and much of the detail regarding individual changes is kept in the SubEntity class. There is a 1:1 relationship between SubEntity instances and the SubMesh instances associated with the Mesh the Entity is based on. @par Entity and SubEntity classes are never created directly. Use the createEntity method of the SceneManager (passing a model name) to create one. @par Entities are included in the scene by associating them with a SceneNode, using the attachEntity method. See the SceneNode class for full information. @note No functions were declared virtual to improve performance. -} ---------- new code below ----------- {-| Nested class to allow entity shadows. -} {- class _OgreExport EntityShadowRenderable : public ShadowRenderable { protected: Entity* mParent; -- Shared link to position buffer HardwareVertexBufferSharedPtr mPositionBuffer; -- Shared link to w-coord buffer (optional) HardwareVertexBufferSharedPtr mWBuffer; -- Link to current vertex data used to bind (maybe changes) const VertexData* mCurrentVertexData; -- Original position buffer source binding unsigned short mOriginalPosBufferBinding; -- | Link to SubEntity, only present if SubEntity has it's own geometry SubEntity* mSubEntity; public: EntityShadowRenderable(Entity* parent, HardwareIndexBufferSharedPtr* indexBuffer, const VertexData* vertexData, bool createSeparateLightCap, SubEntity* subent, bool isLightCap = false); ~EntityShadowRenderable(); -- | Overridden from ShadowRenderable void getWorldTransforms(Matrix4* xform) const; HardwareVertexBufferSharedPtr getPositionBuffer(void) { return mPositionBuffer; } HardwareVertexBufferSharedPtr getWBuffer(void) { return mWBuffer; } -- | Rebind the source positions (for temp buffer users) void rebindPositionBuffer(const VertexData* vertexData, bool force); -- | Overridden from ShadowRenderable bool isVisible(void) const; }; -} -- | Identify which vertex data we should be sending to the renderer 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 { -- MovableObject attributes -- TODO: add all attrs enName :: String , enRenderQueue :: Int -- Own attributes , enMesh :: Mesh vb ib , enSubEntityList :: [SubEntity vb ib t lp] -- TODO , enAnimationState :: AnimationStateSet -- ^ State of animation for animable meshes -- TODO , enTempSkelAnimInfo :: TempBlendedBufferInfo -- ^ Temp buffer details for software skeletal anim of shared geometry -- TODO , enSkelAnimVertexData :: VertexData -- ^ Vertex data details for software skeletal anim of shared geometry -- TODO , enTempVertexAnimInfo :: TempBlendedBufferInfo -- ^ Temp buffer details for software vertex anim of shared geometry -- TODO , enSoftwareVertexAnimVertexData :: VertexData -- ^ Vertex data details for software vertex anim of shared geometry -- | Vertex data details for hardware vertex anim of shared geometry -- | - separate since we need to s/w anim for shadows whilst still altering -- | the vertex data for hardware morphing (pos2 binding) -- TODO , enHardwareVertexAnimVertexData :: VertexData -- TODO , enVertexAnimationAppliedThisFrame :: Bool -- ^ Have we applied any vertex animation to shared geometry? -- , enPreparedForShadowVolumes :: Bool -- ^ Have the temp buffers already had their geometry prepared for use in rendering shadow volumes? -- TODO , enBoneWorldMatrices :: Matrix4 -- ^ Cached bone matrices, including any world transform -- TODO , enBoneMatrices :: Matrix4 -- ^ Cached bone matrices in skeleton local space, might shares with other entity instances. -- TODO , enNumBoneMatrices :: Int -- , enFrameAnimationLastUpdated :: Int -- ^ Records the last frame in which animation was updated -- | Records the last frame in which the bones was updated -- | It's a pointer because it can be shared between different entities with -- | a shared skeleton. -- , enFrameBonesLastUpdated :: Int {-| * A set of all the entities which shares a single SkeletonInstance. * This is only created if the entity is in fact sharing it's SkeletonInstance with * other Entities. -} -- TODO , enSharedSkeletonEntities :: Set Entity -- TODO , enDisplaySkeleton :: Bool -- ^ Flag determines whether or not to display skeleton -- TODO , enHardwareAnimation :: Bool -- ^ Flag indicating whether hardware animation is supported by this entities materials -- TODO , enHardwarePoseCount :: Bool -- ^ Number of hardware poses supported by materials -- , enVertexProgramInUse :: Bool -- ^ Flag indicating whether we have a vertex program in use on any of our subentities -- TODO , enSoftwareAnimationRequests :: Int -- ^ Counter indicating number of requests for software animation. -- TODO , enSoftwareAnimationNormalsRequests :: Int -- ^ Counter indicating number of requests for software blended normals. -- TODO , enSkipAnimStateUpdates :: Bool -- ^ Flag indicating whether to skip automatic updating of the Skeleton's AnimationState -- , enMeshLodIndex :: Int -- ^ The LOD number of the mesh to use, calculated by _notifyCurrentCamera -- , enMeshLodFactorTransformed :: FloatType -- ^ LOD bias factor, transformed for optimisation when calculating adjusted lod value -- , enMinMeshLodIndex :: Int -- ^ Index of minimum detail LOD (NB higher index is lower detail) -- , enMaxMeshLodIndex :: Int -- ^ Index of maximum detail LOD (NB lower index is higher detail) -- , enMaterialLodFactor :: FloatType -- ^ LOD bias factor, not transformed -- , enMaterialLodFactorTransformed :: FloatType -- ^ LOD bias factor, transformed for optimisation when calculating adjusted lod value -- , enMinMaterialLodIndex :: Int -- ^ Index of minimum detail LOD (NB higher index is lower detail) -- , enMaxMaterialLodIndex :: Int -- ^ Index of maximum detail LOD (NB lower index is higher detail) {-| List of LOD Entity instances (for manual LODs). We don't know when the mesh is using manual LODs whether one LOD to the next will have the same number of SubMeshes, therefore we have to allow a separate Entity list with each alternate one. -} -- , enLodEntityList :: [Entity] -- TODO: , enSkeletonInstance :: SkeletonInstance -- ^ This Entity's personal copy of the skeleton, if skeletally animated -- , enInitialised :: Bool -- ^ Has this entity been initialised yet? -- , enLastParentXform :: Matrix4 -- ^ Last parent xform -- , enMeshStateCount :: Int -- ^ Mesh state count, used to detect differences -- TODO: , enChildObjectList :: Map String MovableObject -- ^ Contains the child objects (attached to bones) indexed by name -- TODO: , enFullBoundingBox :: AxisAlignedBox -- ^ Bounding box that 'contains' all the mesh of each child entity -- TODO: , enShadowRenderables :: [ShadowRenderable] } instance (HardwareVertexBuffer vb, HardwareIndexBuffer ib, Texture t, LinkedGpuProgram lp) => Renderable (Entity vb ib t lp) vb ib t lp where prepare = prepareEntity prepareEntity m ent = map mkRenderEntity (enSubEntityList ent) where mkRenderEntity e = RenderEntity { rePassList = fromMaybe [] (fmap (tchPasses . head) (mtSupportedTechniques (seMaterial e))) , reOperation = mkOperation . seSubMesh $ e , reMatrix = m } 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 }