diff --git a/c-object.lisp b/c-object.lisp index e7187bd..8ebf4ea 100644 --- a/c-object.lisp +++ b/c-object.lisp @@ -40,7 +40,7 @@ (defmethod initialize-instance :around ((object c-managed-object) &key handle) (if handle (call-next-method) - (with-cleanup-on-error (free object) + (with-cleanup-on-failure (free object) (call-next-method)))) (defgeneric allocate-handle (c-managed-object)) diff --git a/callback.lisp b/callback.lisp index eedb8be..0aa5cdf 100644 --- a/callback.lisp +++ b/callback.lisp @@ -41,19 +41,19 @@ (let ((callback (pointer->object this))) (if callback (callback callback (cffi:mem-ref parameter `(:struct ,(struct-type callback)))) - (warn "Callback for unregistered pointer ~a" this)))) + (warn* "Callback for unregistered pointer ~a" this)))) (cffi:defcallback callback-with-info :void ((this :pointer) (parameter :pointer) (failed :bool) (api-call :uint64)) (let ((callback (pointer->object this))) (if callback (callback callback (cffi:mem-ref parameter `(:struct ,(struct-type callback))) failed api-call) - (warn "Callback for unregistered pointer ~a" this)))) + (warn* "Callback for unregistered pointer ~a" this)))) (cffi:defcallback size :int ((this :pointer)) (let ((callback (pointer->object this))) (if callback (cffi:foreign-type-size `(:struct ,(struct-type callback))) - (warn "Callback for unregistered pointer ~a" this)))) + (warn* "Callback for unregistered pointer ~a" this)))) (defclass callresult (callback) ()) @@ -65,6 +65,11 @@ (setf (steam::callback-function handle) (cffi:callback result)) (steam::register-call-result handle call-id))) +(defmethod free-handle-function ((callresult callresult) handle) + (lambda () + (steam::unregister-call-result handle call-id) + (cffi:foreign-free handle))) + (defmethod maybe-result ((callresult callresult)) (let ((utils (handle (utils (steamworks))))) (cffi:with-foreign-object (failed :bool) @@ -72,16 +77,25 @@ (result callresult))))) (defmethod result ((callresult callresult)) - (let ((utils (handle (utils (steamworks)))) + (let ((utils (handle (interface 'steamutils T))) + (token (steam::callback-token (handle callresult))) (result-type `(:struct ,(struct-type callresult)))) - (cffi:with-foreign-object (result result-type) + (cffi:with-foreign-objects ((failed :bool) + (result result-type)) (if (steam::utils-get-apicall-result - utils id result (cffi:foreign-type-size result-type) (symbol-value (struct-type callresult)) failed) + utils token result (cffi:foreign-type-size result-type) (symbol-value (struct-type callresult)) failed) (cffi:mem-ref result result-type) - (error "FIXME: call failed: ~a" (steam::utils-get-apicall-failure-reason utils id)))))) + (error "FIXME: call failed: ~a" (steam::utils-get-apicall-failure-reason utils token)))))) (cffi:defcallback result :void ((this :pointer) (parameter :pointer) (failed :bool)) (let ((callback (pointer->object this))) (if callback - (callback callback (cffi:mem-ref parameter `(:struct ,(struct-type callback)))) - (warn "Callback for unregistered pointer ~a" this)))) + (callback callback (cffi:mem-ref parameter `(:struct ,(struct-type callback))) failed) + (warn* "Callback for unregistered pointer ~a" this)))) + +(defclass closure-callresult (callresult) + ((closure :initarg :closure :initform (error "CLOSURE required.") :reader closure))) + +(defmethod callback ((callresult closure-callresult) parameter &optional failed api-call) + (declare (ignore api-call)) + (funcall (closure callresult) (if failed NIL parameter))) diff --git a/cl-steamworks.asd b/cl-steamworks.asd index e10885f..03ec8d9 100644 --- a/cl-steamworks.asd +++ b/cl-steamworks.asd @@ -21,6 +21,7 @@ (:file "steamclient") (:file "steamutils") (:file "steamuser") + (:file "steamfriends") (:file "documentation")) :depends-on (:documentation-utils :alexandria diff --git a/steamfriends.lisp b/steamfriends.lisp new file mode 100644 index 0000000..523beac --- /dev/null +++ b/steamfriends.lisp @@ -0,0 +1,14 @@ +#| + This file is a part of cl-steamworks + (c) 2019 Shirakumo http://tymoon.eu (shinmera@tymoon.eu) + Author: Nicolas Hafner +|# + +(in-package #:org.shirakumo.fraf.steamworks) + +(defclass steamfriends (interface) + ()) + +(defmethod initialize-instance :after ((interface steamfriends) &key version steamworks) + (setf (handle interface) (get-interface-handle steamworks 'steam::client-get-isteam-friends + (user steamworks) (pipe steamworks) version))) diff --git a/steamworks.lisp b/steamworks.lisp index b7cd9ae..c2a8826 100644 --- a/steamworks.lisp +++ b/steamworks.lisp @@ -8,7 +8,7 @@ (defvar *steamworks* NIL) (defvar *default-interfaces* - '(steamclient steamutils steamuser)) + '(steamclient steamutils steamuser steamfriends)) (defun steamworks (&optional container) (if container @@ -70,6 +70,9 @@ (defmethod interface ((name symbol) (steamworks steamworks)) (gethash name (interfaces steamworks))) +(defmethod interface (name (steamworks (eql T))) + (interface name (steamworks))) + (defmethod list-interfaces ((steamworks steamworks)) (alexandria:hash-table-values (interfaces steamworks))) diff --git a/toolkit.lisp b/toolkit.lisp index 74d13f3..68b34f8 100644 --- a/toolkit.lisp +++ b/toolkit.lisp @@ -20,9 +20,18 @@ (dotimes (i (* count (cffi:foreign-type-size type)) ptr) (setf (cffi:mem-aref ptr :uchar i) 0)))) +(defun warn* (datum &rest args) + (let ((condition (etypecase datum + (string (make-condition 'simple-warning :format-control datum :format-arguments args)) + (symbol (apply #'make-condition 'datum args)) + (condition datum)))) + (format *error-output* "~&WARNING: ~a~%" condition) + (warn condition))) + ;; This fucking sucks man (defun foreign-type-p (type) - (not (null (ignore-errors (cffi:foreign-type-size type))))) + (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 steam::*this*))))