From cad29f704bb3dd784023a952416317c7aa6a576e Mon Sep 17 00:00:00 2001 From: Marc Sunet Date: Thu, 2 Aug 2012 15:36:07 +0200 Subject: =?UTF-8?q?=C2=B7=20Changed=20the=20way=20game=20objects=20are=20c?= =?UTF-8?q?reated=20by=20the=20loader=20for=20more=20flexibility.=20=C2=B7?= =?UTF-8?q?=20Added=20model=20function=20'toGround'.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Spear.lkshs | 12 ++--- Spear.lkshw | 2 +- Spear/Assets/Model.hsc | 10 ++++ Spear/Assets/Model/Model.c | 26 ++++++++++ Spear/Assets/Model/Model.h | 3 ++ Spear/Scene/Loader.hs | 115 +++++++++++++++++++++++---------------------- 6 files changed, 105 insertions(+), 63 deletions(-) diff --git a/Spear.lkshs b/Spear.lkshs index 541f4ef..1427d7f 100644 --- a/Spear.lkshs +++ b/Spear.lkshs @@ -1,18 +1,18 @@ Version of session file format: 1 Time of storage: - "Wed Aug 1 13:16:07 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}) 315) 217)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 759) 953 -Population: [(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Collision/Collision.hs" 61)),[SplitP LeftP]),(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" 3739)),[SplitP LeftP]),(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" 12935)),[SplitP LeftP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Math/Matrix4.hs" 14139)),[SplitP LeftP]),(Just (ModulesSt (ModulesState 286 (PackageScope False,False) (Nothing,Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Math/Vector3.hs" 3515)),[SplitP LeftP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs" 789)),[SplitP LeftP])] + "Thu Aug 2 15:35:02 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}) 308) 219)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 756) 953 +Population: [(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Collision/Collision.hs" 61)),[SplitP LeftP]),(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" 2483)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameState.hs" 893)),[SplitP LeftP]),(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" 10609)),[SplitP LeftP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.c" 1772)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.h" 0)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model.hsc" 10563)),[SplitP LeftP]),(Just (ModulesSt (ModulesState 286 (PackageScope False,False) (Nothing,Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([],[]), 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]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs" 1249)),[SplitP LeftP])] Window size: (1796,979) Completion size: (750,400) Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" -Active pane: Just "GameObject.hs" +Active pane: Just "Model.c" Toolbar visible: True -FindbarState: (False,FindState {entryStr = "asd", entryHist = ["col","forward","asd","MouseButton"], replaceStr = "row", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = False, regex = False, lineNr = 1}) +FindbarState: (False,FindState {entryStr = "asd", entryHist = ["mandatory","mandao","col","forward","asd","MouseButton"], replaceStr = "mandatory'", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = False, regex = False, lineNr = 1}) Recently opened files: - ["/home/jeanne/programming/haskell/Spear/demos/simple-scene/simple.scene","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.c","/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameMessage.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameState.hs","/home/jeanne/programming/haskell/Spear/Spear/Collision/Collision.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Camera.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Entity.hs","/home/jeanne/programming/haskell/Spear/Spear/Scene/Scene.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Spatial.hs","/home/jeanne/programming/haskell/Spear/Spear/Assets/Image/BMP/BMP_load.c","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/OBJ/OBJ_load.cc","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model.hsc"] + ["/home/jeanne/programming/haskell/Spear/Spear/Scene/Loader.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/Scene/Graph.hs","/home/jeanne/programming/haskell/Spear/Spear/Scene/SceneResources.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Matrix4.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Vector3.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/simple.scene","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.c","/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameMessage.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameState.hs","/home/jeanne/programming/haskell/Spear/Spear/Collision/Collision.hs"] Recently opened workspaces: ["/home/jeanne/programming/haskell/Spear/Spear.lkshw","/home/jeanne/leksah.lkshw"] \ No newline at end of file diff --git a/Spear.lkshw b/Spear.lkshw index aed85a0..865bceb 100644 --- a/Spear.lkshw +++ b/Spear.lkshw @@ -1,7 +1,7 @@ Version of workspace file format: 1 Time of storage: - "Tue Jul 31 20:32:45 CEST 2012" + "Wed Aug 1 18:11:40 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 e8eff0f..5fd2db3 100644 --- a/Spear/Assets/Model.hsc +++ b/Spear/Assets/Model.hsc @@ -30,6 +30,7 @@ module Spear.Assets.Model , numAnimations -- * Manipulation , transform +, toGround ) where @@ -331,4 +332,13 @@ foreign import ccall "Model.h model_transform" model_transform :: Ptr CModel -> Ptr M4.Matrix4 -> Ptr M3.Matrix3 -> IO () +-- | Transform the given 'Model' such that its lowest point has y = 0. +toGround :: Model -> IO () +toGround (Model model _ _) = with model model_to_ground + + +foreign import ccall "Model.h model_to_ground" + model_to_ground :: Ptr CModel -> IO () + + sizeFloat = #{size float} diff --git a/Spear/Assets/Model/Model.c b/Spear/Assets/Model/Model.c index 94959e9..837dd93 100644 --- a/Spear/Assets/Model/Model.c +++ b/Spear/Assets/Model/Model.c @@ -71,3 +71,29 @@ void model_transform (Model* model, float mat[16], float normal[9]) n++; } } + + +void model_to_ground (Model* model) +{ + unsigned i, f; + vec3* v = model->vertices; + + // Compute the minimum y coordinate for each frame and translate + // the model appropriately. + for (f = 0; f < model->numFrames; ++f) + { + vec3* w = v; + float y = v->y; + + for (i = 0; i < model->numVertices; ++i, ++v) + { + y = fmin (y, v->y); + } + + v = w; + for (i = 0; i < model->numVertices; ++i, ++v) + { + v->y -= y; + } + } +} diff --git a/Spear/Assets/Model/Model.h b/Spear/Assets/Model/Model.h index f23377a..34c6444 100644 --- a/Spear/Assets/Model/Model.h +++ b/Spear/Assets/Model/Model.h @@ -72,6 +72,9 @@ void model_free (Model* model); /// Transform the given Model's vertices by the given matrix. void model_transform (Model* model, float mat[16], float normal[9]); +/// Translate the given Model such that its lowest point has y = 0. +void model_to_ground (Model* model); + #ifdef __cplusplus } #endif diff --git a/Spear/Scene/Loader.hs b/Spear/Scene/Loader.hs index 32aba45..2491907 100644 --- a/Spear/Scene/Loader.hs +++ b/Spear/Scene/Loader.hs @@ -1,12 +1,18 @@ module Spear.Scene.Loader ( SceneResources(..) -, CreateStaticObject -, CreateAnimatedObject +, CreateGameObject , loadScene , validate , resourceMap , loadObjects +, value +, unspecified +, mandatory +, asString +, asFloat +, asVec3 +, asVec4 ) where @@ -43,10 +49,6 @@ loaderIO = loaderSetup . setupIO loaderError = loaderSetup . setupError -type CreateStaticObject a = String -> Matrix4 -> StaticModelResource -> a -type CreateAnimatedObject a = String -> Matrix4 -> AnimatedModelResource -> a - - -- | Load the scene specified by the given file. loadScene :: FilePath -> Setup (SceneResources, SceneGraph) loadScene file = do @@ -141,15 +143,15 @@ getResource field key = do newModel :: SceneGraph -> Loader () newModel (SceneLeaf _ props) = do - name <- asString $ mandatory "name" props - file <- asString $ mandatory "file" props - tex <- asString $ mandatory "texture" props - prog <- asString $ mandatory "shader-program" props - ke <- asVec4 $ mandatory "ke" props - ka <- asVec4 $ mandatory "ka" props - kd <- asVec4 $ mandatory "kd" props - ks <- asVec4 $ mandatory "ks" props - shi <- asFloat $ mandatory "shi" props + name <- asString $ mandatory' "name" props + file <- asString $ mandatory' "file" props + tex <- asString $ mandatory' "texture" props + prog <- asString $ mandatory' "shader-program" props + ke <- asVec4 $ mandatory' "ke" props + ka <- asVec4 $ mandatory' "ka" props + kd <- asVec4 $ mandatory' "kd" props + ks <- asVec4 $ mandatory' "ks" props + shi <- asFloat $ mandatory' "shi" props let rotation = asRotation $ value "rotation" props scale = asVec3 $ value "scale" props @@ -192,6 +194,7 @@ loadModel' file rotation scale = do case scale of Just s -> setupIO $ Model.transform (scalev s) model Nothing -> return () + setupIO $ toGround model return model @@ -213,17 +216,17 @@ newShaderProgram :: SceneGraph -> Loader () newShaderProgram (SceneLeaf _ props) = do (vsName, vertShader) <- Spear.Scene.Loader.loadShader GLSL.VertexShader props (fsName, fragShader) <- Spear.Scene.Loader.loadShader GLSL.FragmentShader props - name <- asString $ mandatory "name" props - stype <- asString $ mandatory "type" props - texChan <- fmap read $ asString $ mandatory "texture-channel" props - ambient <- asString $ mandatory "ambient" props - diffuse <- asString $ mandatory "diffuse" props - specular <- asString $ mandatory "specular" props - shininess <- asString $ mandatory "shininess" props - texture <- asString $ mandatory "texture" props - modelview <- asString $ mandatory "modelview" props - normalmat <- asString $ mandatory "normalmat" props - projection <- asString $ mandatory "projection" props + name <- asString $ mandatory' "name" props + stype <- asString $ mandatory' "type" props + texChan <- fmap read $ asString $ mandatory' "texture-channel" props + ambient <- asString $ mandatory' "ambient" props + diffuse <- asString $ mandatory' "diffuse" props + specular <- asString $ mandatory' "specular" props + shininess <- asString $ mandatory' "shininess" props + texture <- asString $ mandatory' "texture" props + modelview <- asString $ mandatory' "modelview" props + normalmat <- asString $ mandatory' "normalmat" props + projection <- asString $ mandatory' "projection" props prog <- loaderSetup $ GLSL.newProgram [vertShader, fragShader] let getUniformLoc name = @@ -240,8 +243,8 @@ newShaderProgram (SceneLeaf _ props) = do case stype of "static" -> do - vertChan <- fmap read $ asString $ mandatory "vertex-channel" props - normChan <- fmap read $ asString $ mandatory "normal-channel" props + vertChan <- fmap read $ asString $ mandatory' "vertex-channel" props + normChan <- fmap read $ asString $ mandatory' "normal-channel" props let channels = StaticProgramChannels vertChan normChan texChan uniforms = StaticProgramUniforms ka kd ks shi tex mview nmat proj @@ -251,11 +254,11 @@ newShaderProgram (SceneLeaf _ props) = do return () "animated" -> do - vertChan1 <- fmap read $ asString $ mandatory "vertex-channel1" props - vertChan2 <- fmap read $ asString $ mandatory "vertex-channel2" props - normChan1 <- fmap read $ asString $ mandatory "normal-channel1" props - normChan2 <- fmap read $ asString $ mandatory "normal-channel2" props - fp <- asString $ mandatory "fp" props + vertChan1 <- fmap read $ asString $ mandatory' "vertex-channel1" props + vertChan2 <- fmap read $ asString $ mandatory' "vertex-channel2" props + normChan1 <- fmap read $ asString $ mandatory' "normal-channel1" props + normChan2 <- fmap read $ asString $ mandatory' "normal-channel2" props + fp <- asString $ mandatory' "fp" props p <- getUniformLoc fp let channels = AnimatedProgramChannels vertChan1 vertChan2 normChan1 normChan2 texChan @@ -290,34 +293,34 @@ newLight _ = return () -- Object Loading -- -------------------- +type CreateGameObject a = String -- ^ The object's name. + -> SceneResources + -> [Property] + -> Matrix4 -- ^ The object's transform. + -> Setup a + -- | Load objects from the given 'SceneGraph'. -loadObjects :: CreateStaticObject a -> CreateAnimatedObject a -> SceneResources -> SceneGraph -> Setup [a] -loadObjects newSO newAO sceneRes g = +loadObjects :: CreateGameObject a -> SceneResources -> SceneGraph -> Setup [a] +loadObjects newGO sceneRes g = case node "layout" g of Nothing -> return [] - Just n -> do - let gos = concat . fmap (newObject newSO newAO sceneRes) $ children n - forM gos $ \go -> case go of - Left err -> setupError err - Right go -> return go + Just n -> sequence . concat . fmap (newObject newGO sceneRes) $ children n -- to-do: use a strict accumulator and make loadObjects tail recursive. -newObject :: CreateStaticObject a -> CreateAnimatedObject a -> SceneResources -> SceneGraph -> [Either String a] -newObject newSO newAO sceneRes (SceneNode nid props children) = - let o = newObject' newSO newAO sceneRes nid props - in o : (concat $ fmap (newObject newSO newAO sceneRes) children) +newObject :: CreateGameObject a -> SceneResources -> SceneGraph -> [Setup a] +newObject newGO sceneRes (SceneNode nid props children) = + let o = newObject' newGO sceneRes nid props + in o : (concat $ fmap (newObject newGO sceneRes) children) -newObject newSO newAO sceneRes (SceneLeaf nid props) = [newObject' newSO newAO sceneRes nid props] +newObject newGO sceneRes (SceneLeaf nid props) = [newObject' newGO sceneRes nid props] -newObject' :: CreateStaticObject a -> CreateAnimatedObject a -> SceneResources - -> String -> [Property] -> Either String a -newObject' newSO newAO sceneRes nid props = do +newObject' :: CreateGameObject a -> SceneResources -> String -> [Property] -> Setup a +newObject' newGO sceneRes nid props = do -- Optional properties. let name = (asString $ value "name" props) `unspecified` "unknown" - model = (asString $ value "model" props) `unspecified` "ghost" position = (asVec3 $ value "position" props) `unspecified` vec3 0 0 0 rotation = (asVec3 $ value "rotation" props) `unspecified` vec3 0 0 0 right' = (asVec3 $ value "right" props) `unspecified` vec3 1 0 0 @@ -328,11 +331,7 @@ newObject' newSO newAO sceneRes nid props = do -- Compute the object's vectors if a forward vector has been specified. let (right, up, forward) = vectors forward' - case M.lookup model $ staticModels sceneRes of - Just m -> Right $ newSO name (M4.transform right up forward position) m - Nothing -> case M.lookup model $ animatedModels sceneRes of - Just m -> Right $ newAO name (M4.transform right up forward position) m - Nothing -> Left $ "Loader::newObject: model " ++ model ++ " has not been loaded." + newGO name sceneRes props (M4.transform right up forward position) vectors :: Maybe Vector3 -> (Vector3, Vector3, Vector3) @@ -363,12 +362,16 @@ unspecified (Just x) _ = x unspecified Nothing x = x -mandatory :: String -> [Property] -> Loader [String] +mandatory :: String -> [Property] -> Setup [String] mandatory name props = case value name props of - Nothing -> loaderError $ "Loader::mandatory: key not found: " ++ name + Nothing -> setupError $ "Loader::mandatory: key not found: " ++ name Just x -> return x +mandatory' :: String -> [Property] -> Loader [String] +mandatory' name props = loaderSetup $ mandatory name props + + asString :: Functor f => f [String] -> f String asString = fmap concat -- cgit v1.2.3