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 (def-tuple-type triangle
  11     :tuple-element-type (unsigned-byte 16)
  12     :elements (a b c))
  13
  14 ;; mesh definitons mirror ogl definitions
  15
  16
  17 ;; wishful
  18 ;; (make-mesh-class wire-mesh
  19 ;;  (:attributes (:vertex vertex3d)
  20 ;;               (:colour color)))
  21
  22 ;; (make-mesh-class :name textured-mesh
  23 ;;  (:attributes (:vertex vertex3d)
  24 ;;               (:colour color)
  25 ;;               (:texcoord texcoord)))
  26
  27
  28 (defclass mesh-base ()
  29   ((vertex-index-array :accessor vertex-indices-of :documentation "Indices of triangle vertices" :initform nil)
  30    (current-vertex-index :accessor current-vertex-index-of :initform 0)
  31    (current-face-index :accessor current-face-index-of :initform 0))
  32   (:metaclass closer-mop:funcallable-standard-class)
  33   (:documentation "Base mixin class for mesh"))
  34
  35 (defclass mesh (mesh-base)
  36   ((vertex-array :accessor vertices-of :initform nil)
  37    (current-vertex-index :accessor current-vertex-index-of :initform 0)
  38    (current-face-index :accessor current-face-index-of :initform 0))
  39   (:metaclass closer-mop:funcallable-standard-class)
  40   (:documentation "Generic mesh type"))
  41
  42 (defun expand-mesh-class-attributes (attributes)
  43   (loop
  44      for attrib in attributes
  45      collect
  46        `(,(cl-tuples::make-adorned-symbol (car  attrib) :suffix "ARRAY")
  47           :accessor ,(cl-tuples::make-adorned-symbol (car attrib) :suffix "OF")
  48           :initform nil)))
  49
  50 (defun expand-mesh-builder-setters (name attributes)
  51   (loop
  52      for attrib in attributes
  53      collect
  54        `(,(cl-tuples::make-adorned-symbol (car attrib) :prefix "SET" :package :keyword)
  55           (setf (,(cl-tuples::tuple-symboll :def-tuple-aref)
  56                   (,(cl-tuples::make-adorned-symbol (car attrib) :suffix "OF")
  57                     mesh)
  58                   (current-t-vertex-index of mesh)
  59                   (,(cadr attrib) data))))))
  60
  61 (defun expand-mesh-builder-adders (name attributes)
  62   (loop
  63      for attrib in attributes
  64      collect
  65        `(,(cl-tuples::make-adorned-symbol (car attrib) :prefix "ADD" :package :keyword)
  66           )
  67 ))
  68 (defun expand-mesh-builder-function (name attributes)
  69   `(defmethod mesh-builder ((mesh ,name) op data)
  70      (ecase op
  71           (:set-face
  72            (setf (triangle-aref (vertex-indices-of mesh) (current-face-index-of mesh)) (triangle data)))
  73
  74
  75         )
  76        )
  77      ))
  78
  79 (defmacro def-mesh-class  (name &rest attributes)
  80     `(defclass ,name (mesh-base)
  81        (,@(expand-mesh-class-attributes attributes))
  82        (:metaclass closer-mop-funcallable-standard-class)
  83        (:documentation "Custom mesh type")))
  84
  85 (defgeneric make-mesh-faces (mesh triangle-data))
  86
  87 ;; mesh - building protocol
  88 (defgeneric mesh-builder (mesh op data))
  89
  90 ;; constructor : TO DO -- needs keys :has-vertices :has-normals :has-vetex-indices, etc
  91 (defmethod initialize-instance :after ((self base-mesh) &key mesh)
  92   (when mesh
  93     (make-mesh self (car mesh) (cdr mesh))
  94     ;; treat the object as a function
  95     (closer-mop:set-funcallable-instance-function
  96    self
  97    #'(lambda (op data) (mesh-builder self op data)))))
  98
  99
 100 (defclass compiled-mesh (mesh)
 101   ()
 102   (:metaclass closer-mop:funcallable-standard-class)
 103   (:documentation "Optimised, unmodifiable mesh"))
 104
 105 ;; mesh building protocol
 106 (defmethod mesh-builder ((mesh mesh) op data)
 107   (ecase op
 108     (:set-vertex
 109      (setf (vertex3d-aref (vertices-of mesh) (current-vertex-index-of mesh)) (vertex3d data)))n
 110     (:set-face
 111      (setf (triangle-aref (vertex-indices-of mesh) (current-face-index-of mesh)) (triangle data)))
 112     (:add-vertex
 113      (progn
 114        (vertex3d-vector-push-extend (vertex3d data) (vertices-of mesh))
 115        (vertex3d-array-dimensions (vertices-of mesh))))
 116 ;;      (when (normals-of mesh)
 117 ;;        (vector3d-vector-push-extend data (normals-of mesh)))
 118 ;;      (when (colours-of mesh)
 119 ;;        (colour-vector-push-extend data (colours-of mesh)))
 120 ;;      (when (texcoords-of mesh)
 121 ;;        (vector2d-vector-push-exend data (texcoords-of mesh))))
 122     (:add-triangle
 123      (progn
 124        (triangle-vector-push-extend (triangle data) (vertex-indices-of mesh))
 125        (triangle-array-dimensions (vertex-indices-of mesh))))
 126
 127 ;;      (when (normal-indices-of mesh)
 128 ;;        (triangle-vector-push-extend data (normal-indices-of mesh)))
 129 ;;      (when (colour-indices-of mesh)
 130 ;;        (triangle-vector-push-extend data (colour-indices-of mesh)))
 131 ;;      (when (colour-indices-of mesh)
 132 ;;        (triangle-vector-push-extend data (colour-indices-of mesh)))
 133 ;;      (when (texcoords-indices-of mesh)
 134 ;;        (triangle-vector-push-extend data (texcoord-indices-of mesh)))
 135 ;;      (when (face-normals-of mesh)
 136 ;;        (vector3d-vector-push-extend data (face-normals-of mesh)))
 137     (:vertex-index (setf (current-vertex-index-of mesh) data))
 138     (:face-index (setf (current-face-index-of mesh) data))))
 139
 140
 141 ;; Topology, if we get clever.
 142 ;; (defclass half-edge ()
 143 ;;   ((vertex-of :initform 0 :documentation "Indexes vertex of he")
 144 ;;    (predecessor-of :documentation "Half edge previos to this one")
 145 ;;    (successor-of :documentation "Half edge next to this one")
 146 ;;    (tri-of :documentation "Face the he belongs to"))
 147 ;;   (:documentation "Half edge element"))
 148
 149 ;; (:vertex () --) feeds elements into glVertex
 150 ;; (:normal () --) feeds elements into glNormal
 151 ;; (:colour () --) feeds elements into glColour
 152 ;; (:texcoord () --) feeds elements into glTexCoord
 153 ;; (:material (:ambient ) (:diffuse ) (:specular ))
 154 ;; (:triangle (:vertex () () () [(:normal ( ) () )]) ;;
 155 ;;  -- indexes vertices by face, also other elements if present otherwise we assume they map to same indices as vertices
 156
 157 (defmethod make-mesh-faces ((self  mesh) triangle-data)
 158   "Fills in the index arrays in a mesh from the form supplied."
 159   (destructuring-bind
 160    (&key vertex normal colour texcoord)
 161    triangle-data
 162    (assert vertex)
 163    (setf (vertex-indices-of self) (make-triangle-array (length vertex)))
 164    (iterate
 165     (for (a b c) in vertex)
 166     (for index from 0 below (length vertex))
 167     (setf (triangle-aref (vertex-indices-of self) index) (values a b c)))
 168 ;;    (when normal
 169 ;;      (assert (= (length vertex) (length normal)))
 170 ;;      (setf (normal-indices-of self) (make-triangle-array (length vertex)))
 171 ;;      (iterate
 172 ;;       (for (a b c) in normal)
 173 ;;       (for index from 0 below (length normal))
 174 ;;       (setf (triangle-aref (normal-indices-of self) index) (values a b c))))
 175 ;;    (when colour
 176 ;;      (assert (= (length vertex) (length colour)))
 177 ;;      (setf (colour-indices-of self) (make-triangle-array (length vertex)))
 178 ;;      (iterate
 179 ;;       (for (a b c) in colour)
 180 ;;       (for index from 0 below (length colour))
 181 ;;       (setf (triangle-aref (colour-indices-of self) index) (values a b c))))
 182 ;;    (when texcoord
 183 ;;      (assert (= (length vertex) (length texcoord)))
 184 ;;      (setf (texcoord-indices-of self) (make-triangle-array (length vertex)))
 185 ;;      (iterate
 186 ;;       (for (a b c) in texcoord)
 187 ;;       (for index from 0 below (length texcoord))
 188 ;;       (setf (triangle-aref (texcoord-indices-of self) index) (values a b c))))
 189 ))
 190
 191 ;; (def-tuple-op calc-face-normal
 192 ;;     ((vertex-a vertex3d (ax ay az aw))
 193 ;;      (vertex-b vertex3d (bx by bz bw))
 194 ;;      (vertex-c vertex3d (cx cy cz cw)))
 195 ;;   (vector3d-normal
 196 ;;    (vector3d-cross
 197 ;;     (delta-vector3d vertex-a vertex-b)
 198 ;;     (delta-vector3d vertex-a vertex-c))))
 199
 200 ;; (def-tuple-op vector3d-sum
 201 ;;     ((vector-a vector3d (ax ay az))
 202 ;;      (vector-b vector3d (bx by bz)))
 203 ;;   (vector3d-tuple (+ ax bx) (+ ay by) (+ az bz)))
 204
 205 (defclause-sequence in-triangles index-of-triangle
 206   :access-fn 'triangle-aref
 207   :size-fn 'triangle-array-dimensions
 208   :sequence-type 'vector
 209   :element-type '(values  (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16)))
 210
 211
 212 (defclause-sequence in-vertices index-of-vertex
 213   :access-fn 'vertex3d-aref
 214   :size-fn 'vertex3d-array-dimensions
 215   :sequence-type 'vector
 216   :element-type '(values (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16)))
 217
 218
 219 ;; (defmethod calc-face-normals ((self mesh))
 220 ;;   "Calculate the face normals of a mesh."
 221 ;;   (let* ((face-normals (make-vector3d-array (triangle-array-dimensions (vertex-indices-of self)))))
 222 ;;     (iterate
 223 ;;       (for (values a b c) in-triangles (vertex-indices-of self))
 224 ;;       (for triangle-index upfrom 0)
 225 ;;       (setf (vector3d-aref face-normals triangle-index)
 226 ;;             (calc-face-normal
 227 ;;              (vertex3d-aref (vertices-of self) a)
 228 ;;              (vertex3d-aref (vertices-of self) b)
 229 ;;              (vertex3d-aref (vertices-of self) c))))
 230 ;;     (setf (face-normals-of self) face-normals)))
 231
 232 ;; (defmethod calc-vertex-normals ((self mesh))
 233 ;;   "Calculate the vertex normals of a mesh."
 234 ;;   (let ((vertex-normals (make-vector3d-array (length (vertices-of self)))))
 235 ;;     (iterate
 236 ;;       (for index index-of-vertex (vertices-of self))
 237 ;;       (let ((normal (new-vector3d)))
 238 ;;         (iterate
 239 ;;           (for (values a b c) in-triangles (vertex-indices-of self))
 240 ;;           (for face-index upfrom 0)
 241 ;;           (when (or (= a index) (= b index) (= c index))
 242 ;;             (setf (vector3d normal)
 243 ;;                   (vector3d-sum (vector3d normal)
 244 ;;                                 (vector3d-aref (face-normals-of self) face-index))))
 245 ;;           (setf (vector3d-aref vertex-normals  index) (vertex3d normal)))))
 246 ;;     (setf (normals-of self) vertex-normals)))
 247
 248
 249 (defun make-mesh (name &rest args)
 250   "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)"
 251   (labels
 252       ((record-name ()
 253          (typecase name
 254            (symbol (import name :mesh-names))
 255            (string (intern name :mesh-names)))))
 256     (let ((mesh (make-instance 'mesh))
 257           (mesh-name (record-name)))
 258       (destructuring-bind
 259             (&key vertices normals colours texcoords material indices)
 260           args
 261         (setf (vertices-of mesh)
 262               (make-vertex3d-array (length vertices)))
 263         (iterate
 264           (for (x y z) in vertices)
 265           (for index from 0 below (length vertices))
 266           (setf (vertex3d-aref (vertices-of mesh)  index) (values x y z 1.0)))
 267 ;;         (when normals
 268 ;;           (setf (normals-of mesh)
 269 ;;                 (make-vector3d-array (length normals)))
 270 ;;           (iterate
 271 ;;             (for (x y z) in normals)
 272 ;;             (for i from 0 below (length normals))
 273 ;;             (setf (vector3d-aref (normals-of mesh) i)  (values x y z))))
 274 ;;         (when colours
 275 ;;           (setf (colours-of mesh)
 276 ;;                 (make-colour-array (length colours)))
 277 ;;           (iterate
 278 ;;             (for (r g b) in colours)
 279 ;;             (for i from 0 below (length colours))
 280 ;;             (setf (vector3d-aref (colours-of mesh) i)  (values r g b))))
 281 ;;         (when texcoords
 282 ;;           (setf (texcoords-of mesh)
 283 ;;                 (make-vector2d-array (length texcoords)))
 284 ;;           (iterate
 285 ;;             (for (u v) in texcoords)
 286 ;;             (for i from 0 below (length vertices))
 287 ;;             (setf (vector2d-aref (texcoords-of mesh) i)  (values u v))))
 288         (when indices
 289           (make-mesh-faces mesh indices))
 290 ;;         (unless normals
 291 ;;           (setf (normals-of mesh)
 292 ;;                     (make-vector3d-array (length vertices)))))
 293       (setf (gethash mesh-name *meshes*) mesh)
 294       mesh-name))))
 295
 296
 297
 298 ;; mesh geometry calculation ---------------------------------------------
 299
 300 (defmethod box-of ((self mesh))
 301   "Return a bounding box for the mesh."
 302   (let ((maxx most-negative-single-float)
 303         (minx most-positive-single-float)
 304         (maxy most-negative-single-float)
 305         (miny most-positive-single-float)
 306         (maxz most-negative-single-float)
 307         (minz most-positive-single-float))
 308     (iterate
 309       (for index index-of-vertex (vertices-of self))
 310       (with-vertex3d
 311        (vertex3d-aref (vertices-of self) index)
 312        (x y z w)
 313        (cond
 314         ((< x minx) (setf minx x))
 315         ((> x maxx) (setf maxx x))
 316         ((< y miny) (setf miny y))
 317         ((> y maxy) (setf maxy y))
 318         ((< z minz) (setf minz z))
 319         ((< z minz) (setf minz z)))))
 320     (values minx maxx miny maxy minz maxz)))
 321
 322 (defmethod normalize-scale ((self mesh))
 323   "Rescale geometry to fit into a 1:1:1 bounding box"
 324   (multiple-value-bind
 325         (minx maxx miny maxy minz maxz)
 326       (box-of self)
 327     (let ((dx (- maxx minx))
 328           (dy (- maxy miny))
 329           (dz (- maxz minz))
 330         (scale))
 331     (cond
 332       ((and  (> dx dz) (> dx dy))
 333        ;; dx is largest dimension
 334        (setf scale (/ 1 (- maxx minx))))
 335       ;; dy is largest dimension
 336       ((and (> dy dz) (> dy dx))
 337        (setf scale (/ 1 (- maxy miny))))
 338       ;; dz is largest dimension
 339       ((and (> dz dy) (> dz dx))
 340        (setf scale (/ 1 (- maxy miny)))))
 341     (iterate
 342       (for index index-of-vertex (vertices-of self))
 343       (with-vertex3d
 344        (vertex3d-aref (vertices-of self) index)
 345        (x y z)
 346        (setf (vertex3d-aref (vertices-of self) index) (vertex3d-tuple (* x scale) (* y scale) (* z scale) 1.0)))))))
 347
 348
 349 (defmethod stripify ((self mesh))
 350   "Stripify mesh")
 351
 352 (defmethod decompilation ((self compiled-mesh))
 353   "Create a modifiable mesh from a compiled mesh")
 354
 355 (defmethod compilation ((self mesh))
 356   "Given a mesh return a compiled mesh, which is a non-modifiable mesh optimised for rendering in foreign memory."
 357 )
 358
 359
 360 ;; mesh rendering  ---------------------------------------------
 361
 362 ;; (defmethod render ((self mesh))
 363 ;;   "Draw a mesh with any appropiate means."
 364 ;;   (iterate
 365 ;;    (for (values x y z w) in-vertices (vertices-of mesh)
 366 ;;         (gl:vertex-3f x y z w))))
 367
 368
 369
 370