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