Commit b6a70535 authored by David O'Toole's avatar David O'Toole

change RESOURCE to a class

parent a3b596e6
......@@ -17,10 +17,10 @@
;; [[file:~/xelf/xelf.org::*Xelf%20version%20information][Xelf version information:1]]
(defvar *xelf-version* "4.8"
"A string giving the version number of Xelf.")
"A string giving the version number of Xelf.")
(defvar *xelf-series* 4
"An integer giving the major API version of Xelf.")
(defvar *xelf-series* 4
"An integer giving the major API version of Xelf.")
;; Xelf version information:1 ends here
;; User or application specific notices
......@@ -33,10 +33,11 @@
;; [[file:~/xelf/xelf.org::*User%20or%20application%20specific%20notices][User or application specific notices:1]]
(defvar *author* nil "Name of the application author.")
(defvar *author-contact* "URL or email address of application author.")
(defvar *author-contact*
"URL or email address of application author.")
(defvar *author-copyright-notice* nil
"Text of user or application specific copyright notice.")
(defvar *author-copyright-notice* nil
"Text of user or application specific copyright notice.")
;; User or application specific notices:1 ends here
;; Compiler-specific notices :sbcl:ccl:ecl:
......@@ -158,14 +159,14 @@ more information.
;; [[file:~/xelf/xelf.org::*Assembling%20a%20full%20copyright%20notice][Assembling a full copyright notice:1]]
(defvar *copyright-notice*
(concatenate 'string *compiler-copyright-notice* *xelf-copyright-notice*)
"Copyright notices for Xelf, its dependencies, and the current Lisp
(concatenate 'string *compiler-copyright-notice* *xelf-copyright-notice*)
"Copyright notices for Xelf, its dependencies, and the current Lisp
implementation.")
(defun full-copyright-notice ()
(concatenate 'string
(or *author-copyright-notice* "")
*copyright-notice*))
(defun full-copyright-notice ()
(concatenate 'string
(or *author-copyright-notice* "")
*copyright-notice*))
;; Assembling a full copyright notice:1 ends here
;; Queue mechanism
......@@ -3025,8 +3026,17 @@ Returns a newly allocated list."
The string '()' is a valid .XELF file; it contains no resources.")
(defstruct resource
name type properties file data object system-p)
(defclass resource ()
((name :initform nil :accessor resource-name :initarg :name)
(type :initform nil :accessor resource-type :initarg :type)
(properties :initform nil :accessor resource-properties :initarg :properties)
(file :initform nil :accessor resource-file :initarg :file)
(data :initform nil :accessor resource-data :initarg :data)
(object :initform nil :accessor resource-object :initarg :object)
(system-p :initform nil :accessor resource-system-p :initarg :system-p)))
(defun resource-p (res)
(typep res (find-class 'resource)))
;; The extra `object' field is not saved in .XELF files; it is used to
;; store driver-dependent loaded resources (i.e. SDL image surface
......@@ -3118,7 +3128,7 @@ Returns a newly allocated list."
(let ((sexp (read-sexp-from-file filename)))
;; find the resource plists; see `read-sexp-from-file'
(mapcar #'(lambda (s)
(let ((resource (apply #'make-resource s)))
(let ((resource (apply #'make-instance 'resource s)))
(prog1 resource
(setf (resource-system-p resource) system-p))))
(if (every #'resourcep sexp)
......@@ -3488,7 +3498,7 @@ Returns a newly allocated list."
(defun index-pending-resources ()
(message "Indexing ~S pending resources..." (length *pending-resources*))
(dolist (plist *pending-resources*)
(index-resource (apply #'make-resource plist))))
(index-resource (apply #'make-instance 'resource plist))))
(defun play-project (&optional (project *project*))
(initialize-resource-table)
......@@ -3496,7 +3506,7 @@ Returns a newly allocated list."
;; load objects and buffers from disk
(load-project-image project)
(dolist (plist *pending-resources*)
(index-resource (apply #'make-resource plist)))
(index-resource (apply #'make-instance 'resource plist)))
(start-session)
(shut-down))
......@@ -3570,7 +3580,7 @@ Returns a newly allocated list."
"Make an object resource named NAME (a string) with the Lisp object
OBJECT as the resource data."
(message "Creating new object resource ~S." name)
(let ((resource (make-resource :name name
(let ((resource (make-instance 'resource :name name
:type :object
:object object)))
(prog1 resource
......@@ -3586,7 +3596,7 @@ Returns a newly allocated list."
(defun save-buffer (&optional (buffer (current-buffer)))
(save-object-resource
(make-resource :name (buffer-name buffer)
(make-instance 'resource :name (buffer-name buffer)
:data (flatten (find-object buffer))
:type :buffer)))
......@@ -3594,14 +3604,14 @@ Returns a newly allocated list."
(string= "*" (string (aref (resource-name resource) 0))))
(defun make-resource-link (resource)
(make-resource :type :xelf
(make-instance 'resource :type :xelf
:file (concatenate 'string
(resource-name resource)
*resource-file-extension*)))
(defun save-resource (name resource)
(let ((pathname (resource-file resource))
(link (make-resource-link resource)))
(link (make-instance 'resource-link resource)))
(prog1 link
(if (eq :object (resource-type resource))
;; we want to index them all, whether or not we save them all.
......@@ -3837,7 +3847,7 @@ Returns a newly allocated list."
(incf saved)))
(maphash #'store database) ;; copy into database2
(message "Saving ~S objects..." saved garbage)
(values (make-resource :name "--database--"
(values (make-instance 'resource :name "--database--"
:type :database
:data (serialize database2))
(hash-table-count database2)))))
......@@ -4012,7 +4022,7 @@ Returns a newly allocated list."
(boundp name)))
(assert (member name *safe-variables*))
(assert (not (eq name '*safe-variables*)))
(make-resource :name name
(make-instance 'resource :name name
:type :variable
:data (serialize (symbol-value name))))
......@@ -4369,13 +4379,13 @@ Returns a newly allocated list."
"Load the X11 color data into the resource table."
(dolist (color *x11-color-data*)
(destructuring-bind (name red green blue) color
(index-resource (make-resource :name name
(index-resource (make-instance 'resource :name name
:type :color
:data (list red green blue)))
(find-resource-object name))))
;; (prog1 result
;; (when (emulated-vertex-color-p)
;; (index-resource (make-resource
;; (index-resource (make-instance 'resource
;; :name (swatch-name name)
;; :type :image
;; :object (find-swatch name red green blue)))))))))
......@@ -4445,7 +4455,7 @@ Returns a newly allocated list."
;; (if (find-resource name :no-error)
;; (find-texture name)
;; (let ((resource
;; (make-resource :name name
;; (make-instance 'resource :name name
;; :type :image
;; :object (colorize-image (or image "_box.png") color))))
;; (index-resource resource)
......@@ -4454,7 +4464,7 @@ Returns a newly allocated list."
;; (defun index-emulated-vertex-colors ()
;; (dolist (color (mapcar #'first *x11-color-data*))
;; (let ((_color.png (concatenate 'string "_" color ".png")))
;; (index-resource (make-resource :name _color.png :file _color.png :type :image)))))
;; (index-resource (make-instance 'resource :name _color.png :file _color.png :type :image)))))
;; (defun find-emulated-vertex-color (color)
;; (let ((swatch-name (swatch-name color)))
......@@ -4992,7 +5002,7 @@ Returns a newly allocated list."
;; (sdl:with-timestep (do-update))
;; load pending resources
;; (dolist (plist *pending-resources*)
;; (index-resource (apply #'make-resource plist)))
;; (index-resource (apply #'make-instance 'resource plist)))
;; (setf *pending-resources* nil)
(restartably
(gl:clear-color 0 0 0 1)
......
......@@ -2176,7 +2176,6 @@ Here is the top-level update function.
(error fpe))))
#+end_src
* Device driver
** Variable for GL window status :obsolete:
......@@ -3049,8 +3048,17 @@ increases.
The string '()' is a valid .XELF file; it contains no resources.")
(defstruct resource
name type properties file data object system-p)
(defclass resource ()
((name :initform nil :accessor resource-name :initarg :name)
(type :initform nil :accessor resource-type :initarg :type)
(properties :initform nil :accessor resource-properties :initarg :properties)
(file :initform nil :accessor resource-file :initarg :file)
(data :initform nil :accessor resource-data :initarg :data)
(object :initform nil :accessor resource-object :initarg :object)
(system-p :initform nil :accessor resource-system-p :initarg :system-p)))
(defun resource-p (res)
(typep res (find-class 'resource)))
;; The extra `object' field is not saved in .XELF files; it is used to
;; store driver-dependent loaded resources (i.e. SDL image surface
......@@ -3140,7 +3148,7 @@ increases.
(let ((sexp (read-sexp-from-file filename)))
;; find the resource plists; see `read-sexp-from-file'
(mapcar #'(lambda (s)
(let ((resource (apply #'make-resource s)))
(let ((resource (apply #'make-instance 'resource s)))
(prog1 resource
(setf (resource-system-p resource) system-p))))
(if (every #'resourcep sexp)
......@@ -3507,7 +3515,7 @@ increases.
(defun index-pending-resources ()
(message "Indexing ~S pending resources..." (length *pending-resources*))
(dolist (plist *pending-resources*)
(index-resource (apply #'make-resource plist))))
(index-resource (apply #'make-instance 'resource plist))))
(defun play-project (&optional (project *project*))
(initialize-resource-table)
......@@ -3515,7 +3523,7 @@ increases.
;; load objects and buffers from disk
(load-project-image project)
(dolist (plist *pending-resources*)
(index-resource (apply #'make-resource plist)))
(index-resource (apply #'make-instance 'resource plist)))
(start-session)
(shut-down))
......@@ -3589,7 +3597,7 @@ increases.
"Make an object resource named NAME (a string) with the Lisp object
OBJECT as the resource data."
(message "Creating new object resource ~S." name)
(let ((resource (make-resource :name name
(let ((resource (make-instance 'resource :name name
:type :object
:object object)))
(prog1 resource
......@@ -3605,7 +3613,7 @@ increases.
(defun save-buffer (&optional (buffer (current-buffer)))
(save-object-resource
(make-resource :name (buffer-name buffer)
(make-instance 'resource :name (buffer-name buffer)
:data (flatten (find-object buffer))
:type :buffer)))
......@@ -3613,14 +3621,14 @@ increases.
(string= "*" (string (aref (resource-name resource) 0))))
(defun make-resource-link (resource)
(make-resource :type :xelf
(make-instance 'resource :type :xelf
:file (concatenate 'string
(resource-name resource)
*resource-file-extension*)))
(defun save-resource (name resource)
(let ((pathname (resource-file resource))
(link (make-resource-link resource)))
(link (make-instance 'resource-link resource)))
(prog1 link
(if (eq :object (resource-type resource))
;; we want to index them all, whether or not we save them all.
......@@ -3852,7 +3860,7 @@ What that happens, this section will be replaced with the new code.
(incf saved)))
(maphash #'store database) ;; copy into database2
(message "Saving ~S objects..." saved garbage)
(values (make-resource :name "--database--"
(values (make-instance 'resource :name "--database--"
:type :database
:data (serialize database2))
(hash-table-count database2)))))
......@@ -4025,7 +4033,7 @@ What that happens, this section will be replaced with the new code.
(boundp name)))
(assert (member name *safe-variables*))
(assert (not (eq name '*safe-variables*)))
(make-resource :name name
(make-instance 'resource :name name
:type :variable
:data (serialize (symbol-value name))))
......@@ -4373,13 +4381,13 @@ What that happens, this section will be replaced with the new code.
"Load the X11 color data into the resource table."
(dolist (color *x11-color-data*)
(destructuring-bind (name red green blue) color
(index-resource (make-resource :name name
(index-resource (make-instance 'resource :name name
:type :color
:data (list red green blue)))
(find-resource-object name))))
;; (prog1 result
;; (when (emulated-vertex-color-p)
;; (index-resource (make-resource
;; (index-resource (make-instance 'resource
;; :name (swatch-name name)
;; :type :image
;; :object (find-swatch name red green blue)))))))))
......@@ -4448,7 +4456,7 @@ This is for OpenGL ES 2 on Android, and not currently documented.
;; (if (find-resource name :no-error)
;; (find-texture name)
;; (let ((resource
;; (make-resource :name name
;; (make-instance 'resource :name name
;; :type :image
;; :object (colorize-image (or image "_box.png") color))))
;; (index-resource resource)
......@@ -4457,7 +4465,7 @@ This is for OpenGL ES 2 on Android, and not currently documented.
;; (defun index-emulated-vertex-colors ()
;; (dolist (color (mapcar #'first *x11-color-data*))
;; (let ((_color.png (concatenate 'string "_" color ".png")))
;; (index-resource (make-resource :name _color.png :file _color.png :type :image)))))
;; (index-resource (make-instance 'resource :name _color.png :file _color.png :type :image)))))
;; (defun find-emulated-vertex-color (color)
;; (let ((swatch-name (swatch-name color)))
......@@ -4990,7 +4998,7 @@ This section needs to be cleaned up.
;; (sdl:with-timestep (do-update))
;; load pending resources
;; (dolist (plist *pending-resources*)
;; (index-resource (apply #'make-resource plist)))
;; (index-resource (apply #'make-instance 'resource plist)))
;; (setf *pending-resources* nil)
(restartably
(gl:clear-color 0 0 0 1)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment