Migrate to new :claw interface

borodust · Sep 28, 2019 · cc9d5c9 · cc9d5c9
1 parent 0c03810
commit cc9d5c9
Show file tree

Hide file tree

Showing 19 changed files with 112 additions and 98 deletions.
diff --git a/audio/buffer.lisp b/audio/buffer.lisp
@@ -2,10 +2,11 @@
 
 
 (defhandle audio-buffer-handle
-  :initform (claw:c-with ((buffer-id %al:uint))
+  :initform (c-with ((buffer-id %al:uint))
               (%al:gen-buffers 1 (buffer-id &))
               buffer-id)
-  :closeform (claw:c-with ((buffer-id %al:uint :value *handle-value*))
+  :closeform (c-with ((buffer-id %al:uint))
+               (setf buffer-id *handle-value*)
                (%al:delete-buffers 1 (buffer-id &))))
 
 

diff --git a/audio/packages.lisp b/audio/packages.lisp
@@ -1,5 +1,5 @@
 (ge.util:define-package :cl-bodge.audio
-  (:use :cl :cl-bodge.engine :cl-bodge.utils)
+  (:use :cl :cl-bodge.engine :cl-bodge.utils :cffi-c-ref)
   (:nicknames :ge.snd)
   (:export audio-system
            audio

diff --git a/audio/source.lisp b/audio/source.lisp
@@ -2,10 +2,11 @@
 
 
 (defhandle audio-source-handle
-  :initform (claw:c-with ((source-id %al:uint))
+  :initform (c-with ((source-id %al:uint))
               (%al:gen-sources 1 (source-id &))
               source-id)
-  :closeform (claw:c-with ((source-id %al:uint :value *handle-value*))
+  :closeform (c-with ((source-id %al:uint))
+               (setf source-id *handle-value*)
                (%al:delete-sources 1 (source-id &))))
 
 
@@ -42,7 +43,7 @@
 
 
 (defun audio-looped-p (source)
-  (claw:c-with ((value %al:int))
+  (c-with ((value %al:int))
     (%al:get-sourcei (handle-value-of source) %al:+looping+ (value &))
     (= %al:+true+ value)))
 
@@ -53,7 +54,7 @@
 
 
 (defun audio-gain (source)
-  (claw:c-with ((value %al:float))
+  (c-with ((value %al:float))
     (%al:get-sourcef (handle-value-of source) %al:+gain+ (value &))
     value))
 
@@ -64,7 +65,7 @@
 
 
 (defun audio-min-gain (source)
-  (claw:c-with ((value %al:float))
+  (c-with ((value %al:float))
     (%al:get-sourcef (handle-value-of source) %al:+min-gain+ (value &))
     value))
 
@@ -75,7 +76,7 @@
 
 
 (defun audio-max-gain (source)
-  (claw:c-with ((value %al:float))
+  (c-with ((value %al:float))
     (%al:get-sourcef (handle-value-of source) %al:+max-gain+ (value &))
     value))
 
@@ -86,7 +87,7 @@
 
 
 (defun audio-pitch (source)
-  (claw:c-with ((value %al:float))
+  (c-with ((value %al:float))
     (%al:get-sourcef (handle-value-of source) %al:+pitch+ (value &))
     value))
 

diff --git a/audio/system.lisp b/audio/system.lisp
@@ -46,7 +46,7 @@
 
 
 (defun print-device-info (device)
-  (claw:c-with ((value %alc:int))
+  (c-with ((value %alc:int))
     (log/debug "Selected device: ~A~%ALC version: ~A.~A"
                (device-name device)
                (progn
@@ -58,7 +58,7 @@
 
 
 (defun make-audio-context ()
-  (claw:with-float-traps-masked ()
+  (float-features:with-float-traps-masked t
     (print-available-devices-info)
     (if-let ((dev (%alc:open-device (cffi:null-pointer))))
       (progn
@@ -88,7 +88,7 @@
 
 
 (defun listener-gain ()
-  (claw:c-with ((value %al:float))
+  (c-with ((value %al:float))
     (%al:get-listeneri %al:+gain+ (value &))
     value))
 

diff --git a/cl-bodge.asd b/cl-bodge.asd
@@ -16,10 +16,10 @@
   :author "Pavel Korolev"
   :mailto "dev@borodust.org"
   :license "MIT"
-  :depends-on (cl-bodge/utils bodge-memory bodge-math bodge-concurrency
-                              bodge-blobs-support claw claw
-                              log4cl local-time cffi cl-flow uiop
-                              simple-flow-dispatcher cl-muth)
+  :depends-on (:cl-bodge/utils :bodge-memory :bodge-math :bodge-concurrency
+               :bodge-blobs-support :claw :claw-utils :log4cl
+               :local-time :cffi :cl-flow :uiop :simple-flow-dispatcher
+               :cl-muth :float-features :bodge-libc-essentials)
   :pathname "engine/"
   :serial t
   :components ((:file "packages")

diff --git a/engine/engine.lisp b/engine/engine.lisp
@@ -378,7 +378,7 @@ initialized."
         (handler-bind ((t #'handle-comatose))
           (restart-bind ((continue #'handle-continue :report-function #'report-continue)
                          (abort #'handle-abort :report-function #'report-abort))
-            (claw:with-float-traps-masked ()
+            (float-features:with-float-traps-masked t
               (funcall task))))))))
 
 

diff --git a/physics/2d/body.lisp b/physics/2d/body.lisp
@@ -21,7 +21,7 @@
   (let ((cp-mass (cp-float mass))
         (w/2 (/ width 2))
         (h/2 (/ height 2)))
-    (claw:c-with ((verts %cp:vect :count 5))
+    (c-with ((verts %cp: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))

diff --git a/physics/2d/packages.lisp b/physics/2d/packages.lisp
@@ -1,2 +1,2 @@
 (ge.util:define-package :cl-bodge.physics.chipmunk
-  (:use :cl :cl-bodge.physics.backend :cl-bodge.engine :ge.util))
+  (:use :cl :cl-bodge.physics.backend :cl-bodge.engine :ge.util :cffi-c-ref))
diff --git a/physics/2d/shape.lisp b/physics/2d/shape.lisp
@@ -20,7 +20,7 @@
 
 
 (defmethod initialize-instance :after ((this chipmunk-shape) &key universe)
-  (register-shape universe (cffi:pointer-address (claw:ptr (handle-value-of this))) this))
+  (register-shape universe (cffi:pointer-address (handle-value-of this)) this))
 
 
 (defmethod simulation-engine-destroy-shape ((this chipmunk-engine) (shape chipmunk-shape))
@@ -51,10 +51,10 @@
 
 (defmethod initialize-instance ((this segment-shape) &rest args
                                 &key start end body universe)
-  (claw:c-with ((a %cp:vect)
-                (b %cp:vect))
-    (init-cp-vect a start)
-    (init-cp-vect b end)
+  (c-with ((a %cp:vect)
+           (b %cp: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)))
@@ -160,8 +160,8 @@
 (defmethod initialize-instance ((this polygon-shape) &rest args
                                 &key points body universe)
   (let ((point-count (length points)))
-    (claw:c-with ((f-points %cp:vect :count point-count)
-                  (f-transform %cp:transform))
+    (c-with ((f-points %cp:vect :count point-count)
+             (f-transform %cp:transform))
       (setf (f-transform :a) (cp-float 1)
             (f-transform :b) (cp-float 0)
             (f-transform :c) (cp-float 0)
@@ -173,11 +173,11 @@
             do (setf (f-points i :x) (cp-float (x point))
                      (f-points i :y) (cp-float (y point))))
       (apply #'call-next-method this
-             :handle (make-shape-handle (claw:with-float-traps-masked ()
+             :handle (make-shape-handle (float-features:with-float-traps-masked t
                                           (%cp:poly-shape-new (body-handle-or-static universe body)
                                                               point-count
-                                                              f-points
-                                                              f-transform
+                                                              (f-points &)
+                                                              (f-transform &)
                                                               (cp-float 0.0001))))
              args))))
 

diff --git a/physics/2d/universe.lisp b/physics/2d/universe.lisp
@@ -5,7 +5,7 @@
 
 
 (defhandle universe-handle
-  :initform (claw:with-float-traps-masked ()
+  :initform (float-features:with-float-traps-masked t
               (%cp:space-new))
   :closeform (%cp:space-free *handle-value*))
 
@@ -14,13 +14,13 @@
   ((shape-registry :initform (trivial-garbage:make-weak-hash-table :weakness :value :test 'eql))
    (on-pre-solve :initform nil :initarg :on-pre-solve)
    (on-post-solve :initform nil :initarg :on-post-solve)
-   (ptr-store :initform (claw:alloc :pointer 2))
+   (ptr-store :initform (cffi:foreign-alloc :pointer :count 2))
    (post-step-queue :initform (make-task-queue)))
   (:default-initargs :handle (make-universe-handle)))
 
 
 (define-destructor universe (ptr-store)
-  (claw:free ptr-store))
+  (cffi:foreign-free ptr-store))
 
 
 (defun register-shape (universe id shape)
@@ -71,14 +71,16 @@
   (with-gensyms (store vec)
     (once-only (arbiter)
       `(with-slots ((,store ptr-store)) *active-universe*
-         (claw:c-let ((,vec :pointer :ptr ,store))
+         (c-let ((,vec :pointer :from ,store))
            (%cp: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))))))
 
 
-(claw:defcallback pre-solve-callback :int ((arbiter :pointer) (space :pointer) (data :pointer))
+(cffi:defcallback pre-solve-callback :int ((arbiter :pointer)
+                                           (space :pointer)
+                                           (data :pointer))
   (declare (ignore space data))
   (with-slots (on-pre-solve ptr-store) *active-universe*
     (if-let (pre-solve-fu on-pre-solve)
@@ -88,7 +90,9 @@
       %cp:+true+)))
 
 
-(claw:defcallback post-solve-callback :void ((arbiter :pointer) (space :pointer) (data :pointer))
+(cffi:defcallback post-solve-callback :void ((arbiter :pointer)
+                                             (space :pointer)
+                                             (data :pointer))
   (declare (ignore space data))
   (with-slots (on-post-solve) *active-universe*
     (when-let (post-solve-fu on-post-solve)
@@ -98,11 +102,11 @@
 
 
 (defmethod initialize-instance :after ((this universe) &key)
-  (claw:c-let ((collision-handler %cp:collision-handler
-                                  :from (%cp:space-add-default-collision-handler
-                                         (handle-value-of this))))
-    (setf (collision-handler :pre-solve-func) (claw:callback 'pre-solve-callback)
-          (collision-handler :post-solve-func) (claw:callback 'post-solve-callback))))
+  (c-let ((collision-handler %cp:collision-handler
+                             :from (%cp: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))))
 
 
 (defmethod simulation-engine-make-universe ((this chipmunk-engine)
@@ -133,6 +137,6 @@
 (defmethod simulation-engine-observe-universe ((engine chipmunk-engine) (universe universe) time-step)
   (with-slots (post-step-queue) universe
     (let ((*active-universe* universe))
-      (claw:with-float-traps-masked ()
+      (float-features:with-float-traps-masked t
         (%cp:space-step (handle-value-of universe) (cp-float time-step))
         (drain post-step-queue)))))
diff --git a/physics/2d/utils.lisp b/physics/2d/utils.lisp
@@ -9,28 +9,28 @@
 
 
 (definline init-cp-vect (vect bodge-vec)
-  (claw:c-val ((vect %cp:vect))
+  (c-val ((vect %cp:vect))
     (setf (vect :x) (cp-float (x bodge-vec))
-          (vect :y) (cp-float (y bodge-vec)))
-    vect))
+          (vect :y) (cp-float (y bodge-vec))))
+  vect)
 
 
 (definline set-cp-vect (vect x y)
-  (claw:c-val ((vect %cp:vect))
+  (c-val ((vect %cp:vect))
     (setf (vect :x) (cp-float x)
-          (vect :y) (cp-float y))
-    vect))
+          (vect :y) (cp-float y)))
+  vect)
 
 
 (definline init-bodge-vec (bodge-vec cp-vect)
-  (claw:c-val ((cp-vect %cp:vect))
+  (c-val ((cp-vect %cp:vect))
     (setf (x bodge-vec) (cp-vect :x)
-          (y bodge-vec) (cp-vect :y))
-    bodge-vec))
+          (y bodge-vec) (cp-vect :y)))
+  bodge-vec)
 
 
 (defmacro with-cp-vect ((vect &optional bodge-vec) &body body)
-  `(claw:c-with ((,vect %cp:vect))
+  `(c-with ((,vect %cp:vect))
      ,@(when bodge-vec
          `((init-cp-vect ,vect ,bodge-vec)))
      ,@body))

diff --git a/physics/3d/ode/contacts.lisp b/physics/3d/ode/contacts.lisp
@@ -15,17 +15,17 @@
 
 
 (defun contact-position (info)
-  (claw:c-let ((geom %ode:contact-geom :from (contact-geom 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)
-  (claw:c-let ((geom %ode:contact-geom :from (contact-geom 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)
-  (claw:c-ref (contact-geom info) %ode:contact-geom :depth))
+  (c-ref (contact-geom info) %ode:contact-geom :depth))
 
 
 (defun surface-friction (info)
@@ -64,12 +64,17 @@
 
 
 (defun fill-contact-geom (contact-geom info)
-  (claw:memcpy (claw:ptr contact-geom) (claw:ptr (contact-geom info)) 1 '%ode:contact-geom))
+  (%libc.es:memcpy contact-geom
+                   (contact-geom info)
+                   (cffi:foreign-type-size '%ode:contact-geom)))
 
 
 (defun fill-contact (contact info)
-  (claw:c-val ((contact %ode:contact))
-    (setf (contact :surface :mode) (claw:mask 'ode:contact-flags :approx1 :bounce :motion1)
+  (c-val ((contact %ode:contact))
+    (setf (contact :surface :mode) (cffi:foreign-bitfield-value 'ode:contact-flags
+                                                                '(:approx1
+                                                                  :bounce
+                                                                  :motion1))
           (contact :surface :mu) (ode-real (surface-friction info))
           (contact :surface :bounce) (ode-real (surface-bounciness info))
           (contact :surface :motion1) (surface-velocity info))

diff --git a/physics/3d/ode/joints.lisp b/physics/3d/ode/joints.lisp
@@ -23,7 +23,7 @@
        (declaim (inline ,class-ctor-name))
        (defun ,class-ctor-name (universe this-body &optional that-body)
          (make-joint (lambda (world)
-                       (claw:c-fun ,joint-ctor-name world 0))
+                       (,joint-ctor-name world 0))
                      ',class-name universe this-body that-body)))))
 
 

diff --git a/physics/3d/ode/mass.lisp b/physics/3d/ode/mass.lisp
@@ -2,11 +2,11 @@
 
 
 (defclass mass (disposable)
-  ((value :initform (claw:calloc '%ode:mass) :reader value-of)))
+  ((value :initform (cffi:foreign-alloc '%ode:mass) :reader value-of)))
 
 
 (define-destructor mass (value)
-  (claw:free value))
+  (cffi:foreign-free value))
 
 
 (defun make-box-mass (total x y z &optional offset)