From 7404d6f6ca90777cae55bdb352aa85bcc0edf7cc Mon Sep 17 00:00:00 2001 From: Marc Sunet Date: Fri, 10 Aug 2012 16:09:17 +0200 Subject: Major rework: Model is now both C and Haskell friendly --- Spear.lkshs | 12 +- Spear.lkshw | 2 +- Spear/Assets/Model.hsc | 378 +++++++++++++++++++++------------------------ Spear/Assets/Model/Model.c | 56 ------- Spear/Assets/Model/Model.h | 6 - Spear/Render/Model.hsc | 4 +- Spear/Scene/Loader.hs | 37 +++-- 7 files changed, 211 insertions(+), 284 deletions(-) diff --git a/Spear.lkshs b/Spear.lkshs index afbce39..d69e4f9 100644 --- a/Spear.lkshs +++ b/Spear.lkshs @@ -1,18 +1,18 @@ Version of session file format: 1 Time of storage: - "Thu Aug 9 13:31:29 CEST 2012" -Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 6, 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}) 266) 197)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 702) 954 -Population: [(Just (ErrorsSt ErrorsState),[SplitP RightP,SplitP TopP]),(Just (FilesSt FilesState),[SplitP RightP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameObject.hs" 259)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameState.hs" 670)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Sys/Store/ID.hs" 96)),[SplitP LeftP]),(Just (InfoSt (InfoState (Just (Real (RealDescr {dscName' = "storeFree", dscMbTypeStr' = Just "storeFree :: Index -> Store a -> Store a", dscMbModu' = Just (PM {pack = PackageIdentifier {pkgName = PackageName "Spear", pkgVersion = Version {versionBranch = [0,1], versionTags = []}}, modu = ModuleName ["Spear","Sys","Store"]}), dscMbLocation' = Just (Location {locationSLine = 101, locationSCol = 1, locationELine = 108, locationECol = 32}), dscMbComment' = Just " Free the given slot.", dscTypeHint' = VariableDescr, dscExported' = True}))))),[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","Sys","Store"]),Just "storeFree") (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([[0,9],[0]],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([[5]],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Physics.hs" 207)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Physics/Rigid.hs" 2175)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Sys/Store.hs" 4136)),[SplitP LeftP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Physics/World.hs" 287)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs" 204)),[SplitP LeftP])] + "Fri Aug 10 15:19:04 CEST 2012" +Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 4, 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}) 255) 201)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 707) 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 (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Scene/Loader.hs" 6686)),[SplitP LeftP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/MD2/MD2_load.c" 13934)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.c" 433)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.h" 1424)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model.hsc" 12957)),[SplitP LeftP]),(Just (ModulesSt (ModulesState 328 (PackageScope False,False) (Nothing,Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([[0,2],[0]],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/OBJ/OBJ_load.cc" 266)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/OBJ/OBJ_load.h" 0)),[SplitP LeftP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP])] Window size: (1841,964) Completion size: (750,400) Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" -Active pane: Just "World.hs" +Active pane: Just "Model.hsc" Toolbar visible: True -FindbarState: (False,FindState {entryStr = "asda", entryHist = ["assigned","Triangle","transforma","gravity","asdad","rotSpeed","azimuth","mandatory","mandao","col","forward","MouseButton"], replaceStr = "objects", replaceHist = [], caseSensitive = True, entireWord = False, wrapAround = False, regex = False, lineNr = 1}) +FindbarState: (False,FindState {entryStr = "asd", entryHist = ["allocaBytes","copyArray","allocaArray","allocaa","putStrLn","assigned","Triangle","transforma","gravity","asdad","rotSpeed","azimuth"], replaceStr = "objects", replaceHist = [], caseSensitive = True, entireWord = False, wrapAround = False, regex = False, lineNr = 1}) Recently opened files: - ["/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.h","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model.hsc","/home/jeanne/programming/haskell/Spear/Spear/Math/Spatial.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Triangle.hs","/home/jeanne/programming/haskell/Spear/Spear/Render/Triangle.hs","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.c","/home/jeanne/programming/haskell/Spear/Spear/Scene/Loader.hs","/home/jeanne/programming/haskell/Spear/Spear/IDStore.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Spear/IDStore.hs","/home/jeanne/programming/haskell/Spear/Spear/Physics/Types.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/Assets/Image.hsc","/home/jeanne/programming/haskell/Spear/Spear/Render/Model.hsc","/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Player.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameState.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameMessage.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Factory.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/Animation/Ogro.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/AnimatedGO.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/StaticGO.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Render.hs"] Recently opened workspaces: ["/home/jeanne/leksah.lkshw"] \ No newline at end of file diff --git a/Spear.lkshw b/Spear.lkshw index 2291729..143acdc 100644 --- a/Spear.lkshw +++ b/Spear.lkshw @@ -1,7 +1,7 @@ Version of workspace file format: 1 Time of storage: - "Wed Aug 8 21:04:06 CEST 2012" + "Fri Aug 10 15:56:20 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 cb0ef3f..b7cb90d 100644 --- a/Spear/Assets/Model.hsc +++ b/Spear/Assets/Model.hsc @@ -3,28 +3,20 @@ module Spear.Assets.Model ( -- * Data types - ModelErrorCode -, Vec3(..) + Vec3(..) , TexCoord(..) -, CModel +, CTriangle(..) +, Skin(..) , Animation(..) , Triangle(..) -, Model - -- * Loading and unloading +, Model(..) + -- * Loading , loadModel -, releaseModel -- * Accessors , animated -, numFrames -, numVertices -, numTriangles -, numTexCoords -, numSkins -, cmodel , animation , animationByName -, numAnimations -, triangles +, triangles' -- * Manipulation , transformVerts , transformNormals @@ -34,15 +26,12 @@ where import Spear.Setup -import qualified Spear.Math.Matrix4 as M4 -import qualified Spear.Math.Matrix3 as M3 -import Spear.Math.MatrixUtils import qualified Data.ByteString.Char8 as B import Data.Char (toLower) import Data.List (splitAt, elemIndex) -import qualified Data.Vector as V +import qualified Data.Vector.Storable as V import Foreign.Ptr import Foreign.Storable import Foreign.C.Types @@ -69,10 +58,11 @@ data ModelErrorCode sizeFloat = #{size float} +sizePtr = #{size int*} -- | A 3D vector. -data Vec3 = Vec3 !CFloat !CFloat !CFloat +data Vec3 = Vec3 !Float !Float !Float instance Storable Vec3 where @@ -92,7 +82,7 @@ instance Storable Vec3 where -- | A 2D texture coordinate. -data TexCoord = TexCoord !CFloat !CFloat +data TexCoord = TexCoord !Float !Float instance Storable TexCoord where @@ -109,97 +99,154 @@ instance Storable TexCoord where pokeByteOff ptr sizeFloat f1 -data CTriangle = CTriangle !CUShort !CUShort !CUShort !CUShort !CUShort !CUShort +-- | A raw triangle holding vertex/normal and texture indices. +data CTriangle = CTriangle + { vertexIndex0 :: !CUShort + , vertexIndex1 :: !CUShort + , vertexIndex2 :: !CUShort + , textureIndex1 :: !CUShort + , textureIndex2 :: !CUShort + , textureIndex3 :: !CUShort + } -data Skin = Skin !(Ptr Char) +instance Storable CTriangle where + sizeOf _ = #{size triangle} + alignment _ = alignment (undefined :: CUShort) + + peek ptr = do + v0 <- #{peek triangle, vertexIndices[0]} ptr + v1 <- #{peek triangle, vertexIndices[1]} ptr + v2 <- #{peek triangle, vertexIndices[2]} ptr + + t0 <- #{peek triangle, textureIndices[0]} ptr + t1 <- #{peek triangle, textureIndices[1]} ptr + t2 <- #{peek triangle, textureIndices[2]} ptr + + return $ CTriangle v0 v1 v2 t0 t1 t2 + + poke ptr (CTriangle v0 v1 v2 t0 t1 t2) = do + #{poke triangle, vertexIndices[0]} ptr v0 + #{poke triangle, vertexIndices[1]} ptr v1 + #{poke triangle, vertexIndices[2]} ptr v2 + + #{poke triangle, textureIndices[0]} ptr t0 + #{poke triangle, textureIndices[1]} ptr t1 + #{poke triangle, textureIndices[2]} ptr t2 -data CAnimation = CAnimation !B.ByteString !CUInt !CUInt +-- | A model skin. +newtype Skin = Skin { skinName :: B.ByteString } --- | The model's underlying representation. -data CModel = CModel - { cVerts :: Ptr Vec3 -- ^ Pointer to an array of 'cnFrames' * 'cnVerts' vertices. - , cNormals :: Ptr Vec3 -- ^ Pointer to an array of 'cnFrames' * cnVerts normals. - , cTexCoords :: Ptr TexCoord -- ^ Pointer to an array of 'cnTris' texture coordinates. - , cTris :: Ptr CTriangle -- ^ Pointer to an array of 'cnTris' triangles. - , cSkins :: Ptr Skin -- ^ Pointer to an array of 'cnSkins' skins. - , cAnimations :: Ptr CAnimation -- ^ Pointer to an array of 'cnAnimations' animations. - , cnFrames :: CUInt -- ^ Number of frames. - , cnVerts :: CUInt -- ^ Number of vertices per frame. - , cnTris :: CUInt -- ^ Number of triangles in one frame. - , cnTexCoords :: CUInt -- ^ Number of texture coordinates in one frame. - , cnSkins :: CUInt -- ^ Number of skins. - , cnAnimations :: CUInt -- ^ Number of animations. - } +instance Storable Skin where + sizeOf (Skin s) = 64 + alignment _ = 1 + + peek ptr = do + s <- B.packCString $ unsafeCoerce ptr + return $ Skin s + + poke ptr (Skin s) = do + B.useAsCStringLen s $ \(sptr, len) -> copyArray (unsafeCoerce ptr) sptr len -instance Storable CModel where - sizeOf _ = #{size Model} - alignment _ = alignment (undefined :: CUInt) +-- | A model animation. +-- +-- See also: 'animation', 'animationByName', 'numAnimations'. +data Animation = Animation + { name :: B.ByteString + , start :: Int + , end :: Int + } - peek ptr = do - vertices <- #{peek Model, vertices} ptr - normals <- #{peek Model, normals} ptr - texCoords <- #{peek Model, texCoords} ptr - triangles <- #{peek Model, triangles} ptr - skins <- #{peek Model, skins} ptr - animations <- #{peek Model, animations} ptr - numFrames <- #{peek Model, numFrames} ptr - numVertices <- #{peek Model, numVertices} ptr - numTriangles <- #{peek Model, numTriangles} ptr - numTexCoords <- #{peek Model, numTexCoords} ptr - numSkins <- #{peek Model, numSkins} ptr - numAnimations <- #{peek Model, numAnimations} ptr - return $ - CModel vertices normals texCoords triangles skins animations - numFrames numVertices numTriangles numTexCoords numSkins numAnimations - poke ptr - (CModel verts normals texCoords tris skins animations - numFrames numVerts numTris numTex numSkins numAnimations) = do - #{poke Model, vertices} ptr verts - #{poke Model, normals} ptr normals - #{poke Model, texCoords} ptr texCoords - #{poke Model, triangles} ptr tris - #{poke Model, skins} ptr skins - #{poke Model, animations} ptr animations - #{poke Model, numFrames} ptr numFrames - #{poke Model, numVertices} ptr numVerts - #{poke Model, numTriangles} ptr numTris - #{poke Model, numTexCoords} ptr numTex - #{poke Model, numSkins} ptr numSkins - #{poke Model, numAnimations} ptr numAnimations - - --- data CAnimation = CAnimation !(Ptr CChar) !CUInt !CUInt -instance Storable CAnimation where +instance Storable Animation where sizeOf _ = #{size animation} alignment _ = alignment (undefined :: CUInt) - + peek ptr = do name <- B.packCString (unsafeCoerce ptr) start <- #{peek animation, start} ptr end <- #{peek animation, end} ptr - return $ CAnimation name start end - - poke ptr (CAnimation name start end) = do + return $ Animation name start end + + poke ptr (Animation name start end) = do B.useAsCStringLen name $ \(sptr, len) -> copyArray (unsafeCoerce ptr) sptr len #{poke animation, start} ptr start #{poke animation, end} ptr end --- | A model's animation. --- --- See also: 'animation', 'animationByName', 'numAnimations'. -data Animation = Animation - { name :: String - , start :: Int - , end :: Int +-- | 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. + , numFrames :: Int -- ^ Number of frames. + , numVerts :: Int -- ^ Number of vertices (and normals) per frame. + , numTriangles :: Int -- ^ Number of triangles in one frame. + , numTexCoords :: Int -- ^ Number of texture coordinates in one frame. + , numSkins :: Int -- ^ Number of skins. + , numAnimations :: Int -- ^ Number of animations. } +instance Storable Model where + sizeOf _ = #{size Model} + alignment _ = alignment (undefined :: CUInt) + + peek ptr = do + numFrames <- #{peek Model, numFrames} ptr + numVertices <- #{peek Model, numVertices} ptr + numTriangles <- #{peek Model, numTriangles} ptr + numTexCoords <- #{peek Model, numTexCoords} ptr + numSkins <- #{peek Model, numSkins} ptr + numAnimations <- #{peek Model, numAnimations} ptr + pVerts <- peek (unsafeCoerce ptr) + pNormals <- peekByteOff ptr sizePtr + pTexCoords <- peekByteOff ptr (2*sizePtr) + 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 + return $ + Model vertices normals texCoords triangles skins animations + numFrames numVertices numTriangles numTexCoords numSkins numAnimations + + 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 + #{poke Model, vertices} ptr pVerts + #{poke Model, normals} ptr pNormals + #{poke Model, texCoords} ptr pTexCoords + #{poke Model, triangles} ptr pTris + #{poke Model, skins} ptr pSkins + #{poke Model, animations} ptr pAnimations + #{poke Model, numFrames} ptr numFrames + #{poke Model, numVertices} ptr numVerts + #{poke Model, numTriangles} ptr numTris + #{poke Model, numTexCoords} ptr numTex + #{poke Model, numSkins} ptr numSkins + #{poke Model, numAnimations} ptr numAnimations + + +-- | A model triangle. +-- +-- See also: 'triangles''. data Triangle = Triangle { v0 :: Vec3 , v1 :: Vec3 @@ -241,87 +288,58 @@ instance Storable Triangle where #{poke model_triangle, t2} ptr t2 --- | A model 'Resource'. -data Model = Model - { modelData :: CModel - , mAnimations :: V.Vector Animation - , rkey :: Resource - } - - foreign import ccall "Model.h model_free" - model_free :: Ptr CModel -> IO () + model_free :: Ptr Model -> IO () foreign import ccall "MD2_load.h MD2_load" - md2_load' :: Ptr CChar -> CChar -> CChar -> Ptr CModel -> IO Int + md2_load' :: Ptr CChar -> CChar -> CChar -> Ptr Model -> IO Int foreign import ccall "OBJ_load.h OBJ_load" - obj_load' :: Ptr CChar -> CChar -> CChar -> Ptr CModel -> IO Int + obj_load' :: Ptr CChar -> CChar -> CChar -> Ptr Model -> IO Int -md2_load :: Ptr CChar -> CChar -> CChar -> Ptr CModel -> IO ModelErrorCode +md2_load :: Ptr CChar -> CChar -> CChar -> Ptr Model -> IO ModelErrorCode md2_load file clockwise leftHanded model = md2_load' file clockwise leftHanded model >>= \code -> return . toEnum $ code -obj_load :: Ptr CChar -> CChar -> CChar -> Ptr CModel -> IO ModelErrorCode +obj_load :: Ptr CChar -> CChar -> CChar -> Ptr Model -> IO ModelErrorCode obj_load file clockwise leftHanded model = obj_load' file clockwise leftHanded model >>= \code -> return . toEnum $ code --- | Load the model specified by the given 'FilePath'. +-- | Load the model specified by the given file. loadModel :: FilePath -> Setup Model loadModel file = do dotPos <- case elemIndex '.' file of Nothing -> setupError $ "file name has no extension: " ++ file Just p -> return p - + let ext = map toLower . tail . snd $ splitAt dotPos file - + result <- setupIO . alloca $ \ptr -> do status <- withCString file $ \fileCstr -> do case ext of "md2" -> md2_load fileCstr 0 0 ptr "obj" -> obj_load fileCstr 0 0 ptr _ -> return ModelNoSuitableLoader - + case status of - ModelSuccess -> peek ptr >>= return . Right + ModelSuccess -> do + model <- peek ptr + model_free ptr + return . Right $ model ModelReadError -> return . Left $ "read error" ModelMemoryAllocationError -> return . Left $ "memory allocation error" ModelFileNotFound -> return . Left $ "file not found" ModelFileMismatch -> return . Left $ "file mismatch" ModelNoSuitableLoader -> return . Left $ "no suitable loader for extension " ++ ext - + case result of - Right model -> - let numAnimations = fromIntegral $ cnAnimations model - in register (freeModel model) >>= - case numAnimations of - 0 -> return . Model model V.empty - _ -> \key -> setupIO $ do - canims <- peekArray numAnimations $ cAnimations model - let animations = V.fromList $ fmap fromCAnimation canims - return $ Model model animations key - - Left err -> setupError $ "loadModel: " ++ err - - -fromCAnimation :: CAnimation -> Animation -fromCAnimation (CAnimation cname start end) = - Animation (B.unpack cname) (fromIntegral start) (fromIntegral end) - - --- | Release the model. -releaseModel :: Model -> Setup () -releaseModel = release . rkey - - --- | Free the C model. -freeModel :: CModel -> IO () -freeModel model = Foreign.with model model_free + Right model -> return model + Left err -> setupError $ "loadModel: " ++ err -- | Return 'True' if the model is animated, 'False' otherwise. @@ -329,55 +347,21 @@ animated :: Model -> Bool animated = (>1) . numFrames --- | Return the model's number of frames. -numFrames :: Model -> Int -numFrames = fromIntegral . cnFrames . modelData - - --- | Return the model's number of vertices. -numVertices :: Model -> Int -numVertices = fromIntegral . cnVerts . modelData - - --- | Return the model's number of triangles. -numTriangles :: Model -> Int -numTriangles = fromIntegral . cnTris . modelData - - --- | Return the model's number of texture coordinates. -numTexCoords :: Model -> Int -numTexCoords = fromIntegral . cnTexCoords . modelData - - --- | Return the model's number of skins. -numSkins :: Model -> Int -numSkins = fromIntegral . cnSkins . modelData - - --- | Return the underlying C model. -cmodel :: Model -> CModel -cmodel = modelData - - -- | Return the model's ith animation. animation :: Model -> Int -> Animation -animation model i = mAnimations model V.! i +animation model i = animations model V.! i -- | Return the animation specified by the given string. animationByName :: Model -> String -> Maybe Animation -animationByName model anim = V.find ((==) anim . name) $ mAnimations model - - --- | Return the number of animations of the given model. -numAnimations :: Model -> Int -numAnimations = V.length . mAnimations +animationByName model anim = + let anim' = B.pack anim in V.find ((==) anim' . name) $ animations model -- | Return a copy of the model's triangles. -triangles :: Model -> IO [Triangle] -triangles m@(Model model _ _) = - let n = numVertices m * numFrames m +triangles' :: Model -> IO [Triangle] +triangles' model = + let n = numVerts model * numFrames model in with model $ \modelPtr -> allocaArray n $ \arrayPtr -> do model_copy_triangles modelPtr arrayPtr @@ -386,39 +370,35 @@ triangles m@(Model model _ _) = foreign import ccall "Model.h model_copy_triangles" - model_copy_triangles :: Ptr CModel -> Ptr Triangle -> IO () - - --- | Transform the model's vertices with the given matrix. -transformVerts :: M4.Matrix4 -> Model -> IO () -transformVerts mat (Model model _ _) = - allocaBytes (16*sizeFloat) $ \matPtr -> - with model $ \modelPtr -> do - poke matPtr mat - model_transform_vertices modelPtr matPtr - - --- | Transform the model's normals with the given matrix. -transformNormals :: M3.Matrix3 -> Model -> IO () -transformNormals mat (Model model _ _) = - allocaBytes (9*sizeFloat) $ \normalPtr -> - with model $ \modelPtr -> do - poke normalPtr mat - model_transform_normals modelPtr normalPtr + model_copy_triangles :: Ptr Model -> Ptr Triangle -> IO () -foreign import ccall "Model.h model_transform_vertices" - model_transform_vertices :: Ptr CModel -> Ptr M4.Matrix4 -> IO () +-- | Transform the model's vertices. +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 -foreign import ccall "Model.h model_transform_normals" - model_transform_normals :: Ptr CModel -> Ptr M3.Matrix3 -> IO () +-- | Transform the model's normals. +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 --- | Transform the model such that its lowest point has y = 0. -toGround :: Model -> IO () -toGround (Model model _ _) = with model model_to_ground +-- | 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 } + n = numVerts model * numFrames model + in + with model' model_to_ground >> return model' foreign import ccall "Model.h model_to_ground" - model_to_ground :: Ptr CModel -> IO () + model_to_ground :: Ptr Model -> IO () diff --git a/Spear/Assets/Model/Model.c b/Spear/Assets/Model/Model.c index eb955de..4942566 100644 --- a/Spear/Assets/Model/Model.c +++ b/Spear/Assets/Model/Model.c @@ -27,62 +27,6 @@ void model_free (Model* model) } -static void mul (float m[16], vec3* v) -{ - float x = v->x; - float y = v->y; - float z = v->z; - v->x = x*m[0] + y*m[4] + z*m[8] + m[12]; - v->y = x*m[1] + y*m[5] + z*m[9] + m[13]; - v->z = x*m[2] + y*m[6] + z*m[10] + m[14]; -} - - -static void mul_normal (float m[9], vec3* n) -{ - float x = n->x; - float y = n->y; - float z = n->z; - n->x = x*m[0] + y*m[3] + z*m[6]; - n->y = x*m[1] + y*m[4] + z*m[7]; - n->z = x*m[2] + y*m[5] + z*m[8]; - x = n->x; - y = n->y; - z = n->z; - float mag = sqrt(x*x + y*y + z*z); - mag = mag == 0.0 ? 1.0 : mag; - n->x /= mag; - n->y /= mag; - n->z /= mag; -} - - -void model_transform_vertices (Model* model, float mat[16]) -{ - unsigned i = 0; - unsigned j = model->numVertices * model->numFrames; - vec3* v = model->vertices; - - for (; i < j; ++i, ++v) - { - mul (mat, v); - } -} - - -void model_transform_normals (Model* model, float normal[9]) -{ - unsigned i = 0; - unsigned j = model->numVertices * model->numFrames; - vec3* n = model->normals; - - for (; i < j; ++i, ++n) - { - mul_normal (normal, n); - } -} - - void model_to_ground (Model* model) { unsigned i, f; diff --git a/Spear/Assets/Model/Model.h b/Spear/Assets/Model/Model.h index 275b040..0532322 100644 --- a/Spear/Assets/Model/Model.h +++ b/Spear/Assets/Model/Model.h @@ -84,12 +84,6 @@ extern "C" { /// The 'model' pointer itself is not freed. void model_free (Model* model); -/// Transform the Model's vertices by the given matrix. -void model_transform_verts (Model* model, float mat[16]); - -/// Transform the Model's normals by the given matrix. -void model_transform_normals (Model* model, float normal[9]); - /// Translate the Model such that its lowest point has y = 0. void model_to_ground (Model* model); diff --git a/Spear/Render/Model.hsc b/Spear/Render/Model.hsc index 02a37ae..b6c561b 100644 --- a/Spear/Render/Model.hsc +++ b/Spear/Render/Model.hsc @@ -51,11 +51,11 @@ instance Storable RenderModel where foreign import ccall "RenderModel.h render_model_from_model_asset" - render_model_from_model_asset :: Ptr Assets.CModel -> Ptr RenderModel -> IO Int + render_model_from_model_asset :: Ptr Assets.Model -> Ptr RenderModel -> IO Int -- | Convert the given 'Model' to a 'ModelData' instance. renderModelFromModel :: Assets.Model -> IO RenderModel -renderModelFromModel m = with (Assets.cmodel m) $ \mPtr -> alloca $ \mdPtr -> do +renderModelFromModel m = with m $ \mPtr -> alloca $ \mdPtr -> do render_model_from_model_asset mPtr mdPtr peek mdPtr diff --git a/Spear/Scene/Loader.hs b/Spear/Scene/Loader.hs index 06e0aa9..64e81f1 100644 --- a/Spear/Scene/Loader.hs +++ b/Spear/Scene/Loader.hs @@ -19,6 +19,7 @@ where import Spear.Assets.Model as Model import qualified Spear.GLSL as GLSL +import qualified Spear.Math.Matrix3 as M3 import Spear.Math.Matrix4 as M4 import Spear.Math.MatrixUtils (fastNormalMatrix) import Spear.Math.Vector3 as V3 @@ -188,19 +189,21 @@ newModel (SceneLeaf _ props) = do loadModel' :: FilePath -> Maybe Rotation -> Maybe Vector3 -> Setup Model loadModel' file rotation scale = do - model <- Model.loadModel file - case rotation of - Just rot -> setupIO $ rotateModel model rot - Nothing -> return () - case scale of - Just s -> setupIO $ Model.transformVerts (scalev s) model - Nothing -> return () - setupIO $ toGround model - return model - - -rotateModel :: Model -> Rotation -> IO () -rotateModel model (Rotation x y z order) = + let transform = + (case rotation of + Nothing -> Prelude.id + Just rot -> rotateModel rot) . + + (case scale of + Nothing -> Prelude.id + Just s -> flip Model.transformVerts $ + \(Vec3 x' y' z') -> Vec3 (V3.x s * x') (V3.y s * y') (V3.z s * z')) + + (fmap transform $ Model.loadModel file) >>= setupIO . toGround + + +rotateModel :: Rotation -> Model -> Model +rotateModel (Rotation x y z order) model = let mat = case order of XYZ -> rotZ z * rotY y * rotX x XZY -> rotY y * rotZ z * rotX x @@ -209,8 +212,14 @@ rotateModel model (Rotation x y z order) = ZXY -> rotY y * rotX x * rotZ z ZYX -> rotX x * rotY y * rotZ z normalMat = fastNormalMatrix mat + + vTransform (Vec3 x' y' z') = + let v = mat `mulp` (vec3 x' y' z') in Vec3 (V3.x v) (V3.y v) (V3.z v) + + nTransform (Vec3 x' y' z') = + let v = normalMat `M3.mul` (vec3 x' y' z') in Vec3 (V3.x v) (V3.y v) (V3.z v) in - Model.transformVerts mat model >> Model.transformNormals normalMat model + flip Model.transformVerts vTransform . flip Model.transformNormals nTransform $ model loadTexture :: FilePath -> Loader GLSL.Texture -- cgit v1.2.3