2 files changed, 84 insertions, 24 deletions

diff --git a/Spear.lkshs b/Spear.lkshs
index 042ccc8..3f28583 100644
--- a/Spear.lkshs
+++ b/Spear.lkshs
@@ -1,17 +1,17 @@
 Version of session file format:
                1
 Time of storage:
-               "Wed Aug  8 20:32:17 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}) 267) 200)], 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" 8164)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameState.hs" 670)),[SplitP LeftP]),(Just (InfoSt (InfoState (Just (Real (RealDescr {dscName' = "UpdateGO", dscMbTypeStr' = Just "type UpdateGO =\n    Bool -> Input -> Float -> State [GameMessage] GameObject", dscMbModu' = Just (PM {pack = PackageIdentifier {pkgName = PackageName "simple-scene", pkgVersion = Version {versionBranch = [0,1,0,0], versionTags = []}}, modu = ModuleName ["GameObject"]}), dscMbLocation' = Just (Location {locationSLine = 43, locationSCol = 1, locationELine = 43, locationECol = 73}), dscMbComment' = Nothing, dscTypeHint' = TypeDescr, dscExported' = False}))))),[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","IDStore"]),Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([[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 (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Physics/World.hs" 1269)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs" 1294)),[SplitP LeftP])]
+               "Thu Aug  9 11:37:44 CEST 2012"
+Layout:        VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 5, 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}) 279) 208)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 732) 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 Nothing)),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (ModulesSt (ModulesState 328 (PackageScope False,False) (Nothing,Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([],[]), 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" 2183)),[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" 1269)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs" 204)),[SplitP LeftP])]
 Window size:   (1841,964)
 Completion size:
                (750,400)
 Workspace:     Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw"
-Active pane:   Just "Modules"
+Active pane:   Just "Store.hs"
 Toolbar visible:
                True
-FindbarState:  (False,FindState {entryStr = "asd", entryHist = ["Triangle","transforma","gravity","asdad","rotSpeed","azimuth","mandatory","mandao","col","forward","MouseButton"], replaceStr = "CTriangle", replaceHist = [], caseSensitive = True, entireWord = False, wrapAround = False, regex = False, lineNr = 1})
+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})
 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"]
 Recently opened workspaces:
diff --git a/Spear/Sys/Store.hs b/Spear/Sys/Store.hs
index 3d5d794..65381ca 100644
--- a/Spear/Sys/Store.hs
+++ b/Spear/Sys/Store.hs
@@ -4,12 +4,15 @@ module Spear.Sys.Store
 ,   Index
 ,   emptyStore
 ,   store
+,   storel
 ,   storeFree
+,   storeFreel
 ,   element
 )
 where
 
 
+import Data.List as L (find)
 import Data.Maybe (isJust, isNothing)
 import Data.Vector as V
 import Control.Monad.State -- test
@@ -20,8 +23,8 @@ type Index = Int
 
 
 data Store a = Store
-    { assigned :: Vector (Maybe a) -- ^ An array of objects.
-    , last     :: Index -- ^ The greatest index assigned so far.
+    { objects :: Vector (Maybe a) -- ^ An array of objects.
+    , last    :: Index -- ^ The greatest index assigned so far.
     }
     deriving Show
 
@@ -33,32 +36,76 @@ emptyStore = Store V.empty (-1)
 
 -- | Store the given element in the store.
 store :: a -> Store a -> (Index, Store a)
-store elem s@(Store assigned last) =
-    if last == V.length assigned - 1
-    then case findIndex isNothing assigned of
+store elem s@(Store objects last) =
+    if last == V.length objects - 1
+    then case findIndex isNothing objects of
         Just i  -> assign i elem s
-        Nothing -> store elem $ Store (assigned V.++ V.replicate (max 1 last + 1) Nothing) last
+        Nothing -> store elem $ Store (objects V.++ V.replicate (max 1 last + 1) Nothing) last
     else
         assign (last+1) elem s
 
 
 -- Assign a slot the given element in the store.
 assign :: Index -> a -> Store a -> (Index, Store a)
-assign i elem (Store assigned last) =
-    let assigned' = assigned // [(i,Just elem)]
-    in (i, Store assigned' (max last i))
-
-
--- | Free the given element from the store.
+assign i elem (Store objects last) =
+    let objects' = objects // [(i,Just elem)]
+    in (i, Store objects' (max last i))
+
+
+-- | Store the given elements in the store.
+storel :: [a] -> Store a -> ([Index], Store a)
+storel elems s@(Store objects last) =
+    let n = Prelude.length elems
+        (count, slots) = freeSlots objects
+    in
+       let -- place count elements in free slots.
+            (is, s'') = storeInSlots slots (Prelude.take count elems) s
+            
+            -- append the remaining elements
+            (is', s') = append (Prelude.drop count elems) s''
+        in
+            (is Prelude.++ is', s')
+
+
+-- Count and return the free slots.
+freeSlots :: Vector (Maybe a) -> (Int, Vector Int)
+freeSlots v = let is = findIndices isNothing v in (V.length is, is) 
+
+
+-- Store the given elements in the given slots.
+-- Pre: valid indices.
+storeInSlots :: Vector Int -> [a] -> Store a -> ([Index], Store a)
+storeInSlots is elems (Store objects last) =
+    let objects' = V.update_ objects is (V.fromList $ fmap Just elems)
+        last' = let i = V.length is - 1
+                in if i < 0 then last else max last $ is ! i
+    in
+        (V.toList is, Store objects' last')
+
+
+-- Append the given elements to the last slot of the store, making space if necessary.
+append :: [a] -> Store a -> ([Index], Store a)
+append elems (Store objects last) =
+    let n = Prelude.length elems
+        indices = [last+1..last+n]
+        objects'' = if V.length objects <= last+n
+                    then objects V.++ V.replicate n Nothing
+                    else objects
+        objects'  = objects'' // (Prelude.zipWith (,) indices (fmap Just elems))
+    in
+        (indices, Store objects' $ last+n)
+
+
+-- | Free the given slot.
 storeFree :: Index -> Store a -> Store a
-storeFree i (Store assigned last) =
-    let assigned' = assigned // [(i,Nothing)]
+storeFree i (Store objects last) =
+    let objects' = objects // [(i,Nothing)]
     in  if i == last
-        then case findLastIndex isJust assigned' of
-            Just j  -> Store assigned' j
-            Nothing -> Store assigned' 0
+        then case findLastIndex isJust objects' of
+            Just j  -> Store objects' j
+            Nothing -> Store objects' 0
         else
-            Store assigned' last
+            Store objects' last
 
 
 findLastIndex :: (a -> Bool) -> Vector a -> Maybe Index
@@ -70,9 +117,22 @@ findLastIndex p v = findLastIndex' p v Nothing 0
             else findLastIndex' p v current (i+1) 
 
 
+-- | Free the given slots.
+storeFreel :: [Index] -> Store a -> Store a
+storeFreel is (Store objects last) =
+    let objects' = objects // Prelude.zipWith (,) is (repeat Nothing)
+        last' = case L.find (==last) is of
+                    Nothing -> last
+                    Just _  -> case findLastIndex isJust objects' of
+                        Just j  -> j
+                        Nothing -> (-1)
+    in
+        Store objects' last'
+
+
 -- | Access the element in the given slot.
 element :: Index -> Store a -> Maybe a
-element index (Store assigned _) = assigned V.! index
+element index (Store objects _) = objects V.! index
 
 
 -- test