comparison utils/utils.lisp @ 33:d1010755f507

Large upload of local changes. Many additions, such as harmony and piece-level objects

darcs-hash:20070413100909-f76cc-a8aa8dfc07f438dc0c1a7c45cee7ace2ecc1e6a5.gz

 ;;; General purpose utilities 
 
 (cl:in-package #:amuse-utils) 
 
+;; Booleans (for filters)
+(defgeneric pitchedp (event)
+  (:method (e) (declare (ignore e)) nil))
+(defmethod pitchedp ((event amuse:pitched-event))
+  T)
+(defgeneric unpitchedp (event)
+  (:method (e) (not (pitchedp e))))
+
+;; Rhythm methods
+(defgeneric crotchets-in-a-bar (time-signature))
+(defmethod crotchets-in-a-bar ((time-signature basic-time-signature))
+  (let ((num (time-signature-numerator time-signature))
+	(den (time-signature-denominator time-signature)))
+    (* num (/ 4 den))))
+
+;; Pitch methods
+
+(defgeneric sounding-events (anchored-period sequence))
+(defmethod sounding-events ((anchored-period anchored-period)
+			    (sequence composition))
+  (let ((sounding))
+    (sequence:dosequence (event sequence (reverse sounding))
+      (cond
+	((time>= event (cut-off anchored-period))
+	 (return-from sounding-events (reverse sounding)))
+	((period-intersection anchored-period event)
+	 (push event sounding))))))
+
+(defgeneric midi-pitch-distribution (anchored-period composition))
+(defmethod midi-pitch-distribution ((anchored-period anchored-period)
+				    composition)
+  (let ((pitches (make-array 128 :initial-element 0)))
+    (dolist (event (remove-if #'unpitchedp (sounding-events anchored-period composition)) pitches)
+      (let ((overlap (period-intersection anchored-period event)))
+	(if overlap
+	    (incf (aref pitches (midi-pitch-number event))
+		  (duration overlap))
+	    (if (= (duration event) 0)
+		(format t "~%Note ~D beats in has no duration" (timepoint event))
+		(error "This function has gone wrong - looking for overlaps that don't exist")))))))
+
+(defgeneric pitch-class-distribution (anchored-period composition))
+(defmethod pitch-class-distribution ((anchored-period anchored-period)
+				     composition)
+  (let ((pitches (make-array 12 :initial-element 0)))
+    (dolist (event (remove-if #'unpitchedp (sounding-events anchored-period composition)) pitches)
+      (let ((overlap (period-intersection anchored-period event)))
+	(if overlap
+	    (incf (aref pitches (pitch-class event))
+		  (duration overlap))
+	    (if (= (duration event) 0)
+		(format t "~%Note ~D beats in has no duration" (timepoint event))
+		(error "This function has gone wrong - looking for overlaps that don't exist")))))))
+
+(defun normalised-midi-pitch-distribution (object1 object2)
+  (normalise-vector (midi-pitch-distribution object1 object2)))
+(defun normalised-pitch-class-distribution (object1 object2)
+  (normalise-vector (pitch-class-distribution object1 object2)))
+(defun normalise-vector (vector &optional (target-sum 1))
+  (let ((total (loop for i from 0 to (1- (length vector))
+		  sum (aref vector i))))
+    (cond
+      ((= total target-sum)
+       vector)
+      ((= total 0)
+       (make-array (length vector)
+		   :initial-element (/ target-sum (length vector))))
+      (t
+       (map 'vector #'(lambda (x) (* x (/ target-sum total))) vector)))))
+
+;; Not as simple as it seems - have to take into account numbering
+;; practices and leading silences in representations where bar number
+;; isn't part of the explicit structure.
+(defgeneric bar-number (moment composition))
+
+(defgeneric bass-note (anchored-period composition))