mesh.lisp

   1
   2 (in-package :cl-blockworld)
   3
   4 (defparameter *meshes* (make-hash-table))
   5
   6 (make-package :mesh-names)
   7
   8 (defclass mesh ()
   9   ((vertex-index-array :accessor vertex-indices-of :documentation "Indices of triangle vertices" :initarg nil)
  10    (normal-index-array :accessor normal-indices-of :documentation "Indices of normal vertices" :initarg nil)
  11    (colour-index-array :accessor colour-indices-of :documentation "Indices of normal vertices" :initarg nil)
  12    (texcoord-index-array :accessor texcoord-indices-of :documentation "Indices of normal vertices" :initarg nil)
  13    (face-normal-array :accessor face-normals-of :documentation "Face normals of triangles" :initarg nil)
  14 ;; possible topological extension
  15 ;; (tri-edge-array :documentation "Maps to triangles half edge")
  16 ;; (vertex-edge-array :documentation "Maps to vertices half edge")
  17    (vertex-array :accessor vertices-of :initarg nil)
  18    (normal-array :accessor normals-of :initarg nil)
  19    (colour-array :accessor colours-of :initarg nil)
  20    (texcoord-array  :accessor texcoords-of :initarg nil)
  21    (draw-fn :accessor draw-fn-of :initarg nil))
  22   (:documentation "Generic mesh type"))
  23
  24
  25 (defclass compiled-mesh ()
  26   ()
  27   (:documentation "Optimised, unmodifiable mesh"))
  28
  29
  30 ;; Topology, if we get clever.
  31 ;; (defclass half-edge ()
  32 ;;   ((vertex-of :initform 0 :documentation "Indexes vertex of he")
  33 ;;    (predecessor-of :documentation "Half edge previos to this one")
  34 ;;    (successor-of :documentation "Half edge next to this one")
  35 ;;    (tri-of :documentation "Face the he belongs to"))
  36 ;;   (:documentation "Half edge element"))
  37
  38 (def-tuple-type triangle
  39     :tuple-element-type (unsigned-byte 16)
  40     :elements (a b c))
  41
  42 (def-tuple-type colour
  43     :tuple-element-type single-float
  44     :elements (r g b))
  45
  46 ;; mesh definitons mirror ogl definitions
  47 ;; (:vertex () --) feeds elements into glVertex
  48 ;; (:normal () --) feeds elements into glNormal
  49 ;; (:colour () --) feeds elements into glColour
  50 ;; (:texcoord () --) feeds elements into glTexCoord
  51 ;; (:material (:ambient ) (:diffuse ) (:specular ))
  52 ;; (:triangle (:vertex () () () [(:normal ( ) () )]) ;;
  53 ;;  -- indexes vertices by face, also other elements if present otherwise we assume they map to same indices as vertices
  54
  55 (defmethod make-mesh-faces ((self  mesh) triangle)
  56   "Fills in the index arrays in a mesh from the form supplied."
  57   (destructuring-bind
  58    (&key vertex normal colour texcoord)
  59    triangle
  60    (assert vertex)
  61    (setf (vertex-indices-of self) (make-triangle-array (length vertex)))
  62    (iterate
  63     (for (a b c) in vertex)
  64     (for index from 0 below (length vertex))
  65     (setf (triangle-aref (vertex-indices-of self) index) (values a b c)))
  66    (when normal
  67      (assert (= (length vertex) (length normal)))
  68      (setf (normal-indices-of self) (make-triangle-array (length vertex)))
  69      (iterate
  70       (for (a b c) in normal)
  71       (for index from 0 below (length normal))
  72       (setf (triangle-aref (normal-indices-of self) index) (values a b c))))
  73    (when colour
  74      (assert (= (length vertex) (length colour)))
  75      (setf (colour-indices-of self) (make-triangle-array (length vertex)))
  76      (iterate
  77       (for (a b c) in colour)
  78       (for index from 0 below (length colour))
  79       (setf (triangle-aref (colour-indices-of self) index) (values a b c))))
  80    (when texcoord
  81      (assert (= (length vertex) (length texcoord)))
  82      (setf (texcoord-indices-of self) (make-triangle-array (length vertex)))
  83      (iterate
  84       (for (a b c) in texcoord)
  85       (for index from 0 below (length texcoord))
  86       (setf (triangle-aref (texcoord-indices-of self) index) (values a b c))))))
  87
  88 (def-tuple-op calc-face-normal
  89     ((vertex-a vertex3d (ax ay az aw))
  90      (vertex-b vertex3d (bx by bz bw))
  91      (vertex-c vertex3d (cx cy cz cw)))
  92   (vector3d-normal
  93    (vector3d-cross
  94     (delta-vector3d vertex-a vertex-b)
  95     (delta-vector3d vertex-a vertex-c))))
  96
  97 (def-tuple-op vector3d-sum
  98     ((vector-a vector3d (ax ay az))
  99      (vector-b vector3d (bx by bz)))
 100   (vector3d-tuple (+ ax bx) (+ ay by) (+ az bz)))
 101
 102 (defclause-sequence in-triangles-of index-of-triangle
 103   :access-fn 'triangle-aref
 104   :size-fn 'triangle-array-dimensions
 105   :sequence-type 'vector
 106   :element-type '(values  (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16)))
 107
 108
 109 (defclause-sequence in-vertices-of index-of-vertex
 110   :access-fn 'vertex3d-aref
 111   :size-fn 'vertex3d-array-dimensions
 112   :sequence-type 'vector
 113   :element-type '(values (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16)))
 114
 115
 116 (defmethod calc-face-normals ((self mesh))
 117   "Calculate the face normals of a mesh."
 118   (let* ((face-normals (make-vector3d-array (triangle-array-dimensions (vertex-indices-of self)))))
 119     (iterate
 120       (for (values a b c) in-triangles-of (vertex-indices-of self))
 121       (for triangle-index upfrom 0)
 122       (setf (vector3d-aref face-normals triangle-index)
 123             (calc-face-normal
 124              (vertex3d-aref (vertices-of self) a)
 125              (vertex3d-aref (vertices-of self) b)
 126              (vertex3d-aref (vertices-of self) c))))
 127     (setf (face-normals-of self) face-normals)))
 128
 129 (defmethod calc-vertex-normals ((self mesh))
 130   "Calculate the vertex normals of a mesh."
 131   (let ((vertex-normals (make-vector3d-array (length (vertices-of self)))))
 132     (iterate
 133       (for index index-of-vertex (vertices-of self))
 134       (let ((normal (new-vector3d)))
 135         (iterate
 136           (for (values a b c) in-triangles-of (vertex-indices-of self))
 137           (for face-index upfrom 0)
 138           (when (or (= a index) (= b index) (= c index))
 139             (setf (vector3d normal)
 140                   (vector3d-sum (vector3d normal)
 141                                 (vector3d-aref (face-normals-of self) face-index))))
 142           (setf (vector3d-aref vertex-normals  index) (vertex3d normal)))))
 143     (setf (normals-of self) vertex-normals)))
 144
 145 (defmethod make-compiled-drawing-function ((self mesh))
 146   "Create a function for drawing a mesh, based on currend bindings to the mesh."
 147   (compile nil
 148            `(lambda (mesh)
 149               (iterate
 150                 (for (values x y z w) in-vertices-of (vertices-of mesh))
 151                 ,(when (normals-of self)
 152                    `(for (values nx ny nz) in-normals-of (normals-of mesh)))
 153                 ,(when (colours-of self)
 154                    `(for (values cr cg cb ca in-colours-of (colours-of mesh))))
 155                 ,(when (texcoords-of self)
 156                    `(for (values u v) in-texcoords-of (texcoords-of mesh)))
 157                 (gl:vertex-3f x y z w)
 158                 ,(when (normals-of self)
 159                    `(gl:normal-3f nx ny nz))
 160                 ,(when (colours-of self)
 161                    `(gl:color-4f cr cg cb ca))
 162                 ,(when (texcoords-of self)
 163                    `(gl:tex-coord-2d u v))))))
 164
 165 (defun make-mesh (name &rest args)
 166   "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)"
 167   (labels
 168       ((record-name ()
 169          (typecase name
 170            (symbol (import name :mesh-names))
 171            (string (intern name :mesh-names)))))
 172     (let ((mesh (make-instance 'mesh))
 173           (mesh-name (record-name)))
 174       (destructuring-bind
 175             (&key vertices normals colours texcoords material indices)
 176           args
 177         (setf (vertices-of mesh)
 178               (make-vertex3d-array (length vertices)))
 179         (iterate
 180           (for (x y z) in vertices)
 181           (for index from 0 below (length vertices))
 182           (setf (vertex3d-aref (vertices-of mesh)  index) (values x y z 1.0)))
 183         (when normals
 184           (setf (normals-of mesh)
 185                 (make-vector3d-array (length normals)))
 186           (iterate
 187             (for (x y z) in normals)
 188             (for i from 0 below (length normals))
 189             (setf (vector3d-aref (normals-of mesh) i)  (values x y z))))
 190         (when colours
 191           (setf (colours-of mesh)
 192                 (make-colour-array (length colours)))
 193           (iterate
 194             (for (r g b) in colours)
 195             (for i from 0 below (length colours))
 196             (setf (vector3d-aref (colours-of mesh) i)  (values r g b))))
 197         (when texcoords
 198           (setf (texcoords-of mesh)
 199                 (make-vector2d-array (length texcoords)))
 200           (iterate
 201             (for (u v) in texcoords)
 202             (for i from 0 below (length vertices))
 203             (setf (vector2d-aref (texcoordss-of mesh) i)  (values u v))))
 204         (when indices
 205           (make-mesh-faces mesh indices))
 206         (unless normals
 207           (setf (normals-of mesh)
 208                     (make-vector3d-array (length vertices)))))
 209       (setf (draw-fn-of mesh) (make-compiled-drawing-function mesh))
 210       (setf (gethash mesh-name *meshes*) mesh)
 211       mesh-name)))
 212
 213 (defmethod deindex ((self mesh))
 214   "Collapse mesh indices")
 215
 216 (defmethod decompilation ((self compiled-mesh))
 217   "Create a modifiable mesh from a compiled mesh")
 218
 219 (defmethod compilation ((self mesh))
 220   "Given a mesh return a compiled mesh, which is a non-modifiable mesh optimised for rendering in foreign memory.")
 221
 222
 223 (defmethod draw ((self mesh))
 224   "Draw a mesh with any appropiate means."
 225   (gl:with-begin gl:+triangles+
 226     (funcall (draw-fn-of self) self)))