m@24: (cl:in-package #:amuse)
m@24: 
m@24: ;; Time classes
m@24: 
d@136: (defun make-standard-moment (time)
d@136:   "Returns a new standard-moment, taking a number as input for
d@136: the time point."
d@139:   (make-instance 'standard-moment :time time))
m@24: 
m@24: ;; N.B. period should never be constructed directly - it's either
m@24: ;; floating or anchored or some other subclass.
m@24: 
d@136: (defun make-standard-period (interval)
d@136:   "Returns a new (floating) period, taking a number for the
d@134: duration."
d@136:   (make-instance 'standard-period :interval interval))
m@24: 
d@33: 
d@33: ;; Should this take a moment and/or a period too?
d@136: (defun make-standard-anchored-period (onset interval)
d@134:   "Returns a new floating-period, taking numbers for onset and
d@134: duration."
d@136:   (make-instance 'standard-anchored-period
m@24: 		 :time onset
m@24: 		 :interval interval))
m@24: 
m@24: ;; Pitch classes (no, not that sort of pitch class)
m@24: 
m@24: (defun make-chromatic-pitch (pitch-number)
d@134: "Returns a new chromatic pitch, taking a number for the
d@134: pitch."
m@24:   (make-instance 'chromatic-pitch :number pitch-number))
m@24: 
m@24: (defun make-diatonic-pitch (name accidental octave)
d@134:   "Returns a new diatonic pitch, taking as input a character for the name,
d@134: a positive or negative number for the accidental (+ve for sharps,
d@134: -ve for flats) and another for octave. (Is this description right?)"
c@106:   (flet ((asa-string (name accidental octave)
c@106:            (with-output-to-string (s)
c@106:              (write-char name s)
c@106:              (if (zerop accidental)
c@106:                  (write-char #\n s)
c@106:                  (let ((achar (if (plusp accidental) #\s #\f)))
c@106:                    (dotimes (i (abs accidental))
c@106:                      (write-char achar s))))
c@106:              (write octave :stream s :base 10 :radix nil :pretty nil))))
c@106:     (let* ((name (if (numberp name) (elt "ABCDEFG" name) name))
c@106:            (asa-string (asa-string name accidental octave))
c@106:            (p (mips:pn-p asa-string)))
c@109:       (make-instance 'diatonic-pitch :cp (first p) :mp (second p)))))
m@24: 
m@81: (defun make-mips-pitch (cp mp)
c@109:   (make-instance 'diatonic-pitch :cp cp :mp mp))
m@81: 
c@105: (defun make-chromatic-pitch-interval (span)
m@113:   (make-instance 'chromatic-pitch-interval :span span))
m@24: 
c@111: (defun make-mips-pitch-interval (cspan mspan)
c@111:   (make-instance 'diatonic-pitch-interval :span (list cspan mspan)))
c@111: 
io901tp@322: (defun make-diatonic-pitch-interval (interval accidentals)
io901tp@322:   "Returns a diatonic pitch interval given a number for the interval which corresponds to a major/perfect diatonic interval (unison=1,second=2,third=3, ...), if accidentals=0. If accidental>0 (<0), the interval is modified by |accidentals| sharps (flats). The sign of the given interval number determines whether the interval is raising or falling"
io901tp@322: (let*
io901tp@322:     ((direction (signum interval))                         ; -1:falling interval, +1:raising interval , 0: undefined interval
io901tp@322:      (octave (floor (/ (abs interval) 8)))                 ; determines the ocatve of the interval
io901tp@322:      (ref-pitch (make-diatonic-pitch #\C 0 0))             ; use reference pitch for the calculation later
io901tp@322:      (pitch-name                                           ; calculate pitch from interval according to reference pitch
io901tp@322:       (elt "CDEFGAB" (mod (1- (abs interval)) 7)))
io901tp@322:      (diatonic-interval (pitch- (make-diatonic-pitch pitch-name accidentals octave) ref-pitch)))  ; calculate interval
io901tp@322:   (cond ((> direction 0) diatonic-interval)                         ; raising interval
io901tp@322: 	((< direction 0) (pitch- (make-instance 'amuse:diatonic-pitch-interval :span '(0 0)) diatonic-interval)) ; falling interval
io901tp@322: 	((= direction 0)  (error 'invalid-argument :function 'make-diatonic-pitch-interval
io901tp@322: 				 :argument "inverval = 0" )))))  ; the constructor is not defined if interval = 0
io901tp@322: 
m@24: ;; Events
m@24: 
m@24: (defun make-chromatic-pitched-event (pitch-number onset duration)
j@282:   (make-instance 'standard-chromatic-pitched-event
m@24: 		 :number pitch-number
m@24: 		 :time onset
m@24: 		 :interval duration))
m@24: 
d@136: (defun make-standard-time-signature (numerator denominator)
d@136:   (make-instance 'standard-time-signature
d@136: 		 :numerator numerator
d@136: 		 :denominator denominator))
d@136: 
d@136: (defun make-standard-time-signature-period (numerator denominator onset duration)
d@136:   (make-instance 'standard-time-signature-period
m@24: 		 :numerator numerator
m@24: 		 :denominator denominator
m@24: 		 :time onset
m@24: 		 :interval duration))
m@24: 
d@136: (defun make-standard-key-signature (sharp-count)
d@136:   (make-instance 'standard-key-signature
d@136: 		 :sharp-count sharp-count))
d@136: 
d@136: (defun make-standard-key-signature-period (sharp-count onset duration)
d@136:   (make-instance 'standard-key-signature-period
m@24: 		 :sharp-count sharp-count
m@24: 		 :time onset
m@24: 		 :interval duration))
m@24: 
d@136: (defun make-midi-key-signature (sharp-count mode)
m@40:   (make-instance 'midi-key-signature
m@40: 		 :sharp-count sharp-count
d@136: 		 :mode mode))
d@136: 
d@136: (defun make-midi-key-signature-period (sharp-count mode onset duration)
d@136:   (make-instance 'midi-key-signature-period
d@136: 		 :sharp-count sharp-count
m@40: 		 :mode mode
m@40: 		 :time onset
m@40: 		 :interval duration))
m@40: 
d@136: (defun make-standard-tempo (bpm)
d@136:   (make-instance 'standard-tempo
d@137: 		 :bpm bpm))
d@136: 
d@136: (defun make-standard-tempo-period (bpm onset duration)
d@136:   (make-instance 'standard-tempo-period
d@136: 		 :bpm bpm
d@136: 		 :time onset
d@136: 		 :interval duration))
d@174: 
d@174: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
d@174: ;;
d@174: ;; Experimental:
d@174: ;;
d@174: 
d@174: (defun make-standard-clef-period (type line onset duration &key octave-shift)
d@174:   "Constructor for standard-clef-periods"
d@174:   (make-instance 'standard-clef-period
d@174:                  :type type
d@174:                  :line line
d@174:                  :octave-shift octave-shift
d@174:                  :time onset
d@174:                  :interval duration))
d@174: 
d@174: (defun make-standard-treble-clef-period (onset duration)
d@174:   "Convenience function for making treble clefs"
d@174:   (make-instance 'standard-clef-period
d@174:                  :type :G
d@174:                  :line 2
d@174:                  :octave-shift nil
d@174:                  :time onset
d@174:                  :interval duration))
d@174: 
d@174: (defun make-standard-bass-clef-period (onset duration)
d@174:   "Convenience function for making bass clefs"
d@174:   (make-instance 'standard-clef-period
d@174:                  :type :F
d@174:                  :line 4
d@174:                  :octave-shift nil
d@174:                  :time onset
d@174:                  :interval duration))
d@174: 
d@174: (defun make-standard-alto-clef-period (onset duration)
d@174:   "Convenience function for making alto clefs"
d@174:   (make-instance 'standard-clef-period
d@174:                  :type :C
d@174:                  :line 3
d@174:                  :octave-shift nil
d@174:                  :time onset
j@282:                  :interval duration))