4 (defparameter *meshes
* (make-hash-table :test
'equalp
)
5 "A table of loaded meshes to use as brushes.")
7 (unless (find-package :mesh-names
)
8 (make-package :mesh-names
))
11 ((vertex-index-array :accessor vertex-indices-of
:documentation
"Indices of triangle vertices" :initarg nil
)
12 (normal-index-array :accessor normal-indices-of
:documentation
"Indices of normal vertices" :initarg nil
)
13 (colour-index-array :accessor colour-indices-of
:documentation
"Indices of normal vertices" :initarg nil
)
14 (texcoord-index-array :accessor texcoord-indices-of
:documentation
"Indices of normal vertices" :initarg nil
)
15 (face-normal-array :accessor face-normals-of
:documentation
"Face normals of triangles" :initarg nil
)
16 ;; possible topological extension
17 ;; (tri-edge-array :documentation "Maps to triangles half edge")
18 ;; (vertex-edge-array :documentation "Maps to vertices half edge")
19 (vertex-array :accessor vertices-of
:initarg nil
)
20 (normal-array :accessor normals-of
:initarg nil
)
21 (colour-array :accessor colours-of
:initarg nil
)
22 (texcoord-array :accessor texcoords-of
:initarg nil
)
23 (draw-fn :accessor draw-fn-of
:initarg nil
))
24 (:metaclass closer-mop
:funcallable-standard-class
)
25 (:documentation
"Generic mesh type"))
30 (defclass compiled-mesh
()
32 (:documentation
"Optimised, unmodifiable mesh"))
36 ;; Topology, if we get clever.
37 ;; (defclass half-edge ()
38 ;; ((vertex-of :initform 0 :documentation "Indexes vertex of he")
39 ;; (predecessor-of :documentation "Half edge previos to this one")
40 ;; (successor-of :documentation "Half edge next to this one")
41 ;; (tri-of :documentation "Face the he belongs to"))
42 ;; (:documentation "Half edge element"))
44 (def-tuple-type triangle
45 :tuple-element-type
(unsigned-byte 16)
48 (def-tuple-type colour
49 :tuple-element-type single-float
52 ;; mesh definitons mirror ogl definitions
53 ;; (:vertex () --) feeds elements into glVertex
54 ;; (:normal () --) feeds elements into glNormal
55 ;; (:colour () --) feeds elements into glColour
56 ;; (:texcoord () --) feeds elements into glTexCoord
57 ;; (:material (:ambient ) (:diffuse ) (:specular ))
58 ;; (:triangle (:vertex () () () [(:normal ( ) () )]) ;;
59 ;; -- indexes vertices by face, also other elements if present otherwise we assume they map to same indices as vertices
61 (defmethod make-mesh-faces ((self mesh
) triangle
)
62 "Fills in the index arrays in a mesh from the form supplied."
64 (&key vertex normal colour texcoord
)
67 (setf (vertex-indices-of self
) (make-triangle-array (length vertex
)))
69 (for (a b c
) in vertex
)
70 (for index from
0 below
(length vertex
))
71 (setf (triangle-aref (vertex-indices-of self
) index
) (values a b c
)))
73 (assert (= (length vertex
) (length normal
)))
74 (setf (normal-indices-of self
) (make-triangle-array (length vertex
)))
76 (for (a b c
) in normal
)
77 (for index from
0 below
(length normal
))
78 (setf (triangle-aref (normal-indices-of self
) index
) (values a b c
))))
80 (assert (= (length vertex
) (length colour
)))
81 (setf (colour-indices-of self
) (make-triangle-array (length vertex
)))
83 (for (a b c
) in colour
)
84 (for index from
0 below
(length colour
))
85 (setf (triangle-aref (colour-indices-of self
) index
) (values a b c
))))
87 (assert (= (length vertex
) (length texcoord
)))
88 (setf (texcoord-indices-of self
) (make-triangle-array (length vertex
)))
90 (for (a b c
) in texcoord
)
91 (for index from
0 below
(length texcoord
))
92 (setf (triangle-aref (texcoord-indices-of self
) index
) (values a b c
))))))
94 (def-tuple-op calc-face-normal
95 ((vertex-a vertex3d
(ax ay az aw
))
96 (vertex-b vertex3d
(bx by bz bw
))
97 (vertex-c vertex3d
(cx cy cz cw
)))
100 (delta-vector3d vertex-a vertex-b
)
101 (delta-vector3d vertex-a vertex-c
))))
103 (def-tuple-op vector3d-sum
104 ((vector-a vector3d
(ax ay az
))
105 (vector-b vector3d
(bx by bz
)))
106 (vector3d-tuple (+ ax bx
) (+ ay by
) (+ az bz
)))
108 (defclause-sequence in-triangles index-of-triangle
109 :access-fn
'triangle-aref
110 :size-fn
'triangle-array-dimensions
111 :sequence-type
'vector
112 :element-type
'(values (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16)))
115 (defclause-sequence in-vertices index-of-vertex
116 :access-fn
'vertex3d-aref
117 :size-fn
'vertex3d-array-dimensions
118 :sequence-type
'vector
119 :element-type
'(values (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16)))
122 (defmethod calc-face-normals ((self mesh
))
123 "Calculate the face normals of a mesh."
124 (let* ((face-normals (make-vector3d-array (triangle-array-dimensions (vertex-indices-of self
)))))
126 (for (values a b c
) in-triangles
(vertex-indices-of self
))
127 (for triangle-index upfrom
0)
128 (setf (vector3d-aref face-normals triangle-index
)
130 (vertex3d-aref (vertices-of self
) a
)
131 (vertex3d-aref (vertices-of self
) b
)
132 (vertex3d-aref (vertices-of self
) c
))))
133 (setf (face-normals-of self
) face-normals
)))
135 (defmethod calc-vertex-normals ((self mesh
))
136 "Calculate the vertex normals of a mesh."
137 (let ((vertex-normals (make-vector3d-array (length (vertices-of self
)))))
139 (for index index-of-vertex
(vertices-of self
))
140 (let ((normal (new-vector3d)))
142 (for (values a b c
) in-triangles
(vertex-indices-of self
))
143 (for face-index upfrom
0)
144 (when (or (= a index
) (= b index
) (= c index
))
145 (setf (vector3d normal
)
146 (vector3d-sum (vector3d normal
)
147 (vector3d-aref (face-normals-of self
) face-index
))))
148 (setf (vector3d-aref vertex-normals index
) (vertex3d normal
)))))
149 (setf (normals-of self
) vertex-normals
)))
151 (defmethod make-compiled-drawing-function ((self mesh
))
152 "Create a function for drawing a mesh, based on current bindings to the mesh."
156 (for (values x y z w
) in-vertices
(vertices-of mesh
))
157 ,(when (normals-of self
)
158 `(for (values nx ny nz
) in-normals-of
(normals-of mesh
)))
159 ,(when (colours-of self
)
160 `(for (values cr cg cb ca in-colours-of
(colours-of mesh
))))
161 ,(when (texcoords-of self
)
162 `(for (values u v
) in-texcoords-of
(texcoords-of mesh
)))
163 (gl:vertex-3f x y z w
)
164 ,(when (normals-of self
)
165 `(gl:normal-3f nx ny nz
))
166 ,(when (colours-of self
)
167 `(gl:color-4f cr cg cb ca
))
168 ,(when (texcoords-of self
)
169 `(gl:tex-coord-2d u v
))))))
171 (defun make-mesh (name &rest args
)
172 "Create a mesh of the form (name :vertices (list of vertices) :normal (list of normals) :material (list of materials) :triangle (list of list of indices)) -- see make-mesh-triangles)"
176 (symbol (import name
:mesh-names
))
177 (string (intern name
:mesh-names
)))))
178 (let ((mesh (make-instance 'mesh
))
179 (mesh-name (record-name)))
181 (&key vertices normals colours texcoords material indices
)
183 (setf (vertices-of mesh
)
184 (make-vertex3d-array (length vertices
)))
186 (for (x y z
) in vertices
)
187 (for index from
0 below
(length vertices
))
188 (setf (vertex3d-aref (vertices-of mesh
) index
) (values x y z
1.0)))
190 (setf (normals-of mesh
)
191 (make-vector3d-array (length normals
)))
193 (for (x y z
) in normals
)
194 (for i from
0 below
(length normals
))
195 (setf (vector3d-aref (normals-of mesh
) i
) (values x y z
))))
197 (setf (colours-of mesh
)
198 (make-colour-array (length colours
)))
200 (for (r g b
) in colours
)
201 (for i from
0 below
(length colours
))
202 (setf (vector3d-aref (colours-of mesh
) i
) (values r g b
))))
204 (setf (texcoords-of mesh
)
205 (make-vector2d-array (length texcoords
)))
207 (for (u v
) in texcoords
)
208 (for i from
0 below
(length vertices
))
209 (setf (vector2d-aref (texcoords-of mesh
) i
) (values u v
))))
211 (make-mesh-faces mesh indices
))
213 (setf (normals-of mesh
)
214 (make-vector3d-array (length vertices
)))))
215 (setf (draw-fn-of mesh
) (make-compiled-drawing-function mesh
))
216 (setf (gethash mesh-name
*meshes
*) mesh
)
219 ;; mesh building protocol
220 (defun mesh-builder (op data
)
230 (defmethod initialize-instance :after
((self mesh
) &key mesh
)
232 (make-mesh self
(car mesh
) (cdr mesh
)))
233 (closer-mop:set-funcallable-instance-function self
)
236 (defmethod box-of ((self mesh
))
237 "Return a bounding box for the mesh."
238 (let ((maxx most-negative-single-float
)
239 (minx most-positive-single-float
)
240 (maxy most-negative-single-float
)
241 (miny most-positive-single-float
)
242 (maxz most-negative-single-float
)
243 (minz most-positive-single-float
))
245 (for index index-of-vertex
(vertices-of self
))
247 (vertex3d-aref (vertices-of self
) index
)
250 ((< x minx
) (setf minx x
))
251 ((> x maxx
) (setf maxx x
))
252 ((< y miny
) (setf miny y
))
253 ((> y maxy
) (setf maxy y
))
254 ((< z minz
) (setf minz z
))
255 ((< z minz
) (setf minz z
)))))
256 (values minx maxx miny maxy minz maxz
)))
258 (defmethod normalize-scale ((self mesh
))
259 "Rescale geometry to fit into a 1:1:1 bounding box"
261 (minx maxx miny maxy minz maxz
)
263 (let ((dx (- maxx minx
))
268 ((and (> dx dz
) (> dx dy
))
269 ;; dx is largest dimension
270 (setf scale
(/ 1 (- maxx minx
))))
271 ;; dy is largest dimension
272 ((and (> dy dz
) (> dy dx
))
273 (setf scale
(/ 1 (- maxy miny
))))
274 ;; dz is largest dimension
275 ((and (> dz dy
) (> dz dx
))
276 (setf scale
(/ 1 (- maxy miny
)))))
278 (for index index-of-vertex
(vertices-of self
))
280 (vertex3d-aref (vertices-of self
) index
)
282 (setf (vertex3d-aref (vertices-of self
) index
) (vertex3d-tuple (* x scale
) (* y scale
) (* z scale
) 1.0)))))))
285 (defmethod stripify ((self mesh
))
288 (defmethod decompilation ((self compiled-mesh
))
289 "Create a modifiable mesh from a compiled mesh")
291 (defmethod compilation ((self mesh
))
292 "Given a mesh return a compiled mesh, which is a non-modifiable mesh optimised for rendering in foreign memory."
296 (defmethod render ((self mesh
))
297 "Draw a mesh with any appropiate means."
298 (gl:with-begin gl
:+triangles
+
299 (funcall (draw-fn-of self
) self
)))