view 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))