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