Add collision-mask-p

Shirakumo · Nov 22, 2024 · d86488d · d86488d
1 parent f717b29
commit d86488d
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 1 deletion.
diff --git a/package.lisp b/package.lisp
@@ -383,6 +383,7 @@
    #:define-support-function
    #:finish-hit
    #:collision-system-idx
+   #:collision-mask-p
    #:primitive
    #:primitive-entity
    #:primitive-material

diff --git a/physics/primitives.lisp b/physics/primitives.lisp
@@ -130,7 +130,7 @@
                (T
                 (write-char (char-downcase char) out))))))
 
-(defun collision-system-idx (system-ish)
+(defun %collision-system-idx (system-ish)
   (etypecase system-ish
     (integer
      system-ish)
@@ -149,6 +149,14 @@
        (sequences:dosequence (system system-ish mask)
          (setf (ldb (byte 1 (collision-system-idx system)) mask) 1))))))
 
+(defun collision-system-idx (system-ish)
+  (%collision-system-idx system-ish))
+
+(define-compiler-macro collision-system-idx (&whole whole system-ish &environment env)
+  (if (constantp system-ish env)
+      `(load-time-value (%collision-system-idx ,system-ish))
+      whole))
+
 (defun (setf collision-system-idx) (index system-ish)
   (etypecase system-ish
     (integer
@@ -167,6 +175,10 @@
      (sequences:dosequence (system system-ish system-ish)
        (setf (collision-system-idx system) index)))))
 
+(declaim (inline collision-mask-p))
+(defun collision-mask-p (mask entity)
+  (logbitp (collision-system-idx mask) (collision-mask entity)))
+
 (defstruct primitive
   (entity NIL :type T)
   (material NIL :type T)