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