|
m@23
|
1 ;;; General purpose utilities
|
|
m@23
|
2
|
|
m@23
|
3 (cl:in-package #:amuse-utils)
|
|
m@23
|
4
|
|
d@33
|
5 ;; Booleans (for filters)
|
|
d@33
|
6 (defgeneric pitchedp (event)
|
|
d@33
|
7 (:method (e) (declare (ignore e)) nil))
|
|
d@33
|
8 (defmethod pitchedp ((event amuse:pitched-event))
|
|
d@33
|
9 T)
|
|
d@33
|
10 (defgeneric unpitchedp (event)
|
|
d@33
|
11 (:method (e) (not (pitchedp e))))
|
|
d@33
|
12
|
|
d@33
|
13 ;; Rhythm methods
|
|
d@33
|
14 (defgeneric crotchets-in-a-bar (time-signature))
|
|
d@33
|
15 (defmethod crotchets-in-a-bar ((time-signature basic-time-signature))
|
|
d@33
|
16 (let ((num (time-signature-numerator time-signature))
|
|
d@33
|
17 (den (time-signature-denominator time-signature)))
|
|
d@33
|
18 (* num (/ 4 den))))
|
|
d@33
|
19
|
|
d@33
|
20 ;; Pitch methods
|
|
d@33
|
21
|
|
d@33
|
22 (defgeneric sounding-events (anchored-period sequence))
|
|
d@33
|
23 (defmethod sounding-events ((anchored-period anchored-period)
|
|
d@33
|
24 (sequence composition))
|
|
d@33
|
25 (let ((sounding))
|
|
d@33
|
26 (sequence:dosequence (event sequence (reverse sounding))
|
|
d@33
|
27 (cond
|
|
d@33
|
28 ((time>= event (cut-off anchored-period))
|
|
d@33
|
29 (return-from sounding-events (reverse sounding)))
|
|
d@33
|
30 ((period-intersection anchored-period event)
|
|
d@33
|
31 (push event sounding))))))
|
|
d@33
|
32
|
|
d@33
|
33 (defgeneric midi-pitch-distribution (anchored-period composition))
|
|
d@33
|
34 (defmethod midi-pitch-distribution ((anchored-period anchored-period)
|
|
d@33
|
35 composition)
|
|
d@33
|
36 (let ((pitches (make-array 128 :initial-element 0)))
|
|
d@33
|
37 (dolist (event (remove-if #'unpitchedp (sounding-events anchored-period composition)) pitches)
|
|
d@33
|
38 (let ((overlap (period-intersection anchored-period event)))
|
|
d@33
|
39 (if overlap
|
|
d@33
|
40 (incf (aref pitches (midi-pitch-number event))
|
|
d@33
|
41 (duration overlap))
|
|
d@33
|
42 (if (= (duration event) 0)
|
|
d@33
|
43 (format t "~%Note ~D beats in has no duration" (timepoint event))
|
|
d@33
|
44 (error "This function has gone wrong - looking for overlaps that don't exist")))))))
|
|
d@33
|
45
|
|
d@33
|
46 (defgeneric pitch-class-distribution (anchored-period composition))
|
|
d@33
|
47 (defmethod pitch-class-distribution ((anchored-period anchored-period)
|
|
d@33
|
48 composition)
|
|
d@33
|
49 (let ((pitches (make-array 12 :initial-element 0)))
|
|
d@33
|
50 (dolist (event (remove-if #'unpitchedp (sounding-events anchored-period composition)) pitches)
|
|
d@33
|
51 (let ((overlap (period-intersection anchored-period event)))
|
|
d@33
|
52 (if overlap
|
|
d@33
|
53 (incf (aref pitches (pitch-class event))
|
|
d@33
|
54 (duration overlap))
|
|
d@33
|
55 (if (= (duration event) 0)
|
|
d@33
|
56 (format t "~%Note ~D beats in has no duration" (timepoint event))
|
|
d@33
|
57 (error "This function has gone wrong - looking for overlaps that don't exist")))))))
|
|
d@33
|
58
|
|
d@33
|
59 (defun normalised-midi-pitch-distribution (object1 object2)
|
|
d@33
|
60 (normalise-vector (midi-pitch-distribution object1 object2)))
|
|
d@33
|
61 (defun normalised-pitch-class-distribution (object1 object2)
|
|
d@33
|
62 (normalise-vector (pitch-class-distribution object1 object2)))
|
|
d@33
|
63 (defun normalise-vector (vector &optional (target-sum 1))
|
|
d@33
|
64 (let ((total (loop for i from 0 to (1- (length vector))
|
|
d@33
|
65 sum (aref vector i))))
|
|
d@33
|
66 (cond
|
|
d@33
|
67 ((= total target-sum)
|
|
d@33
|
68 vector)
|
|
d@33
|
69 ((= total 0)
|
|
d@33
|
70 (make-array (length vector)
|
|
d@33
|
71 :initial-element (/ target-sum (length vector))))
|
|
d@33
|
72 (t
|
|
d@33
|
73 (map 'vector #'(lambda (x) (* x (/ target-sum total))) vector)))))
|
|
d@33
|
74
|
|
d@33
|
75 ;; Not as simple as it seems - have to take into account numbering
|
|
d@33
|
76 ;; practices and leading silences in representations where bar number
|
|
d@33
|
77 ;; isn't part of the explicit structure.
|
|
d@33
|
78 (defgeneric bar-number (moment composition))
|
|
d@33
|
79
|
|
d@33
|
80 (defgeneric bass-note (anchored-period composition)) |
