aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Spear.lkshs10
-rw-r--r--Spear/Sys/Store.hs98
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 @@
1Version of session file format: 1Version of session file format:
2 1 2 1
3Time of storage: 3Time of storage:
4 "Wed Aug 8 20:32:17 CEST 2012" 4 "Thu Aug 9 11:37:44 CEST 2012"
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}) 267) 200)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 702) 954 5Layout: 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
6Population: [(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])] 6Population: [(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])]
7Window size: (1841,964) 7Window size: (1841,964)
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 "Modules" 11Active pane: Just "Store.hs"
12Toolbar visible: 12Toolbar visible:
13 True 13 True
14FindbarState: (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}) 14FindbarState: (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})
15Recently opened files: 15Recently opened files:
16 ["/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"] 16 ["/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"]
17Recently opened workspaces: 17Recently 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
4, Index 4, Index
5, emptyStore 5, emptyStore
6, store 6, store
7, storel
7, storeFree 8, storeFree
9, storeFreel
8, element 10, element
9) 11)
10where 12where
11 13
12 14
15import Data.List as L (find)
13import Data.Maybe (isJust, isNothing) 16import Data.Maybe (isJust, isNothing)
14import Data.Vector as V 17import Data.Vector as V
15import Control.Monad.State -- test 18import Control.Monad.State -- test
@@ -20,8 +23,8 @@ type Index = Int
20 23
21 24
22data Store a = Store 25data Store a = Store
23 { assigned :: Vector (Maybe a) -- ^ An array of objects. 26 { objects :: Vector (Maybe a) -- ^ An array of objects.
24 , last :: Index -- ^ The greatest index assigned so far. 27 , last :: Index -- ^ The greatest index assigned so far.
25 } 28 }
26 deriving Show 29 deriving Show
27 30
@@ -33,32 +36,76 @@ emptyStore = Store V.empty (-1)
33 36
34-- | Store the given element in the store. 37-- | Store the given element in the store.
35store :: a -> Store a -> (Index, Store a) 38store :: a -> Store a -> (Index, Store a)
36store elem s@(Store assigned last) = 39store elem s@(Store objects last) =
37 if last == V.length assigned - 1 40 if last == V.length objects - 1
38 then case findIndex isNothing assigned of 41 then case findIndex isNothing objects of
39 Just i -> assign i elem s 42 Just i -> assign i elem s
40 Nothing -> store elem $ Store (assigned V.++ V.replicate (max 1 last + 1) Nothing) last 43 Nothing -> store elem $ Store (objects V.++ V.replicate (max 1 last + 1) Nothing) last
41 else 44 else
42 assign (last+1) elem s 45 assign (last+1) elem s
43 46
44 47
45-- Assign a slot the given element in the store. 48-- Assign a slot the given element in the store.
46assign :: Index -> a -> Store a -> (Index, Store a) 49assign :: Index -> a -> Store a -> (Index, Store a)
47assign i elem (Store assigned last) = 50assign i elem (Store objects last) =
48 let assigned' = assigned // [(i,Just elem)] 51 let objects' = objects // [(i,Just elem)]
49 in (i, Store assigned' (max last i)) 52 in (i, Store objects' (max last i))
50 53
51 54
52-- | Free the given element from the store. 55-- | Store the given elements in the store.
56storel :: [a] -> Store a -> ([Index], Store a)
57storel elems s@(Store objects last) =
58 let n = Prelude.length elems
59 (count, slots) = freeSlots objects
60 in
61 let -- place count elements in free slots.
62 (is, s'') = storeInSlots slots (Prelude.take count elems) s
63
64 -- append the remaining elements
65 (is', s') = append (Prelude.drop count elems) s''
66 in
67 (is Prelude.++ is', s')
68
69
70-- Count and return the free slots.
71freeSlots :: Vector (Maybe a) -> (Int, Vector Int)
72freeSlots v = let is = findIndices isNothing v in (V.length is, is)
73
74
75-- Store the given elements in the given slots.
76-- Pre: valid indices.
77storeInSlots :: Vector Int -> [a] -> Store a -> ([Index], Store a)
78storeInSlots is elems (Store objects last) =
79 let objects' = V.update_ objects is (V.fromList $ fmap Just elems)
80 last' = let i = V.length is - 1
81 in if i < 0 then last else max last $ is ! i
82 in
83 (V.toList is, Store objects' last')
84
85
86-- Append the given elements to the last slot of the store, making space if necessary.
87append :: [a] -> Store a -> ([Index], Store a)
88append elems (Store objects last) =
89 let n = Prelude.length elems
90 indices = [last+1..last+n]
91 objects'' = if V.length objects <= last+n
92 then objects V.++ V.replicate n Nothing
93 else objects
94 objects' = objects'' // (Prelude.zipWith (,) indices (fmap Just elems))
95 in
96 (indices, Store objects' $ last+n)
97
98
99-- | Free the given slot.
53storeFree :: Index -> Store a -> Store a 100storeFree :: Index -> Store a -> Store a
54storeFree i (Store assigned last) = 101storeFree i (Store objects last) =
55 let assigned' = assigned // [(i,Nothing)] 102 let objects' = objects // [(i,Nothing)]
56 in if i == last 103 in if i == last
57 then case findLastIndex isJust assigned' of 104 then case findLastIndex isJust objects' of
58 Just j -> Store assigned' j 105 Just j -> Store objects' j
59 Nothing -> Store assigned' 0 106 Nothing -> Store objects' 0
60 else 107 else
61 Store assigned' last 108 Store objects' last
62 109
63 110
64findLastIndex :: (a -> Bool) -> Vector a -> Maybe Index 111findLastIndex :: (a -> Bool) -> Vector a -> Maybe Index
@@ -70,9 +117,22 @@ findLastIndex p v = findLastIndex' p v Nothing 0
70 else findLastIndex' p v current (i+1) 117 else findLastIndex' p v current (i+1)
71 118
72 119
120-- | Free the given slots.
121storeFreel :: [Index] -> Store a -> Store a
122storeFreel is (Store objects last) =
123 let objects' = objects // Prelude.zipWith (,) is (repeat Nothing)
124 last' = case L.find (==last) is of
125 Nothing -> last
126 Just _ -> case findLastIndex isJust objects' of
127 Just j -> j
128 Nothing -> (-1)
129 in
130 Store objects' last'
131
132
73-- | Access the element in the given slot. 133-- | Access the element in the given slot.
74element :: Index -> Store a -> Maybe a 134element :: Index -> Store a -> Maybe a
75element index (Store assigned _) = assigned V.! index 135element index (Store objects _) = objects V.! index
76 136
77 137
78-- test 138-- test