comparison implementations/meredith/methods.lisp @ 215:4eceac78e7c6

add minimal backend for Dave Meredith's data

Ignore-this: 91608f727967a4c5709bd41634ab9ae2

darcs-hash:20090524193956-16a00-038e6f7cb235dea4e7efcc70c4d1a7bc7fd402a6.gz

committer: Jamie Forth <[e-mail]>

+(cl:in-package #:amuse-meredith)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Specialised constructors
+(defmethod make-composition-identifier ((package (eql *package*))
+				       composition-id)
+  (make-meredith-composition-identifier composition-id))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Compositions
+
+(defvar *event-attributes*
+  #.(clsql:locally-enable-sql-reader-syntax)
+  (list [event-id] [tatum-on] [tatum-dur] [tactus-on] [tactus-dur]
+	[crot-on] [crot-dur] [tatum-on-ms] [tatum-dur-ms] [beat-on-ms]
+	[beat-dur-ms] [crot-on-ms] [crot-dur-ms] [pitch-name]
+	[midi-note-number] [chrom-pitch] [morph-pitch] [voice])
+  #.(clsql:locally-disable-sql-reader-syntax))
+
+(defmethod get-composition ((identifier meredith-composition-identifier))
+  #.(clsql:locally-enable-sql-reader-syntax)
+  (let* ((composition-id (composition-id identifier))
+	 (where-clause [= [composition-id] composition-id])
+	 (description
+	  (car (clsql:select [description] :from [|meredith-compositions|]
+			     :where where-clause :flatp t :field-names nil)))
+	 (db-events (apply #'clsql:select
+                           (append *event-attributes*
+                                   (list :from [|meredith-events|]
+                                         :order-by '(([event-id] :asc))
+                                         :where where-clause))))
+         (events nil))
+    (dolist (e db-events)
+      (push (db-event->meredith-event e) events))
+    (let* ((composition
+	    (make-meredith-composition :identifier identifier
+				       :description description)))
+      (sequence:adjust-sequence composition (length events)
+ 				:initial-contents (nreverse events))
+      composition))
+  #.(clsql:locally-disable-sql-reader-syntax))
+
+(defmethod copy-event (event)
+  (with-slots (identifier tatum-on tatum-dur tactus-on tactus-dur
+			  (time amuse::time)
+			  (interval amuse::interval) tatum-on-ms
+			  tatum-dur-ms beat-on-ms beat-dur-ms
+			  crot-on-ms crot-dur-ms pitch-name
+			  (midi-note-number amuse::number)
+			  (cp amuse::cp) (mp amuse::mp) voice) event
+    (make-meredith-event :identifier identifier
+			 :tatum-on tatum-on
+			 :tatum-dur tatum-dur
+			 :tactus-on tactus-on
+			 :tactus-dur tactus-dur
+			 :time time
+			 :interval interval
+			 :tatum-on-ms tatum-on-ms
+			 :tatum-dur-ms tatum-dur-ms
+			 :beat-on-ms beat-on-ms
+			 :beat-dur-ms beat-dur-ms
+			 :crot-on-ms crot-on-ms
+			 :crot-dur-ms crot-dur-ms
+			 :pitch-name pitch-name
+			 :number midi-note-number
+			 :cp cp
+			 :mp mp
+			 :voice voice)))
+
+(defmethod get-applicable-key-signatures ((event meredith-event)
+					  (composition
+					   meredith-composition))
+  nil)
+
+(defmethod get-applicable-key-signatures ((event meredith-composition)
+					  o)
+  nil)
+
+(defmethod get-applicable-time-signatures ((event meredith-event)
+					   (composition
+					    meredith-composition))
+    (make-standard-time-signature-period 4 4 0 (duration composition)))
+
+(defmethod time-signatures ((composition meredith-composition))
+  (list (make-standard-time-signature-period 4 4 0 (duration composition))))
+
+(defmethod crotchet ((event meredith-composition))
+  (amuse:make-standard-period 1))
+
+(defmethod crotchet ((event meredith-event))
+  (amuse:make-standard-period 1))
+
+(defmethod tempi ((composition meredith-composition))
+  (list (make-standard-tempo-period 120 0 88)))