Semi-complete steamuser interface

interface.lisp

@@ -21,7 +21,11 @@
 (defmethod call-with ((interface symbol) function &rest args)
   (apply #'call-with (interface interface (steamworks)) function args))
 
-(defmacro define-interface-method (interface method (function &rest args) &body body)
-  `(defmethod ,method ((,interface ,interface) ,@args)
-     ,@(or body
-           `((,function (handle ,interface) ,@(mapcar #'delist args))))))
+(defmacro define-interface-method (interface method call &body body)
+  (let ((function (find-if (lambda (a) (eq (symbol-package a) (find-package '#:steam))) call))
+        (method-args (copy-list call)))
+    (setf (nth (position function method-args) method-args) (list interface interface))
+    `(defmethod ,method ,method-args
+       ,@(or body
+             `((,function (handle ,interface) ,@(apply #'remove-all (mapcar #'delist call)
+                                                       function LAMBDA-LIST-KEYWORDS)))))))

steamuser.lisp

@@ -24,3 +24,36 @@
 (define-interface-method steamuser phone-verified-p (steam::user-bis-phone-verified))
 (define-interface-method steamuser two-factor-p (steam::user-bis-two-factor-enabled))
 (define-interface-method steamuser logged-on-p (steam::user-blogged-on))
+(define-interface-method steamuser badge-level (steam::user-get-game-badge-level &key (series 1) foil))
+(define-interface-method steamuser steam-level (steam::user-get-player-steam-level))
+(define-interface-method steamuser steam-id (steam::user-get-steam-id))
+(define-interface-method steamuser optimal-voice-sample-rate (steam::user-get-voice-optimal-sample-rate))
+(define-interface-method steamuser make-store-url (steam::user-request-store-auth-url landing-page))
+(define-interface-method steamuser start-voice-recording (steam::user-start-voice-recording))
+(define-interface-method steamuser stop-voice-recording (steam::user-stop-voice-recording))
+
+;; FIXME: Token mechanism
+
+;; Internal static buffer for compressed voice data
+(#-sbcl defvar #+sbcl sb-ext:defglobal compressed-voice-buffer
+        (make-array (* 1024 8) :element-type '(unsigned-byte 8)))
+
+(defmethod voice ((user steamuser) destination samplerate)
+  (cffi:with-pointer-to-vector-data (dest destination)
+    (cffi:with-pointer-to-vector-data (buffer COMPRESSED-VOICE-BUFFER)
+      (cffi:with-foreign-objects ((compressed-written :uint32)
+                                  (destination-written :uint32))
+        (let ((result (steam::user-get-voice (handle user) NIL buffer (* 1024 8) compressed-written
+                                             NIL (cffi:null-pointer) 0 (cffi:null-pointer) 0)))
+          (case result
+            (:ok
+             (steam::user-decompress-voice (handle user) buffer (cffi:mem-ref compressed-written :uint32)
+                                           dest (length destination) destination-written samplerate)
+             (cffi:mem-ref destination-written))
+            (:no-data
+             0)
+            (:data-corrupted
+             (warn "FIXME: corrupted voice data.")
+             0)
+            (T
+             (error "FIXME: failed to get voice data: ~a" result))))))))

steamutils.lisp

@@ -23,17 +23,14 @@
 (define-interface-method steamutils virtual-reality-p (steam::utils-is-steam-running-in-vr))
 (define-interface-method steamutils virtual-reality-streaming-p (steam::utils-is-vrheadset-streaming-enabled))
 (define-interface-method steamutils start-virtual-reality-dashboard (steam::utils-start-vrdashboard))
+(define-interface-method steamutils (setf virtual-reality-streaming-p) (value steam::utils-set-vrheadset-streaming-enabled))
+(define-interface-method steamutils show-text-input
+    (steam::utils-show-gamepad-text-input &key (mode :normal) (line-mode :single-line) (description "") (max 32) (default "")))
 
 (defmethod battery-power ((utils steamutils))
   (let ((res (steam::utils-get-current-battery-power (handle utils))))
     (if (= 255 res) (values) res)))
 
-(defmethod (setf virtual-reality-streaming-p) (value (utils steamutils))
-  (steam::utils-set-vrheadset-streaming-enabled (handle utils) value))
-
-(defmethod show-text-input ((utils steamutils) &key (mode :normal) (line-mode :single-line) (description "") (max 32) (default ""))
-  (steam::utils-show-gamepad-text-input (handle utils) mode line-mode description max default))
-
 (defmethod input-text ((utils steamutils))
   (let ((length (steam::utils-get-entered-gamepad-text-length (handle utils))))
     (cffi:with-foreign-object (data :char length)

toolkit.lisp

@@ -118,3 +118,6 @@ Load cl-steamworks-generator and then run (cl-steamworks-generator:setup)"))
     (setf (ldb (byte 8  8) x) (parse-integer ipstring :start (1+ d2) :end d3))
     (setf (ldb (byte 8  0) x) (parse-integer ipstring :start (1+ d3)))
     x))
+
+(defun remove-all (sequence &rest items)
+  (remove-if (lambda (i) (find i items)) sequence))