diff options
-rw-r--r-- | Spear.lkshs | 10 | ||||
-rw-r--r-- | Spear/Sys/Store.hs | 98 |
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 @@ | |||
1 | Version of session file format: | 1 | Version of session file format: |
2 | 1 | 2 | 1 |
3 | Time of storage: | 3 | Time of storage: |
4 | "Wed Aug 8 20:32:17 CEST 2012" | 4 | "Thu Aug 9 11:37:44 CEST 2012" |
5 | 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 | 5 | 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 |
6 | 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])] | 6 | 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])] |
7 | Window size: (1841,964) | 7 | Window size: (1841,964) |
8 | Completion size: | 8 | Completion size: |
9 | (750,400) | 9 | (750,400) |
10 | Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" | 10 | Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" |
11 | Active pane: Just "Modules" | 11 | Active pane: Just "Store.hs" |
12 | Toolbar visible: | 12 | Toolbar visible: |
13 | True | 13 | True |
14 | 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}) | 14 | 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}) |
15 | Recently opened files: | 15 | Recently 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"] |
17 | Recently opened workspaces: | 17 | 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 | |||
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 | ) |
10 | where | 12 | where |
11 | 13 | ||
12 | 14 | ||
15 | import Data.List as L (find) | ||
13 | import Data.Maybe (isJust, isNothing) | 16 | import Data.Maybe (isJust, isNothing) |
14 | import Data.Vector as V | 17 | import Data.Vector as V |
15 | import Control.Monad.State -- test | 18 | import Control.Monad.State -- test |
@@ -20,8 +23,8 @@ type Index = Int | |||
20 | 23 | ||
21 | 24 | ||
22 | data Store a = Store | 25 | data 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. |
35 | store :: a -> Store a -> (Index, Store a) | 38 | store :: a -> Store a -> (Index, Store a) |
36 | store elem s@(Store assigned last) = | 39 | store 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. |
46 | assign :: Index -> a -> Store a -> (Index, Store a) | 49 | assign :: Index -> a -> Store a -> (Index, Store a) |
47 | assign i elem (Store assigned last) = | 50 | assign 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. |
56 | storel :: [a] -> Store a -> ([Index], Store a) | ||
57 | storel 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. | ||
71 | freeSlots :: Vector (Maybe a) -> (Int, Vector Int) | ||
72 | freeSlots 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. | ||
77 | storeInSlots :: Vector Int -> [a] -> Store a -> ([Index], Store a) | ||
78 | storeInSlots 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. | ||
87 | append :: [a] -> Store a -> ([Index], Store a) | ||
88 | append 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. | ||
53 | storeFree :: Index -> Store a -> Store a | 100 | storeFree :: Index -> Store a -> Store a |
54 | storeFree i (Store assigned last) = | 101 | storeFree 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 | ||
64 | findLastIndex :: (a -> Bool) -> Vector a -> Maybe Index | 111 | findLastIndex :: (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. | ||
121 | storeFreel :: [Index] -> Store a -> Store a | ||
122 | storeFreel 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. |
74 | element :: Index -> Store a -> Maybe a | 134 | element :: Index -> Store a -> Maybe a |
75 | element index (Store assigned _) = assigned V.! index | 135 | element index (Store objects _) = objects V.! index |
76 | 136 | ||
77 | 137 | ||
78 | -- test | 138 | -- test |