Add collision mask to rigid-shapes too to allow easily toggling an en…

…tity's collision behaviour

physics/primitives.lisp

@@ -162,17 +162,25 @@
            (v<- (global-bounds-cache-obb target) (global-bounds-cache-obb source))
            (v<- (global-bounds-cache-aabb target) (global-bounds-cache-aabb source)))))
 
-(declaim (ftype (function (T) (unsigned-byte 32)) collision-mask))
+(declaim (ftype (function (T) (values (unsigned-byte 32) &optional)) collision-mask))
 (defmethod collision-mask ((primitive primitive))
   (primitive-collision-mask primitive))
 
 (defmethod (setf collision-mask) ((mask integer) (primitive primitive))
   (setf (primitive-collision-mask primitive) mask))
 
-(defmethod (setf collision-mask) ((systems sequence) (primitive primitive))
-  (setf (collision-mask primitive) (collision-system-idx systems))
+(defmethod (setf collision-mask) ((systems sequence) thing)
+  (setf (collision-mask thing) (collision-system-idx systems))
   systems)
 
+(defmethod (setf collision-mask) ((all (eql T)) thing)
+  (setf (collision-mask thing) (1- (ash 1 32)))
+  T)
+
+(defmethod (setf collision-mask) ((none null) thing)
+  (setf (collision-mask thing) 0)
+  NIL)
+
 (defmethod global-transform-matrix ((primitive primitive) &optional target)
   (etypecase target
     (null (primitive-transform primitive))

physics/resolution.lisp

@@ -332,7 +332,8 @@
                       ;; Don't bother detecting hits between immovable objects
                       (loop for a-p across (physics-primitives a)
                             do (loop for b-p across (physics-primitives b)
-                                     do (when (and (< 0 (logand (collision-mask a-p) (collision-mask b-p)))
+                                     do (when (and (< 0 (logand (collision-mask a-p) (collision-mask b-p)
+                                                                (collision-mask a) (collision-mask b)))
                                                    (intersects-p (primitive-global-bounds-cache a-p)
                                                                  (primitive-global-bounds-cache b-p)))
                                           (let ((new-start (detect-hits a-p b-p hits start end)))
@@ -475,12 +476,14 @@
                         (awake-p object))
                (loop for a across (physics-primitives object)
                      do (3ds:do-overlapping (b structure a)
-                          (when (< 0 (logand (collision-mask a) (collision-mask b)))
+                          (when (< 0 (logand (collision-mask a) (collision-mask b)
+                                             (collision-mask object) (collision-mask (primitive-entity b))))
                             (update-start (detect-hits a b hits start end)))))))
     (3ds:do-pairs (a b (dynamic-acceleration-structure system) start)
-      (when (< 0 (logand (collision-mask a) (collision-mask b)))
-        (let ((entity1 (primitive-entity a))
-              (entity2 (primitive-entity b)))
+      (let ((entity1 (primitive-entity a))
+            (entity2 (primitive-entity b)))
+        (when (< 0 (logand (collision-mask a) (collision-mask b)
+                           (collision-mask entity1) (collision-mask entity2)))
           (when (and (not (eq entity1 entity2))
                      (or (awake-p entity1)
                          (awake-p entity2)))
@@ -574,9 +577,10 @@
                (collision-pairs '())
                (result (let ((start start))
                          (3ds:do-pairs (a b (dynamic-acceleration-structure system) start)
-                           (when (< 0 (logand (primitive-collision-mask a) (primitive-collision-mask b)))
-                             (let ((entity1 (primitive-entity a))
-                                   (entity2 (primitive-entity b)))
+                           (let ((entity1 (primitive-entity a))
+                                 (entity2 (primitive-entity b)))
+                             (when (< 0 (logand (primitive-collision-mask a) (primitive-collision-mask b)
+                                                (collision-mask entity1) (collision-mask entity2)))
                                (unless (or (eq entity1 entity2)
                                            (and (= 0.0 (inverse-mass entity1))
                                                 (= 0.0 (inverse-mass entity2))))

physics/rigidbody.lisp

@@ -3,23 +3,15 @@
 (defclass rigid-shape (physics-entity transformed-entity global-bounds-cached-entity)
   ((physics-primitives :initform #() :accessor physics-primitives)
    ;; Cache
-   (transform-matrix :initform (mat4) :reader transform-matrix)))
+   (transform-matrix :initform (mat4) :reader transform-matrix)
+   (collision-mask :initform (1- (ash 1 32)) :accessor collision-mask)))
 
 (defmethod shared-initialize :after ((body rigid-shape) slots &key physics-primitives)
   (when physics-primitives (setf (physics-primitives body) physics-primitives)))
 
 (define-transfer rigid-shape
   (physics-primitives physics-primitives (lambda (p) (map-into (make-array (length p)) #'clone p))))
 
-(defmethod collision-mask ((shape rigid-shape))
-  (if (= 0 (length (physics-primitives shape)))
-      0
-      (collision-mask (aref (physics-primitives shape) 0))))
-
-(defmethod (setf collision-mask) (mask (shape rigid-shape))
-  (loop for primitive across (physics-primitives shape)
-        do (setf (collision-mask primitive) mask)))
-
 (define-hit-detector (rigid-shape primitive)
   (loop for ai across (physics-primitives a)
         do (detect-hits ai b)))