Allow symbols as names for resources

borodust · Jul 23, 2019 · 4a609ab · 4a609ab
1 parent af0eae5
commit 4a609ab
Show file tree

Hide file tree

Showing 2 changed files with 29 additions and 20 deletions.
diff --git a/resources/font-atlas.lisp b/resources/font-atlas.lisp
@@ -47,5 +47,4 @@
 
 
 (defmacro define-sdf-font (name)
-  `(progn
-     (defresource :font (sdf-font-metrics-resource-name ,name) :type :sdf)))
+  `(defresource (sdf-font-metrics-resource-name ,name) :font :type :sdf))
diff --git a/resources/registry.lisp b/resources/registry.lisp
@@ -4,10 +4,20 @@
 (defvar *resource-storage* (make-instance 'resource-storage))
 
 
+(defun resource-name->string (name)
+  (etypecase name
+    (string name)
+    (pathname (namestring name))
+    (symbol (format nil "/_symbol/~A/~A"
+                    (package-name (symbol-package name))
+                    (symbol-name name)))))
+
+
 (defun mount-resource-provider (path provider)
-  (let ((node-name (if (fad:directory-pathname-p path)
-                       (enough-namestring path (fad:pathname-parent-directory path))
-                       (file-namestring path))))
+  (let* ((path (resource-name->string path))
+         (node-name (if (fad:directory-pathname-p path)
+                        (enough-namestring path (fad:pathname-parent-directory path))
+                        (file-namestring path))))
     (mount-storage-resource-node *resource-storage* path
                                  (funcall provider node-name))))
 
@@ -39,7 +49,7 @@
 (defun register-resource (name handler)
   (with-instance-lock-held (*resource-registry*)
     (with-slots (resource-table) *resource-registry*
-      (with-hash-entries ((resource-entry (namestring name))) resource-table
+      (with-hash-entries ((resource-entry (resource-name->string name))) resource-table
         (let ((entry resource-entry))
           (when (and entry (not (eq entry handler)))
             (warn "Resource redefinition: handler ~A for '~A' was registered earlier"
@@ -50,19 +60,20 @@
 (defun find-resource-handler (resource-name)
   (with-slots (resource-table) *resource-registry*
     (with-instance-lock-held (*resource-registry*)
-      (gethash (namestring resource-name) resource-table))))
+      (gethash (resource-name->string resource-name) resource-table))))
 
 
 (defun load-resource (name &optional handler)
   (with-slots (resource-table) *resource-registry*
     (log/trace "Resource requested: '~A'" name)
-    (if-let ((handler (or handler
-                          (find-resource-handler name)
-                          (when-let ((type (resource-type *resource-storage* name)))
-                            (make-resource-handler type)))))
-      (with-resource-stream (stream name *resource-storage*)
-        (decode-resource handler stream))
-      (error "Failed to determine handler for '~A'" name))))
+    (let ((name (resource-name->string name)))
+     (if-let ((handler (or handler
+                           (find-resource-handler name)
+                           (when-let ((type (resource-type *resource-storage* name)))
+                             (make-resource-handler type)))))
+       (with-resource-stream (stream name *resource-storage*)
+         (decode-resource handler stream))
+       (error "Failed to determine handler for '~A'" name)))))
 
 
 (defun list-registered-resource-names ()
@@ -75,9 +86,8 @@
 ;;;
 ;;; Define resource
 ;;;
-(defmacro defresource (type resource-path &body opts &key path &allow-other-keys)
-  (once-only (resource-path)
-    `(progn
-       (register-resource ,resource-path (make-resource-handler ,type ,@opts))
-       ,@(when path
-           `((mount-filesystem ,resource-path ,path))))))
+(defmacro defresource (resource-name type &body opts &key path &allow-other-keys)
+  `(progn
+     (register-resource ',resource-name (make-resource-handler ,type ,@opts))
+     ,@(when path
+         `((mount-filesystem ',resource-name ,path)))))