Moved IDStore to Store.ID. Created generic Store

5 files changed, 124 insertions, 9 deletions

diff --git a/Spear.cabal b/Spear.cabal
index f025de2..d30cbae 100644
--- a/Spear.cabal
+++ b/Spear.cabal
@@ -16,7 +16,7 @@ library
                    StateVar -any, base -any, bytestring -any, directory -any,
                    mtl -any, transformers -any, resource-simple -any, parsec >=3.1.3,
                    containers -any, vector -any, array -any
-    exposed-modules: Spear.Math.Triangle Spear.IDStore
+    exposed-modules: Spear.Math.Triangle
                      Spear.Physics.Types Spear.Physics.World Spear.App
                      Spear.App.Application Spear.App.Input Spear.Assets.Image
                      Spear.Assets.Model Spear.Collision Spear.Collision.AABB
@@ -34,6 +34,7 @@ library
                      Spear.Render.StaticModel Spear.Render.Texture Spear.Scene.Graph
                      Spear.Scene.Light Spear.Scene.Loader Spear.Scene.Scene
                      Spear.Scene.SceneResources Spear.Setup Spear.Sys.Timer
+                     Spear.Sys.Store Spear.Sys.Store.ID
                      Spear.Updatable
     exposed: True
     buildable: True
diff --git a/Spear.lkshs b/Spear.lkshs
index a3f492f..042ccc8 100644
--- a/Spear.lkshs
+++ b/Spear.lkshs
@@ -1,18 +1,18 @@
 Version of session file format:
                1
 Time of storage:
-               "Wed Aug  8 13:25:10 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}) 273) 205)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 716) 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" 3129)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/IDStore.hs" 186)),[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 286 (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/Math/Spatial.hs" 0)),[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" 3781)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs" 1603)),[SplitP LeftP])]
+               "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])]
 Window size:   (1841,964)
 Completion size:
                (750,400)
 Workspace:     Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw"
-Active pane:   Just "IDStore.hs"
+Active pane:   Just "Modules"
 Toolbar visible:
                True
-FindbarState:  (False,FindState {entryStr = "asd", entryHist = ["gravity","asdad","rotSpeed","azimuth","mandatory","mandao","col","forward","MouseButton"], replaceStr = "mandatory'", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = False, regex = False, lineNr = 1})
+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})
 Recently opened files:
-               ["/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","/home/jeanne/programming/haskell/Spear/Spear/App/Input.hs"]
+               ["/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:
                ["/home/jeanne/leksah.lkshw"]
\ No newline at end of file
diff --git a/Spear.lkshw b/Spear.lkshw
index cc572e4..2291729 100644
--- a/Spear.lkshw
+++ b/Spear.lkshw
@@ -1,7 +1,7 @@
 Version of workspace file format:
                1
 Time of storage:
-               "Wed Aug  8 15:15:08 CEST 2012"
+               "Wed Aug  8 21:04:06 CEST 2012"
 Name of the workspace:
                "Spear"
 File paths of contained packages:
diff --git a/Spear/Sys/Store.hs b/Spear/Sys/Store.hs
new file mode 100644
index 0000000..3d5d794
--- /dev/null
+++ b/Spear/Sys/Store.hs
@@ -0,0 +1,114 @@
+module Spear.Sys.Store
+(
+    Store
+,   Index
+,   emptyStore
+,   store
+,   storeFree
+,   element
+)
+where
+
+
+import Data.Maybe (isJust, isNothing)
+import Data.Vector as V
+import Control.Monad.State -- test
+import Text.Printf -- test
+
+
+type Index = Int
+
+
+data Store a = Store
+    { assigned :: Vector (Maybe a) -- ^ An array of objects.
+    , last     :: Index -- ^ The greatest index assigned so far.
+    }
+    deriving Show
+
+
+-- | Create an empty store.
+emptyStore :: Store a
+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
+        Just i  -> assign i elem s
+        Nothing -> store elem $ Store (assigned 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.
+storeFree :: Index -> Store a -> Store a
+storeFree i (Store assigned last) =
+    let assigned' = assigned // [(i,Nothing)]
+    in  if i == last
+        then case findLastIndex isJust assigned' of
+            Just j  -> Store assigned' j
+            Nothing -> Store assigned' 0
+        else
+            Store assigned' last
+
+
+findLastIndex :: (a -> Bool) -> Vector a -> Maybe Index
+findLastIndex p v = findLastIndex' p v Nothing 0
+    where
+        findLastIndex' p v current i =
+            if i >= V.length v then current
+            else if p $ v V.! i then let x = Just i in x `seq` findLastIndex' p v x (i+1)
+            else findLastIndex' p v current (i+1) 
+
+
+-- | Access the element in the given slot.
+element :: Index -> Store a -> Maybe a
+element index (Store assigned _) = assigned V.! index
+
+
+-- test
+test :: IO ()
+test = evalStateT test' emptyStore
+
+
+test' :: StateT (Store Int) IO ()
+test' = do
+    x <- store' 1
+    y <- store' 2
+    z <- store' 3
+    w <- store' 4
+    free y
+    store' 5
+    free w
+    store' 6
+    a <- store' 7
+    free a
+    store' 8
+    return ()
+
+
+store' :: Int -> StateT (Store Int) IO Int
+store' elem = do
+    s <- get
+    let (i, s') = store elem s
+    put s'
+    lift $ printf "%d stored at %d; %s\n" elem i (show s')
+    return i
+
+
+free :: Index -> StateT (Store Int) IO ()
+free i = do
+    s <- get
+    let s' = storeFree i s
+    put s'
+    lift $ printf "Slot %d freed; %s\n" i (show s')
+
diff --git a/Spear/IDStore.hs b/Spear/Sys/Store/ID.hs
index 8879756..a4da3d0 100644
--- a/Spear/IDStore.hs
+++ b/Spear/Sys/Store/ID.hs
@@ -1,4 +1,4 @@
-module Spear.IDStore
+module Spear.Sys.Store.ID
 (
     ID   
 ,   IDStore