mesh.lisp

   1
   2 (in-package :mixamesh)
   3
   4 (defparameter *meshes* (make-hash-table :test 'equalp)
   5   "A table of loaded meshes to use as brushes.")
   6
   7 (unless (find-package :mesh-names)
   8   (make-package :mesh-names))
   9
  10 (defclass mesh ()
  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"))
  26
  27
  28
  29
  30 (defclass compiled-mesh ()
  31   ()
  32   (:documentation "Optimised, unmodifiable mesh"))
  33
  34
  35
  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"))
  43
  44 (def-tuple-type triangle
  45     :tuple-element-type (unsigned-byte 16)
  46     :elements (a b c))
  47
  48 (def-tuple-type colour
  49     :tuple-element-type single-float
  50     :elements (r g b))
  51
  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
  60
  61 (defmethod make-mesh-faces ((self  mesh) triangle)
  62   "Fills in the index arrays in a mesh from the form supplied."
  63   (destructuring-bind
  64    (&key vertex normal colour texcoord)
  65    triangle
  66    (assert vertex)
  67    (setf (vertex-indices-of self) (make-triangle-array (length vertex)))
  68    (iterate
  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)))
  72    (when normal
  73      (assert (= (length vertex) (length normal)))
  74      (setf (normal-indices-of self) (make-triangle-array (length vertex)))
  75      (iterate
  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))))
  79    (when colour
  80      (assert (= (length vertex) (length colour)))
  81      (setf (colour-indices-of self) (make-triangle-array (length vertex)))
  82      (iterate
  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))))
  86    (when texcoord
  87      (assert (= (length vertex) (length texcoord)))
  88      (setf (texcoord-indices-of self) (make-triangle-array (length vertex)))
  89      (iterate
  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))))))
  93
  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)))
  98   (vector3d-normal
  99    (vector3d-cross
 100     (delta-vector3d vertex-a vertex-b)
 101     (delta-vector3d vertex-a vertex-c))))
 102
 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)))
 107
 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)))
 113
 114
 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)))
 120
 121
 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)))))
 125     (iterate
 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)
 129             (calc-face-normal
 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)))
 134
 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)))))
 138     (iterate
 139       (for index index-of-vertex (vertices-of self))
 140       (let ((normal (new-vector3d)))
 141         (iterate
 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)))
 150
 151 (defmethod make-compiled-drawing-function ((self mesh))
 152   "Create a function for drawing a mesh, based on current bindings to the mesh."
 153   (compile nil
 154            `(lambda (mesh)
 155               (iterate
 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))))))
 170
 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)"
 173   (labels
 174       ((record-name ()
 175          (typecase name
 176            (symbol (import name :mesh-names))
 177            (string (intern name :mesh-names)))))
 178     (let ((mesh (make-instance 'mesh))
 179           (mesh-name (record-name)))
 180       (destructuring-bind
 181             (&key vertices normals colours texcoords material indices)
 182           args
 183         (setf (vertices-of mesh)
 184               (make-vertex3d-array (length vertices)))
 185         (iterate
 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)))
 189         (when normals
 190           (setf (normals-of mesh)
 191                 (make-vector3d-array (length normals)))
 192           (iterate
 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))))
 196         (when colours
 197           (setf (colours-of mesh)
 198                 (make-colour-array (length colours)))
 199           (iterate
 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))))
 203         (when texcoords
 204           (setf (texcoords-of mesh)
 205                 (make-vector2d-array (length texcoords)))
 206           (iterate
 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))))
 210         (when indices
 211           (make-mesh-faces mesh indices))
 212         (unless normals
 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)
 217       mesh-name)))
 218
 219 ;; mesh building protocol
 220 (defun mesh-builder (op data)
 221   (ecase op
 222     (:set-vertex)
 223     (:set-normal)
 224     (:set-face)
 225     (:new-vertex)
 226     (:new-face)
 227     (:vertex-index)
 228     (:face-index))))
 229
 230 (defmethod initialize-instance :after ((self mesh) &key mesh)
 231   (when mesh
 232     (make-mesh self (car mesh) (cdr mesh)))
 233   (closer-mop:set-funcallable-instance-function self)
 234   #'mesh-builder)
 235
 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))
 244     (iterate
 245       (for index index-of-vertex (vertices-of self))
 246       (with-vertex3d
 247        (vertex3d-aref (vertices-of self) index)
 248        (x y z w)
 249        (cond
 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)))
 257
 258 (defmethod normalize-scale ((self mesh))
 259   "Rescale geometry to fit into a 1:1:1 bounding box"
 260   (multiple-value-bind
 261         (minx maxx miny maxy minz maxz)
 262       (box-of self)
 263     (let ((dx (- maxx minx))
 264           (dy (- maxy miny))
 265           (dz (- maxz minz))
 266         (scale))
 267     (cond
 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)))))
 277     (iterate
 278       (for index index-of-vertex (vertices-of self))
 279       (with-vertex3d
 280        (vertex3d-aref (vertices-of self) index)
 281        (x y z)
 282        (setf (vertex3d-aref (vertices-of self) index) (vertex3d-tuple (* x scale) (* y scale) (* z scale) 1.0)))))))
 283
 284
 285 (defmethod stripify ((self mesh))
 286   "Stripify mesh")
 287
 288 (defmethod decompilation ((self compiled-mesh))
 289   "Create a modifiable mesh from a compiled mesh")
 290
 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."
 293 )
 294
 295
 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)))
 300
 301