New collision interface

Collision callbacks and contact filters are bound to geoms.
borodust · Jan 14, 2017 · 6f16155 · 6f16155
1 parent 10123b1
commit 6f16155
Show file tree

Hide file tree

Showing 13 changed files with 174 additions and 107 deletions.
diff --git a/cl-bodge.asd b/cl-bodge.asd
@@ -187,6 +187,7 @@
   :serial t
   :components ((:file "packages")
                (:file "ode")
+               (:file "contacts")
                (:file "universe")
                (:file "system")
                (:file "mass")

diff --git a/host/events.lisp b/host/events.lisp
@@ -90,7 +90,7 @@
   (x y))
 
 
-(defevent framebuffer-size-change-event (event)
+(defevent viewport-size-change-event (event)
   (width height))
 
 

diff --git a/host/packages.lisp b/host/packages.lisp
@@ -30,7 +30,7 @@
            scroll-event
            x-offset-from
            y-offset-from
-           framebuffer-size-change-event
+           viewport-size-change-event
            width-from
            height-from
            viewport-hiding-event))
diff --git a/host/system.lisp b/host/system.lisp
@@ -60,7 +60,7 @@
 
 (glfw:def-framebuffer-size-callback on-framebuffer-size-change (window w h)
   (declare (ignore window))
-  (post (make-framebuffer-size-change-event w h) (event-system-of *system*)))
+  (post (make-viewport-size-change-event w h) (event-system-of *system*)))
 
 
 (%glfw:define-glfw-callback on-character-input ((window :pointer) (char-code :unsigned-int))
@@ -76,7 +76,7 @@
                           'mouse-event
                           'cursor-event
                           'scroll-event
-                          'framebuffer-size-change-event
+                          'viewport-size-change-event
                           'viewport-hiding-event))
 
 

diff --git a/physics/contacts.lisp b/physics/contacts.lisp
@@ -0,0 +1,32 @@
+(in-package :cl-bodge.physics)
+
+
+(defstruct (contact
+             (:constructor make-contact (geom)))
+  (geom nil :read-only t))
+
+
+(defun contact-position (info)
+  (c-let ((geom %ode:contact-geom :from (contact-geom info)))
+    (vec3 (geom :pos 0) (geom :pos 1) (geom :pos 2))))
+
+
+(defun contact-normal (info)
+  (c-let ((geom %ode:contact-geom :from (contact-geom info)))
+    (vec3 (geom :normal 0) (geom :normal 1) (geom :normal 2))))
+
+
+(defun contact-depth (info)
+  (c-ref (contact-geom info) %ode:contact-geom :depth))
+
+
+(defun fill-contact-geom (contact-geom info)
+  (memcpy (ptr contact-geom) (ptr (contact-geom info)) :type '%ode:contact-geom))
+
+
+(defun fill-contact (contact info)
+  (setf (%ode:contact.surface.mode contact) (mask 'contact-flags :approx0 :bounce)
+        (%ode:contact.surface.mu contact) +infinity+
+        (%ode:contact.surface.bounce contact) 1.0)
+  (fill-contact-geom (%ode:contact.geom contact) info)
+  contact)
diff --git a/physics/geometry.lisp b/physics/geometry.lisp
@@ -5,8 +5,7 @@
     :closeform (%ode:geom-destroy *handle-value*))
 
 
-(defclass geom (ode-object)
-  ())
+(defclass geom (ode-object) ())
 
 
 (defmethod initialize-instance :around ((this geom) &key)
@@ -31,32 +30,37 @@
 (defclass volume-geom (geom) ())
 
 
-(defgeneric bind-geom (geom rigid-body)
-  (:method ((this volume-geom) rigid-body)
-    (%ode:geom-set-body (handle-value-of this) (handle-value-of rigid-body))))
+(defun bind-geom (geom rigid-body)
+  (%ode:geom-set-body (handle-value-of geom) (handle-value-of rigid-body)))
 
 ;;;
 ;;;
 ;;;
 (defclass sphere-geom (volume-geom) ())
 
 
-(define-system-function make-sphere-geom physics-system (radius &key (system *system*))
-  (make-instance 'sphere-geom
-                 :system system
-                 :handle (make-geom-handle (%ode:create-sphere (space-of (universe)) radius))))
-
+(defmethod initialize-instance ((this sphere-geom) &rest args
+                                &key (radius (error ":radius missing")))
+  (apply #'call-next-method
+         this
+         :handle (make-geom-handle (%ode:create-sphere (space-of (universe)) radius))
+         args))
 
 ;;;
 ;;;
 ;;;
 (defclass box-geom (volume-geom) ())
 
 
-(define-system-function make-box-geom physics-system (x y z &key (system *system*))
-  (make-instance 'box-geom
-                 :system system
-                 :handle (make-geom-handle (%ode:create-box (space-of (universe)) x y z))))
+(defmethod initialize-instance ((this box-geom) &rest args
+                                &key (dimensions (error ":dimensions missing")))
+  (apply #'call-next-method
+         this
+         :handle (make-geom-handle (%ode:create-box (space-of (universe))
+                                                    (x dimensions)
+                                                    (y dimensions)
+                                                    (z dimensions)))
+         args))
 
 
 
@@ -66,32 +70,50 @@
 (defclass plane-geom (geom) ())
 
 
-(define-system-function make-plane-geom physics-system (a b c z &key (system *system*))
-  (make-instance 'plane-geom :system system
-                 :handle (make-geom-handle (%ode:create-plane (space-of (universe)) a b c z))))
-
+(defmethod initialize-instance ((this plane-geom) &rest args
+                                &key (normal (error ":normal missing"))
+                                  (offset 0.0))
+  (apply #'call-next-method
+         this
+         :handle (make-geom-handle
+                  (%ode:create-plane (space-of (universe))
+                                     (x normal) (y normal) (z normal) offset))
+         args))
 
 ;;;
 ;;;
 ;;;
-(defclass capped-cylinder-geom (volume-geom) ())
+(defclass ray-geom (geom)
+  ((position :reader position-of)
+   (direction :reader direction-of)))
 
 
-(define-system-function make-capped-cylinder-geom physics-system
-    (radius length &key (system *system*))
-  (make-instance 'capped-cylinder-geom
-                 :system system
-                 :handle (make-geom-handle
-                          (%ode:create-cylinder (space-of (universe)) radius length))))
+(defmethod initialize-instance ((this ray-geom) &rest args
+                                &key (position (vec3 0.0 0.0 0.0))
+                                  (direction (error ":direction missing"))
+                                  (length (error ":length missing")))
+  (with-slots ((pos position) (dir direction)) this
+    (let ((ode-ray (%ode:create-ray (space-of (universe)) length)))
+      (setf pos position
+            dir direction)
+      (%ode:geom-ray-set ode-ray
+                         (x position) (y position) (z position)
+                         (x direction) (y direction) (z direction))
+      (apply #'call-next-method
+             this
+             :handle (make-geom-handle ode-ray)
+             args))))
 
 
-;;;
-;;;
-;;;
-(defclass ray-geom (geom) ())
+(defmethod (setf position-of) ((position vec3) (this ray-geom))
+  (with-slots (direction) this
+    (%ode:geom-ray-set (handle-value-of this)
+                       (x position) (y position) (z position)
+                       (x direction) (y direction) (z direction))))
 
 
-(define-system-function make-ray-geom physics-system (length &key (system *system*))
-  (make-instance 'ray-geom
-                 :system system
-                 :handle (make-geom-handle (%ode:create-ray (space-of (universe)) length))))
+(defmethod (setf direction-of) ((direction vec3) (this ray-geom))
+  (with-slots (position) this
+    (%ode:geom-ray-set (handle-value-of this)
+                       (x position) (y position) (z position)
+                       (x direction) (y direction) (z direction))))
diff --git a/physics/ode.lisp b/physics/ode.lisp
@@ -2,3 +2,33 @@
 
 
 (defclass ode-object (foreign-object) ())
+
+
+(defgeneric direction-of (object))
+(defgeneric (setf direction-of) (value object))
+
+
+(defgeneric collide (this-geom that-geom)
+  (:method (this-geom that-geom) t))
+
+
+(defgeneric filter-contacts (contacts this-geom that-geom)
+  (:method (contacts this-geom that-geom) contacts))
+
+
+;;;
+;;;
+;;;
+(defclass collidable () ())
+
+
+(defgeneric collidablep (obj)
+  (:method (obj) nil))
+
+
+(defmethod collidablep ((this collidable))
+  t)
+
+
+(defmethod collide ((this collidable) (that collidable))
+  nil)
diff --git a/physics/packages.lisp b/physics/packages.lisp
@@ -9,8 +9,10 @@
            physics
            observe-universe
            gravity
-           register-collision-callback
-           register-contact-callback
+
+           contact-position
+           contact-normal
+           contact-depth
 
            make-rigid-body
            position-of
@@ -27,11 +29,15 @@
            make-double-hinge-joint
            make-angular-motor-joint
 
-           make-sphere-geom
-           make-box-geom
-           make-plane-geom
-           make-capped-cylinder-geom
-           make-ray-geom
+           collide
+           filter-contacts
+           collidable
+           collidablep
+           sphere-geom
+           box-geom
+           plane-geom
+           ray-geom
+           direction-of
            bind-geom
 
            make-box-mass

diff --git a/physics/rigid-body.lisp b/physics/rigid-body.lisp
@@ -44,7 +44,7 @@
 ;; fixme memory sink
 (defmethod position-of ((this rigid-body))
   (let ((ode-pos (%ode:body-get-position (handle-value-of this))))
-    (flet ((el (idx) #f(c-aref ode-pos idx '%ode:real)))
+    (flet ((el (idx) #f(c-ref ode-pos %ode:real idx)))
       (vec3 (el 0) (el 1) (el 2)))))
 
 
@@ -59,7 +59,7 @@
     (macrolet ((init ()
                  `(mat3 ,@(loop for i from 0 below 3 append
                                (loop for j from 0 below 3 collect
-                                    `(float (c-aref m3 ,(+ (* j 4) i) '%ode:real)))))))
+                                    `(float (c-ref m3 %ode:real ,(+ (* j 4) i)) 0f0))))))
       (init))))
 
 

diff --git a/physics/system.lisp b/physics/system.lisp
@@ -1,5 +1,6 @@
 (in-package :cl-bodge.physics)
 
+
 (defstruct (physics-context
              (:conc-name ctx-))
   (universe (make-universe) :read-only t))
@@ -10,14 +11,6 @@
   (ctx-universe *system-context*))
 
 
-(defun register-collision-callback (callback)
-  (%register-collision-callback (universe) callback))
-
-
-(defun register-contact-callback (callback)
-  (%register-contact-callback (universe) callback))
-
-
 (defclass physics-system (thread-bound-system) ())
 
 
@@ -39,6 +32,6 @@
   (%observe-universe (universe) timestep))
 
 
-(defun (setf gravity) (vec)
+(define-system-function (setf gravity) physics-system (vec)
   (%ode:world-set-gravity (world-of (universe))
                           (vref vec 0) (vref vec 1) (vref vec 2)))
-Original file line number
+Diff line change
@@ Expand Up / @@ -90,7 +90,7 @@ @@
       (x y))
-    (defevent framebuffer-size-change-event (event)
+    (defevent viewport-size-change-event (event)
       (width height))
@@ Expand Down @@