diff options
-rw-r--r-- | Spear.lkshs | 12 | ||||
-rw-r--r-- | Spear.lkshw | 2 | ||||
-rw-r--r-- | Spear/Assets/Model.hsc | 10 | ||||
-rw-r--r-- | Spear/Assets/Model/Model.c | 26 | ||||
-rw-r--r-- | Spear/Assets/Model/Model.h | 3 | ||||
-rw-r--r-- | 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 @@ | |||
1 | Version of session file format: | 1 | Version of session file format: |
2 | 1 | 2 | 1 |
3 | Time of storage: | 3 | Time of storage: |
4 | "Wed Aug 1 13:16:07 CEST 2012" | 4 | "Thu Aug 2 15:35:02 CEST 2012" |
5 | 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 | 5 | 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 |
6 | 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])] | 6 | 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])] |
7 | Window size: (1796,979) | 7 | Window size: (1796,979) |
8 | Completion size: | 8 | Completion size: |
9 | (750,400) | 9 | (750,400) |
10 | Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" | 10 | Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" |
11 | Active pane: Just "GameObject.hs" | 11 | Active pane: Just "Model.c" |
12 | Toolbar visible: | 12 | Toolbar visible: |
13 | True | 13 | True |
14 | FindbarState: (False,FindState {entryStr = "asd", entryHist = ["col","forward","asd","MouseButton"], replaceStr = "row", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = False, regex = False, lineNr = 1}) | 14 | 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}) |
15 | Recently opened files: | 15 | Recently opened files: |
16 | ["/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"] | 16 | ["/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"] |
17 | Recently opened workspaces: | 17 | Recently opened workspaces: |
18 | ["/home/jeanne/programming/haskell/Spear/Spear.lkshw","/home/jeanne/leksah.lkshw"] \ No newline at end of file | 18 | ["/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 @@ | |||
1 | Version of workspace file format: | 1 | Version of workspace file format: |
2 | 1 | 2 | 1 |
3 | Time of storage: | 3 | Time of storage: |
4 | "Tue Jul 31 20:32:45 CEST 2012" | 4 | "Wed Aug 1 18:11:40 CEST 2012" |
5 | Name of the workspace: | 5 | Name of the workspace: |
6 | "Spear" | 6 | "Spear" |
7 | File paths of contained packages: | 7 | 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 | |||
30 | , numAnimations | 30 | , numAnimations |
31 | -- * Manipulation | 31 | -- * Manipulation |
32 | , transform | 32 | , transform |
33 | , toGround | ||
33 | ) | 34 | ) |
34 | where | 35 | where |
35 | 36 | ||
@@ -331,4 +332,13 @@ foreign import ccall "Model.h model_transform" | |||
331 | model_transform :: Ptr CModel -> Ptr M4.Matrix4 -> Ptr M3.Matrix3 -> IO () | 332 | model_transform :: Ptr CModel -> Ptr M4.Matrix4 -> Ptr M3.Matrix3 -> IO () |
332 | 333 | ||
333 | 334 | ||
335 | -- | Transform the given 'Model' such that its lowest point has y = 0. | ||
336 | toGround :: Model -> IO () | ||
337 | toGround (Model model _ _) = with model model_to_ground | ||
338 | |||
339 | |||
340 | foreign import ccall "Model.h model_to_ground" | ||
341 | model_to_ground :: Ptr CModel -> IO () | ||
342 | |||
343 | |||
334 | sizeFloat = #{size float} | 344 | 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]) | |||
71 | n++; | 71 | n++; |
72 | } | 72 | } |
73 | } | 73 | } |
74 | |||
75 | |||
76 | void model_to_ground (Model* model) | ||
77 | { | ||
78 | unsigned i, f; | ||
79 | vec3* v = model->vertices; | ||
80 | |||
81 | // Compute the minimum y coordinate for each frame and translate | ||
82 | // the model appropriately. | ||
83 | for (f = 0; f < model->numFrames; ++f) | ||
84 | { | ||
85 | vec3* w = v; | ||
86 | float y = v->y; | ||
87 | |||
88 | for (i = 0; i < model->numVertices; ++i, ++v) | ||
89 | { | ||
90 | y = fmin (y, v->y); | ||
91 | } | ||
92 | |||
93 | v = w; | ||
94 | for (i = 0; i < model->numVertices; ++i, ++v) | ||
95 | { | ||
96 | v->y -= y; | ||
97 | } | ||
98 | } | ||
99 | } | ||
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); | |||
72 | /// Transform the given Model's vertices by the given matrix. | 72 | /// Transform the given Model's vertices by the given matrix. |
73 | void model_transform (Model* model, float mat[16], float normal[9]); | 73 | void model_transform (Model* model, float mat[16], float normal[9]); |
74 | 74 | ||
75 | /// Translate the given Model such that its lowest point has y = 0. | ||
76 | void model_to_ground (Model* model); | ||
77 | |||
75 | #ifdef __cplusplus | 78 | #ifdef __cplusplus |
76 | } | 79 | } |
77 | #endif | 80 | #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 @@ | |||
1 | module Spear.Scene.Loader | 1 | module Spear.Scene.Loader |
2 | ( | 2 | ( |
3 | SceneResources(..) | 3 | SceneResources(..) |
4 | , CreateStaticObject | 4 | , CreateGameObject |
5 | , CreateAnimatedObject | ||
6 | , loadScene | 5 | , loadScene |
7 | , validate | 6 | , validate |
8 | , resourceMap | 7 | , resourceMap |
9 | , loadObjects | 8 | , loadObjects |
9 | , value | ||
10 | , unspecified | ||
11 | , mandatory | ||
12 | , asString | ||
13 | , asFloat | ||
14 | , asVec3 | ||
15 | , asVec4 | ||
10 | ) | 16 | ) |
11 | where | 17 | where |
12 | 18 | ||
@@ -43,10 +49,6 @@ loaderIO = loaderSetup . setupIO | |||
43 | loaderError = loaderSetup . setupError | 49 | loaderError = loaderSetup . setupError |
44 | 50 | ||
45 | 51 | ||
46 | type CreateStaticObject a = String -> Matrix4 -> StaticModelResource -> a | ||
47 | type CreateAnimatedObject a = String -> Matrix4 -> AnimatedModelResource -> a | ||
48 | |||
49 | |||
50 | -- | Load the scene specified by the given file. | 52 | -- | Load the scene specified by the given file. |
51 | loadScene :: FilePath -> Setup (SceneResources, SceneGraph) | 53 | loadScene :: FilePath -> Setup (SceneResources, SceneGraph) |
52 | loadScene file = do | 54 | loadScene file = do |
@@ -141,15 +143,15 @@ getResource field key = do | |||
141 | 143 | ||
142 | newModel :: SceneGraph -> Loader () | 144 | newModel :: SceneGraph -> Loader () |
143 | newModel (SceneLeaf _ props) = do | 145 | newModel (SceneLeaf _ props) = do |
144 | name <- asString $ mandatory "name" props | 146 | name <- asString $ mandatory' "name" props |
145 | file <- asString $ mandatory "file" props | 147 | file <- asString $ mandatory' "file" props |
146 | tex <- asString $ mandatory "texture" props | 148 | tex <- asString $ mandatory' "texture" props |
147 | prog <- asString $ mandatory "shader-program" props | 149 | prog <- asString $ mandatory' "shader-program" props |
148 | ke <- asVec4 $ mandatory "ke" props | 150 | ke <- asVec4 $ mandatory' "ke" props |
149 | ka <- asVec4 $ mandatory "ka" props | 151 | ka <- asVec4 $ mandatory' "ka" props |
150 | kd <- asVec4 $ mandatory "kd" props | 152 | kd <- asVec4 $ mandatory' "kd" props |
151 | ks <- asVec4 $ mandatory "ks" props | 153 | ks <- asVec4 $ mandatory' "ks" props |
152 | shi <- asFloat $ mandatory "shi" props | 154 | shi <- asFloat $ mandatory' "shi" props |
153 | 155 | ||
154 | let rotation = asRotation $ value "rotation" props | 156 | let rotation = asRotation $ value "rotation" props |
155 | scale = asVec3 $ value "scale" props | 157 | scale = asVec3 $ value "scale" props |
@@ -192,6 +194,7 @@ loadModel' file rotation scale = do | |||
192 | case scale of | 194 | case scale of |
193 | Just s -> setupIO $ Model.transform (scalev s) model | 195 | Just s -> setupIO $ Model.transform (scalev s) model |
194 | Nothing -> return () | 196 | Nothing -> return () |
197 | setupIO $ toGround model | ||
195 | return model | 198 | return model |
196 | 199 | ||
197 | 200 | ||
@@ -213,17 +216,17 @@ newShaderProgram :: SceneGraph -> Loader () | |||
213 | newShaderProgram (SceneLeaf _ props) = do | 216 | newShaderProgram (SceneLeaf _ props) = do |
214 | (vsName, vertShader) <- Spear.Scene.Loader.loadShader GLSL.VertexShader props | 217 | (vsName, vertShader) <- Spear.Scene.Loader.loadShader GLSL.VertexShader props |
215 | (fsName, fragShader) <- Spear.Scene.Loader.loadShader GLSL.FragmentShader props | 218 | (fsName, fragShader) <- Spear.Scene.Loader.loadShader GLSL.FragmentShader props |
216 | name <- asString $ mandatory "name" props | 219 | name <- asString $ mandatory' "name" props |
217 | stype <- asString $ mandatory "type" props | 220 | stype <- asString $ mandatory' "type" props |
218 | texChan <- fmap read $ asString $ mandatory "texture-channel" props | 221 | texChan <- fmap read $ asString $ mandatory' "texture-channel" props |
219 | ambient <- asString $ mandatory "ambient" props | 222 | ambient <- asString $ mandatory' "ambient" props |
220 | diffuse <- asString $ mandatory "diffuse" props | 223 | diffuse <- asString $ mandatory' "diffuse" props |
221 | specular <- asString $ mandatory "specular" props | 224 | specular <- asString $ mandatory' "specular" props |
222 | shininess <- asString $ mandatory "shininess" props | 225 | shininess <- asString $ mandatory' "shininess" props |
223 | texture <- asString $ mandatory "texture" props | 226 | texture <- asString $ mandatory' "texture" props |
224 | modelview <- asString $ mandatory "modelview" props | 227 | modelview <- asString $ mandatory' "modelview" props |
225 | normalmat <- asString $ mandatory "normalmat" props | 228 | normalmat <- asString $ mandatory' "normalmat" props |
226 | projection <- asString $ mandatory "projection" props | 229 | projection <- asString $ mandatory' "projection" props |
227 | prog <- loaderSetup $ GLSL.newProgram [vertShader, fragShader] | 230 | prog <- loaderSetup $ GLSL.newProgram [vertShader, fragShader] |
228 | 231 | ||
229 | let getUniformLoc name = | 232 | let getUniformLoc name = |
@@ -240,8 +243,8 @@ newShaderProgram (SceneLeaf _ props) = do | |||
240 | 243 | ||
241 | case stype of | 244 | case stype of |
242 | "static" -> do | 245 | "static" -> do |
243 | vertChan <- fmap read $ asString $ mandatory "vertex-channel" props | 246 | vertChan <- fmap read $ asString $ mandatory' "vertex-channel" props |
244 | normChan <- fmap read $ asString $ mandatory "normal-channel" props | 247 | normChan <- fmap read $ asString $ mandatory' "normal-channel" props |
245 | 248 | ||
246 | let channels = StaticProgramChannels vertChan normChan texChan | 249 | let channels = StaticProgramChannels vertChan normChan texChan |
247 | uniforms = StaticProgramUniforms ka kd ks shi tex mview nmat proj | 250 | uniforms = StaticProgramUniforms ka kd ks shi tex mview nmat proj |
@@ -251,11 +254,11 @@ newShaderProgram (SceneLeaf _ props) = do | |||
251 | return () | 254 | return () |
252 | 255 | ||
253 | "animated" -> do | 256 | "animated" -> do |
254 | vertChan1 <- fmap read $ asString $ mandatory "vertex-channel1" props | 257 | vertChan1 <- fmap read $ asString $ mandatory' "vertex-channel1" props |
255 | vertChan2 <- fmap read $ asString $ mandatory "vertex-channel2" props | 258 | vertChan2 <- fmap read $ asString $ mandatory' "vertex-channel2" props |
256 | normChan1 <- fmap read $ asString $ mandatory "normal-channel1" props | 259 | normChan1 <- fmap read $ asString $ mandatory' "normal-channel1" props |
257 | normChan2 <- fmap read $ asString $ mandatory "normal-channel2" props | 260 | normChan2 <- fmap read $ asString $ mandatory' "normal-channel2" props |
258 | fp <- asString $ mandatory "fp" props | 261 | fp <- asString $ mandatory' "fp" props |
259 | p <- getUniformLoc fp | 262 | p <- getUniformLoc fp |
260 | 263 | ||
261 | let channels = AnimatedProgramChannels vertChan1 vertChan2 normChan1 normChan2 texChan | 264 | let channels = AnimatedProgramChannels vertChan1 vertChan2 normChan1 normChan2 texChan |
@@ -290,34 +293,34 @@ newLight _ = return () | |||
290 | -- Object Loading -- | 293 | -- Object Loading -- |
291 | -------------------- | 294 | -------------------- |
292 | 295 | ||
296 | type CreateGameObject a = String -- ^ The object's name. | ||
297 | -> SceneResources | ||
298 | -> [Property] | ||
299 | -> Matrix4 -- ^ The object's transform. | ||
300 | -> Setup a | ||
301 | |||
293 | 302 | ||
294 | -- | Load objects from the given 'SceneGraph'. | 303 | -- | Load objects from the given 'SceneGraph'. |
295 | loadObjects :: CreateStaticObject a -> CreateAnimatedObject a -> SceneResources -> SceneGraph -> Setup [a] | 304 | loadObjects :: CreateGameObject a -> SceneResources -> SceneGraph -> Setup [a] |
296 | loadObjects newSO newAO sceneRes g = | 305 | loadObjects newGO sceneRes g = |
297 | case node "layout" g of | 306 | case node "layout" g of |
298 | Nothing -> return [] | 307 | Nothing -> return [] |
299 | Just n -> do | 308 | Just n -> sequence . concat . fmap (newObject newGO sceneRes) $ children n |
300 | let gos = concat . fmap (newObject newSO newAO sceneRes) $ children n | ||
301 | forM gos $ \go -> case go of | ||
302 | Left err -> setupError err | ||
303 | Right go -> return go | ||
304 | 309 | ||
305 | 310 | ||
306 | -- to-do: use a strict accumulator and make loadObjects tail recursive. | 311 | -- to-do: use a strict accumulator and make loadObjects tail recursive. |
307 | newObject :: CreateStaticObject a -> CreateAnimatedObject a -> SceneResources -> SceneGraph -> [Either String a] | 312 | newObject :: CreateGameObject a -> SceneResources -> SceneGraph -> [Setup a] |
308 | newObject newSO newAO sceneRes (SceneNode nid props children) = | 313 | newObject newGO sceneRes (SceneNode nid props children) = |
309 | let o = newObject' newSO newAO sceneRes nid props | 314 | let o = newObject' newGO sceneRes nid props |
310 | in o : (concat $ fmap (newObject newSO newAO sceneRes) children) | 315 | in o : (concat $ fmap (newObject newGO sceneRes) children) |
311 | 316 | ||
312 | newObject newSO newAO sceneRes (SceneLeaf nid props) = [newObject' newSO newAO sceneRes nid props] | 317 | newObject newGO sceneRes (SceneLeaf nid props) = [newObject' newGO sceneRes nid props] |
313 | 318 | ||
314 | 319 | ||
315 | newObject' :: CreateStaticObject a -> CreateAnimatedObject a -> SceneResources | 320 | newObject' :: CreateGameObject a -> SceneResources -> String -> [Property] -> Setup a |
316 | -> String -> [Property] -> Either String a | 321 | newObject' newGO sceneRes nid props = do |
317 | newObject' newSO newAO sceneRes nid props = do | ||
318 | -- Optional properties. | 322 | -- Optional properties. |
319 | let name = (asString $ value "name" props) `unspecified` "unknown" | 323 | let name = (asString $ value "name" props) `unspecified` "unknown" |
320 | model = (asString $ value "model" props) `unspecified` "ghost" | ||
321 | position = (asVec3 $ value "position" props) `unspecified` vec3 0 0 0 | 324 | position = (asVec3 $ value "position" props) `unspecified` vec3 0 0 0 |
322 | rotation = (asVec3 $ value "rotation" props) `unspecified` vec3 0 0 0 | 325 | rotation = (asVec3 $ value "rotation" props) `unspecified` vec3 0 0 0 |
323 | right' = (asVec3 $ value "right" props) `unspecified` vec3 1 0 0 | 326 | right' = (asVec3 $ value "right" props) `unspecified` vec3 1 0 0 |
@@ -328,11 +331,7 @@ newObject' newSO newAO sceneRes nid props = do | |||
328 | -- Compute the object's vectors if a forward vector has been specified. | 331 | -- Compute the object's vectors if a forward vector has been specified. |
329 | let (right, up, forward) = vectors forward' | 332 | let (right, up, forward) = vectors forward' |
330 | 333 | ||
331 | case M.lookup model $ staticModels sceneRes of | 334 | newGO name sceneRes props (M4.transform right up forward position) |
332 | Just m -> Right $ newSO name (M4.transform right up forward position) m | ||
333 | Nothing -> case M.lookup model $ animatedModels sceneRes of | ||
334 | Just m -> Right $ newAO name (M4.transform right up forward position) m | ||
335 | Nothing -> Left $ "Loader::newObject: model " ++ model ++ " has not been loaded." | ||
336 | 335 | ||
337 | 336 | ||
338 | vectors :: Maybe Vector3 -> (Vector3, Vector3, Vector3) | 337 | vectors :: Maybe Vector3 -> (Vector3, Vector3, Vector3) |
@@ -363,12 +362,16 @@ unspecified (Just x) _ = x | |||
363 | unspecified Nothing x = x | 362 | unspecified Nothing x = x |
364 | 363 | ||
365 | 364 | ||
366 | mandatory :: String -> [Property] -> Loader [String] | 365 | mandatory :: String -> [Property] -> Setup [String] |
367 | mandatory name props = case value name props of | 366 | mandatory name props = case value name props of |
368 | Nothing -> loaderError $ "Loader::mandatory: key not found: " ++ name | 367 | Nothing -> setupError $ "Loader::mandatory: key not found: " ++ name |
369 | Just x -> return x | 368 | Just x -> return x |
370 | 369 | ||
371 | 370 | ||
371 | mandatory' :: String -> [Property] -> Loader [String] | ||
372 | mandatory' name props = loaderSetup $ mandatory name props | ||
373 | |||
374 | |||
372 | asString :: Functor f => f [String] -> f String | 375 | asString :: Functor f => f [String] -> f String |
373 | asString = fmap concat | 376 | asString = fmap concat |
374 | 377 | ||