Fun with Garnet & ASDF - Garnet ASDF cursor system, defining cursors at system load time

--liOOAslEiF7prFVr
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

Hello,

In order to make it somehow easier to load and develop Garnet, and to
incorporate Garnet with other Common Lisp applications that do and
would have ASDF system definitions, I've been taking some time to
define ASDF systems for Garnet. I hope to share the work, made for
this, once it would be all completed and tested -- I've got as far as
defining a system for Garnet-Gadgets, then had to stop to address how
I will have GARNET-BITMAP-PATHNAME defined, given how I've been doing
the Garnet ASDF "stuff", thus far. At that time, I stopped to notice
the Garnet cursor files.

The ASDF work, mentioned, is not my primary point, here, though it has
been coincident to this email. When it would be released, I hope to
write enough notes to explain it.



As a result of the ASDF+Garnet fun, I decided to define something,
upon a lark, about Garnet cursor files. I thought it would be worth
sharing, then. It's attached -- an ASDF system definition, containing
some  extensions on ASDF; it would best be located within the Garnet
lib/bitmaps/ directory, named garnet-cursors.asd, if one would load
it. It would be most easily used, if one would already have Opal
loaded. Then, one would simply load the file, and execute

  (asdf:operate  'asdf:load-op :garnet-cursors)

Of course, it would redefine some things, but just as how they've been
defined, before.


Essentially, the code in the attached ADSF file does represent a means
for automatically defining Garnet cursors when an ASDF system is
loaded -- such that the system would contain one or more
CURSOR-COMPONENT components. I'm sure it is not perfectly  done, but
it may at least serve as an example, and a first revision (avaialble
in later forms, once it would be availabile)


As for  how the attached ASDF extensions would work, I'll explain it
in regards to a hypothetical ASDF component with the name <FOO>. This
explanation might be more clear, after a brief look at the attached
*.asd file.


I'd thought that this set of extensions on ASDF would be helpful, for
that it would allow a Garnet developer to simply create the
appropriate <FOO>.mask and <FOO>.cursor files, then identify a
<FOO> CURSOR-COMPONENT in an ASDF system -- with no more code being
required, for this.  When the ASDF system would be loaded, then, the
apprpriate <FOO>-CURSOR and <FOO>-CURSOR-MASK schemas would be defined
for the <FOO> CURSOR-COMPONENT; both of those schemas would then be 
identified within a <FOO>-PAIR variable -- much like how it is being
done in Garnet, though this would do it automatically, upon the
loading of the ASDF system.

Additionally, this allows for a :PACKAGE argument to be specified in
the definition of the comopnent; it would be spedified in the ASDF
definiton for the <FOO>  CURSOR-COMPONENT, or in the definiton
of the module (possibly a system) directly containing the <FOO>
component. Granted, the attached *.asd file is not so well desinged
for this -- some class names may need to be revised -- but it works.

The :PACKAGE identified will have to exist when the component would be
loaded; it would be used as the package in which the symbols for the
CURSOR-COMPONENT would be interned (namely, the cursor schemas and the
cursor's <FOO>-PAIR variable)


Granted, this serves to require that one wold be using ASDF, to load
the appropriate system. I'm sure that that should not be a matter of
problem; ASDF is hardly an uncommon application.


Furthermore, now having completed the thing, I've come to realize that
this particular system definition, attached, it is not so glaringly
necessary; there is already the code, within Garnet, for
acccomplishing what the attached system definition does accomplish.

Still, if anyone would be defining new cursors for Garnet, and using
ASDF, then perhaps the attached code would be of interest.


I hope it serves to demonstrate some of what can be done with ASDF
systems, furthermore. 

Something like this could be done, if necesary, for automatically
loading Garnet bitmaps, when an appropriate ASDF system would be
loaded. Of course, it could be done for any image file, given
some appropriate support in the Lisp image.

(Incorporating Garnet with more of what exists for the representation
of image files -- I do not know the package-names offhand, but I know
they exist, and they should be at http://common-lisp.net/ -- it  is
one more item on my own to-do list; perhaps there will be come code
after it, sometime when.)

Incidentally, the ASDF+Garnet work is being done as part of an
intention, for to package Garnet for Debian GNU/Linux systems. That
should be reported about, when it's done and tested

I do not intend to work-in this garnet-cursor code with it, except
perhaps as an example. Regardless, it's done, and attached, in at
least a first draft form. Maybe it will have been of any interest.




--
Sean Champ
[email protected]

--liOOAslEiF7prFVr
Content-Type: text/plain; charset=us-ascii
Content-Description: garnet-cursors.asd
Content-Disposition: attachment; filename="garnet-cursors.asd"

;;;; -*- Mode: Lisp -*-
;;;; ASDF definition for garnet-cursors 

(in-package #:cl-user)

;; must have opal loaded, first
(unless (get :garnet-modules :opal)
  (user::do-load user::garnet-opal-loader))


(defpackage #:garnet-cursors-system (:use #:cl #:asdf))

(in-package #:garnet-cursors-system)

;; * CURSOR-COMPONENT Class and Loading


;; The following forms ensure that when an CURSOR-COMPONENT is loaded,
;; there will be defined the appropriate Opal schemas for the cursor
;; represented by the component.

;; Conventions:
;;
;; For a given CURSOR-COMPONENT named "foo" there must exist both the files
;; "foo.cursor" and "foo.mask" within the same directory as the module
;; containing the CURSOR-COMPONENT.

;; Purpose:
;;
;; This was intended largely as a matter of convenience, serving to
;; ensure that Garnet developers would not have to hard-code the code for
;; the loading of cursor files. Of course, this will only work for
;; Garnet users using ASDF

(defgeneric cursor-package (component)
  (:documentation "Determine the package in which to intern the symbols for naming the given component"))


(defclass cursor-mixin ()
  ((cursor-package
    :type (or symbol package)
    :documentation
"the package in which to intern the symbols for naming the given
component.

This should be specified, at least for the module (or the system) most
directly containing the component"
    :initarg :package
    :reader cursor-package)))

(defclass cursor-system (cursor-mixin system )
  ())


(defclass cursor-component (cursor-mixin component)
  ())

(defmethod cursor-package ((c cursor-component))
  (find-package
   (if (slot-boundp c 'cursor-package)
       (slot-value c 'cursor-package)
     (cursor-package (component-parent c)))))



(defmethod component-relative-pathname ((c cursor-component))
  (component-pathname (component-parent c)))

(defmethod perform ((op compile-op) (c cursor-component))
  (declare (ignore op c))
  (when (next-method-p) (call-next-method)))




(defmethod perform ((op load-op) (c cursor-component)
		    &aux (name  (component-name c))
		    (package (cursor-package c)))

  (declare (ignore op))
  (let ((cursor-name (intern (format nil "~:@(~a~)-CURSOR" name)
			     package))
	(cursor-mask-name (intern (format nil "~:@(~a~)-CURSOR-MASK" name)
				  package)))

    (kr:create-instance cursor-name opal:bitmap
      (:constant :image)
      (:image (make-pathname :name name
			     :type "cursor"
			     :defaults (asdf::component-pathname c))))

    (kr:create-instance cursor-mask-name opal:bitmap
      (:constant :image)
      (:image (make-pathname :name name
			     :type "mask"
			     :defaults (asdf:component-pathname c))))

    (proclaim (list 'special cursor-name cursor-mask-name))

    (export (list cursor-name cursor-mask-name) package)

    (setf (symbol-value (intern (format nil "~:@(~a~)-PAIR" name) package))
	  (cons (symbol-value cursor-name) (symbol-value cursor-mask-name)))))


(defsystem garnet-cursors
  :class cursor-system
  :package :opal
;  :depends-on (:garnet-common :opal)
  :components 
  ((cursor-component "garbage")
   (cursor-component "garnet")
   (cursor-component "hourglass")
   ;; should define a separate system for these:
;   (cursor-component "lapidary-copy" :package :lapidary)
;   (cursor-component "lapidary-delete"  :package :lapidary)
;   (cursor-component "lapidary-instance"  :package :lapidary)
;   (cursor-component "lapidary-load"  :package :lapidary)
;   (cursor-component "lapidary-move"  :package :lapidary)
   ))


;(asdf:operate 'asdf:load-op :garnet-cursors)

--liOOAslEiF7prFVr--