Fix some shit to make it more sensible and to actually work as though…

…t before I screwed it up.

c-support.lisp

@@ -16,7 +16,7 @@
 (defvar steam::*callback-id-map* (make-hash-table :test 'eq))
 (defvar steam::*function-callresult-map* (make-hash-table :test 'eq))
 
-(defun callback-id (callback)
+(defun callback-type-id (callback)
   (or (gethash callback steam::*callback-id-map*)
       (error "Not a callback: ~s" callback)))
 
@@ -56,22 +56,52 @@
    "steam_api.dll"
    :search-path #.(merge-pathnames "win64/" *static*)))
 
+(defun maybe-load-low-level (&optional file)
+  (let ((file (or file (make-pathname :name "low-level" :type "lisp" :defaults *this*))))
+    (when (probe-file file)
+      (cffi:load-foreign-library 'steam::steamworks)
+      #+asdf
+      (let ((component (make-instance 'asdf:cl-source-file
+                                      :parent (asdf:find-system :cl-steamworks)
+                                      :name "low-level"
+                                      :pathname file))
+            (compile (asdf:find-operation NIL 'asdf:compile-op))
+            (load (asdf:find-operation NIL 'asdf:load-op)))
+        (when (asdf:needed-in-image-p compile component)
+          (asdf:perform compile component))
+        (when (asdf:needed-in-image-p load component)
+          (asdf:perform load component)))
+      #-asdf
+      (let ((fasl (compile-file-pathname file)))
+        (unless (probe-file fasl)
+          (compile-file file :verbose NIL :print NIL :output-file fasl))
+        (load fasl :verbose NIL :print NIL))
+      T)))
+
+(or (maybe-load-low-level)
+    (alexandria:simple-style-warning "No low-level file present. Please install the SteamWorks SDK:
+Load cl-steamworks-generator and then run (cl-steamworks-generator:setup)"))
+
+;; DEFCSTRUCT interns its accessors in *PACKAGE* rather than using the package
+;; of either CONC-NAME or the slot name, so we have to switch packages here.
+(in-package #:org.shirakumo.fraf.steamworks.cffi)
+
 #+windows
-(cffi:defcstruct (steam::vtable :class steam::vtable :conc-name steam::vtable-)
+(cffi:defcstruct (vtable :class vtable :conc-name vtable-)
   (result-with-info :pointer)
   (result :pointer)
   (size :pointer))
 
 #-windows
-(cffi:defcstruct (steam::vtable :class steam::vtable :conc-name steam::vtable-)
+(cffi:defcstruct (vtable :class vtable :conc-name vtable-)
   ;; void (pointer this, pointer param)
   (result :pointer)
   ;; void (pointer this, pointer param, bool failed, steam-apicall-t api-call)
   (result-with-info :pointer)
   ;; int (pointer this)
   (size :pointer))
 
-(cffi:defcstruct (steam::callback :class steam::callback :conc-name steam::callback-)
+(cffi:defcstruct (callback :class callback :conc-name callback-)
   ;; Pointer to vtable instance.
   (vtable-ptr :pointer)
   ;; Should be 2 on a game server, 0 otherwise?
@@ -85,4 +115,4 @@
   ;; Function pointer to call for callresult
   (function :pointer)
   ;; vtable alloc
-  (vtable (:struct steam::vtable)))
+  (vtable (:struct vtable)))

callback.lisp

@@ -17,7 +17,7 @@
   (let* ((handle (calloc '(:struct steam::callback)))
          (vtable (cffi:foreign-slot-pointer handle '(:struct steam::callback) 'steam::vtable)))
     (setf (steam::callback-vtable-ptr handle) vtable)
-    (setf (steam::callback-id handle) (callback-id (struct-type callback)))
+    (setf (steam::callback-id handle) (callback-type-id (struct-type callback)))
     (setf (steam::callback-flags handle) (if (typep (steamworks) 'steamworks-server) 2 0))
     (setf (steam::vtable-result vtable) (cffi:callback callback))
     (setf (steam::vtable-result-with-info vtable) (cffi:callback callback-with-info))
@@ -62,7 +62,7 @@
 (defclass closure-callback (callback)
   ((closure :initarg :closure :initform (error "CLOSURE required.") :reader closure)))
 
-(defmethod callback ((callresult closure-callback) parameter &optional failed api-call)
+(defmethod callback ((callback closure-callback) parameter &optional failed api-call)
   (declare (ignore api-call))
   (when (funcall (closure callback) (if failed NIL parameter))
     (free callback)))
@@ -99,7 +99,7 @@
     (cffi:with-foreign-objects ((failed :bool)
                                 (result result-type))
       (if (steam::utils-get-apicall-result
-           utils token result (cffi:foreign-type-size result-type) (callback-id (struct-type callresult)) failed)
+           utils token result (cffi:foreign-type-size result-type) (callback-type-id (struct-type callresult)) failed)
           (cffi:mem-ref result result-type)
           (error "FIXME: call failed: ~a" (steam::utils-get-apicall-failure-reason utils token))))))
 

steamclient.lisp

@@ -10,7 +10,7 @@
   ())
 
 (defmethod initialize-instance :after ((client steamclient) &key version)
-  (let ((handle (steam::create-interface version)))
+  (let ((handle (steam::create-interface (t-or version steam::steamclient-interface-version))))
     (when (cffi:null-pointer-p handle)
       (error "FIXME: failed to create steam client handle."))
     (setf (handle client) handle)
@@ -48,10 +48,10 @@
 
 (defmethod allocate-handle ((user client-user))
   (if (eql :global (account-type user))
-      (steam::client-connect-to-global-user (handle (steamclient pipe)) (handle (pipe user)))
+      (steam::client-connect-to-global-user (handle (steamclient user)) (handle (pipe user)))
       (cffi:with-foreign-object (var 'steam::hsteam-pipe)
         (setf (cffi:mem-ref var 'steam::hsteam-pipe) (handle (pipe user)))
-        (steam::client-create-local-user (handle (steamclient pipe)) var (account-type user)))))
+        (steam::client-create-local-user (handle (steamclient user)) var (account-type user)))))
 
 (defmethod free-handle-function ((user client-user) handle)
   (let ((client (handle (steamclient user)))

steamfriends.lisp

@@ -11,7 +11,8 @@
 
 (defmethod initialize-instance :after ((interface steamfriends) &key version steamworks)
   (setf (handle interface) (get-interface-handle steamworks 'steam::client-get-isteam-friends
-                                                 (handle (user steamworks)) (handle (pipe steamworks)) version)))
+                                                 (handle (user steamworks)) (handle (pipe steamworks))
+                                                 (t-or version steam::steamfriends-interface-version))))
 
 (define-interface-method steamfriends clear-rich-presence (steam::friends-clear-rich-presence))
 (define-interface-method steamfriends close-clan-chat-window (steam::friends-close-clan-chat-window-in-steam chat-id))
@@ -23,14 +24,14 @@
   (< 0 (steam::friends-get-user-restrictions (handle friends))))
 
 (defmethod activate-overlay ((friends steamfriends) &key (dialog :friends) user lobby app url)
-  (let ((type (ecase dialog
-                (:friends "friends")
-                (:community "community")
-                (:players "players")
-                (:settings "settings")
-                (:game-group "officialgamegroup")
-                (:stats "stats")
-                (:achievements "achievements"))))
+  (let ((dialog (ecase dialog
+                  (:friends "friends")
+                  (:community "community")
+                  (:players "players")
+                  (:settings "settings")
+                  (:game-group "officialgamegroup")
+                  (:stats "stats")
+                  (:achievements "achievements"))))
     (when (< 1 (+ (if user 1 0) (if lobby 1 0) (if app 1 0) (if url 1 0)))
       (error "FIXME: Can't display more than one dialog at the same time."))
     (cond (lobby
@@ -83,7 +84,7 @@
                (T (let ((*print-case* :downcase))
                     (princ-to-string key)))))
         (value (let ((*print-case* :downcase))
-                 (pring-to-string value))))
+                 (princ-to-string value))))
     (when (< steam::max-rich-presence-key-length (length key))
       (error "FIXME: key too long"))
     (when (< steam::max-rich-presence-value-length (length value))
@@ -217,7 +218,7 @@
 
 (defmethod initialize-instance :after ((clan clan) &key steamfriends index)
   (when index
-    (setf (handle clan) (steam::friends-get-clan-by-index (handle friends) index))))
+    (setf (handle clan) (steam::friends-get-clan-by-index (handle steamfriends) index))))
 
 (defmethod print-object ((clan clan) stream)
   (print-unreadable-object (clan stream :type T)
@@ -237,19 +238,20 @@
   (admin-p clan (handle user)))
 
 (defmethod activity ((clan clan) &key callback)
-  (if callback
-      (cffi:with-foreign-object (list :unsigned-long)
-        (setf (cffi:mem-ref list :unsigned-long) (handle clan))
-        (with-call-result (result) (steam::friends-download-clan-activity-counts (handle friends) list 1)
-          (when (steam::download-clan-activity-counts-success result)
-            (funcall callback (activity clan)))))
-      (cffi:with-foreign-objects ((online :int)
-                                  (in-game :int)
-                                  (chatting :int))
-        (steam::friends-get-clan-activity-counts (handle friends) (handle clan) online in-game chatting)
-        (list :online (cffi:mem-ref online :int)
-              :in-game (cffi:mem-ref in-game :int)
-              :chatting (cffi:mem-ref chatting :int)))))
+  (let ((friends (steamfriends clan)))
+    (if callback
+        (cffi:with-foreign-object (list :unsigned-long)
+          (setf (cffi:mem-ref list :unsigned-long) (handle clan))
+          (with-call-result (result) (steam::friends-download-clan-activity-counts (handle friends) list 1)
+            (when (steam::download-clan-activity-counts-success result)
+              (funcall callback (activity clan)))))
+        (cffi:with-foreign-objects ((online :int)
+                                    (in-game :int)
+                                    (chatting :int))
+          (steam::friends-get-clan-activity-counts (handle friends) (handle clan) online in-game chatting)
+          (list :online (cffi:mem-ref online :int)
+                :in-game (cffi:mem-ref in-game :int)
+                :chatting (cffi:mem-ref chatting :int))))))
 
 (defmethod display-name ((clan clan))
   (let ((name (steam::friends-get-clan-name (handle (steamfriends clan)) (handle clan))))

steamuser.lisp

@@ -11,7 +11,8 @@
 
 (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)))
+                                                 (handle (user steamworks)) (handle (pipe steamworks))
+                                                 (t-or version steam::steamuser-interface-version))))
 
 (defmethod advertise-game (user server (ip string) port)
   (advertise-game user server (ipv4->int ip) port))
@@ -48,7 +49,7 @@
             (: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))
+             (cffi:mem-ref destination-written :uint32))
             (:no-data
              0)
             (:data-corrupted

steamutils.lisp

@@ -11,7 +11,8 @@
 
 (defmethod initialize-instance :after ((interface steamutils) &key version steamworks)
   (setf (handle interface) (get-interface-handle steamworks 'steam::client-get-isteam-utils
-                                                 (handle (pipe steamworks)) version)))
+                                                 (handle (pipe steamworks))
+                                                 (t-or version steam::steamutils-interface-version))))
 
 (define-interface-method steamutils app-id (steam::utils-get-app-id))
 (define-interface-method steamutils ipc-call-count (steam::utils-get-ipccall-count))
@@ -41,7 +42,8 @@
 
 (defmacro with-input-text ((text utils &rest args) &body body)
   (let ((utilsg (gensym "UTILS"))
-        (struct (gensym "STRUCT")))
+        (struct (gensym "STRUCT"))
+        (thunk (gensym "THUNK")))
     `(let ((,utilsg ,utils))
        (flet ((,thunk (,struct)
                 (when (steam::gamepad-text-input-dismissed-submitted ,struct)
@@ -50,7 +52,8 @@
                 T))
          (make-instance 'closure-callback
                         :closure #',thunk
-                        :struct-type 'steam::gamepad-text-input-dismissed)))))
+                        :struct-type 'steam::gamepad-text-input-dismissed)
+         (show-text-input utils ,@args)))))
 
 (defmethod (setf overlay-notification-location) ((value cons) (utils steamutils))
   (destructuring-bind (position x y) value
@@ -74,7 +77,7 @@
 
 (defmethod print-object ((image image) stream)
   (print-unreadable-object (image stream :type T)
-    (format stream "~dx~d @~d" (width image) (height image) (handle clan))))
+    (format stream "~dx~d @~d" (width image) (height image) (handle image))))
 
 ;; Lazy load and cache
 (defmethod rgba ((image image))

steamworks.lisp

@@ -16,11 +16,6 @@
       (or *steamworks*
           (error "FIXME: steamworks is not initialised."))))
 
-(defun most-recent-interface-version (interface)
-  (let ((name (format NIL "~a~a" (remove #\- (string interface)) '#:-interface-version)))
-    (symbol-value (or (find-symbol name '#:org.shirakumo.fraf.steamworks.cffi)
-                      (error "FIXME: No such interface ~s" interface)))))
-
 (defclass pipe (c-object)
   ())
 
@@ -55,8 +50,6 @@
   (flet ((maybe-create (interface)
            (destructuring-bind (interface &optional (version T)) (enlist interface)
              (unless (interface interface steamworks)
-               (when (eql T version)
-                 (setf version (most-recent-interface-version interface)))
                (setf (gethash interface (interfaces steamworks))
                      (make-instance interface :version version :steamworks steamworks))))))
     (maybe-create 'steamclient)
@@ -115,12 +108,11 @@
                                                            :pipe (pipe steamworks))))
 
 (defmethod free-handle-function ((steamworks steamworks-server) handle)
-  (let ((interfaces (interfaces steamworks)))
-    (lambda ()
-      (setf (slot-value steamworks 'user) NIL)
-      (setf (slot-value steamworks 'pipe) NIL)
-      (steam::game-server-shutdown)
-      (setf *steamworks* NIL))))
+  (lambda ()
+    (setf (slot-value steamworks 'user) NIL)
+    (setf (slot-value steamworks 'pipe) NIL)
+    (steam::game-server-shutdown)
+    (setf *steamworks* NIL)))
 
 (defmethod run-callbacks ((steamworks steamworks-server))
   (steam::game-server-run-callbacks))

toolkit.lisp

@@ -39,25 +39,6 @@
   (handler-bind ((warning #'muffle-warning))
     (not (null (ignore-errors (cffi:foreign-type-size type))))))
 
-(defun maybe-load-low-level (&optional file)
-  (let ((file (or file (make-pathname :name "low-level" :type "lisp" :defaults *this*))))
-    (when (probe-file file)
-      (cffi:load-foreign-library 'steam::steamworks)
-      #+asdf
-      (let ((component (make-instance 'asdf:cl-source-file
-                                      :parent (asdf:find-system :cl-steamworks)
-                                      :name "low-level"
-                                      :pathname file)))
-        (asdf:perform 'asdf:compile-op component)
-        (asdf:perform 'asdf:load-op component))
-      #-asdf
-      (load (compile-file file :verbose NIL :print NIL) :verbose NIL :print NIL)
-      T)))
-
-(or (maybe-load-low-level)
-    (alexandria:simple-style-warning "No low-level file present. Please install the SteamWorks SDK:
-Load cl-steamworks-generator and then run (cl-steamworks-generator:setup)"))
-
 (defun env-var (x)
   #+(or abcl clasp clisp ecl xcl) (ext:getenv x)
   #+allegro (sys:getenv x)
@@ -114,6 +95,14 @@ Load cl-steamworks-generator and then run (cl-steamworks-generator:setup)"))
 (defun delist (a)
   (if (listp a) (first a) a))
 
+(defmacro t-or (&rest clauses)
+  (when clauses
+    (let ((result (gensym "RESULT")))
+      `(let ((,result ,(first clauses)))
+         (if (eql T ,result)
+             (t-or ,@(rest clauses))
+             ,result)))))
+
 (defun ipv4->int (ipstring)
   (let* ((d1 (position #\. ipstring))
          (d2 (position #\. ipstring :start (1+ d1)))