aboutsummaryrefslogtreecommitdiff
path: root/Spear/Math/Octree.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Spear/Math/Octree.hs')
-rw-r--r--Spear/Math/Octree.hs284
1 files changed, 0 insertions, 284 deletions
diff --git a/Spear/Math/Octree.hs b/Spear/Math/Octree.hs
deleted file mode 100644
index 15f7dde..0000000
--- a/Spear/Math/Octree.hs
+++ /dev/null
@@ -1,284 +0,0 @@
1module Spear.Math.Octree
2(
3 Octree
4, makeOctree
5, clone
6, Spear.Math.Octree.insert
7, insertl
8, Spear.Math.Octree.map
9, gmap
10, population
11)
12where
13
14import Spear.Collision.Types
15import Spear.Math.AABB
16import Spear.Math.Vector3
17
18import Control.Applicative ((<*>))
19import Data.List
20import Data.Functor
21import Data.Monoid
22import qualified Data.Foldable as F
23
24
25-- | Represents an Octree.
26data Octree e
27 = Octree
28 {
29 root :: !AABB,
30 ents :: ![e],
31 c1 :: !(Octree e),
32 c2 :: !(Octree e),
33 c3 :: !(Octree e),
34 c4 :: !(Octree e),
35 c5 :: !(Octree e),
36 c6 :: !(Octree e),
37 c7 :: !(Octree e),
38 c8 :: !(Octree e)
39 }
40 |
41 Leaf
42 {
43 root :: !AABB,
44 ents :: ![e]
45 }
46
47
48-- | Builds an Octree using the specified AABB as the root and having the specified depth.
49makeOctree :: Int -> AABB -> Octree e
50makeOctree d root@(AABB min max)
51 | d == 0 = Leaf root []
52 | otherwise = Octree root [] c1 c2 c3 c4 c5 c6 c7 c8
53 where
54 boxes = subdivide root
55 c1 = makeOctree (d-1) $ boxes !! 0
56 c2 = makeOctree (d-1) $ boxes !! 1
57 c3 = makeOctree (d-1) $ boxes !! 2
58 c4 = makeOctree (d-1) $ boxes !! 3
59 c5 = makeOctree (d-1) $ boxes !! 4
60 c6 = makeOctree (d-1) $ boxes !! 5
61 c7 = makeOctree (d-1) $ boxes !! 6
62 c8 = makeOctree (d-1) $ boxes !! 7
63
64
65subdivide :: AABB -> [AABB]
66subdivide (AABB min max) = [a1, a2, a3, a4, a5, a6, a7, a8]
67 where
68 v = (max-min) / 2
69 c = vec3 (x min + x v) (y min + y v) (z min + z v)
70 a1 = AABB min c
71 a2 = AABB ( vec3 (x min) (y min) (z c) ) ( vec3 (x c) (y c) (z max) )
72 a3 = AABB ( vec3 (x min) (y c) (z min) ) ( vec3 (x c) (y max) (z c) )
73 a4 = AABB ( vec3 (x min) (y c) (z c) ) ( vec3 (x c) (y max) (z max) )
74 a5 = AABB ( vec3 (x c) (y min) (z min) ) ( vec3 (x max) (y c) (z c) )
75 a6 = AABB ( vec3 (x c) (y min) (z c) ) ( vec3 (x max) (y c) (z max) )
76 a7 = AABB ( vec3 (x c) (y c) (z min) ) ( vec3 (x max) (y max) (z c) )
77 a8 = AABB c max
78
79
80-- | Clones the structure of an octree. The new octree has no entities.
81clone :: Octree e -> Octree e
82clone (Leaf root ents) = Leaf root []
83clone (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) = Octree root [] c1' c2' c3' c4' c5' c6' c7' c8'
84 where
85 c1' = clone c1
86 c2' = clone c2
87 c3' = clone c3
88 c4' = clone c4
89 c5' = clone c5
90 c6' = clone c6
91 c7' = clone c7
92 c8' = clone c8
93
94
95keep :: (e -> AABB -> CollisionType) -> AABB -> e -> Bool
96keep testAABB aabb e = test == FullyContainedBy
97 where test = e `testAABB` aabb
98
99
100-- | Inserts an entity into the given octree.
101insert :: (e -> AABB -> CollisionType) -> Octree e -> e -> Octree e
102insert testAABB octree e = octree' where (octree', _) = insert' testAABB e octree
103
104
105insert' :: (e -> AABB -> CollisionType) -> e -> Octree e -> (Octree e, Bool)
106
107
108insert' testAABB e l@(Leaf root ents)
109 | test == True = (Leaf root (e:ents), True)
110 | otherwise = (l, False)
111 where
112 test = keep testAABB root e
113
114
115insert' testAABB e o@(Octree root ents c1 c2 c3 c4 c5 c6 c7 c8)
116 | test == False = (o, False)
117 | otherwise =
118 if isContainedInChild then (Octree root ents c1' c2' c3' c4' c5' c6' c7' c8', True)
119 else (Octree root (e:ents) c1 c2 c3 c4 c5 c6 c7 c8, True)
120 where
121 children = [c1,c2,c3,c4,c5,c6,c7,c8]
122 test = keep testAABB root e
123 descend = fmap (Spear.Math.Octree.insert' testAABB e) children
124 (children', results) = unzip descend
125 isContainedInChild = or results
126 c1' = children' !! 0
127 c2' = children' !! 1
128 c3' = children' !! 2
129 c4' = children' !! 3
130 c5' = children' !! 4
131 c6' = children' !! 5
132 c7' = children' !! 6
133 c8' = children' !! 7
134
135
136-- | Inserts a list of entities into the given octree.
137insertl :: (e -> AABB -> CollisionType) -> Octree e -> [e] -> Octree e
138insertl testAABB octree es = octree' where (octree', _) = insertl' testAABB es octree
139
140
141insertl' :: (e -> AABB -> CollisionType) -> [e] -> Octree e -> (Octree e, [e])
142
143insertl' testAABB es (Leaf root ents) = (Leaf root ents', outliers)
144 where
145 ents' = ents ++ ents_kept
146 ents_kept = filter (keep testAABB root) es
147 outliers = filter (not . keep testAABB root) es
148
149insertl' testAABB es (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
150 (Octree root ents' c1' c2' c3' c4' c5' c6' c7' c8', outliers)
151 where
152 ents' = ents ++ ents_kept
153 new_ents = es ++ ents1 ++ ents2 ++ ents3 ++ ents4 ++ ents5 ++ ents6 ++ ents7 ++ ents8
154 ents_kept = filter (keep testAABB root) new_ents
155 outliers = filter (not . keep testAABB root) new_ents
156 (c1', ents1) = insertl' testAABB es c1
157 (c2', ents2) = insertl' testAABB es c2
158 (c3', ents3) = insertl' testAABB es c3
159 (c4', ents4) = insertl' testAABB es c4
160 (c5', ents5) = insertl' testAABB es c5
161 (c6', ents6) = insertl' testAABB es c6
162 (c7', ents7) = insertl' testAABB es c7
163 (c8', ents8) = insertl' testAABB es c8
164
165
166-- | Extracts all entities from an octree. The resulting octree has no entities.
167extract :: Octree e -> (Octree e, [e])
168extract (Leaf root ents) = (Leaf root [], ents)
169extract (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) = (Octree root [] c1' c2' c3' c4' c5' c6' c7' c8', ents')
170 where
171 (c1', ents1) = extract c1
172 (c2', ents2) = extract c2
173 (c3', ents3) = extract c3
174 (c4', ents4) = extract c4
175 (c5', ents5) = extract c5
176 (c6', ents6) = extract c6
177 (c7', ents7) = extract c7
178 (c8', ents8) = extract c8
179 ents' = ents ++ ents1 ++ ents2 ++ ents3 ++ ents4 ++ ents5 ++ ents6 ++ ents7 ++ ents8
180
181
182-- | Applies the given function to the entities in the octree.
183-- Entities that break out of their cell are reallocated appropriately.
184map :: (e -> AABB -> CollisionType) -> (e -> e) -> Octree e -> Octree e
185map testAABB f o = let (o', outliers) = map' testAABB f o in insertl testAABB o' outliers
186
187
188map' :: (e -> AABB -> CollisionType) -> (e -> e) -> Octree e -> (Octree e, [e])
189
190
191map' testAABB f (Leaf root ents) = (Leaf root ents_kept, outliers)
192 where
193 ents' = fmap f ents
194 ents_kept = filter (keep testAABB root) ents'
195 outliers = filter (not . keep testAABB root) ents'
196
197
198map' testAABB f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
199 (Octree root ents_kept c1' c2' c3' c4' c5' c6' c7' c8', outliers)
200 where
201 ents' = (fmap f ents) ++ out1 ++ out2 ++ out3 ++ out4 ++ out5 ++ out6 ++ out7 ++ out8
202 ents_kept = filter (keep testAABB root) ents'
203 outliers = filter (not . keep testAABB root) ents'
204 (c1', out1) = map' testAABB f c1
205 (c2', out2) = map' testAABB f c2
206 (c3', out3) = map' testAABB f c3
207 (c4', out4) = map' testAABB f c4
208 (c5', out5) = map' testAABB f c5
209 (c6', out6) = map' testAABB f c6
210 (c7', out7) = map' testAABB f c7
211 (c8', out8) = map' testAABB f c8
212
213
214-- | Applies a function to the entity groups in the octree.
215-- Entities that break out of their cell are reallocated appropriately.
216gmap :: (e -> AABB -> CollisionType) -> (e -> e -> e) -> Octree e -> Octree e
217gmap testAABB f o = let (o', outliers) = gmap' testAABB f o in insertl testAABB o' outliers
218
219
220gmap' :: (e -> AABB -> CollisionType) -> (e -> e -> e) -> Octree e -> (Octree e, [e])
221
222gmap' testAABB f (Leaf root ents) = (Leaf root ents_kept, outliers)
223 where
224 ents' = f <$> ents <*> ents
225 ents_kept = filter (keep testAABB root) ents'
226 outliers = filter (not . keep testAABB root) ents'
227
228gmap' testAABB f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
229 (Octree root ents_kept c1' c2' c3' c4' c5' c6' c7' c8', outliers)
230 where
231 ents' = (f <$> ents <*> ents) ++ out1 ++ out2 ++ out3 ++ out4 ++ out5 ++ out6 ++ out7 ++ out8
232 ents_kept = filter (keep testAABB root) ents'
233 outliers = filter (not . keep testAABB root) ents'
234 (c1', out1) = gmap' testAABB f c1
235 (c2', out2) = gmap' testAABB f c2
236 (c3', out3) = gmap' testAABB f c3
237 (c4', out4) = gmap' testAABB f c4
238 (c5', out5) = gmap' testAABB f c5
239 (c6', out6) = gmap' testAABB f c6
240 (c7', out7) = gmap' testAABB f c7
241 (c8', out8) = gmap' testAABB f c8
242
243
244population :: Octree e -> Int
245population = F.foldr (\_ acc -> acc+1) 0
246
247
248
249
250instance Functor Octree where
251
252 fmap f (Leaf root ents) = Leaf root $ fmap f ents
253
254 fmap f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
255 Octree root (fmap f ents) c1' c2' c3' c4' c5' c6' c7' c8'
256 where
257 c1' = fmap f c1
258 c2' = fmap f c2
259 c3' = fmap f c3
260 c4' = fmap f c4
261 c5' = fmap f c5
262 c6' = fmap f c6
263 c7' = fmap f c7
264 c8' = fmap f c8
265
266
267
268instance F.Foldable Octree where
269
270 foldMap f (Leaf root ents) = mconcat . fmap f $ ents
271
272 foldMap f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
273 mconcat (fmap f ents) `mappend`
274 c1' `mappend` c2' `mappend` c3' `mappend` c4' `mappend`
275 c5' `mappend` c6' `mappend` c7' `mappend` c8'
276 where
277 c1' = F.foldMap f c1
278 c2' = F.foldMap f c2
279 c3' = F.foldMap f c3
280 c4' = F.foldMap f c4
281 c5' = F.foldMap f c5
282 c6' = F.foldMap f c6
283 c7' = F.foldMap f c7
284 c8' = F.foldMap f c8
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-30 21:51:53 +0000