view base/constructors.lisp @ 282:1499e5d1b8a7

fix make-chromatic-pitched-event constructor

Ignore-this: 93298c4a64a4a65dc948f8473c92a9c8

darcs-hash:20090524152250-16a00-295d43f8c2d16089196ab223b43264ae55f5620b.gz

(cl:in-package #:amuse)

;; Time classes

(defun make-standard-moment (time)
  "Returns a new standard-moment, taking a number as input for
the time point."
  (make-instance 'standard-moment :time time))

;; N.B. period should never be constructed directly - it's either
;; floating or anchored or some other subclass.

(defun make-standard-period (interval)
  "Returns a new (floating) period, taking a number for the
duration."
  (make-instance 'standard-period :interval interval))


;; Should this take a moment and/or a period too?
(defun make-standard-anchored-period (onset interval)
  "Returns a new floating-period, taking numbers for onset and
duration."
  (make-instance 'standard-anchored-period
		 :time onset
		 :interval interval))

;; Pitch classes (no, not that sort of pitch class)

(defun make-chromatic-pitch (pitch-number)
"Returns a new chromatic pitch, taking a number for the
pitch."
  (make-instance 'chromatic-pitch :number pitch-number))

(defun make-diatonic-pitch (name accidental octave)
  "Returns a new diatonic pitch, taking as input a character for the name,
a positive or negative number for the accidental (+ve for sharps,
-ve for flats) and another for octave. (Is this description right?)"
  (flet ((asa-string (name accidental octave)
           (with-output-to-string (s)
             (write-char name s)
             (if (zerop accidental)
                 (write-char #\n s)
                 (let ((achar (if (plusp accidental) #\s #\f)))
                   (dotimes (i (abs accidental))
                     (write-char achar s))))
             (write octave :stream s :base 10 :radix nil :pretty nil))))
    (let* ((name (if (numberp name) (elt "ABCDEFG" name) name))
           (asa-string (asa-string name accidental octave))
           (p (mips:pn-p asa-string)))
      (make-instance 'diatonic-pitch :cp (first p) :mp (second p)))))

(defun make-mips-pitch (cp mp)
  (make-instance 'diatonic-pitch :cp cp :mp mp))

(defun make-chromatic-pitch-interval (span)
  (make-instance 'chromatic-pitch-interval :span span))

(defun make-mips-pitch-interval (cspan mspan)
  (make-instance 'diatonic-pitch-interval :span (list cspan mspan)))

;; Events

(defun make-chromatic-pitched-event (pitch-number onset duration)
  (make-instance 'standard-chromatic-pitched-event
		 :number pitch-number
		 :time onset
		 :interval duration))

(defun make-standard-time-signature (numerator denominator)
  (make-instance 'standard-time-signature
		 :numerator numerator
		 :denominator denominator))

(defun make-standard-time-signature-period (numerator denominator onset duration)
  (make-instance 'standard-time-signature-period
		 :numerator numerator
		 :denominator denominator
		 :time onset
		 :interval duration))

(defun make-standard-key-signature (sharp-count)
  (make-instance 'standard-key-signature
		 :sharp-count sharp-count))

(defun make-standard-key-signature-period (sharp-count onset duration)
  (make-instance 'standard-key-signature-period
		 :sharp-count sharp-count
		 :time onset
		 :interval duration))

(defun make-midi-key-signature (sharp-count mode)
  (make-instance 'midi-key-signature
		 :sharp-count sharp-count
		 :mode mode))

(defun make-midi-key-signature-period (sharp-count mode onset duration)
  (make-instance 'midi-key-signature-period
		 :sharp-count sharp-count
		 :mode mode
		 :time onset
		 :interval duration))

(defun make-standard-tempo (bpm)
  (make-instance 'standard-tempo
		 :bpm bpm))

(defun make-standard-tempo-period (bpm onset duration)
  (make-instance 'standard-tempo-period
		 :bpm bpm
		 :time onset
		 :interval duration))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Experimental:
;;

(defun make-standard-clef-period (type line onset duration &key octave-shift)
  "Constructor for standard-clef-periods"
  (make-instance 'standard-clef-period
                 :type type
                 :line line
                 :octave-shift octave-shift
                 :time onset
                 :interval duration))

(defun make-standard-treble-clef-period (onset duration)
  "Convenience function for making treble clefs"
  (make-instance 'standard-clef-period
                 :type :G
                 :line 2
                 :octave-shift nil
                 :time onset
                 :interval duration))

(defun make-standard-bass-clef-period (onset duration)
  "Convenience function for making bass clefs"
  (make-instance 'standard-clef-period
                 :type :F
                 :line 4
                 :octave-shift nil
                 :time onset
                 :interval duration))

(defun make-standard-alto-clef-period (onset duration)
  "Convenience function for making alto clefs"
  (make-instance 'standard-clef-period
                 :type :C
                 :line 3
                 :octave-shift nil
                 :time onset
                 :interval duration))