-
Notifications
You must be signed in to change notification settings - Fork 8
/
shapes.clj
301 lines (268 loc) · 10.6 KB
/
shapes.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
(ns lambdaisland.witchcraft.shapes
(:require [lambdaisland.witchcraft :as wc]
[lambdaisland.witchcraft.matrix :as m]))
(defn range*
"Like range, but deal with negative or non-ascending numbers in a way
we like better.
(range -3) ;;=> (-2 -1 0)
(range 5 2) ;;=> (2 3 4)"
([a]
(if (< 0 a)
(range a)
(range (inc a) 1)))
([a b]
(if (< a b)
(range a b)
(range b a))))
(defn ball-fn
"Return a predicate that checks if the location is part of the ball."
[{:keys [radius center inner-radius]
:or {inner-radius (- radius 1)
center [0 0 0]}}]
(let [[cx cy cz] (wc/xyz center)]
(fn self
([loc]
(self (wc/x loc) (wc/y loc) (wc/z loc)))
([x y z]
(< inner-radius (wc/distance center [x y z]) radius)))))
(defn- handle-start+material [loc start material]
(as-> loc $
(if start (m/v+ $ start) $)
(if material
(let [m (if (fn? material) (material $) material)]
(if (vector? m)
(into $ m)
(conj $ m)))
$)))
(defn box
"Create a simple box.
We also use this as the base shape to carve out other shapes.
If the start position is omitted you get a box which starts at [0 0 0] and you
need to position the result yourself.
`:material` is either a keyword, or a function which receives the `[x y z]`
position and returns a keyword. `:material` is optional, you can add materials
on the result yourself instead.
Returns a sequence of `[x y z]` or `[x y z material]`, to be passed
to [[wc/set-blocks]].
To specify the size use `:height`, and either `:width`/`:length`, or
`:east-west-length`/`:north-south-length`, as per your preference.
"
[{:keys [east-west-length width
north-south-length length
height
material
start]}]
(let [width (or east-west-length width)
length (or north-south-length length)]
(for [x (range* width)
y (range* height)
z (range* length)]
(handle-start+material [x y z] start material))))
(defn ball
"Create a ball shape.
By default the inner-radius is one block less than the outer radius, so you
get a ball with a \"wall\" that is one block thick. Set inner-radius to 0 to
get a solid ball.
`:material` is either a keyword, or a function which receives the `[x y z]`
position and returns a keyword.
Returns a sequence of `[x y z]` or `[x y z material]`, to be passed
to [[wc/set-blocks]]."
[{:keys [radius center inner-radius material fill]
:as opts}]
(let [pred (ball-fn opts)]
(concat
(for [loc (map #(wc/add %
center
[(- radius) (- radius) (- radius)])
(box {:east-west-length (inc (* radius 2))
:north-south-length (inc (* radius 2))
:height (inc (* radius 2))
:material material}))
:when (pred loc)]
loc)
(when fill
(ball (assoc opts
:radius (or inner-radius (- radius 1))
:inner-radius 0
:material fill
:fill nil))) )))
(defn line
"Draw a straight line between two points.
Specify either end or direction+length, not both.
`:material` is either a keyword, or a function which receives the `[x y z]`
position and returns a keyword.
Returns a sequence of `[x y z]` or `[x y z material]`, to be passed
to [[wc/set-blocks]]."
[{:keys [start
end
length
direction
material]}]
(assert (or (and end (not direction) (not length))
(and (not end) direction length))
"specify either end or direction+length, not both")
(let [start (wc/xyz start)
end (wc/xyz end)
direction (when direction (m/vnorm direction))
end (or end (m/v+ start (m/v* direction length)))
direction (or direction (m/vnorm (m/v- end start)))
new-pos #(conj % (if (fn? material)
(material (wc/xyz %))
material))]
(loop [blocks #{(new-pos start)}
pos start]
(if (< (wc/distance pos end) 1.5)
blocks
(recur (conj blocks (new-pos pos))
(m/v+ pos direction))))))
(defn tube
"Draw a tube, pipe, cylinder, or tunnel.
This can be arbitrarily rotated, it does not have to be axis-aligned.
`:start` and `:end` are the two ends of the central axis of the cylinder.
`:radius` is the radius of the cylinder, `:inner-radius` is the space inside
the \"tube\" that is hollow (or filled in if you specify a `:fill` material).
Alternatively to specifying `:end` you can specify a `:direction` + `:length`.
`:material` and `:fill` are either keywords, or functions which receive the
`[x y z]` position and returns a keyword.
For best result experiment with fractional numbers, e.g. a `:radius
6.1 :inner-radius 4.9` may look better than `:radius 6 :inner-radius 5`.
To compute this we determine the bounding box, then iterate over all blocks,
project them onto the central axis, and then see if the distance between the
block and this projected point equals the radius. You can specify the
`:distance-fn` to use something other than euclidian distance here, e.g.
Manhatten ([[m/manhatten]]) distance or Chebyshev ([[m/chebyshev]]) distance,
which will give you more of a square pipe.
Returns a sequence of `[x y z]` or `[x y z material]`, to be passed
to [[wc/set-blocks]]."
[{:keys [start
end
length
direction
radius
inner-radius
material
fill
distance-fn]
:or {inner-radius -0.1
distance-fn wc/distance}}]
(assert (or (and end (not direction) (not length))
(and (not end) direction length))
"specify either end or direction+length, not both")
(let [direction (when direction (m/vnorm direction))
end (or end (m/v+ start (m/v* direction length)))
direction (or direction (m/vnorm (m/v- end start)))
length (or length (wc/distance start end))
;; https://stackoverflow.com/posts/36773942
[dx dy dz] direction
sigma (if (< dx 0) -1 1)
h (+ dx sigma)
beta (/ -1.0 (* sigma h))
f (* beta dy)
g (* beta dz)
u (m/v* (m/vnorm [(* f h) (+ 1.0 (* f dy)) (* f dz)]) radius)
v (m/v* (m/vnorm [(* g h) (* g dy) (+ 1.0 (* g dz))]) radius)
bounds (mapcat #(map (partial m/v+ %) [u v (m/v- u) (m/v- v)]) [start end])
[x1 y1 z1] [(apply min (map wc/x bounds))
(apply min (map wc/y bounds))
(apply min (map wc/z bounds))]
[x2 y2 z2] [(apply max (map wc/x bounds))
(apply max (map wc/y bounds))
(apply max (map wc/z bounds))]]
(for [x (range x1 (inc x2))
y (range y1 (inc y2))
z (range z1 (inc z2))
:let [;; The component of the [x y z] vector projected onto the axis
axis-component (m/dot-product (m/v- [x y z] start) direction)
;; the location on the axis of the projection of [x y z]
axis-loc (m/v+ start (m/v* direction axis-component))
block? (and
(<= 0 axis-component length)
(<=
inner-radius
(distance-fn [x y z] axis-loc)
(+ radius 0.1)))
inside? (<=
(distance-fn [x y z] axis-loc)
inner-radius)]
:when (or (and fill inside?) block?)]
(let [material (cond
(and block? (fn? material)) (material [x y z])
block? material
(fn? fill) (fill [x y z])
:else fill)]
(cond-> [x y z]
material
(conj material))))))
(defn torus
"Draw a torus shape.
`:radius` is the radius of the \"ring\", `:tube-radius` is the radius of the
tube/pipe. `:material` is optional and can be a keyword or a function from `[x
y z]` to keyword. `:margin` determines the \"thickness\", experiment with
different values depending on the size of your torus.
Returns a sequence of `[x y z]` or `[x y z material]`, to be passed
to [[wc/set-blocks]]."
[{:keys [radius tube-radius material margin start]
:or {margin 15}}]
(for [x (range (Math/floor (- (- radius) margin))
(Math/ceil (+ radius margin)))
y (range (Math/floor (- (- tube-radius) 3))
(Math/ceil (+ tube-radius 3)))
z (range (Math/floor (- (- radius) margin))
(Math/ceil (+ radius margin)))
:when (<= (Math/abs (- (+ (Math/pow (- (Math/sqrt (+ (* x x) (* z z)))
radius) 2)
(* y y))
(* tube-radius tube-radius)))
margin)]
(handle-start+material [x y z] start material)))
(defn rectube
"Create a rectangular tube, i.e. a box but with the inside hollow and two
opposing sides open.
Arguments are like [[box]], but with the added `:direction` which can be
`:east-west`, `:north-south`, or `:top-bottom`. `:top-bottom` is the default."
[{:keys [east-west-length width
north-south-length length
height
material
start
direction]
:or {direction :top-bottom}}]
(let [width (or east-west-length width)
length (or north-south-length length)
xs (range* width)
ys (range* height)
zs (range* length)]
(for [x xs, y ys, z zs
:when (or (and (or (= (first xs) x) (= (last xs) x))
(not (= direction :east-west)))
(and (or (= (first ys) y) (= (last ys) y))
(not (= direction :top-bottom)))
(and (or (= (first zs) z) (= (last zs) z))
(not (= direction :north-south))))]
(handle-start+material [x y z] start material))))
(comment
(wc/set-blocks
(tube {:start [732 70 -783]
:end [732 80 -770]
:material :air
:radius 6.1
:inner-radius 3.9
:distance-fn m/chebyshev
}))
(wc/set-blocks
(box {:start [750 63 -755]
:east-west-length -30
:north-south-length -30
:height -1
:material :water}))
(wc/set-blocks
(tube {:start [732 40 -770]
:end [732 256 -770]
:material :air
:radius 3.1
:inner-radius 1.9
:fill :air}))
(wc/set-blocks
(tube {:start [732 80 -783]
:end [730 90 -780]
:material :stone})))