128 lines
4.3 KiB
Common Lisp
128 lines
4.3 KiB
Common Lisp
#|
|
|
This file is a part of stoe project.
|
|
Copyright (c) 2015 Renaud Casenave-Péré (renaud@casenave-pere.fr)
|
|
|#
|
|
|
|
(uiop:define-package :stoe/core/resources
|
|
(:use :cl :blackbird
|
|
:stoe/core/utils
|
|
:stoe/core/file
|
|
:stoe/core/modules
|
|
:stoe/core/jobs)
|
|
(:export #:resource #:res-path #:res-loaded-p
|
|
#:shared-resource
|
|
#:binary-resource #:res-buffer
|
|
#:stream-resource #:res-stream
|
|
#:lisp-resource #:res-data
|
|
#:resource-proxy #:res-deref
|
|
#:load-bin-resource #:load-stream-resource
|
|
#:load-lisp-resource #:unload-resource))
|
|
(in-package :stoe/core/resources)
|
|
|
|
(defvar *resources-db* (make-hash-table :test 'equal))
|
|
|
|
(defclass resource ()
|
|
((path :initarg :path :reader res-path)
|
|
(loaded :initarg :loaded :initform nil :reader res-loaded-p))
|
|
(:documentation "Base class for a resource."))
|
|
|
|
(defclass shared-resource (resource shared-object)
|
|
()
|
|
(:documentation "Base class for a shared resource."))
|
|
|
|
(defclass binary-resource (shared-resource)
|
|
((buffer :initarg :buffer :type '(array (unsigned-byte 8) (*)) :reader res-buffer))
|
|
(:documentation "Resource containing binary data."))
|
|
|
|
(defclass stream-resource (resource)
|
|
((stream :initarg :stream :accessor res-stream))
|
|
(:documentation "Streaming resource."))
|
|
|
|
(defclass lisp-resource (resource)
|
|
((data :initarg :data :reader res-data))
|
|
(:documentation "Resource defined in lisp."))
|
|
|
|
(defclass resource-proxy ()
|
|
((resource :initarg :resource))
|
|
(:documentation "Proxy class of a resource."))
|
|
|
|
(defgeneric res-deref (proxy))
|
|
(defmethod res-deref ((proxy resource-proxy))
|
|
(with-slots (resource) proxy
|
|
(tg:weak-pointer-value resource)))
|
|
|
|
(defun initialize (&optional argv)
|
|
"Initialize resources module."
|
|
(declare (ignore argv)))
|
|
|
|
(defun finalize ()
|
|
"Finalize resources module."
|
|
(when (> (hash-table-count *resources-db*) 0)
|
|
(format t "There are still ~d resources in the database~%" (hash-table-count *resources-db*))
|
|
(loop for res being the hash-values in *resources-db*
|
|
do (format t " file ~a is still referenced by ~d proxies~%" (pathname-path (res-path res))
|
|
(slot-value res 'refcount)))
|
|
(clrhash *resources-db*)))
|
|
|
|
(defun update (delta-time)
|
|
(declare (ignore delta-time)))
|
|
|
|
(defmodule stoe/core/resources :resources)
|
|
|
|
(defun register-resource (res)
|
|
(assert (null (gethash (res-path res) *resources-db*)))
|
|
(setf (gethash (res-path res) *resources-db*) res))
|
|
|
|
(defun unregister-resource (res)
|
|
(assert (gethash (res-path res) *resources-db*))
|
|
(remhash (res-path res) *resources-db*))
|
|
|
|
(defun make-resource (path type)
|
|
(let ((res (gethash path *resources-db*))
|
|
(newres nil))
|
|
(unless res
|
|
(setf res (make-instance type :path path))
|
|
(register-resource res)
|
|
(setf newres t))
|
|
(values (make-resource-proxy res) newres)))
|
|
|
|
(defmethod dec-ref :after ((res shared-resource))
|
|
(with-slots (refcount) res
|
|
(when (= refcount 0)
|
|
(unregister-resource res))))
|
|
|
|
(defun make-resource-proxy (res)
|
|
(let ((proxy (make-instance 'resource-proxy :resource (tg:make-weak-pointer res))))
|
|
(tg:finalize proxy (lambda () (dec-ref res)))
|
|
(inc-ref res)
|
|
proxy))
|
|
|
|
(defun load-bin-resource (path)
|
|
(multiple-value-bind (proxy newres) (make-resource path 'binary-resource)
|
|
(values proxy (if newres
|
|
(alet ((data (load-file path)))
|
|
(let ((res (res-deref proxy)))
|
|
(with-slots (buffer loaded) res
|
|
(setf buffer data)
|
|
(setf loaded t))
|
|
res))
|
|
(promisify (res-deref proxy))))))
|
|
|
|
(defun load-stream-resource (path)
|
|
(declare (ignore path)))
|
|
|
|
(defun load-lisp-resource (path)
|
|
(multiple-value-bind (proxy newres) (make-resource path 'lisp-resource)
|
|
(values proxy (if newres
|
|
(alet ((s (load-file path :type 'character)))
|
|
(let ((res (res-deref proxy)))
|
|
(with-slots (data loaded) res
|
|
(setf data (safe-read-from-string s))
|
|
(setf loaded t))
|
|
res))
|
|
(promisify (res-deref proxy))))))
|
|
|
|
(defun unload-resource (proxy)
|
|
(tg:cancel-finalization proxy)
|
|
(with-slots (resource) proxy
|
|
(dec-ref (tg:weak-pointer-value resource))))
|