From e114024b8123bf035ee5a3a65a1cbb213d714494 Mon Sep 17 00:00:00 2001 From: Marc Sunet Date: Tue, 28 Aug 2012 22:09:36 +0200 Subject: Added model boxes. + Added modelBoxes function. + Added boxes to model resources. - AnimatedModelResource no longer updatable. + Added update function to AnimatedModel. --- Spear.cabal | 29 ++++----- Spear.lkshs | 14 ++--- Spear.lkshw | 2 +- Spear/Assets/Model.hsc | 139 +++++++++++++++++++++++++++++++----------- Spear/Assets/Model/Model.c | 27 ++++++++ Spear/Assets/Model/Model.h | 3 + Spear/Render/AnimatedModel.hs | 29 +++++---- Spear/Render/StaticModel.hs | 7 ++- 8 files changed, 179 insertions(+), 71 deletions(-) diff --git a/Spear.cabal b/Spear.cabal index ffe11dc..254f181 100644 --- a/Spear.cabal +++ b/Spear.cabal @@ -16,24 +16,25 @@ library StateVar -any, base -any, bytestring -any, directory -any, mtl -any, transformers -any, resourcet -any, parsec >=3.1.3, containers -any, vector -any, array -any - exposed-modules: Spear.Math.QuadTree Spear.Physics.Types Spear.App - Spear.App.Application Spear.App.Input Spear.Assets.Image - Spear.Assets.Model Spear.Collision Spear.Math.AABB - Spear.Collision.Collision Spear.Collision.Collisioner - Spear.Math.Circle Spear.Math.Triangle Spear.Collision.Types - Spear.Game Spear.GLSL Spear.GLSL.Buffer Spear.GLSL.Error - Spear.GLSL.Management Spear.GLSL.Texture Spear.GLSL.Uniform - Spear.GLSL.VAO Spear.Math.Camera Spear.Math.Entity - Spear.Math.Matrix3 Spear.Math.Matrix4 Spear.Math.MatrixUtils - Spear.Math.Plane Spear.Math.Quaternion Spear.Math.Spatial - Spear.Math.Vector3 Spear.Math.Vector4 Spear.Physics - Spear.Physics.Rigid Spear.Render.AnimatedModel + exposed-modules: Spear.Scene.GameObject Spear.Math.QuadTree + Spear.Physics.Types Spear.App Spear.App.Application Spear.App.Input + Spear.Assets.Image Spear.Assets.Model Spear.Collision + Spear.Math.AABB Spear.Collision.Collision + Spear.Collision.Collisioner Spear.Math.Circle Spear.Math.Triangle + Spear.Collision.Types Spear.Game Spear.GLSL Spear.GLSL.Buffer + Spear.GLSL.Error Spear.GLSL.Management Spear.GLSL.Texture + Spear.GLSL.Uniform Spear.GLSL.VAO Spear.Math.Camera + Spear.Math.Entity Spear.Math.Matrix3 Spear.Math.Matrix4 + Spear.Math.MatrixUtils Spear.Math.Plane Spear.Math.Quaternion + Spear.Math.Spatial Spear.Math.Vector3 Spear.Math.Vector4 + Spear.Physics Spear.Physics.Rigid Spear.Render.AnimatedModel Spear.Render.Material Spear.Render.Model Spear.Render.Program Spear.Render.Renderable Spear.Render.StaticModel Spear.Render.Texture Spear.Scene.Graph Spear.Scene.Light Spear.Scene.Loader Spear.Scene.Scene Spear.Scene.SceneResources Spear.Setup Spear.Sys.Timer Spear.Sys.Store Spear.Sys.Store.ID - Spear.Updatable Spear.Math.Vector2 + Spear.Updatable Spear.Math.Vector2 Spear.Math.Quad Spear.Math.Ray + Spear.Math.Segment Spear.Math.Utils exposed: True buildable: True build-tools: hsc2hs -any @@ -56,4 +57,4 @@ library Spear/Sys hs-source-dirs: . ghc-options: -O2 -rtsopts - + \ No newline at end of file diff --git a/Spear.lkshs b/Spear.lkshs index 2663b79..8ff60d0 100644 --- a/Spear.lkshs +++ b/Spear.lkshs @@ -1,18 +1,18 @@ Version of session file format: 1 Time of storage: - "Tue Aug 28 18:24:30 CEST 2012" -Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = -1, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [("Browser",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 240) 199)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 696) 954 -Population: [(Just (ErrorsSt ErrorsState),[SplitP RightP,SplitP TopP]),(Just (FilesSt FilesState),[SplitP RightP,SplitP TopP]),(Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (ModulesSt (ModulesState 328 (PackageScope False,False) (Nothing,Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([[0]],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP TopP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP])] + "Tue Aug 28 22:08:10 CEST 2012" +Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 3, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [("Browser",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 308) 194)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 683) 954 +Population: [(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Render/AnimatedModel.hs" 247)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Collision/Collision.hs" 2235)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Collision/Collisioner.hs" 1019)),[SplitP LeftP]),(Just (ErrorsSt ErrorsState),[SplitP RightP,SplitP TopP]),(Just (FilesSt FilesState),[SplitP RightP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Scene/GameObject.hs" 1898)),[SplitP LeftP]),(Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (ModulesSt (ModulesState 328 (PackageScope False,False) (Just (ModuleName ["Spear","Collision","Collision"]),Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([[0,7],[0,4],[0,1],[0]],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP TopP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP])] Window size: (1820,939) Completion size: - (750,400) + (750,399) Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" -Active pane: Just "Modules" +Active pane: Just "GameObject.hs" Toolbar visible: True -FindbarState: (False,FindState {entryStr = "asad", entryHist = ["asad","Octree","idxs","asd","elemIndexa","elemtIn","splitAt","allocaBytes","copyArray","allocaArray","allocaa","putStrLn"], replaceStr = "QuadTree", replaceHist = [], caseSensitive = True, entireWord = False, wrapAround = False, regex = False, lineNr = 1}) +FindbarState: (False,FindState {entryStr = "asd", entryHist = ["copy_tr","asad","Octree","idxs","asd","elemIndexa","elemtIn","splitAt","allocaBytes","copyArray","allocaArray","allocaa"], replaceStr = "QuadTree", replaceHist = [], caseSensitive = True, entireWord = False, wrapAround = False, regex = False, lineNr = 1}) Recently opened files: - ["/home/jeanne/programming/haskell/Spear/Spear/Math/AABB.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Circle.hs","/home/jeanne/programming/haskell/Spear/Spear/Collision/Collision.hs","/home/jeanne/programming/haskell/Spear/Spear/Collision/Collisioner.hs","/home/jeanne/programming/haskell/Spear/Spear/Scene/Scene.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/QuadTree.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Sphere.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Triangle.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Spatial.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Quaternion.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Plane.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Octree.hs"] + ["/home/jeanne/programming/haskell/Spear/Spear/Collision/Collision.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Matrix3.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/AABB.hs","/home/jeanne/programming/haskell/Spear/Spear/Render/Texture.hs","/home/jeanne/programming/haskell/Spear/Spear/Render/Program.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Factory.hs","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model.hsc","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.h","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.c","/home/jeanne/programming/haskell/Spear/Spear/App/Input.hs","/home/jeanne/programming/haskell/Spear/Spear/Scene/SceneResources.hs","/home/jeanne/programming/haskell/Spear/Spear/Render/StaticModel.hs"] Recently opened workspaces: ["/home/jeanne/programming/haskell/hagen/hagen.lkshw","/home/jeanne/programming/haskell/foo/foo.lkshw","/home/jeanne/programming/haskell/Spear/Spear.lkshw","/home/jeanne/programming/haskell/nexus/nexus.lkshw","/home/jeanne/leksah.lkshw"] \ No newline at end of file diff --git a/Spear.lkshw b/Spear.lkshw index 5345907..b41cb88 100644 --- a/Spear.lkshw +++ b/Spear.lkshw @@ -1,7 +1,7 @@ Version of workspace file format: 1 Time of storage: - "Tue Aug 28 17:23:50 CEST 2012" + "Tue Aug 28 21:08:58 CEST 2012" Name of the workspace: "Spear" File paths of contained packages: diff --git a/Spear/Assets/Model.hsc b/Spear/Assets/Model.hsc index b7cb90d..1b01062 100644 --- a/Spear/Assets/Model.hsc +++ b/Spear/Assets/Model.hsc @@ -3,9 +3,11 @@ module Spear.Assets.Model ( -- * Data types - Vec3(..) + Vec2(..) +, Vec3(..) , TexCoord(..) , CTriangle(..) +, Box(..) , Skin(..) , Animation(..) , Triangle(..) @@ -21,6 +23,7 @@ module Spear.Assets.Model , transformVerts , transformNormals , toGround +, modelBoxes ) where @@ -31,7 +34,8 @@ import Spear.Setup import qualified Data.ByteString.Char8 as B import Data.Char (toLower) import Data.List (splitAt, elemIndex) -import qualified Data.Vector.Storable as V +import qualified Data.Vector as V +import qualified Data.Vector.Storable as S import Foreign.Ptr import Foreign.Storable import Foreign.C.Types @@ -61,8 +65,26 @@ sizeFloat = #{size float} sizePtr = #{size int*} +-- | A 2D vector. +data Vec2 = Vec2 {-# UNPACK #-} !Float {-# UNPACK #-} !Float + + +instance Storable Vec2 where + sizeOf _ = 2*sizeFloat + alignment _ = alignment (undefined :: CFloat) + + peek ptr = do + f0 <- peekByteOff ptr 0 + f1 <- peekByteOff ptr sizeFloat + return $ Vec2 f0 f1 + + poke ptr (Vec2 f0 f1) = do + pokeByteOff ptr 0 f0 + pokeByteOff ptr sizeFloat f1 + + -- | A 3D vector. -data Vec3 = Vec3 !Float !Float !Float +data Vec3 = Vec3 {-# UNPACK #-} !Float {-# UNPACK #-} !Float {-# UNPACK #-} !Float instance Storable Vec3 where @@ -82,7 +104,7 @@ instance Storable Vec3 where -- | A 2D texture coordinate. -data TexCoord = TexCoord !Float !Float +data TexCoord = TexCoord {-# UNPACK #-} !Float {-# UNPACK #-} !Float instance Storable TexCoord where @@ -101,12 +123,12 @@ instance Storable TexCoord where -- | A raw triangle holding vertex/normal and texture indices. data CTriangle = CTriangle - { vertexIndex0 :: !CUShort - , vertexIndex1 :: !CUShort - , vertexIndex2 :: !CUShort - , textureIndex1 :: !CUShort - , textureIndex2 :: !CUShort - , textureIndex3 :: !CUShort + { vertexIndex0 :: {-# UNPACK #-} !CUShort + , vertexIndex1 :: {-# UNPACK #-} !CUShort + , vertexIndex2 :: {-# UNPACK #-} !CUShort + , textureIndex1 :: {-# UNPACK #-} !CUShort + , textureIndex2 :: {-# UNPACK #-} !CUShort + , textureIndex3 :: {-# UNPACK #-} !CUShort } @@ -135,6 +157,28 @@ instance Storable CTriangle where #{poke triangle, textureIndices[2]} ptr t2 +-- | A 2D axis-aligned bounding box. +data Box = Box {-# UNPACK #-} !Vec2 {-# UNPACK #-} !Vec2 + + +instance Storable Box where + sizeOf _ = 4 * sizeFloat + alignment _ = alignment (undefined :: CFloat) + + peek ptr = do + f0 <- peekByteOff ptr 0 + f1 <- peekByteOff ptr sizeFloat + f2 <- peekByteOff ptr $ 2*sizeFloat + f3 <- peekByteOff ptr $ 3*sizeFloat + return $ Box (Vec2 f0 f1) (Vec2 f2 f3) + + poke ptr (Box (Vec2 f0 f1) (Vec2 f2 f3)) = do + pokeByteOff ptr 0 f0 + pokeByteOff ptr sizeFloat f1 + pokeByteOff ptr (2*sizeFloat) f2 + pokeByteOff ptr (3*sizeFloat) f3 + + -- | A model skin. newtype Skin = Skin { skinName :: B.ByteString } @@ -179,12 +223,12 @@ instance Storable Animation where -- | A 3D model. data Model = Model - { vertices :: V.Vector Vec3 -- ^ Array of 'numFrames' * 'numVerts' vertices. - , normals :: V.Vector Vec3 -- ^ Array of 'numFrames' * 'numVerts' normals. - , texCoords :: V.Vector TexCoord -- ^ Array of 'numTexCoords' texture coordinates. - , triangles :: V.Vector CTriangle -- ^ Array of 'numTriangles' triangles. - , skins :: V.Vector Skin -- ^ Array of 'numSkins' skins. - , animations :: V.Vector Animation -- ^ Array of 'numAnimations' animations. + { vertices :: S.Vector Vec3 -- ^ Array of 'numFrames' * 'numVerts' vertices. + , normals :: S.Vector Vec3 -- ^ Array of 'numFrames' * 'numVerts' normals. + , texCoords :: S.Vector TexCoord -- ^ Array of 'numTexCoords' texture coordinates. + , triangles :: S.Vector CTriangle -- ^ Array of 'numTriangles' triangles. + , skins :: S.Vector Skin -- ^ Array of 'numSkins' skins. + , animations :: S.Vector Animation -- ^ Array of 'numAnimations' animations. , numFrames :: Int -- ^ Number of frames. , numVerts :: Int -- ^ Number of vertices (and normals) per frame. , numTriangles :: Int -- ^ Number of triangles in one frame. @@ -211,12 +255,12 @@ instance Storable Model where pTriangles <- peekByteOff ptr (3*sizePtr) pSkins <- peekByteOff ptr (4*sizePtr) pAnimations <- peekByteOff ptr (5*sizePtr) - vertices <- fmap V.fromList $ peekArray (numVertices*numFrames) pVerts - normals <- fmap V.fromList $ peekArray (numVertices*numFrames) pNormals - texCoords <- fmap V.fromList $ peekArray numTexCoords pTexCoords - triangles <- fmap V.fromList $ peekArray numTriangles pTriangles - skins <- fmap V.fromList $ peekArray numSkins pSkins - animations <- fmap V.fromList $ peekArray numAnimations pAnimations + vertices <- fmap S.fromList $ peekArray (numVertices*numFrames) pVerts + normals <- fmap S.fromList $ peekArray (numVertices*numFrames) pNormals + texCoords <- fmap S.fromList $ peekArray numTexCoords pTexCoords + triangles <- fmap S.fromList $ peekArray numTriangles pTriangles + skins <- fmap S.fromList $ peekArray numSkins pSkins + animations <- fmap S.fromList $ peekArray numAnimations pAnimations return $ Model vertices normals texCoords triangles skins animations numFrames numVertices numTriangles numTexCoords numSkins numAnimations @@ -224,12 +268,12 @@ instance Storable Model where poke ptr (Model verts normals texCoords tris skins animations numFrames numVerts numTris numTex numSkins numAnimations) = - V.unsafeWith verts $ \pVerts -> - V.unsafeWith normals $ \pNormals -> - V.unsafeWith texCoords $ \pTexCoords -> - V.unsafeWith tris $ \pTris -> - V.unsafeWith skins $ \pSkins -> - V.unsafeWith animations $ \pAnimations -> do + S.unsafeWith verts $ \pVerts -> + S.unsafeWith normals $ \pNormals -> + S.unsafeWith texCoords $ \pTexCoords -> + S.unsafeWith tris $ \pTris -> + S.unsafeWith skins $ \pSkins -> + S.unsafeWith animations $ \pAnimations -> do #{poke Model, vertices} ptr pVerts #{poke Model, normals} ptr pNormals #{poke Model, texCoords} ptr pTexCoords @@ -349,13 +393,13 @@ animated = (>1) . numFrames -- | Return the model's ith animation. animation :: Model -> Int -> Animation -animation model i = animations model V.! i +animation model i = animations model S.! i -- | Return the animation specified by the given string. animationByName :: Model -> String -> Maybe Animation animationByName model anim = - let anim' = B.pack anim in V.find ((==) anim' . name) $ animations model + let anim' = B.pack anim in S.find ((==) anim' . name) $ animations model -- | Return a copy of the model's triangles. @@ -378,8 +422,8 @@ transformVerts :: Model -> (Vec3 -> Vec3) -> Model transformVerts model f = model { vertices = vertices' } where n = numVerts model * numFrames model - vertices' = V.generate n f' - f' i = f $ vertices model V.! i + vertices' = S.generate n f' + f' i = f $ vertices model S.! i -- | Transform the model's normals. @@ -387,14 +431,14 @@ transformNormals :: Model -> (Vec3 -> Vec3) -> Model transformNormals model f = model { normals = normals' } where n = numVerts model * numFrames model - normals' = V.generate n f' - f' i = f $ normals model V.! i + normals' = S.generate n f' + f' i = f $ normals model S.! i -- | Translate the model such that its lowest point has y = 0. toGround :: Model -> IO Model toGround model = - let model' = model { vertices = V.generate n $ \i -> vertices model V.! i } + let model' = model { vertices = S.generate n $ \i -> vertices model S.! i } n = numVerts model * numFrames model in with model' model_to_ground >> return model' @@ -402,3 +446,28 @@ toGround model = foreign import ccall "Model.h model_to_ground" model_to_ground :: Ptr Model -> IO () + + +-- | Get the model's 2D bounding boxes. +modelBoxes :: Model -> IO (V.Vector Box) +modelBoxes model = + with model $ \modelPtr -> + allocaArray (numVerts model * numFrames model) $ \pointsPtr -> do + model_compute_boxes modelPtr pointsPtr + let n = numFrames model + getBoxes = peekBoxes pointsPtr n 0 0 $ return [] + peekBoxes ptr n cur off l + | cur == n = l + | otherwise = do + f0 <- peekByteOff ptr off + f1 <- peekByteOff ptr $ off + sizeFloat + f2 <- peekByteOff ptr $ off + 2*sizeFloat + f3 <- peekByteOff ptr $ off + 3*sizeFloat + peekBoxes ptr n (cur+1) (off + 4*sizeFloat) $ + fmap ((f3:) . (f2:) . (f1:) . (f0:)) l + fmap (V.fromList . reverse) getBoxes + + + +foreign import ccall "Model.h model_compute_boxes" + model_compute_boxes :: Ptr Model -> Ptr Vec2 -> IO () diff --git a/Spear/Assets/Model/Model.c b/Spear/Assets/Model/Model.c index 4942566..6fa88c3 100644 --- a/Spear/Assets/Model/Model.c +++ b/Spear/Assets/Model/Model.c @@ -79,3 +79,30 @@ void model_copy_triangles (Model* model, unsigned frame, model_triangle* tris) tris->t2 = t[tri->textureIndices[2]]; } } + + +void model_box (Model* model, float* points) +{ + vec3* v = model->vertices; + + unsigned f; + for (f = 0; f < model->numFrames; ++f) + { + float xmin = v->x; + float xmax = v->x; + float ymin = v->y; + float ymax = v->y; + + unsigned i; + for (i = 0; i < model->numVertices; ++i, ++v) + { + xmin = fmin (xmin, v->x); + ymin = fmin (ymin, v->y); + xmax = fmax (xmax, v->x); + ymax = fmax (ymax, v->y); + } + + *points++ = xmin; *points++ = ymin; + *points++ = xmax; *points++ = ymax; + } +} diff --git a/Spear/Assets/Model/Model.h b/Spear/Assets/Model/Model.h index 0532322..eb9c39b 100644 --- a/Spear/Assets/Model/Model.h +++ b/Spear/Assets/Model/Model.h @@ -90,6 +90,9 @@ void model_to_ground (Model* model); /// Copy the triangles of the given frame from the Model into the given array. void model_copy_triangles (Model* model, unsigned frame, model_triangle* tris); +/// Compute the model's 2d AABBs. +void model_compute_boxes (Model* model, float* points); + #ifdef __cplusplus } #endif diff --git a/Spear/Render/AnimatedModel.hs b/Spear/Render/AnimatedModel.hs index cc31f12..8db87c3 100644 --- a/Spear/Render/AnimatedModel.hs +++ b/Spear/Render/AnimatedModel.hs @@ -9,6 +9,7 @@ module Spear.Render.AnimatedModel , currentAnimation , bind , render +, update ) where @@ -18,10 +19,10 @@ import Spear.Render.Model import Spear.GLSL import Spear.Render.Material import Spear.Render.Program -import Spear.Updatable import Spear.Setup as Setup import Control.Applicative ((<$>), (<*>)) +import qualified Data.Vector as V import Graphics.Rendering.OpenGL.Raw.Core31 import Unsafe.Coerce (unsafeCoerce) @@ -36,6 +37,7 @@ data AnimatedModelResource = AnimatedModelResource , nVertices :: Int , material :: Material , texture :: Texture + , boxes :: V.Vector Box , rkey :: Resource } @@ -89,6 +91,7 @@ animatedModelResource RenderModel elements numFrames numVertices <- setupIO . renderModelFromModel $ model elementBuf <- newBuffer vao <- newVAO + boxes <- setupIO $ modelBoxes model setupIO $ do @@ -119,7 +122,8 @@ animatedModelResource releaseBuffer elementBuf return $ AnimatedModelResource - model vao (unsafeCoerce numFrames) (unsafeCoerce numVertices) material texture rkey + model vao (unsafeCoerce numFrames) (unsafeCoerce numVertices) + material texture boxes rkey -- | Release the given 'AnimatedModelResource'. @@ -132,16 +136,17 @@ animatedModelRenderer :: AnimatedModelResource -> AnimatedModelRenderer animatedModelRenderer modelResource = AnimatedModelRenderer modelResource 0 0 0 0 0 -instance Updatable AnimatedModelRenderer where - - update dt (AnimatedModelRenderer model curAnim startFrame endFrame curFrame fp) = - AnimatedModelRenderer model curAnim startFrame endFrame curFrame' fp' - where f = fp + dt - nextFrame = f >= 1.0 - fp' = if nextFrame then f - 1.0 else f - curFrame' = if nextFrame - then let x = curFrame + 1 in if x > endFrame then startFrame else x - else curFrame +-- | Update the 'AnimatedModelRenderer'. +update dt (AnimatedModelRenderer model curAnim startFrame endFrame curFrame fp) = + AnimatedModelRenderer model curAnim startFrame endFrame curFrame' fp' + where f = fp + dt + nextFrame = f >= 1.0 + fp' = if nextFrame then f - 1.0 else f + curFrame' = if nextFrame + then + let x = curFrame + 1 + in if x > endFrame then startFrame else x + else curFrame -- | Set the active animation to the given one. diff --git a/Spear/Render/StaticModel.hs b/Spear/Render/StaticModel.hs index 05e80e4..cefb7ed 100644 --- a/Spear/Render/StaticModel.hs +++ b/Spear/Render/StaticModel.hs @@ -18,6 +18,7 @@ import Spear.Render.Material import Spear.Render.Program import Spear.Setup as Setup +import qualified Data.Vector as V import Graphics.Rendering.OpenGL.Raw.Core31 import Unsafe.Coerce (unsafeCoerce) @@ -27,6 +28,7 @@ data StaticModelResource = StaticModelResource , nVertices :: Int , material :: Material , texture :: Texture + , boxes :: V.Vector Box , rkey :: Resource } @@ -61,6 +63,7 @@ staticModelResource (StaticProgramChannels vertChan normChan texChan) material t RenderModel elements _ numVertices <- setupIO . renderModelFromModel $ model elementBuf <- newBuffer vao <- newVAO + boxes <- setupIO $ modelBoxes model setupIO $ do @@ -85,9 +88,9 @@ staticModelResource (StaticProgramChannels vertChan normChan texChan) material t setupIO $ putStrLn "Releasing static model resource" releaseVAO vao releaseBuffer elementBuf - --sequence_ . fmap releaseBuffer $ [elementBuf, indexBuf] - return $ StaticModelResource vao (unsafeCoerce numVertices) material texture rkey + return $ StaticModelResource + vao (unsafeCoerce numVertices) material texture boxes rkey -- | Release the given 'StaticModelResource'. -- cgit v1.2.3