Mercurial > hg > amuse

changeset 288:d1e5bbcc5ea4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Rationalise base and geerdes classes, constructors and methods. Ignore-this: d9d4d88566a6d110844d91d4c70513cd Towards a more standardised interface. Some of these changes (generalised constructors and reader functions) are necessary for amuse-database-admin functionality and some other CHARM-like things. darcs-hash:20090716154406-16a00-8a9b4fb1fc1f5ba75af66a1bbd87e1bb68e02493.gz
author j.forth <j.forth@gold.ac.uk>
date Thu, 16 Jul 2009 16:44:06 +0100
parents 00d35eb70ef9
children 2519652145c3
files base/classes.lisp base/package.lisp implementations/geerdes/classes.lisp implementations/geerdes/constructors.lisp implementations/geerdes/methods.lisp
diffstat 5 files changed, 97 insertions(+), 35 deletions(-) [+]
line wrap: on
line diff
--- a/base/classes.lisp	Thu Jul 16 15:58:07 2009 +0100
+++ b/base/classes.lisp	Thu Jul 16 16:44:06 2009 +0100
@@ -8,12 +8,18 @@
 
 (defclass identifier (amuse-object) ()
   (:documentation "DEPRECATED: Base class to allow specification of
-  composition to get. Must be subclassed."))
+  composition to get. Must be subclassed.")) ; FIXME: Why deprecated?
 
 (defclass constituent-identifier (identifier) ()
-  (:documentation "Base class to allow specifiction of constituents"))
+  (:documentation "Base class to allow specification of
+  constituents"))
+
 (defclass composition-identifier (constituent-identifier) ()
-  (:documentation "Base class to allow-specification of constituents"))
+  (:documentation "Base class to allow specification of
+  compositions constituents"))
+
+(defclass event-identifier (identifier) ()
+  (:documentation "Base class to allow specification of events."))
 
 (defclass moment (amuse-object) ()
   (:documentation "Object indicating a point in time"))
--- a/base/package.lisp	Thu Jul 16 15:58:07 2009 +0100
+++ b/base/package.lisp	Thu Jul 16 16:44:06 2009 +0100
@@ -160,4 +160,12 @@
 	   #:%list-slot-sequence-data
 	   #:list-slot-sequence
 	   #:move-to-first-bar
+	   #:copy-event
+	   #:voice
+	   #:event-identifier
+	   #:id
+	   #:event-id
+	   #:composition-id
+	   #:interval
+	   #:event
 	   ))
--- a/implementations/geerdes/classes.lisp	Thu Jul 16 15:58:07 2009 +0100
+++ b/implementations/geerdes/classes.lisp	Thu Jul 16 16:44:06 2009 +0100
@@ -7,13 +7,24 @@
 
 (defclass geerdes-object (property-list-mixin) ())
 
-(defclass geerdes-identifier (composition-identifier geerdes-object) ())
-(defclass geerdes-identifier-cat-id (geerdes-identifier)
+(defclass geerdes-identifier (geerdes-object) ())
+
+(defclass geerdes-composition-identifier (composition-identifier
+					  geerdes-object) ())
+
+(defclass geerdes-identifier-cat-id (geerdes-composition-identifier)
   ((cat-id :initarg :cat-id
 	   :initform 'nil)))
-(defclass geerdes-identifier-file-id (geerdes-identifier)
+
+(defclass geerdes-identifier-file-id (geerdes-composition-identifier)
   ((file-id :initarg :file-id
-	    :initform 'nil)))
+	    :initform 'nil))
+  (:documentation "Define geerdes-file-id as composition-id."))
+
+(defclass geerdes-event-identifier (event-identifier
+				    geerdes-identifier)
+  ((event-id :initarg :event-id
+	     :reader event-id)))
 
 (defclass geerdes-composition (midi-composition geerdes-object)
   ((db-entry :initarg :db-entry
@@ -50,12 +61,18 @@
 			      :initform 0
 			      :accessor %ioi-mode)))
 
-(defclass geerdes-pitched-event (midi-pitched-event geerdes-object)
-  ((id :initarg :id
-       :accessor %geerdes-pitched-event-id))
-  (:documentation "Only adds a database id to midi-pitched-event"))
+(defclass geerdes-event (geerdes-object) ()
+  (:documentation "Base class for geerdes events."))
 
-(defclass geerdes-percussive-event (midi-percussive-event geerdes-object)
-  ((id :initarg :id
-       :accessor %geerdes-percussive-event-id))
-  (:documentation "Only adds a database id to midi-percussive-event"))
+(defclass geerdes-pitched-event (midi-pitched-event geerdes-event)
+  ((identifier :initarg :identifier
+	       :reader identifier))
+  (:documentation "Only adds a database identifier to
+  midi-pitched-event"))
+
+(defclass geerdes-percussive-event (midi-percussive-event
+				    geerdes-event)
+  ((identifier :initarg :identifier
+	       :reader identifier))
+  (:documentation "Only adds a database identifier to
+  midi-percussive-event"))
--- a/implementations/geerdes/constructors.lisp	Thu Jul 16 15:58:07 2009 +0100
+++ b/implementations/geerdes/constructors.lisp	Thu Jul 16 16:44:06 2009 +0100
@@ -1,5 +1,25 @@
 (cl:in-package #:amuse-geerdes)
 
+;; Identifiers
+;; FIXME: use standard constructor names?
+;; FIXME: use standard composition-identifier?
+(defun g-id (cat-id)
+  "Make a geerdes-identifier based on a catalogue id"
+  (make-instance 'geerdes-identifier-cat-id
+		 :cat-id cat-id))
+
+(defun g-id-file-id (file-id)
+  "Make a geerdes-identifier based on the file id. This is used as
+the standard composition-id."
+  (make-instance 'geerdes-identifier-file-id
+		 :file-id file-id))
+
+(defun make-geerdes-event-identifier (event-id)
+  (make-instance 'geerdes-event-identifier
+		 :event-id event-id))
+
+;; Events
+
 (defgeneric %initialise-notes (composition))
 (defmethod %initialise-notes ((composition geerdes-composition))
   (let ((notes) (l 0) (last-time 0) (monody-notes)
@@ -108,8 +128,8 @@
   (and (not (= (%fast-channel event-row) 10))
        (< (%fast-patch event-row) 112)))
 
-(defun make-geerdes-pitched-event (pitch-number velocity patch
-				channel track onset duration id)
+(defun make-geerdes-pitched-event (pitch-number velocity patch channel
+				   track onset duration event-id)
   (make-instance 'geerdes-pitched-event
 		 :number pitch-number
 		 :velocity velocity
@@ -118,10 +138,12 @@
 		 :track track
 		 :time onset
 		 :interval duration
-		 :id id))
+		 :identifier (make-geerdes-event-identifier
+			      event-id)))
 
 (defun make-geerdes-percussive-event (pitch-number velocity patch
-				   channel track onset duration id)
+				      channel track onset duration
+				      event-id)
   (make-instance 'geerdes-percussive-event
 		 :sound pitch-number
 		 :velocity velocity
@@ -130,7 +152,8 @@
 		 :track track
 		 :time onset
 		 :interval duration
-		 :id id))
+		 :identifier (make-geerdes-event-identifier
+			      event-id)))
 
 (defmethod copy-event ((event geerdes-pitched-event))
   (with-slots ((channel amuse-midi::channel)
@@ -139,7 +162,8 @@
 	       (time amuse::time)
 	       (interval amuse::interval)
 	       (velocity amuse-midi::velocity)
-	       (patch amuse-midi::patch) id)
+	       (patch amuse-midi::patch)
+	       identifier)
       event
     (make-instance 'geerdes-pitched-event
 		   :channel channel
@@ -149,7 +173,8 @@
 		   :interval interval
 		   :velocity velocity
 		   :patch patch
-		   :id id)))
+		   :identifier identifier)))
+
 (defmethod copy-event ((event geerdes-percussive-event))
   (with-slots ((channel amuse-midi::channel)
 	       (track amuse-midi::track)
@@ -157,7 +182,8 @@
 	       (interval amuse::interval)
 	       (velocity amuse-midi::velocity)
 	       (patch amuse-midi::patch)
-	       (sound amuse-midi::sound) id)
+	       (sound amuse-midi::sound)
+	       identifier)
       event
     (make-instance 'geerdes-percussive-event
 		   :channel channel
@@ -167,7 +193,7 @@
 		   :velocity velocity
 		   :patch patch
 		   :sound sound
-		   :id id)))
+		   :identifier identifier)))
 
 ;; We want any function that generates a sequence from a geerdes
 ;; composition to preserve all slot values:
--- a/implementations/geerdes/methods.lisp	Thu Jul 16 15:58:07 2009 +0100
+++ b/implementations/geerdes/methods.lisp	Thu Jul 16 16:44:06 2009 +0100
@@ -1,14 +1,6 @@
 (cl:in-package #:amuse-geerdes)
 
-;;; Compositions
-
-;; identifiers
-(defun g-id (cat-id)
-  "Make a geerdes-identifier based on a catalogue id"
-  (make-instance 'geerdes-identifier-cat-id :cat-id cat-id))
-(defun g-id-file-id (file-id)
-  "Make a geerdes-identifier based on a catalogue id"
-  (make-instance 'geerdes-identifier-file-id :file-id file-id))
+;; Identifiers
 
 (defgeneric cat-id (object)
   (:documentation "Return a database catalogue id for object (for
@@ -16,7 +8,7 @@
 (defgeneric file-id (object)
   (:documentation "Return a database file id for object (for
   Geerdes data, this is a unique integer identifier)"))
-(defgeneric (setf cat-id) (value object))
+(defgeneric (setf cat-id) (value object)) ;; FIXME: why?
 (defgeneric (setf file-id) (value object))
 
 (defmethod cat-id ((object geerdes-composition))
@@ -36,6 +28,18 @@
 (defmethod (setf file-id) (value (object geerdes-identifier-file-id))
   (setf (slot-value object 'file-id) value))
 
+;; Identifier accessors for CHARM constituents
+
+(defmethod composition-id ((o geerdes-composition-identifier))
+  "Composition-id is file-id in geerdes."
+  (file-id o))
+
+(defmethod composition-id ((o geerdes-composition))
+  (file-id o))
+
+(defmethod event-id ((o geerdes-event))
+  (event-id (identifier o)))
+
 ;; Specialised constructors
 
 (defmethod make-composition-identifier ((package (eql *package*))
@@ -44,7 +48,8 @@
 
 ;; Composition 
 
-(defmethod get-composition ((identifier geerdes-identifier))
+(defmethod get-composition ((identifier
+			     geerdes-composition-identifier))
   (let* ((composition (get-geerdes-composition identifier)))
     (%initialise-notes composition)
     (%initialise-constituents composition)))