# HG changeset patch
# User Thomas Praetzlich <io901tp@gold.ac.uk>
# Date 1275908244 -3600
# Node ID 51389b0db7fee66418e706e79a9d601923a92af6
# Parent  376357c84189de134bf4edf3fe866428469fccdc
Constructor for diatonic pitch intervals

Ignore-this: 2a9c7d2c4972b19a2b88ee3a7d25c032

darcs-hash:20100607105724-13bc2-c8c542edf11defdacc53ff53320413e251c472c5.gz

diff -r 376357c84189 -r 51389b0db7fe base/constructors.lisp
--- a/base/constructors.lisp	Mon Jun 07 11:54:00 2010 +0100
+++ b/base/constructors.lisp	Mon Jun 07 11:57:24 2010 +0100
@@ -58,6 +58,20 @@
 (defun make-mips-pitch-interval (cspan mspan)
   (make-instance 'diatonic-pitch-interval :span (list cspan mspan)))
 
+(defun make-diatonic-pitch-interval (interval accidentals)
+  "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"
+(let*
+    ((direction (signum interval))                         ; -1:falling interval, +1:raising interval , 0: undefined interval
+     (octave (floor (/ (abs interval) 8)))                 ; determines the ocatve of the interval
+     (ref-pitch (make-diatonic-pitch #\C 0 0))             ; use reference pitch for the calculation later
+     (pitch-name                                           ; calculate pitch from interval according to reference pitch
+      (elt "CDEFGAB" (mod (1- (abs interval)) 7)))
+     (diatonic-interval (pitch- (make-diatonic-pitch pitch-name accidentals octave) ref-pitch)))  ; calculate interval
+  (cond ((> direction 0) diatonic-interval)                         ; raising interval
+	((< direction 0) (pitch- (make-instance 'amuse:diatonic-pitch-interval :span '(0 0)) diatonic-interval)) ; falling interval
+	((= direction 0)  (error 'invalid-argument :function 'make-diatonic-pitch-interval
+				 :argument "inverval = 0" )))))  ; the constructor is not defined if interval = 0
+
 ;; Events
 
 (defun make-chromatic-pitched-event (pitch-number onset duration)
diff -r 376357c84189 -r 51389b0db7fe base/package.lisp
--- a/base/package.lisp	Mon Jun 07 11:54:00 2010 +0100
+++ b/base/package.lisp	Mon Jun 07 11:57:24 2010 +0100
@@ -129,6 +129,7 @@
 	   #:make-standard-anchored-period
 	   #:make-chromatic-pitch
 	   #:make-diatonic-pitch
+	   #:make-diatonic-pitch-interval
 	   #:make-chromatic-pitch-interval
 	   #:make-chromatic-pitched-event
 	   #:make-standard-time-signature