diff --git a/cl-bodge.asd b/cl-bodge.asd index 0fdf56e..a0407f1 100644 --- a/cl-bodge.asd +++ b/cl-bodge.asd @@ -17,7 +17,7 @@ :mailto "dev@borodust.org" :license "MIT" :depends-on (:cl-bodge/utils :bodge-memory :bodge-math :bodge-concurrency - :bodge-blobs-support :claw :claw-utils :log4cl :cl-fad + :bodge-blobs-support :log4cl :cl-fad :local-time :cffi :cl-flow :uiop :simple-flow-dispatcher :cl-muth :float-features :bodge-libc-essentials) :pathname "engine/" @@ -203,7 +203,7 @@ :mailto "dev@borodust.org" :license "MIT" :depends-on (cl-bodge/utils cl-bodge/engine cl-bodge/physics/backend - ode-blob bodge-ode log4cl claw local-time) + ode-blob bodge-ode log4cl local-time) :pathname "physics/3d/" :serial t :components ((:file "packages") @@ -230,7 +230,7 @@ :mailto "dev@borodust.org" :license "MIT" :depends-on (cl-bodge/utils cl-bodge/engine cl-bodge/physics/backend - chipmunk-blob bodge-chipmunk log4cl claw + chipmunk-blob bodge-chipmunk log4cl trivial-garbage cffi) :pathname "physics/2d/" :serial t @@ -289,7 +289,7 @@ :mailto "dev@borodust.org" :license "MIT" :depends-on (cl-bodge/engine cl-bodge/utils bodge-ui cl-bodge/graphics cl-bodge/canvas - cl-bodge/host claw) + cl-bodge/host) :pathname "ui/" :serial t :components ((:file "packages") diff --git a/physics/2d/body.lisp b/physics/2d/body.lisp index 0f4ffda..f81a84a 100644 --- a/physics/2d/body.lisp +++ b/physics/2d/body.lisp @@ -13,7 +13,7 @@ (let ((cp-mass (cp-float mass))) (with-cp-vect (vect offset) (make-mass :value cp-mass - :inertia (%cp:moment-for-circle cp-mass (cp-float 0) (cp-float radius) vect))))) + :inertia (%chipmunk:moment-for-circle cp-mass (cp-float 0) (cp-float radius) vect))))) (defmethod simulation-engine-make-mass-for-box ((engine chipmunk-engine) (mass number) @@ -21,14 +21,14 @@ (let ((cp-mass (cp-float mass)) (w/2 (/ width 2)) (h/2 (/ height 2))) - (c-with ((verts %cp:vect :count 5)) + (c-with ((verts %chipmunk:vect :count 5)) (init-cp-vect (verts 0) (vec2 (- w/2) (- h/2))) (init-cp-vect (verts 1) (vec2 (- w/2) h/2)) (init-cp-vect (verts 2) (vec2 w/2 h/2)) (init-cp-vect (verts 3) (vec2 w/2 (- h/2))) (init-cp-vect (verts 4) offset) (make-mass :value cp-mass - :inertia (%cp:moment-for-poly cp-mass 4 (verts &) (verts 4 &) (cp-float 0)))))) + :inertia (%chipmunk:moment-for-poly cp-mass 4 (verts &) (verts 4 &) (cp-float 0)))))) @@ -36,7 +36,7 @@ ;;; RIGID BODY ;;; (defhandle rigid-body-handle - :closeform (%cp:body-free *handle-value*)) + :closeform (%chipmunk:body-free *handle-value*)) (defclass rigid-body (disposable) ((universe :initarg :universe :initform (error ":universe missing")) @@ -53,8 +53,8 @@ (if kinematic (progn (when mass (error "Kinematic bodies cannot have mass")) - (%cp:body-new-kinematic)) - (%cp:body-new (mass-value mass) (mass-inertia mass)))) + (%chipmunk:body-new-kinematic)) + (%chipmunk:body-new (mass-value mass) (mass-inertia mass)))) args)) @@ -64,44 +64,44 @@ :universe universe :kinematic kinematic))) (flet ((%space-add-body () - (%cp:space-add-body (handle-value-of universe) (handle-value-of body)))) + (%chipmunk:space-add-body (handle-value-of universe) (handle-value-of body)))) (invoke-between-observations #'%space-add-body)) body)) (defmethod simulation-engine-apply-force ((engine chipmunk-engine) (body rigid-body) (force vec2)) (with-cp-vect (current-force) - (%cp:body-get-force current-force (handle-value-of body)) + (%chipmunk:body-get-force current-force (handle-value-of body)) (incf (current-force :x) (cp-float (x force))) (incf (current-force :y) (cp-float (y force))) - (%cp:body-set-force (handle-value-of body) current-force)) + (%chipmunk:body-set-force (handle-value-of body) current-force)) force) (defmethod simulation-engine-apply-torque ((engine chipmunk-engine) (body rigid-body) (torque number)) - (let* ((current-torque (%cp:body-get-torque (handle-value-of body)))) - (%cp:body-set-torque (handle-value-of body) (cp-float (+ current-torque torque)))) + (let* ((current-torque (%chipmunk:body-get-torque (handle-value-of body)))) + (%chipmunk:body-set-torque (handle-value-of body) (cp-float (+ current-torque torque)))) torque) (defmethod simulation-engine-body-mass ((engine chipmunk-engine) (body rigid-body)) (let ((handle (handle-value-of body))) - (make-mass :value (%cp:body-get-mass handle) - :inertia (%cp:body-get-moment handle)))) + (make-mass :value (%chipmunk:body-get-mass handle) + :inertia (%chipmunk:body-get-moment handle)))) (defmethod (setf simulation-engine-body-mass) ((value mass) (engine chipmunk-engine) (body rigid-body)) (between-observations (let ((handle (handle-value-of body))) - (%cp:body-set-mass handle (cp-float (mass-value value))) - (%cp:body-set-moment handle (cp-float (mass-inertia value))))) + (%chipmunk:body-set-mass handle (cp-float (mass-value value))) + (%chipmunk:body-set-moment handle (cp-float (mass-inertia value))))) value) (defmethod simulation-engine-body-position ((engine chipmunk-engine) (body rigid-body)) (with-cp-vect (vect) - (%cp:body-get-position vect (handle-value-of body)) + (%chipmunk:body-get-position vect (handle-value-of body)) (init-bodge-vec (vec2) vect))) @@ -109,13 +109,13 @@ (body rigid-body)) (between-observations (with-cp-vect (vect value) - (%cp:body-set-position (handle-value-of body) vect))) + (%chipmunk:body-set-position (handle-value-of body) vect))) value) (defmethod simulation-engine-body-linear-velocity ((engine chipmunk-engine) (body rigid-body)) (with-cp-vect (vect) - (%cp:body-get-velocity vect (handle-value-of body)) + (%chipmunk:body-get-velocity vect (handle-value-of body)) (init-bodge-vec (vec2) vect))) @@ -123,31 +123,31 @@ (body rigid-body)) (between-observations (with-cp-vect (vect value) - (%cp:body-set-velocity (handle-value-of body) vect))) + (%chipmunk:body-set-velocity (handle-value-of body) vect))) value) (defmethod simulation-engine-body-rotation ((engine chipmunk-engine) (body rigid-body)) - (euler-angle->mat2 (%cp:body-get-angle (handle-value-of body)))) + (euler-angle->mat2 (%chipmunk:body-get-angle (handle-value-of body)))) (defmethod (setf simulation-engine-body-rotation) ((value mat2) (engine chipmunk-engine) (body rigid-body)) (between-observations - (%cp:body-set-angle (handle-value-of body) (cp-float (atan (mref value 1 0) + (%chipmunk:body-set-angle (handle-value-of body) (cp-float (atan (mref value 1 0) (mref value 0 0))))) value) (defmethod simulation-engine-body-angular-velocity ((engine chipmunk-engine) (body rigid-body)) - (%cp:body-get-angular-velocity (handle-value-of body))) + (%chipmunk:body-get-angular-velocity (handle-value-of body))) (defmethod (setf simulation-engine-body-angular-velocity) ((value number) (engine chipmunk-engine) (body rigid-body)) (between-observations - (%cp:body-set-angular-velocity (handle-value-of body) (cp-float value)))) + (%chipmunk:body-set-angular-velocity (handle-value-of body) (cp-float value)))) (defmethod simulation-engine-destroy-rigid-body ((engine chipmunk-engine) (body rigid-body)) diff --git a/physics/2d/contact.lisp b/physics/2d/contact.lisp index f57c006..f7cab4f 100644 --- a/physics/2d/contact.lisp +++ b/physics/2d/contact.lisp @@ -3,22 +3,22 @@ (declaim (special *arbiter*)) (defmethod (setf simulation-engine-collision-friction) ((value number) (engine chipmunk-engine)) - (%cp:arbiter-set-friction *arbiter* (cp-float value)) + (%chipmunk:arbiter-set-friction *arbiter* (cp-float value)) value) (defmethod (setf simulation-engine-collision-elasticity) ((value number) (engine chipmunk-engine)) - (%cp:arbiter-set-restitution *arbiter* (cp-float value)) + (%chipmunk:arbiter-set-restitution *arbiter* (cp-float value)) value) (defmethod (setf simulation-engine-collision-surface-velocity) ((value ge.ng:vec2) (engine chipmunk-engine)) (with-cp-vect (vec value) - (%cp:arbiter-set-surface-velocity *arbiter* vec)) + (%chipmunk:arbiter-set-surface-velocity *arbiter* vec)) value) (defmethod simulation-engine-collision-surface-velocity ((engine chipmunk-engine)) (with-cp-vect (vec) - (%cp:arbiter-get-surface-velocity vec *arbiter*) + (%chipmunk:arbiter-get-surface-velocity vec *arbiter*) (init-bodge-vec (vec2) vec))) (defmethod simulation-engine-contact-normal ((engine chipmunk-engine)) diff --git a/physics/2d/joint.lisp b/physics/2d/joint.lisp index 63a4a62..125e46c 100644 --- a/physics/2d/joint.lisp +++ b/physics/2d/joint.lisp @@ -2,7 +2,7 @@ (defhandle constraint-handle - :closeform (%cp:constraint-free *handle-value*)) + :closeform (%chipmunk:constraint-free *handle-value*)) (defclass chipmunk-constraint (disposable) @@ -32,13 +32,13 @@ (let ((constraint (make-instance 'chipmunk-constraint :universe universe :handle (make-constraint-handle - (%cp:damped-spring-new (handle-value-of this-body) + (%chipmunk:damped-spring-new (handle-value-of this-body) (handle-value-of that-body) anchor-a anchor-b (cp-float rest-length) (cp-float stiffness) (cp-float damping)))))) - (%cp:space-add-constraint (handle-value-of universe) (handle-value-of constraint)) + (%chipmunk:space-add-constraint (handle-value-of universe) (handle-value-of constraint)) constraint))) @@ -55,12 +55,12 @@ (let ((constraint (make-instance 'chipmunk-constraint :universe universe :handle (make-constraint-handle - (%cp:slide-joint-new (handle-value-of this-body) + (%chipmunk:slide-joint-new (handle-value-of this-body) (handle-value-of that-body) anchor-a anchor-b (cp-float min) (cp-float max)))))) - (%cp:space-add-constraint (handle-value-of universe) (handle-value-of constraint)) + (%chipmunk:space-add-constraint (handle-value-of universe) (handle-value-of constraint)) constraint))) @@ -75,9 +75,9 @@ (let ((constraint (make-instance 'chipmunk-constraint :universe universe :handle (make-constraint-handle - (%cp:pin-joint-new (handle-value-of this-body) + (%chipmunk:pin-joint-new (handle-value-of this-body) (or (and that-body (handle-value-of that-body)) - (%cp:space-get-static-body (handle-value-of universe))) + (%chipmunk:space-get-static-body (handle-value-of universe))) anchor-a anchor-b))))) - (%cp:space-add-constraint (handle-value-of universe) (handle-value-of constraint)) + (%chipmunk:space-add-constraint (handle-value-of universe) (handle-value-of constraint)) constraint))) diff --git a/physics/2d/shape.lisp b/physics/2d/shape.lisp index 8fec26d..cad5038 100644 --- a/physics/2d/shape.lisp +++ b/physics/2d/shape.lisp @@ -5,7 +5,7 @@ ;;; SHAPE ;;; (defhandle shape-handle - :closeform (%cp:shape-free *handle-value*)) + :closeform (%chipmunk:shape-free *handle-value*)) (defclass chipmunk-shape (disposable) @@ -45,7 +45,7 @@ (defun add-space-shape (universe shape) (flet ((%add () - (%cp:space-add-shape (handle-value-of universe) (handle-value-of shape)))) + (%chipmunk:space-add-shape (handle-value-of universe) (handle-value-of shape)))) (invoke-between-observations #'%add))) @@ -57,13 +57,13 @@ (defmethod initialize-instance ((this segment-shape) &rest args &key start end body universe) - (c-with ((a %cp:vect) - (b %cp:vect)) + (c-with ((a %chipmunk:vect) + (b %chipmunk:vect)) (init-cp-vect (a &) start) (init-cp-vect (b &) end) (apply #'call-next-method this :handle (make-shape-handle - (%cp:segment-shape-new (body-handle-or-static universe body) a b (cp-float 0.0))) + (%chipmunk:segment-shape-new (body-handle-or-static universe body) a b (cp-float 0.0))) args))) @@ -97,7 +97,7 @@ (let ((shape (simulation-engine-make-segment-shape engine universe origin end :body body :substance substance))) - (%cp:segment-shape-set-neighbors (handle-value-of shape) + (%chipmunk:segment-shape-set-neighbors (handle-value-of shape) (init-cp-vect cp-vect-prev (or prev origin)) (init-cp-vect cp-vect-next (or next end))) shape)))) @@ -142,7 +142,7 @@ (setf (zero-vect :x) (cp-float (if offset (x offset) 0)) (zero-vect :y) (cp-float (if offset (y offset) 0))) (apply #'call-next-method this - :handle (make-shape-handle (%cp:circle-shape-new (body-handle-or-static universe body) + :handle (make-shape-handle (%chipmunk:circle-shape-new (body-handle-or-static universe body) (cp-float radius) zero-vect)) args))) @@ -168,8 +168,8 @@ (defmethod initialize-instance ((this polygon-shape) &rest args &key points body universe radius) (let ((point-count (length points))) - (c-with ((f-points %cp:vect :count point-count) - (f-transform %cp:transform)) + (c-with ((f-points %chipmunk:vect :count point-count) + (f-transform %chipmunk:transform)) (setf (f-transform :a) (cp-float 1) (f-transform :b) (cp-float 0) (f-transform :c) (cp-float 0) @@ -182,7 +182,7 @@ (f-points i :y) (cp-float (y point)))) (apply #'call-next-method this :handle (make-shape-handle (float-features:with-float-traps-masked t - (%cp:poly-shape-new (body-handle-or-static universe body) + (%chipmunk:poly-shape-new (body-handle-or-static universe body) point-count (f-points &) (f-transform &) @@ -210,7 +210,7 @@ (defmethod initialize-instance ((this box-shape) &rest args &key width height body universe radius &allow-other-keys) (apply #'call-next-method this - :handle (make-shape-handle (%cp:box-shape-new (body-handle-or-static universe body) + :handle (make-shape-handle (%chipmunk:box-shape-new (body-handle-or-static universe body) (cp-float width) (cp-float height) (cp-float (or radius 0)))) diff --git a/physics/2d/universe.lisp b/physics/2d/universe.lisp index d783797..d2c3883 100644 --- a/physics/2d/universe.lisp +++ b/physics/2d/universe.lisp @@ -6,8 +6,8 @@ (defhandle universe-handle :initform (float-features:with-float-traps-masked t - (%cp:space-new)) - :closeform (%cp:space-free *handle-value*)) + (%chipmunk:space-new)) + :closeform (%chipmunk:space-free *handle-value*)) (defclass universe (foreign-object) @@ -33,26 +33,26 @@ (defun universe-locked-p (universe) - (= %cp:+true+ (%cp:space-is-locked (handle-value-of universe)))) + (= %chipmunk:+true+ (%chipmunk:space-is-locked (handle-value-of universe)))) (defun %remove-and-free-shape (universe shape-handle) (flet ((%destroy-shape () - (%cp:space-remove-shape (handle-value-of universe) (value-of shape-handle)) + (%chipmunk:space-remove-shape (handle-value-of universe) (value-of shape-handle)) (destroy-handle shape-handle))) (invoke-between-observations #'%destroy-shape))) (defun %remove-and-free-constraint (universe constraint-handle) (flet ((%destroy-constraint () - (%cp:space-remove-constraint (handle-value-of universe) (value-of constraint-handle)) + (%chipmunk:space-remove-constraint (handle-value-of universe) (value-of constraint-handle)) (destroy-handle constraint-handle))) (invoke-between-observations #'%destroy-constraint))) (defun %remove-and-free-body (universe body-handle) (flet ((%destroy-body () - (%cp:space-remove-body (handle-value-of universe) (value-of body-handle)) + (%chipmunk:space-remove-body (handle-value-of universe) (value-of body-handle)) (destroy-handle body-handle))) (invoke-between-observations #'%destroy-body))) @@ -62,7 +62,7 @@ (once-only (arbiter) `(with-slots ((,store ptr-store)) *active-universe* (c-let ((,vec :pointer :from ,store)) - (%cp:arbiter-get-shapes ,arbiter (,vec 0 &) (,vec 1 &)) + (%chipmunk:arbiter-get-shapes ,arbiter (,vec 0 &) (,vec 1 &)) (let ((,this (find-shape *active-universe* (cffi:pointer-address (,vec 0)))) (,that (find-shape *active-universe* (cffi:pointer-address (,vec 1))))) ,@body)))))) @@ -76,8 +76,8 @@ (if-let (pre-solve-fu on-pre-solve) (with-colliding-shapes (this that) arbiter (let ((*arbiter* arbiter)) - (if (funcall pre-solve-fu this that) %cp:+true+ %cp:+false+))) - %cp:+true+))) + (if (funcall pre-solve-fu this that) %chipmunk:+true+ %chipmunk:+false+))) + %chipmunk:+true+))) (cffi:defcallback post-solve-callback :void ((arbiter :pointer) @@ -92,8 +92,8 @@ (defmethod initialize-instance :after ((this universe) &key) - (c-let ((collision-handler %cp:collision-handler - :from (%cp:space-add-default-collision-handler + (c-let ((collision-handler %chipmunk:collision-handler + :from (%chipmunk:space-add-default-collision-handler (handle-value-of this)))) (setf (collision-handler :pre-solve-func) (cffi:callback pre-solve-callback) (collision-handler :post-solve-func) (cffi:callback post-solve-callback)))) @@ -109,18 +109,18 @@ (defun universe-static-body (universe) - (%cp:space-get-static-body (handle-value-of universe))) + (%chipmunk:space-get-static-body (handle-value-of universe))) (defmethod (setf simulation-engine-gravity) ((value vec2) (this chipmunk-engine) (universe universe)) (with-cp-vect (vec value) - (%cp:space-set-gravity (handle-value-of universe) vec)) + (%chipmunk:space-set-gravity (handle-value-of universe) vec)) value) (defmethod simulation-engine-gravity ((this chipmunk-engine) (universe universe)) (with-cp-vect (vec) - (%cp:space-get-gravity vec (handle-value-of universe)) + (%chipmunk:space-get-gravity vec (handle-value-of universe)) (init-bodge-vec (vec2) vec))) @@ -129,6 +129,6 @@ (*observing-p* t) (*post-observation-hooks* nil)) (float-features:with-float-traps-masked t - (%cp:space-step (handle-value-of universe) (cp-float time-step)) + (%chipmunk:space-step (handle-value-of universe) (cp-float time-step)) (loop for hook in *post-observation-hooks* do (funcall hook))))) diff --git a/physics/2d/utils.lisp b/physics/2d/utils.lisp index f254746..c25db00 100644 --- a/physics/2d/utils.lisp +++ b/physics/2d/utils.lisp @@ -9,28 +9,28 @@ (definline init-cp-vect (vect bodge-vec) - (c-val ((vect %cp:vect)) + (c-val ((vect %chipmunk:vect)) (setf (vect :x) (cp-float (x bodge-vec)) (vect :y) (cp-float (y bodge-vec)))) vect) (definline set-cp-vect (vect x y) - (c-val ((vect %cp:vect)) + (c-val ((vect %chipmunk:vect)) (setf (vect :x) (cp-float x) (vect :y) (cp-float y))) vect) (definline init-bodge-vec (bodge-vec cp-vect) - (c-val ((cp-vect %cp:vect)) + (c-val ((cp-vect %chipmunk:vect)) (setf (x bodge-vec) (cp-vect :x) (y bodge-vec) (cp-vect :y))) bodge-vec) (defmacro with-cp-vect ((vect &optional bodge-vec) &body body) - `(c-with ((,vect %cp:vect)) + `(c-with ((,vect %chipmunk:vect)) ,@(when bodge-vec `((init-cp-vect ,vect ,bodge-vec))) ,@body))