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