(defn
cylinder
[{:keys
[bottom-radius
top-radius
height
radial-subdivisions
vertical-subdivisions
top-cap?
bottom-cap?],
:or {top-cap? true, bottom-cap? true}}]
(let
[extra
(+ (if top-cap? 2 0) (if bottom-cap? 2 0))
num-vertices
(* (inc radial-subdivisions) (+ vertical-subdivisions 1 extra))
verts-around-edge
(inc radial-subdivisions)
slant
(math atan2 (- bottom-radius top-radius) height)
cos-slant
(math cos slant)
sin-slant
(math sin slant)
start
(if top-cap? -2 0)
end
(+ vertical-subdivisions (if bottom-cap? 2 0))]
(->
(fn
[m yy]
(let
[v
(/ yy vertical-subdivisions)
y
(* height v)
[y v ring-radius]
(cond
(< yy 0)
[0 1 bottom-radius]
(> yy vertical-subdivisions)
[height 1 top-radius]
:else
[y
v
(+
bottom-radius
(*
(- top-radius bottom-radius)
(/ yy vertical-subdivisions)))])
[y v ring-radius]
(if
(or (= yy -2) (= yy (+ vertical-subdivisions 2)))
[y 0 0]
[y v ring-radius])
y
(- y (/ height 2))]
(reduce
(fn
[m ii]
(let
[sin
(math sin (-> ii (* (math PI)) (* 2) (/ radial-subdivisions)))
cos
(math
cos
(-> ii (* (math PI)) (* 2) (/ radial-subdivisions)))]
(->
m
(update
:positions
(fn
[positions]
(->
positions
(conj! (* sin ring-radius))
(conj! y)
(conj! (* cos ring-radius)))))
(update
:normals
(fn
[normals]
(->
normals
(conj!
(if
(or (< yy 0) (> yy vertical-subdivisions))
0
(* sin cos-slant)))
(conj!
(if
(< yy 0)
-1
(if (> yy vertical-subdivisions) 1 sin-slant)))
(conj!
(if
(or (< yy 0) (> yy vertical-subdivisions))
0
(* cos cos-slant))))))
(update
:texcoords
(fn
[texcoords]
(->
texcoords
(conj! (/ ii radial-subdivisions))
(conj! (- 1 v))))))))
m
(range verts-around-edge))))
(reduce
{:positions (transient []),
:normals (transient []),
:texcoords (transient [])}
(range start (inc end)))
(assoc
:indices
(reduce
(fn
[indices yy]
(reduce
(fn
[indices ii]
(->
indices
(conj! (-> verts-around-edge (* (+ yy 0)) (+ 0) (+ ii)))
(conj! (-> verts-around-edge (* (+ yy 0)) (+ 1) (+ ii)))
(conj! (-> verts-around-edge (* (+ yy 1)) (+ 1) (+ ii)))
(conj! (-> verts-around-edge (* (+ yy 0)) (+ 0) (+ ii)))
(conj! (-> verts-around-edge (* (+ yy 1)) (+ 1) (+ ii)))
(conj! (-> verts-around-edge (* (+ yy 1)) (+ 0) (+ ii)))))
indices
(range radial-subdivisions)))
(transient [])
(range (+ vertical-subdivisions extra))))
(update :positions persistent!)
(update :normals persistent!)
(update :texcoords persistent!)
(update :indices persistent!))))