aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Spear.lkshs12
-rw-r--r--Spear.lkshw2
-rw-r--r--Spear/Assets/Model.hsc10
-rw-r--r--Spear/Assets/Model/Model.c26
-rw-r--r--Spear/Assets/Model/Model.h3
-rw-r--r--Spear/Scene/Loader.hs115
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 @@
1Version of session file format: 1Version of session file format:
2 1 2 1
3Time of storage: 3Time of storage:
4 "Wed Aug 1 13:16:07 CEST 2012" 4 "Thu Aug 2 15:35:02 CEST 2012"
5Layout: 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 5Layout: 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
6Population: [(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])] 6Population: [(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])]
7Window size: (1796,979) 7Window size: (1796,979)
8Completion size: 8Completion size:
9 (750,400) 9 (750,400)
10Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" 10Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw"
11Active pane: Just "GameObject.hs" 11Active pane: Just "Model.c"
12Toolbar visible: 12Toolbar visible:
13 True 13 True
14FindbarState: (False,FindState {entryStr = "asd", entryHist = ["col","forward","asd","MouseButton"], replaceStr = "row", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = False, regex = False, lineNr = 1}) 14FindbarState: (False,FindState {entryStr = "asd", entryHist = ["mandatory","mandao","col","forward","asd","MouseButton"], replaceStr = "mandatory'", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = False, regex = False, lineNr = 1})
15Recently opened files: 15Recently 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"]
17Recently opened workspaces: 17Recently 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 @@
1Version of workspace file format: 1Version of workspace file format:
2 1 2 1
3Time of storage: 3Time of storage:
4 "Tue Jul 31 20:32:45 CEST 2012" 4 "Wed Aug 1 18:11:40 CEST 2012"
5Name of the workspace: 5Name of the workspace:
6 "Spear" 6 "Spear"
7File paths of contained packages: 7File 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)
34where 35where
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.
336toGround :: Model -> IO ()
337toGround (Model model _ _) = with model model_to_ground
338
339
340foreign import ccall "Model.h model_to_ground"
341 model_to_ground :: Ptr CModel -> IO ()
342
343
334sizeFloat = #{size float} 344sizeFloat = #{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
76void 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.
73void model_transform (Model* model, float mat[16], float normal[9]); 73void 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.
76void 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 @@
1module Spear.Scene.Loader 1module 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)
11where 17where
12 18
@@ -43,10 +49,6 @@ loaderIO = loaderSetup . setupIO
43loaderError = loaderSetup . setupError 49loaderError = loaderSetup . setupError
44 50
45 51
46type CreateStaticObject a = String -> Matrix4 -> StaticModelResource -> a
47type 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.
51loadScene :: FilePath -> Setup (SceneResources, SceneGraph) 53loadScene :: FilePath -> Setup (SceneResources, SceneGraph)
52loadScene file = do 54loadScene file = do
@@ -141,15 +143,15 @@ getResource field key = do
141 143
142newModel :: SceneGraph -> Loader () 144newModel :: SceneGraph -> Loader ()
143newModel (SceneLeaf _ props) = do 145newModel (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 ()
213newShaderProgram (SceneLeaf _ props) = do 216newShaderProgram (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
296type 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'.
295loadObjects :: CreateStaticObject a -> CreateAnimatedObject a -> SceneResources -> SceneGraph -> Setup [a] 304loadObjects :: CreateGameObject a -> SceneResources -> SceneGraph -> Setup [a]
296loadObjects newSO newAO sceneRes g = 305loadObjects 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.
307newObject :: CreateStaticObject a -> CreateAnimatedObject a -> SceneResources -> SceneGraph -> [Either String a] 312newObject :: CreateGameObject a -> SceneResources -> SceneGraph -> [Setup a]
308newObject newSO newAO sceneRes (SceneNode nid props children) = 313newObject 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
312newObject newSO newAO sceneRes (SceneLeaf nid props) = [newObject' newSO newAO sceneRes nid props] 317newObject newGO sceneRes (SceneLeaf nid props) = [newObject' newGO sceneRes nid props]
313 318
314 319
315newObject' :: CreateStaticObject a -> CreateAnimatedObject a -> SceneResources 320newObject' :: CreateGameObject a -> SceneResources -> String -> [Property] -> Setup a
316 -> String -> [Property] -> Either String a 321newObject' newGO sceneRes nid props = do
317newObject' 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
338vectors :: Maybe Vector3 -> (Vector3, Vector3, Vector3) 337vectors :: Maybe Vector3 -> (Vector3, Vector3, Vector3)
@@ -363,12 +362,16 @@ unspecified (Just x) _ = x
363unspecified Nothing x = x 362unspecified Nothing x = x
364 363
365 364
366mandatory :: String -> [Property] -> Loader [String] 365mandatory :: String -> [Property] -> Setup [String]
367mandatory name props = case value name props of 366mandatory 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
371mandatory' :: String -> [Property] -> Loader [String]
372mandatory' name props = loaderSetup $ mandatory name props
373
374
372asString :: Functor f => f [String] -> f String 375asString :: Functor f => f [String] -> f String
373asString = fmap concat 376asString = fmap concat
374 377