More crap

cl-steamworks.asd

@@ -18,6 +18,7 @@
                (:file "c-object")
                (:file "callback")
                (:file "steamworks")
+               (:file "interface")
                (:file "steamclient")
                (:file "steamutils")
                (:file "steamuser")

interface.lisp

@@ -0,0 +1,27 @@
+#|
+ This file is a part of cl-steamworks
+ (c) 2019 Shirakumo http://tymoon.eu (shinmera@tymoon.eu)
+ Author: Nicolas Hafner <shinmera@tymoon.eu>
+|#
+
+(in-package #:org.shirakumo.fraf.steamworks)
+
+(defclass interface (c-object)
+  ((steamworks :initarg :steamworks :initform (error "STEAMWORKS required.") :reader %steamworks)))
+
+(defun get-interface-handle (steamworks function &rest args)
+  (let ((handle (apply function (handle (interface 'steamclient steamworks)) args)))
+    (when (cffi:null-pointer-p handle)
+      (error "FIXME: failed to create steam utils handle."))
+    handle))
+
+(defmethod call-with ((interface interface) function &rest args)
+  (apply function (handle interface) args))
+
+(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))))))

steamuser.lisp

@@ -12,3 +12,15 @@
 (defmethod initialize-instance :after ((interface steamuser) &key version steamworks)
   (setf (handle interface) (get-interface-handle steamworks 'steam::client-get-isteam-user
                                                  (handle (user steamworks)) (handle (pipe steamworks)) version)))
+
+(define-interface-method steamuser advertise-game (steam::user-advertise-game server (ip integer) (port integer)))
+
+(defmethod advertise-game (user server (ip string) port)
+  (advertise-game user server (ipv4->int ip) port))
+
+(define-interface-method steamuser behind-nat-p (steam::user-bis-behind-nat))
+(define-interface-method steamuser phone-identified-p (steam::user-bis-phone-identifying))
+(define-interface-method steamuser phone-verification-needed-p (steam::user-bis-phone-requiring-verification))
+(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))

steamutils.lisp

@@ -13,36 +13,20 @@
   (setf (handle interface) (get-interface-handle steamworks 'steam::client-get-isteam-utils
                                                  (handle (pipe steamworks)) version)))
 
-(defmethod app-id ((utils steamutils))
-  (steam::utils-get-app-id (handle utils)))
-
-(defmethod ipc-call-count ((utils steamutils))
-  (steam::utils-get-ipccall-count (handle utils)))
+(define-interface-method steamutils app-id (steam::utils-get-app-id))
+(define-interface-method steamutils ipc-call-count (steam::utils-get-ipccall-count))
+(define-interface-method steamutils country-code (steam::utils-get-ipcountry))
+(define-interface-method steamutils uptime (steam::utils-get-seconds-since-app-active))
+(define-interface-method steamutils idle-time (steam::utils-get-seconds-since-computer-active))
+(define-interface-method steamutils server-real-time (steam::utils-get-server-real-time))
+(define-interface-method steamutils big-picture-p (steam::utils-is-steam-in-big-picture-mode))
+(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))
 
 (defmethod battery-power ((utils steamutils))
   (let ((res (steam::utils-get-current-battery-power (handle utils))))
-    (if (= 255 res) :ac res)))
-
-(defmethod country-code ((utils steamutils))
-  (steam::utils-get-ipcountry (handle utils)))
-
-(defmethod uptime ((utils steamutils))
-  (steam::utils-get-seconds-since-app-active (handle utils)))
-
-(defmethod idle-time ((utils steamutils))
-  (steam::utils-get-seconds-since-computer-active (handle utils)))
-
-(defmethod server-real-time ((utils steamutils))
-  (steam::utils-get-server-real-time (handle utils)))
-
-(defmethod big-picture-p ((utils steamutils))
-  (steam::utils-is-steam-in-big-picture-mode (handle utils)))
-
-(defmethod virtual-reality-p ((utils steamutils))
-  (steam::utils-is-steam-running-in-vr (handle utils)))
-
-(defmethod virtual-reality-streaming-p ((utils steamutils))
-  (steam::utils-is-vrheadset-streaming-enabled (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))
@@ -69,9 +53,6 @@
                         :closure #',thunk
                         :struct-type 'steam::gamepad-text-input-dismissed-t)))))
 
-(defmethod start-virtual-reality-dashboard ((utils steamutils))
-  (steam::utils-start-vrdashboard (handle utils)))
-
 (defmethod (setf overlay-notification-location) ((value cons) (utils steamutils))
   (destructuring-bind (position x y) value
     (steam::utils-set-overlay-notification-position (handle utils) position)

steamworks.lisp

@@ -122,18 +122,3 @@
 
 (defmethod run-callbacks ((steamworks steamworks-server))
   (steam::game-server-run-callbacks))
-
-(defclass interface (c-object)
-  ((steamworks :initarg :steamworks :initform (error "STEAMWORKS required.") :reader %steamworks)))
-
-(defun get-interface-handle (steamworks function &rest args)
-  (let ((handle (apply function (handle (interface 'steamclient steamworks)) args)))
-    (when (cffi:null-pointer-p handle)
-      (error "FIXME: failed to create steam utils handle."))
-    handle))
-
-(defmethod call-with ((interface interface) function &rest args)
-  (apply function (handle interface) args))
-
-(defmethod call-with ((interface symbol) function &rest args)
-  (apply #'call-with (interface interface (steamworks)) function args))

toolkit.lisp

@@ -104,3 +104,17 @@ Load cl-steamworks-generator and then run (cl-steamworks-generator:setup)"))
 
 (defun enlist (a &rest items)
   (if (listp a) a (list* a items)))
+
+(defun delist (a)
+  (if (listp a) (first a) a))
+
+(defun ipv4->int (ipstring)
+  (let* ((d1 (position #\. ipstring))
+         (d2 (position #\. ipstring :start (1+ d1)))
+         (d3 (position #\. ipstring :start (1+ d2)))
+         (x 0))
+    (setf (ldb (byte 8 24) x) (parse-integer ipstring :start 0 :end d1))
+    (setf (ldb (byte 8 16) x) (parse-integer ipstring :start (1+ d1) :end d2))
+    (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))