changeset 113:3ceaa5a08dc5

base/: more print-object methods darcs-hash:20070726161241-c0ce4-7a27d0a24569bdc83daba9433cd163656ea2798b.gz
author Marcus Pearce <m.pearce@gold.ac.uk>
date Thu, 26 Jul 2007 17:12:41 +0100
parents 034ef8412ddb
children 956f4c6f8571
files base/classes.lisp base/constructors.lisp base/methods.lisp
diffstat 3 files changed, 34 insertions(+), 7 deletions(-) [+]
line wrap: on
line diff
--- a/base/classes.lisp	Thu Jul 26 16:19:05 2007 +0100
+++ b/base/classes.lisp	Thu Jul 26 17:12:41 2007 +0100
@@ -98,12 +98,6 @@
   ((mode :accessor %midi-key-signature-mode
 	 :initarg :mode)))
 
-(defmethod print-object ((mks midi-key-signature) stream)
-  (format stream "#<~A ~A ~A>"
-          (symbol-name (class-name (class-of mks)))
-          (%basic-key-signature-sharp-count mks)
-          (%midi-key-signature-mode mks)))
-
 (defclass tempo (anchored-period)
   ;; accel and rit in symbolic encoding will need other structures, as
   ;; will textual tempo markings.
--- a/base/constructors.lisp	Thu Jul 26 16:19:05 2007 +0100
+++ b/base/constructors.lisp	Thu Jul 26 17:12:41 2007 +0100
@@ -42,7 +42,7 @@
   (make-instance 'diatonic-pitch :cp cp :mp mp))
 
 (defun make-chromatic-pitch-interval (span)
-  (make-instance 'pitch-interval :span span))
+  (make-instance 'chromatic-pitch-interval :span span))
 
 (defun make-mips-pitch-interval (cspan mspan)
   (make-instance 'diatonic-pitch-interval :span (list cspan mspan)))
--- a/base/methods.lisp	Thu Jul 26 16:19:05 2007 +0100
+++ b/base/methods.lisp	Thu Jul 26 17:12:41 2007 +0100
@@ -75,6 +75,15 @@
 (defmethod midi-pitch-number ((pitch-designator pitch))
   (%chromatic-pitch-number (chromatic-pitch pitch-designator)))
 
+(defmethod print-object ((o chromatic-pitch) stream)
+  (print-unreadable-object (o stream :type t)
+    (write (midi-pitch-number o) :stream stream)))
+
+(defmethod print-object ((o chromatic-pitch-interval) stream)
+  (print-unreadable-object (o stream :type t)
+    (write (span o) :stream stream)))
+
+
 (defmethod span ((pitch-interval-designator chromatic-pitch-interval))
   (%chromatic-pitch-interval-span pitch-interval-designator))
 
@@ -95,6 +104,16 @@
 		 :time (+ (%moment-time anchored-period-designator)
 			  (%period-interval anchored-period-designator))))
 
+(defmethod print-object ((o moment) stream)
+  (print-unreadable-object (o stream :type t)
+    (write (timepoint o) :stream stream)))
+
+(defmethod print-object ((o period ) stream)
+  (print-unreadable-object (o stream :type t)
+    (write (duration o) :stream stream)))
+
+
+
 (defmethod beat-units-per-bar ((time-signature basic-time-signature))
   (%basic-time-signature-numerator time-signature))
 
@@ -110,12 +129,22 @@
     (and n1 n2 (= n1 n2) 
          d1 d2 (= d1 d2))))
 
+(defmethod print-object ((bts basic-time-signature) stream)
+  (print-unreadable-object (bts stream :type t)
+    (format stream "~A/~A" (beat-units-per-bar bts) (beat-units bts))))
+
 (defmethod key-signature-sharps ((key-signature basic-key-signature))
   (%basic-key-signature-sharp-count key-signature))
 
 (defmethod key-signature-mode ((ks midi-key-signature))
   (%midi-key-signature-mode ks))
 
+(defmethod print-object ((mks midi-key-signature) stream)
+  (print-unreadable-object (mks stream :type t)
+    (format stream "~A ~A"
+            (%basic-key-signature-sharp-count mks)
+            (%midi-key-signature-mode mks))))
+
 (defmethod key-signature-equal ((ks1 basic-key-signature) 
                                 (ks2 basic-key-signature))
   (let ((s1 (key-signature-sharps ks1))
@@ -134,6 +163,10 @@
 (defmethod bpm ((tempo tempo))
   (%tempo-bpm tempo))
 
+(defmethod print-object ((tempo tempo) stream)
+  (print-unreadable-object (tempo stream :type t)
+    (write (bpm tempo) :stream stream)))
+
 (defmethod tempo-equal ((t1 tempo) (t2 tempo))
   (and (bpm t1) (bpm t2) (= t1 t2)))