1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 (define-public (music-map function music)
4 "Apply @var{function} to @var{music} and all of the music it contains. "
5 (let* ((es (ly:get-mus-property music 'elements))
6 (e (ly:get-mus-property music 'element))
9 (ly:set-mus-property! music 'elements
10 (map (lambda (y) (music-map function y)) es))
12 (ly:set-mus-property! music 'element (music-map function e)))
16 (define-public (music-filter pred? music)
17 "Filter out music expressions that do not satisfy PRED."
19 (define (inner-music-filter pred? music)
21 (let* ((es (ly:get-mus-property music 'elements))
22 (e (ly:get-mus-property music 'element))
23 (as (ly:get-mus-property music 'articulations))
24 (filtered-as (filter ly:music? (map (lambda (y) (inner-music-filter pred? y)) as)))
25 (filtered-e (if (ly:music? e)
26 (inner-music-filter pred? e)
28 (filtered-es (filter ly:music? (map (lambda (y) (inner-music-filter pred? y)) es)))
31 (ly:set-mus-property! music 'element filtered-e)
32 (ly:set-mus-property! music 'elements filtered-es)
33 (ly:set-mus-property! music 'articulations filtered-as)
35 ;; if filtering emptied the expression, we remove it completely.
37 (and (eq? filtered-es '()) (not (ly:music? e))
38 (or (not (eq? es '()))
44 (set! music (inner-music-filter pred? music))
47 (make-music-by-name 'Music) ;must return music.
50 (define-public (remove-tag tag)
54 (let* ((tags (ly:get-mus-property m 'tags))
55 (res (memq tag tags)))
58 (define-public (display-music music)
59 "Display music, not done with music-map for clarity of presentation."
63 (let* ((es (ly:get-mus-property music 'elements))
64 (e (ly:get-mus-property music 'element))
67 (display (ly:get-mutable-properties music))
70 (begin (display "\nElements: {\n")
71 (map display-music es)
90 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
92 (define (shift-one-duration-log music shift dot)
93 " add SHIFT to ly:duration-log and optionally
94 a dot to any note encountered. This scales the music up by a factor
95 2^shift * (2 - (1/2)^dot)"
99 (d (ly:get-mus-property music 'duration))
103 (cp (ly:duration-factor d))
104 (nd (ly:make-duration (+ shift (ly:duration-log d))
105 (+ dot (ly:duration-dot-count d))
110 (ly:set-mus-property! music 'duration nd)
116 (define-public (shift-duration-log music shift dot)
117 (music-map (lambda (x) (shift-one-duration-log x shift dot))
121 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
124 (define-public (note-to-cluster music)
125 "Replace NoteEvents by ClusterNoteEvents."
126 (if (eq? (ly:get-mus-property music 'name) 'NoteEvent)
127 (let* ((cn (make-music-by-name 'ClusterNoteEvent)))
129 (ly:set-mus-property! cn 'pitch (ly:get-mus-property music 'pitch))
130 (ly:set-mus-property! cn 'duration (ly:get-mus-property music 'duration))
134 (define-public (notes-to-clusters music)
135 (music-map note-to-cluster music))
137 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
140 (define-public (unfold-repeats music)
142 This function replaces all repeats with unfold repeats. It was
143 written by Rune Zedeler. "
144 (let* ((es (ly:get-mus-property music 'elements))
145 (e (ly:get-mus-property music 'element))
146 (n (ly:music-name music)))
148 (if (equal? n "Repeated_music")
151 (ly:get-mus-property music 'iterator-ctor)
152 Chord_tremolo_iterator::constructor)
153 (shift-duration-log music (ly:intlog2 (ly:get-mus-property music 'repeat-count)) 0)
155 (ly:set-mus-property!
156 music 'length Repeated_music::unfolded_music_length)
157 (ly:set-mus-property!
158 music 'start-moment-function Repeated_music::first_start)
159 (ly:set-mus-property!
160 music 'iterator-ctor Unfolded_repeat_iterator::constructor)))
163 (ly:set-mus-property!
165 (map unfold-repeats es)))
168 (ly:set-mus-property!
175 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
176 ;; property setting music objs.
178 (define-public (make-grob-property-set grob gprop val)
180 "Make a Music expression that sets GPROP to VAL in GROB. Does a pop first,
181 i.e. this is not an override"
183 (let* ((m (make-music-by-name 'OverrideProperty)))
184 (ly:set-mus-property! m 'symbol grob)
185 (ly:set-mus-property! m 'grob-property gprop)
186 (ly:set-mus-property! m 'grob-value val)
187 (ly:set-mus-property! m 'pop-first #t)
192 (define-public (make-grob-property-override grob gprop val)
194 "Make a Music expression that sets GPROP to VAL in GROB. Does a pop first,
195 i.e. this is not an override"
197 (let* ((m (make-music-by-name 'OverrideProperty)))
198 (ly:set-mus-property! m 'symbol grob)
199 (ly:set-mus-property! m 'grob-property gprop)
200 (ly:set-mus-property! m 'grob-value val)
207 (define-public (make-grob-property-revert grob gprop)
208 "Revert the grob property GPROP for GROB."
209 (let* ((m (make-music-by-name 'OverrideProperty)))
210 (ly:set-mus-property! m 'symbol grob)
211 (ly:set-mus-property! m 'grob-property gprop)
217 (define direction-polyphonic-grobs
218 '(Tie Slur Script TextScript Stem Dots DotColumn))
220 (define-public (make-voice-props-set n)
221 (make-sequential-music
223 (map (lambda (x) (make-grob-property-set x 'direction
225 direction-polyphonic-grobs)
227 (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2))
228 (make-grob-property-set 'MultiMeasureRest 'staff-position
236 (define-public (make-voice-props-revert)
237 (make-sequential-music
239 (map (lambda (x) (make-grob-property-revert x 'direction))
240 direction-polyphonic-grobs)
242 (list (make-grob-property-revert 'NoteColumn 'horizontal-shift))
247 (define-public (context-spec-music m context . rest)
248 "Add \\context CONTEXT = foo to M. "
250 (let* ((cm (make-music-by-name 'ContextSpeccedMusic)))
251 (ly:set-mus-property! cm 'element m)
252 (ly:set-mus-property! cm 'context-type context)
253 (if (and (pair? rest) (string? (car rest)))
254 (ly:set-mus-property! cm 'context-id (car rest))
259 (define-public (make-apply-context func)
261 ((m (make-music-by-name 'ApplyContext)))
263 (ly:set-mus-property! m 'procedure func)
267 (define-public (make-sequential-music elts)
268 (let* ((m (make-music-by-name 'SequentialMusic)))
269 (ly:set-mus-property! m 'elements elts)
273 (define-public (make-simultaneous-music elts)
274 (let* ((m (make-music-by-name 'SimultaneousMusic)))
275 (ly:set-mus-property! m 'elements elts)
279 (define-public (make-event-chord elts)
280 (let* ((m (make-music-by-name 'EventChord)))
281 (ly:set-mus-property! m 'elements elts)
286 (define-public (make-nonevent-skip dur)
287 (let* ((m (make-music-by-name 'NonEventSkip)))
288 (ly:set-mus-property! m 'duration dur)
295 (define-public (make-multi-measure-rest duration location)
298 (start (make-music-by-name 'MultiMeasureRestEvent))
299 (ch (make-music-by-name 'BarCheck))
300 (ch2 (make-music-by-name 'BarCheck))
301 (seq (make-music-by-name 'MultiMeasureRestMusicGroup))
304 (map (lambda (x) (ly:set-mus-property! x 'origin location))
305 (list start ch ch2 seq))
306 (ly:set-mus-property! start 'duration duration)
307 (ly:set-mus-property! seq 'elements
310 (make-event-chord (list start))
317 (define-public (glue-mm-rest-texts music)
318 "Check if we have R1*4-\\markup { .. }, and if applicable convert to
319 a property set for MultiMeasureRestNumber."
321 (define (script-to-mmrest-text script-music)
322 "Extract 'direction and 'text from SCRIPT-MUSIC, and transform into property sets."
326 (text (ly:get-mus-property script-music 'text))
327 (dir (ly:get-mus-property script-music 'direction))
328 (p (make-music-by-name 'MultiMeasureTextEvent))
332 (ly:set-mus-property! p 'direction dir))
333 (ly:set-mus-property! p 'text text)
337 (if (eq? (ly:get-mus-property music 'name) 'MultiMeasureRestMusicGroup)
340 (text? (lambda (x) (memq 'script-event (ly:get-mus-property x 'types))))
341 (es (ly:get-mus-property music 'elements))
342 (texts (map script-to-mmrest-text (filter text? es)))
343 (others (remove text? es))
346 (ly:set-mus-property!
348 (cons (make-event-chord texts) others)
355 (define-public (make-property-set sym val)
358 (m (make-music-by-name 'PropertySet))
360 (ly:set-mus-property! m 'symbol sym)
361 (ly:set-mus-property! m 'value val)
367 (define-public (make-ottava-set octavation)
369 ((m (make-music-by-name 'ApplyContext)))
372 (define (ottava-modify context)
373 "Either reset centralCPosition to the stored original, or remember
374 old centralCPosition, add OCTAVATION to centralCPosition, and set
375 OTTAVATION to `8va', or whatever appropriate."
377 (if (number? (ly:get-context-property context 'centralCPosition))
381 ((where (ly:context-property-where-defined context 'centralCPosition))
382 (oc0 (ly:get-context-property context 'originalCentralCPosition)))
384 (ly:set-context-property! context 'centralCPosition oc0)
385 (ly:unset-context-property where 'originalCentralCPosition)
386 (ly:unset-context-property where 'ottavation))
389 ((where (ly:context-property-where-defined context 'centralCPosition))
390 (c0 (ly:get-context-property context 'centralCPosition))
391 (new-c0 (+ c0 (* -7 octavation)))
393 (assoc octavation '((2 . "15ma")
397 (-2 . "15ma bassa"))))))
399 (ly:set-context-property! context 'centralCPosition new-c0)
400 (ly:set-context-property! context 'originalCentralCPosition c0)
401 (ly:set-context-property! context 'ottavation string)
405 (ly:set-mus-property! m 'procedure ottava-modify)
406 (context-spec-music m 'Staff)
409 (define-public (set-octavation ottavation)
410 (ly:export (make-ottava-set ottavation)))
412 (define-public (make-time-signature-set num den . rest)
413 " Set properties for time signature NUM/DEN.
414 Rest can contain a list of beat groupings
420 (set1 (make-property-set 'timeSignatureFraction (cons num den) ))
421 (beat (ly:make-moment 1 den))
422 (len (ly:make-moment num den))
423 (set2 (make-property-set 'beatLength beat))
424 (set3 (make-property-set 'measureLength len))
425 (set4 (make-property-set 'beatGrouping (if (pair? rest)
428 (basic (list set1 set2 set3 set4)))
431 (make-sequential-music basic) 'Timing)))
433 (define-public (make-mark-set label)
434 "make the music for the \\mark command."
437 ((set (if (integer? label)
438 (context-spec-music (make-property-set 'rehearsalMark label)
441 (ev (make-music-by-name 'MarkEvent))
442 (ch (make-event-chord (list ev)))
447 (make-sequential-music (list set ch))
449 (ly:set-mus-property! ev 'label label)
454 (define-public (set-time-signature num den . rest)
455 (ly:export (apply make-time-signature-set `(,num ,den . ,rest))))
457 (define-public (make-penalty-music pen)
459 ((m (make-music-by-name 'BreakEvent)))
460 (ly:set-mus-property! m 'penalty pen)
463 (define-public (make-articulation name)
465 (m (make-music-by-name 'ArticulationEvent))
467 (ly:set-mus-property! m 'articulation-type name)
471 (define-public (make-lyric-event string duration)
472 (let* ((m (make-music-by-name 'LyricEvent)))
474 (ly:set-mus-property! m 'duration duration)
475 (ly:set-mus-property! m 'text string)
478 (define-public (make-span-event type spandir)
480 (m (make-music-by-name type))
482 (ly:set-mus-property! m 'span-direction spandir)
486 (define-public (set-mus-properties! m alist)
487 "Set all of ALIST as properties of M."
490 (ly:set-mus-property! m (caar alist) (cdar alist))
491 (set-mus-properties! m (cdr alist)))
496 (define-public (music-separator? m)
498 (let* ((ts (ly:get-mus-property m 'types )))
503 ;;; splitting chords into voices.
505 (define (voicify-list lst number)
506 "Make a list of Musics.
508 voicify-list :: [ [Music ] ] -> number -> [Music]
509 LST is a list music-lists.
513 (cons (context-spec-music
514 (make-sequential-music
516 (make-voice-props-set number)
517 (make-simultaneous-music (car lst))))
519 'Voice (number->string number))
520 (voicify-list (cdr lst) (+ number 1))
524 (define (voicify-chord ch)
525 "Split the parts of a chord into different Voices using separator"
526 (let* ((es (ly:get-mus-property ch 'elements)))
528 (ly:set-mus-property! ch 'elements
529 (voicify-list (split-list es music-separator?) 0))
533 (define (voicify-music m)
534 "Recursively split chords that are separated with \\ "
536 (if (not (ly:music? m))
538 (error "not music!"))
541 ((es (ly:get-mus-property m 'elements))
542 (e (ly:get-mus-property m 'element))
545 (ly:set-mus-property! m 'elements (map voicify-music es)))
547 (ly:set-mus-property! m 'element (voicify-music e)))
549 (and (equal? (ly:music-name m) "Simultaneous_music")
550 (reduce (lambda (x y ) (or x y)) #f (map music-separator? es)))
557 (define-public (empty-music)
558 (ly:export (make-music-by-name 'Music))
562 ; Make a function that checks score element for being of a specific type.
563 (define-public (make-type-checker symbol)
566 ;;(eq? #t (ly:get-grob-property elt symbol))
567 (not (eq? #f (memq symbol (ly:get-grob-property elt 'interfaces))))))
569 (define-public ((outputproperty-compatibility func sym val) grob g-context ao-context)
571 (ly:set-grob-property! grob sym val)))
574 (define-public ((set-output-property grob-name symbol val) grob grob-c context)
577 \\applyoutput #(set-output-property 'Clef 'extra-offset '(0 . 1))
582 ((meta (ly:get-grob-property grob 'meta)))
584 (if (equal? (cdr (assoc 'name meta)) grob-name)
585 (ly:set-grob-property! grob symbol val)
590 (define-public (smart-bar-check n)
591 "Make a bar check that checks for a specific bar number.
595 (m (make-music-by-name 'ApplyContext))
599 (let* ((bn (ly:get-context-property tr 'currentBarNumber)))
603 (format "Bar check failed, we should have reached ~a, instead at ~a\n"
607 (ly:set-mus-property! m 'procedure checker)
611 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
612 ;; warn for bare chords at start.
614 (define (has-request-chord elts)
615 (reduce (lambda (x y) (or x y)) #f (map (lambda (x) (equal? (ly:music-name x)
616 "Request_chord")) elts)
619 (define (ly:music-message music msg)
622 (ip (ly:get-mus-property music 'origin))
625 (if (ly:input-location? ip)
626 (ly:input-message ip msg)
630 (define (check-start-chords music)
631 "Check music expression for a Simultaneous_music containing notes\n(ie. Request_chords), without context specification. Called from parser."
634 ((es (ly:get-mus-property music 'elements))
635 (e (ly:get-mus-property music 'element))
636 (name (ly:music-name music))
640 ((equal? name "Context_specced_music") #t)
641 ((equal? name "Simultaneous_music")
643 (if (has-request-chord es)
644 (ly:music-message music "Starting score with a chord.\nPlease insert an explicit \\context before chord")
645 (map check-start-chords es)))
647 ((equal? name "Sequential_music")
649 (check-start-chords (car es))))
650 (else (if (ly:music? e) (check-start-chords e )))
658 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
660 ;; setting stuff for grace context.
663 (define (vector-extend v x)
664 "Make a new vector consisting of V, with X added to the end."
666 ((n (vector-length v))
667 (nv (make-vector (+ n 1) '())))
670 (vector-move-left! v 0 n nv 0)
675 (define (vector-map f v)
676 "Map F over V. This function returns nothing."
678 ((n (vector-length v))
682 (f (vector-ref v i))))
684 (define (vector-reverse-map f v)
685 "Map F over V, N to 0 order. This function returns nothing."
687 ((i (- (vector-length v) 1) (- i 1)))
690 (f (vector-ref v i))))
692 ;; TODO: make a remove-grace-property too.
693 (define-public (add-grace-property context-name grob sym val)
694 "Set SYM=VAL for GROB in CONTEXT-NAME. "
695 (define (set-prop context)
697 ((where (ly:context-property-where-defined context 'graceSettings))
698 (current (ly:get-context-property where 'graceSettings))
699 (new-settings (vector-extend current (list context-name grob sym val)))
701 (ly:set-context-property! where 'graceSettings new-settings)))
703 (ly:export (context-spec-music (make-apply-context set-prop) 'Voice)))
706 (define-public (set-start-grace-properties context)
707 (define (execute-1 x)
709 ((tr (ly:translator-find context (car x))))
712 (ly:context-pushpop-property tr (cadr x) (caddr x) (cadddr x))
716 ((props (ly:get-context-property context 'graceSettings)))
718 (vector-map execute-1 props))))
720 (define-public (set-stop-grace-properties context)
721 (define (execute-1 x)
723 ((tr (ly:translator-find context (car x))))
725 (ly:context-pushpop-property tr (cadr x) (caddr x))
729 ((props (ly:get-context-property context 'graceSettings)))
731 (vector-reverse-map execute-1 props))))
733 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
734 ;; switch it on here, so parsing and init isn't checked (too slow!)
736 ;; automatic music transformations.
738 (define (switch-on-debugging m)
739 (set-debug-cell-accesses! 15000)
742 (define-public toplevel-music-functions
744 ;; check-start-chords ; ; no longer needed with chord syntax.
746 (lambda (x) (music-map glue-mm-rest-texts x))
747 ; switch-on-debugging
756 (define (apply-durations lyric-music durations)
757 (define (apply-duration music)
758 (if (and (not (equal? (ly:music-length music) ZERO-MOMENT))
759 (ly:duration? (ly:get-mus-property music 'duration)))
761 (ly:set-mus-property! music 'duration (car durations))
762 (set! durations (cdr durations))
765 (music-map apply-duration lyric-music))
768 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
772 (define-public ((add-balloon-text object-name text off) grob orig-context cur-context)
773 "Usage: see input/regression/balloon.ly "
775 ((meta (ly:get-grob-property grob 'meta))
776 (nm (if (pair? meta) (cdr (assoc 'name meta)) "nonexistant"))
777 (cb (ly:get-grob-property grob 'molecule-callback)))
779 (if (equal? nm object-name)
781 (ly:set-grob-property! grob 'molecule-callback Balloon_interface::brew_molecule)
782 (ly:set-grob-property! grob 'balloon-original-callback cb)
783 (ly:set-grob-property! grob 'balloon-text text)
784 (ly:set-grob-property! grob 'balloon-text-offset off)
785 (ly:set-grob-property! grob 'balloon-text-props '((font-family . roman)))
790 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
796 (define part-combine-listener '())
797 (define-public (set-part-combine-listener x)
798 (set! part-combine-listener x))
800 (define-public (notice-the-events-for-pc context lst)
801 (set! noticed (acons (ly:context-id context) lst noticed)))
803 (define-public (make-new-part-combine-music music-list)
805 ((m (make-music-by-name 'NewPartCombineMusic))
806 (m1 (context-spec-music (car music-list) 'Voice "one"))
807 (m2 (context-spec-music (cadr music-list) 'Voice "two"))
808 (props '((denies Thread)
809 (consists Rest_engraver)
810 (consists Note_heads_engraver)
813 (ly:set-mus-property! m 'elements (list m1 m2))
814 (ly:set-mus-property! m1 'property-operations props)
815 (ly:set-mus-property! m2 'property-operations props)
816 (ly:run-translator m2 part-combine-listener)
817 (ly:run-translator m1 part-combine-listener)
818 (ly:set-mus-property! m 'split-list
819 (determine-split-list (reverse (cdr (assoc "one" noticed)))
820 (reverse (cdr (assoc "two" noticed)))))
828 ;; due to a bug in the GUILE evaluator,
829 ;; stack traces result in core dumps.
830 ;; therefore we retain debugging code.
834 ;; todo: this is too hairy.
836 (define-public (determine-split-list evl1 evl2)
837 "EVL1 and EVL2 should be ascending"
839 (define ev1 (list->vector evl1))
840 (define ev2 (list->vector evl2))
842 (car (vector-ref v i)))
844 (cdr (vector-ref v i)))
846 (define chord-threshold 8)
847 (define (get-note-evs v i)
849 (equal? (ly:get-mus-property x 'name) 'NoteEvent))
850 (filter f? (map car (what v i))))
857 (merge (map car evl1) (map car evl2) ly:moment<?)))))
859 (define (analyse-time-step i1 i2 ri
863 (define (analyse-tie-start active ev)
864 (if (equal? (ly:get-mus-property ev 'name) 'TieEvent)
865 (acons 'tie ri active)
869 (define (analyse-tie-end active ev)
870 (if (equal? (ly:get-mus-property ev 'name) 'NoteEvent)
871 (assoc-remove! active 'tie)
874 (define (active<? a b)
876 ((symbol<? (car a) (car b)) #t)
877 ((symbol<? (car b) (car b)) #f)
882 (define (analyse-span-event active ev)
884 ((name (ly:get-mus-property ev 'name))
886 ((equal? name 'SlurEvent) 'slur)
887 ((equal? name 'PhrasingSlurEvent) 'tie)
888 ((equal? name 'BeamEvent) 'beam)
889 ((equal? name 'CrescendoEvent) 'cresc)
890 ((equal? name 'DecrescendoEvent) 'decr)
892 (sp (ly:get-mus-property ev 'span-direction))
895 (if (and (symbol? key) (ly:dir? sp))
897 (assoc-remove! active key)
898 (acons key ri active))
902 (define (analyse-events active evs)
903 (define (helper analyzer active evs)
905 (helper analyzer (analyzer active (car evs)) (cdr evs))
909 (helper analyse-span-event
910 (helper analyse-tie-start
911 (helper analyse-tie-end active evs) evs) evs)
915 (define (put x . index)
916 "Put the result to X, starting from INDEX backwards."
918 ((i (if (pair? index) (car index) ri)))
920 (if (and (<= 0 i) (not (symbol? (what result i))))
922 (set-cdr! (vector-ref result i) x)
929 ((= ri (vector-length result)) '())
930 ((= i1 (vector-length ev1)) (put 'apart))
931 ((= i2 (vector-length ev2)) (put 'apart))
935 ; (x (display (list "\nelse" (= i1 (vector-length ev1)) i2 (vector-length ev2) (= i2 (vector-length ev2)))))
938 ; (x (display "oked"))
939 (evs1 (map car (what ev1 i1)))
940 (evs2 (map car (what ev2 i2)))
941 (new-active1 (analyse-events active1 evs1))
942 (new-active2 (analyse-events active2 evs2))
946 (or #t (display (list (when result ri) i1 i2 ri
947 active1 "->" new-active1
948 active2 "->" new-active2
949 (vector-length ev1) (vector-length ev2) (vector-length result) "\n")))
952 (if (not (or (equal? m1 (when result ri))
953 (equal? m2 (when result ri))))
956 (list "<? M1,M2 != result :"
957 m1 m2 (when result ri)))
963 (if (> ri 0) (put 'apart (1- ri)))
964 (analyse-time-step (1+ i1) i2 (1+ ri) new-active1 active2))
967 (if (> ri 0) (put 'apart (1- ri)))
968 (analyse-time-step i1 (1+ i2) (1+ ri) active1 new-active2))
970 (if (and (equal? active1 active2) (equal? new-active2 new-active1))
972 ((notes1 (get-note-evs ev1 i1))
973 (durs1 (sort (map (lambda (x) (ly:get-mus-property x 'duration)) notes1) ly:duration<?))
975 (map (lambda (x) (ly:get-mus-property x 'pitch)) notes1) ly:pitch<?))
976 (notes2 (get-note-evs ev2 i2))
977 (durs2 (sort (map (lambda (x) (ly:get-mus-property x 'duration)) notes2) ly:duration<?))
979 (map (lambda (x) (ly:get-mus-property x 'pitch)) notes2) ly:pitch<?))
982 ((> (length notes1) 1) (put 'apart))
983 ((> (length notes2) 1) (put 'apart))
984 ((not (= (length notes1) (length notes2)))
989 (not (equal? (car durs1) (car durs2))))
993 (if (and (= (length pitches1) (length pitches2)))
995 (and (pair? pitches1) (pair? pitches2)
996 (< chord-threshold (ly:pitch-steps
997 (ly:pitch-diff (car pitches1) (car pitches2)))))
1001 ;; copy previous split state from spanner state
1003 (map (lambda (key-idx)
1005 ((idx (cdr key-idx))
1006 (prev (what result idx))
1010 )) (append active1 active2))
1011 (if (and (null? new-active1) (null? new-active2))
1016 ;; active states different:
1018 (analyse-time-step (1+ i1) (1+ i2) (1+ ri) new-active1 new-active2)))
1022 (define (analyse-solo12 i1 i2 ri)
1024 ((= ri (vector-length result)) '())
1025 ((= i1 (vector-length ev1)) '())
1026 ((= i2 (vector-length ev2)) '())
1032 (notes1 (get-note-evs ev1 i1))
1033 (durs1 (sort (map (lambda (x) (ly:get-mus-property x 'duration)) notes1) ly:duration<?))
1035 (map (lambda (x) (ly:get-mus-property x 'pitch)) notes1) ly:pitch<?))
1036 (notes2 (get-note-evs ev2 i2))
1037 (durs2 (sort (map (lambda (x) (ly:get-mus-property x 'duration)) notes2) ly:duration<?))
1039 (map (lambda (x) (ly:get-mus-property x 'pitch)) notes2) ly:pitch<?))
1042 (if (equal? (what result ri) 'apart)
1044 ((and (= 0 (length notes1))
1045 (< 0 (length notes2)))
1046 (set-cdr! (vector-ref result ri) 'solo2))
1047 ((and (< 0 (length notes1))
1048 (= 0 (length notes2)))
1049 (set-cdr! (vector-ref result ri) 'solo1))
1053 (equal? (what result ri) 'chords)
1055 (equal? pitches1 pitches2))
1056 (set-cdr! (vector-ref result ri) 'unisono) )
1059 ((ly:moment<? m1 m2)
1060 (analyse-solo12 (1+ i1) i2 (1+ ri) ))
1061 ((ly:moment<? m2 m1)
1062 (analyse-solo12 i1 (1+ i2) (1+ ri) ))
1064 (analyse-solo12 (1+ i1) (1+ i2) (1+ ri)))
1067 (analyse-time-step 0 0 0 '() '())
1068 (analyse-solo12 0 0 0)
1070 (vector->list result))