Left: | ||
Right: |
LEFT | RIGHT |
---|---|
1 ;;;; This file is part of LilyPond, the GNU music typesetter. | 1 ;;;; This file is part of LilyPond, the GNU music typesetter. |
2 ;;;; | 2 ;;;; |
3 ;;;; Copyright (C) 2004--2010 Han-Wen Nienhuys <hanwen@xs4all.nl> | 3 ;;;; Copyright (C) 2004--2010 Han-Wen Nienhuys <hanwen@xs4all.nl> |
4 ;;;; | 4 ;;;; |
5 ;;;; LilyPond is free software: you can redistribute it and/or modify | 5 ;;;; LilyPond is free software: you can redistribute it and/or modify |
6 ;;;; it under the terms of the GNU General Public License as published by | 6 ;;;; it under the terms of the GNU General Public License as published by |
7 ;;;; the Free Software Foundation, either version 3 of the License, or | 7 ;;;; the Free Software Foundation, either version 3 of the License, or |
8 ;;;; (at your option) any later version. | 8 ;;;; (at your option) any later version. |
9 ;;;; | 9 ;;;; |
10 ;;;; LilyPond is distributed in the hope that it will be useful, | 10 ;;;; LilyPond is distributed in the hope that it will be useful, |
(...skipping 248 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... | |
259 m)) | 259 m)) |
260 | 260 |
261 (define-public (determine-split-list evl1 evl2) | 261 (define-public (determine-split-list evl1 evl2) |
262 "EVL1 and EVL2 should be ascending" | 262 "EVL1 and EVL2 should be ascending" |
263 (let* ((pc-debug #f) | 263 (let* ((pc-debug #f) |
264 (chord-threshold 8) | 264 (chord-threshold 8) |
265 (voice-state-vec1 (make-voice-states evl1)) | 265 (voice-state-vec1 (make-voice-states evl1)) |
266 (voice-state-vec2 (make-voice-states evl2)) | 266 (voice-state-vec2 (make-voice-states evl2)) |
267 (result (make-split-state voice-state-vec1 voice-state-vec2))) | 267 (result (make-split-state voice-state-vec1 voice-state-vec2))) |
268 | 268 |
269 ;; Go through all moments recursively and check if the events of that· | 269 ;; Go through all moments recursively and check if the events of that |
Neil Puttock
2010/09/16 19:59:00
The indentation throughout this new code is poor.
| |
270 ;; moment contain a partcombine override, i.e. a \set partcombineForced=...· | 270 ;; moment contain a part-combine-force-event override. If so, store its· |
271 ;; event. If so, store its value in the forced-configuration field, which | 271 ;; value in the forced-configuration field, which will override. The· |
272 ;; will override configuration | 272 ;; previous configuration is used to determine non-terminated settings. |
273 ;; The previous configuration is used to determine non-terminated settings | 273 (define (analyse-forced-combine result-idx prev-res) |
274 (define (analyse-forced-combine result-idx prev-res prev-voices) | 274 |
275 | 275 (define (get-forced-event x) |
276 ;; part-combine-events: extract only set/unsetProperty events | 276 (if (ly:in-event-class? x 'part-combine-force-event) |
277 (cons (ly:event-property x 'forced-type) (ly:event-property x 'once) ) | |
278 #f)) | |
277 (define (part-combine-events vs) | 279 (define (part-combine-events vs) |
278 » (define (f? x) | 280 (if (not vs) |
Neil Puttock
2010/09/16 19:59:00
needs a more descriptive name
| |
279 » (and· | 281 '() |
280 » (or (equal? (ly:event-property x 'class) 'SetProperty) | 282 (filter-map get-forced-event (events vs)))) |
281 » (equal? (ly:event-property x 'class) 'UnsetProperty)) | |
Neil Puttock
2010/09/16 19:59:00
(or (ly:in-event-class? x 'SetProperty)
(ly:in
| |
282 » (equal? (ly:event-property x 'symbol) 'partCombineForced))) | |
283 » (if vs (filter f? (events vs)) '())) | |
284 ;; end part-combine-events | 283 ;; end part-combine-events |
285 | 284 |
286 ;; forced-combine-result: Take the previous config for one voice and | 285 ;; forced-result: Take the previous config and analyse whether· |
287 ;; analyse whether any change happened.... Return new config and whether· | 286 ;; any change happened.... Return new once and permanent config |
288 ;; it has changed. | 287 (define (forced-result evt state) |
289 (define (forced-combine-result evs prev) | 288 ;; sanity check, evt should always be (new-state . once) |
290 (define (new-val x) | 289 (if (not (and (pair? evt) (pair? state))) |
291 (if (equal? (ly:event-property x 'class) 'UnsetProperty)· | 290 state |
Neil Puttock
2010/09/16 19:59:00
(ly:in-event-class? x 'UnsetProperty)
| |
292 #f | 291 (if (cdr evt) |
293 (ly:event-property x 'value))) | 292 ;; Once-event, leave permanent state unchanged |
294 ;; end new-val | 293 (cons (car evt) (cdr state)) |
295 (if (pair? evs) | 294 ;; permanent change, leave once state unchanged |
296 (let* ((res (car (map new-val (reverse evs))))) | 295 (cons (car state) (car evt))))) |
Neil Puttock
2010/09/16 19:59:00
let
| |
297 (cons res (not (equal? res prev)))) | |
298 (cons prev #f))) | |
299 ;; end forced-combine-result | 296 ;; end forced-combine-result |
300 | |
301 ;; Merge the two forced states of the two voices to one result | |
302 (define (combine-forced-results force1 force2 previous) | |
303 (let* ((val1 (car force1)) | |
Neil Puttock
2010/09/16 19:59:00
let
| |
304 (val2 (car force2)) | |
305 (changed1 (cdr force1)) | |
306 (changed2 (cdr force2))) | |
307 (cond | |
308 ((equal? val1 val2) val1) ;; both voices have same value => easy | |
Neil Puttock
2010/09/16 19:59:00
These comments make the lines too long; I think th
| |
309 ((not (or changed1 changed2)) previous) ;; both voices unch anged => previous value | |
310 ((not changed1) val2) ;; only voice 1 or 2 changed => use that val ue | |
311 ((not changed2) val1) | |
312 ;; Both voices have changed... | |
313 ((not val1) val2) ;; one voice is empty => use the other one | |
314 ((not val2) val1) | |
315 ;; Both have changed to something different non-empty... | |
316 (else (ly:warning (_ "Conflicting partcombineForce values: ~a and ~a") val1 val2) | |
317 val1)))) | |
318 ;; end combine-forced-results | |
319 | 297 |
320 ;; body of analyse-forced-combine: | 298 ;; body of analyse-forced-combine: |
321 (if (< result-idx (vector-length result)) | 299 (if (< result-idx (vector-length result)) |
322 » (let* ((now-state (vector-ref result result-idx)) ; current result | 300 » (let* ((now-state (vector-ref result result-idx)) ; current result |
323 » (ev1 (part-combine-events (car (voice-states now-state)))) ;; ev ents of voice #1 | 301 » ;; Extract all part-combine force events |
324 » (ev2 (part-combine-events (cdr (voice-states now-state)))) ;; ev ents of voice #2 | 302 » (ev1 (part-combine-events (car (voice-states now-state)))) |
325 » (ev1result (forced-combine-result ev1 (car prev-voices))) ;; co nverted to direction | 303 » (ev2 (part-combine-events (cdr (voice-states now-state)))) |
326 » (ev2result (forced-combine-result ev2 (cdr prev-voices))) ;; co nverted to direction | 304 » (evts (append ev1 ev2)) |
327 » (this-results (cons (car ev1result) (car ev2result))) ;; re sults for both voices | 305 » ;; result is (once-state permament-state): |
328 » (force-result (combine-forced-results ev1result ev2result prev-re s)));; combined to one strategy | 306 » (state (fold forced-result (cons 'automatic prev-res) evts)) |
329 » (set! (forced-configuration (vector-ref result result-idx)) force-resu lt) | 307 » ;; Now let once override permanent changes: |
330 » (analyse-forced-combine (1+ result-idx) force-result this-results)))) | 308 » (force-state (if (equal? (car state) 'automatic)· |
309 » (cdr state)· | |
310 » (car state)))) | |
311 » (set! (forced-configuration (vector-ref result result-idx))· | |
312 » force-state) | |
313 » ;; For the next moment, ignore the once override (car stat)· | |
314 » ;; and pass on the permanent override, stored as (cdr state) | |
315 » (analyse-forced-combine (1+ result-idx) (cdr state))))) | |
331 ;; end analyse-forced-combine | 316 ;; end analyse-forced-combine |
332 | 317 |
333 | 318 |
334 (define (analyse-time-step result-idx) | 319 (define (analyse-time-step result-idx) |
335 (define (put x . index) | 320 (define (put x . index) |
336 "Put the result to X, starting from INDEX backwards. | 321 "Put the result to X, starting from INDEX backwards. |
337 | 322 |
338 Only set if not set previously. | 323 Only set if not set previously. |
339 " | 324 " |
340 (let ((i (if (pair? index) (car index) result-idx))) | 325 (let ((i (if (pair? index) (car index) result-idx))) |
(...skipping 212 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... | |
553 (display voice-state-vec1) | 538 (display voice-state-vec1) |
554 (display "***\n") | 539 (display "***\n") |
555 (display voice-state-vec2) | 540 (display voice-state-vec2) |
556 (display "***\n") | 541 (display "***\n") |
557 (display result) | 542 (display result) |
558 (display "***\n"))) | 543 (display "***\n"))) |
559 | 544 |
560 ;; Extract all forced combine strategies (\set partcombineForced=...) | 545 ;; Extract all forced combine strategies (\set partcombineForced=...) |
561 ;; they will in the end override the automaically determined ones. | 546 ;; they will in the end override the automaically determined ones. |
562 ;; Initial state for both voices is no override | 547 ;; Initial state for both voices is no override |
563 (analyse-forced-combine 0 #f '(#f #f)) | 548 (analyse-forced-combine 0 #f) |
Carl
2010/10/24 10:38:23
U.S. spelling --> analyze
But I see that the stan
| |
564 ;; Now go through all time steps in a loop and find a combination strategy | 549 ;; Now go through all time steps in a loop and find a combination strategy |
565 ;; based only on the events of that one moment (i.e. neglecting longer | 550 ;; based only on the events of that one moment (i.e. neglecting longer |
566 ;; periods of solo/apart, etc.) | 551 ;; periods of solo/apart, etc.) |
567 (analyse-time-step 0) | 552 (analyse-time-step 0) |
568 ;; (display result) | 553 ;; (display result) |
569 ;; Check for unisono or unisilence moments | 554 ;; Check for unisono or unisilence moments |
570 (analyse-a2 0) | 555 (analyse-a2 0) |
571 ;;(display result) | 556 ;;(display result) |
572 (analyse-solo12 0) | 557 (analyse-solo12 0) |
573 ;; (display result) | 558 ;; (display result) |
574 (set! result (map | 559 (set! result (map |
560 ;; forced-configuration overrides, if it is set | |
575 (lambda (x) (cons (when x) (or (forced-configuration x) (confi guration x)))) | 561 (lambda (x) (cons (when x) (or (forced-configuration x) (confi guration x)))) |
576 (vector->list result))) | 562 (vector->list result))) |
577 (if #f ;; pc-debug | 563 (if #f ;; pc-debug |
578 (display result)) | 564 (display result)) |
579 result)) | 565 result)) |
580 | 566 |
581 | 567 |
582 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 568 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
583 | 569 |
584 (define-public (add-quotable parser name mus) | 570 (define-public (add-quotable parser name mus) |
585 (let* ((tab (eval 'musicQuotes (current-module))) | 571 (let* ((tab (eval 'musicQuotes (current-module))) |
586 (context-list (recording-group-emulate (context-spec-music mus 'Voice) | 572 (context-list (recording-group-emulate (context-spec-music mus 'Voice) |
587 (ly:parser-lookup parser 'partCo mbineListener)))) | 573 (ly:parser-lookup parser 'partCo mbineListener)))) |
588 (if (pair? context-list) | 574 (if (pair? context-list) |
589 (hash-set! tab name | 575 (hash-set! tab name |
590 ;; cdr : skip name string | 576 ;; cdr : skip name string |
591 (list->vector (reverse! (cdar context-list) | 577 (list->vector (reverse! (cdar context-list) |
592 '())))))) | 578 '())))))) |
LEFT | RIGHT |