Mercurial > hg > amuse

(cl:in-package #:amuse-meredith)

;;;=====================================================================
;;; Specialised constructors
;;;=====================================================================

(defmethod make-composition-identifier ((package (eql *package*))
				       composition-id)
  (make-meredith-composition-identifier composition-id))


;;;=====================================================================
;;; Specialized composition methods
;;;=====================================================================

(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
			     :database *amuse-database*)))
	 (composition (make-meredith-composition
		       :identifier identifier
		       :description description))
	 (db-events (apply #'clsql:select
                           (append *event-attributes*
                                   (list :from [|meredith-events|]
                                         :order-by '(([event-id] :asc))
                                         :where where-clause
					 :database *amuse-database*))))
         (events (loop for e in db-events
		    collect (db-event->meredith-event e composition))))
    (sequence:adjust-sequence composition (length events)
			      :initial-contents events))
  #.(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)))
author	j.forth <j.forth@gold.ac.uk>
date	Thu, 24 Feb 2011 11:23:18 +0000
parents	6f0881af3403
children