1 ;;; define-music-display-methods.scm -- data for displaying music
2 ;;; expressions using LilyPond notation.
4 ;;; (c) 2005--2006 Nicolas Sceaux <nicolas.sceaux@free.fr>
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9 ;;; Display method implementation
12 (define-module (scm display-lily))
17 (define (scheme-expr->lily-string scm-arg)
18 (cond ((or (number? scm-arg)
20 (format #f "~s" scm-arg))
21 ((or (symbol? scm-arg)
23 (format #f "'~s" scm-arg))
26 (or (procedure-name scm-arg)
27 (with-output-to-string
29 (pretty-print (procedure-source scm-arg)))))))
32 (with-output-to-string
34 (display-scheme-music scm-arg)))))))
39 (define-public (markup->lily-string markup-expr)
40 "Return a string describing, in LilyPond syntax, the given markup expression."
41 (define (proc->command proc)
42 (let ((cmd-markup (symbol->string (procedure-name proc))))
43 (substring cmd-markup 0 (- (string-length cmd-markup)
44 (string-length "-markup")))))
45 (define (arg->string arg)
48 ((markup? arg) ;; a markup
49 (markup->lily-string-aux arg))
50 ((and (pair? arg) (every markup? arg)) ;; a markup list
51 (format #f "{~{ ~a~}}" (map-in-order markup->lily-string-aux arg)))
52 (else ;; a scheme argument
53 (format #f "#~a" (scheme-expr->lily-string arg)))))
54 (define (markup->lily-string-aux expr)
57 (let ((cmd (car expr))
59 (if (eqv? cmd simple-markup) ;; a simple markup
60 (format #f "~s" (car args))
61 (format #f "\\~a~{ ~a~}"
63 (map-in-order arg->string args))))))
64 (cond ((string? markup-expr)
65 (format #f "~s" markup-expr))
66 ((eqv? (car markup-expr) simple-markup)
67 (format #f "~s" (second markup-expr)))
69 (format #f "\\markup ~a"
70 (markup->lily-string-aux markup-expr)))))
76 ;; It is a pity that there is no rassoc in Scheme.
77 (define* (rassoc item alist #:optional (test equal?))
78 (do ((alist alist (cdr alist))
80 ((or result (null? alist)) result)
81 (if (and (car alist) (test item (cdar alist)))
82 (set! result (car alist)))))
84 (define (note-name->lily-string ly-pitch parser)
85 ;; here we define a custom pitch= function, since we do not want to
86 ;; test whether octaves are also equal. (otherwise, we would be using equal?)
87 (define (pitch= pitch1 pitch2)
88 (and (= (ly:pitch-notename pitch1) (ly:pitch-notename pitch2))
89 (= (ly:pitch-alteration pitch1) (ly:pitch-alteration pitch2))))
90 (let ((result (rassoc ly-pitch (ly:parser-lookup parser 'pitchnames) pitch=)))
95 (define (octave->lily-string pitch)
96 (let ((octave (ly:pitch-octave pitch)))
98 (make-string (1+ octave) #\'))
100 (make-string (1- (* -1 octave)) #\,))
106 (define* (duration->lily-string ly-duration #:key (prev-duration (*previous-duration*))
107 (force-duration (*force-duration*))
108 (time-factor-numerator (*time-factor-numerator*))
109 (time-factor-denominator (*time-factor-denominator*)))
110 (let ((log2 (ly:duration-log ly-duration))
111 (dots (ly:duration-dot-count ly-duration))
112 (num+den (ly:duration-factor ly-duration)))
113 (if (or force-duration (not prev-duration) (not (equal? ly-duration prev-duration)))
114 (string-append (case log2
118 (else (number->string (expt 2 log2))))
119 (make-string dots #\.)
120 (let ((num? (not (or (= 1 (car num+den))
121 (and time-factor-numerator
122 (= (car num+den) time-factor-numerator)))))
123 (den? (not (or (= 1 (cdr num+den))
124 (and time-factor-denominator
125 (= (cdr num+den) time-factor-denominator))))))
127 (format #f "*~a/~a" (car num+den) (cdr num+den)))
129 (format #f "*~a" (car num+den)))
137 (define post-event? (make-music-type-predicate
142 'MultiMeasureTextEvent
157 'AbsoluteDynamicEvent
164 (define* (event-direction->lily-string event #:optional (required #t))
165 (let ((direction (ly:music-property event 'direction)))
166 (cond ((or (not direction) (null? direction) (= CENTER direction))
167 (if required "-" ""))
168 ((= UP direction) "^")
169 ((= DOWN direction) "_")
172 (define-macro (define-post-event-display-method type vars direction-required str)
173 `(define-display-method ,type ,vars
175 (event-direction->lily-string ,(car vars) ,direction-required)
178 (define-macro (define-span-event-display-method type vars direction-required str-start str-stop)
179 `(define-display-method ,type ,vars
181 (event-direction->lily-string ,(car vars) ,direction-required)
182 (if (= START (ly:music-property ,(car vars) 'span-direction))
186 (define-display-method HyphenEvent (event parser)
188 (define-display-method ExtenderEvent (event parser)
190 (define-display-method TieEvent (event parser)
192 (define-display-method BeamForbidEvent (event parser)
194 (define-display-method StringNumberEvent (event parser)
195 (format #f "\\~a" (ly:music-property event 'string-number)))
198 (define-display-method TremoloEvent (event parser)
199 (let ((tremolo-type (ly:music-property event 'tremolo-type)))
200 (format #f ":~a" (if (= 0 tremolo-type)
204 (define-post-event-display-method ArticulationEvent (event parser) #t
205 (let ((articulation (ly:music-property event 'articulation-type)))
206 (case (string->symbol articulation)
210 ((staccatissimo) "|")
214 (else (format #f "\\~a" articulation)))))
216 (define-post-event-display-method FingeringEvent (event parser) #t
217 (ly:music-property event 'digit))
219 (define-post-event-display-method TextScriptEvent (event parser) #t
220 (markup->lily-string (ly:music-property event 'text)))
222 (define-post-event-display-method MultiMeasureTextEvent (event parser) #t
223 (markup->lily-string (ly:music-property event 'text)))
225 (define-post-event-display-method HarmonicEvent (event parser) #t "\\harmonic")
226 (define-post-event-display-method GlissandoEvent (event parser) #t "\\glissando")
227 (define-post-event-display-method ArpeggioEvent (event parser) #t "\\arpeggio")
228 (define-post-event-display-method AbsoluteDynamicEvent (event parser) #f
229 (format #f "\\~a" (ly:music-property event 'text)))
231 (define-span-event-display-method BeamEvent (event parser) #f "[" "]")
232 (define-span-event-display-method SlurEvent (event parser) #f "(" ")")
233 (define-span-event-display-method CrescendoEvent (event parser) #f "\\<" "\\!")
234 (define-span-event-display-method DecrescendoEvent (event parser) #f "\\>" "\\!")
235 (define-span-event-display-method PhrasingSlurEvent (event parser) #f "\\(" "\\)")
236 (define-span-event-display-method SustainEvent (event parser) #f "\\sustainDown" "\\sustainUp")
237 (define-span-event-display-method SostenutoEvent (event parser) #f "\\sostenutoDown" "\\sostenutoUp")
238 (define-span-event-display-method TextSpanEvent (event parser) #f "\\startTextSpan" "\\stopTextSpan")
239 (define-span-event-display-method TrillSpanEvent (event parser) #f "\\startTrillSpan" "\\stopTrillSpan")
240 (define-span-event-display-method StaffSpanEvent (event parser) #f "\\startStaff" "\\stopStaff")
241 (define-span-event-display-method NoteGroupingEvent (event parser) #f "\\startGroup" "\\stopGroup")
242 (define-span-event-display-method UnaCordaEvent (event parser) #f "\\unaCorda" "\\treCorde")
248 (define-display-method GraceMusic (expr parser)
249 (format #f "\\grace ~a"
250 (music->lily-string (ly:music-property expr 'element) parser)))
252 ;; \acciaccatura \appoggiatura \grace
253 ;; TODO: it would be better to compare ?start and ?stop
254 ;; with startAppoggiaturaMusic and stopAppoggiaturaMusic,
255 ;; using a custom music equality predicate.
256 (define-extra-display-method GraceMusic (expr parser)
257 "Display method for appoggiatura."
258 (with-music-match (expr (music
265 ;; we check whether ?start and ?stop look like
266 ;; startAppoggiaturaMusic stopAppoggiaturaMusic
267 (and (with-music-match (?start (music
273 duration (ly:make-duration 0 0 0 1))
276 span-direction START))))))
278 (with-music-match (?stop (music
284 duration (ly:make-duration 0 0 0 1))
287 span-direction STOP))))))
288 (format #f "\\appoggiatura ~a" (music->lily-string ?music parser))))))
291 (define-extra-display-method GraceMusic (expr parser)
292 "Display method for acciaccatura."
293 (with-music-match (expr (music
300 ;; we check whether ?start and ?stop look like
301 ;; startAcciaccaturaMusic stopAcciaccaturaMusic
302 (and (with-music-match (?start (music
308 duration (ly:make-duration 0 0 0 1))
311 span-direction START)))
316 grob-property-path '(stroke-style)
320 (with-music-match (?stop (music
326 grob-property-path '(stroke-style)
332 duration (ly:make-duration 0 0 0 1))
335 span-direction STOP))))))
336 (format #f "\\acciaccatura ~a" (music->lily-string ?music parser))))))
338 (define-extra-display-method GraceMusic (expr parser)
339 "Display method for grace."
340 (with-music-match (expr (music
347 ;; we check whether ?start and ?stop look like
348 ;; startGraceMusic stopGraceMusic
349 (and (null? (ly:music-property ?start 'elements))
350 (null? (ly:music-property ?stop 'elements))
351 (format #f "\\grace ~a" (music->lily-string ?music parser)))))
357 (define-display-method SequentialMusic (seq parser)
358 (let ((force-line-break (and (*force-line-break*)
360 (> (length (ly:music-property seq 'elements))
361 (*max-element-number-before-break*))))
362 (elements (ly:music-property seq 'elements))
363 (chord? (make-music-type-predicate 'EventChord))
364 (cluster? (make-music-type-predicate 'ClusterNoteEvent))
365 (note? (make-music-type-predicate 'NoteEvent)))
366 (format #f "~a~a{~v%~v_~{~a ~}~v%~v_}"
369 (any cluster? (ly:music-property e 'elements))))
373 (if (*explicit-mode*)
374 ;; if the sequence contains EventChord which contains figures ==> figuremode
375 ;; if the sequence contains EventChord which contains lyrics ==> lyricmode
376 ;; if the sequence contains EventChord which contains drum notes ==> drummode
377 (cond ((any (lambda (chord)
378 (any (make-music-type-predicate 'BassFigureEvent)
379 (ly:music-property chord 'elements)))
380 (filter chord? elements))
382 ((any (lambda (chord)
383 (any (make-music-type-predicate 'LyricEvent)
384 (ly:music-property chord 'elements)))
385 (filter chord? elements))
387 ((any (lambda (chord)
390 (not (null? (ly:music-property event 'drum-type)))))
391 (ly:music-property chord 'elements)))
392 (filter chord? elements))
394 (else ;; TODO: other modes?
397 (if force-line-break 1 0)
398 (if force-line-break (+ 2 (*indent*)) 1)
399 (parameterize ((*indent* (+ 2 (*indent*))))
400 (map-in-order (lambda (music)
401 (music->lily-string music parser))
403 (if force-line-break 1 0)
404 (if force-line-break (*indent*) 0))))
406 (define-display-method SimultaneousMusic (sim parser)
407 (parameterize ((*indent* (+ 3 (*indent*))))
408 (format #f "<< ~{~a ~}>>"
409 (map-in-order (lambda (music)
410 (music->lily-string music parser))
411 (ly:music-property sim 'elements)))))
413 (define-extra-display-method SimultaneousMusic (expr parser)
414 "If `sim' is an \afterGrace expression, return \"\\afterGrace ...\".
415 Otherwise, return #f."
416 ;; TODO: do something with afterGraceFraction?
417 (with-music-match (expr (music 'SimultaneousMusic
418 elements (?before-grace
419 (music 'SequentialMusic
420 elements ((music 'SkipMusic)
423 (format #f "\\afterGrace ~a ~a"
424 (music->lily-string ?before-grace parser)
425 (music->lily-string ?grace parser))))
431 (define-display-method EventChord (chord parser)
432 ;; event_chord : simple_element post_events
434 ;; | note_chord_element
436 ;; TODO : tagged post_events
437 ;; post_events : ( post_event | tagged_post_event )*
438 ;; tagged_post_event: '-' \tag embedded_scm post_event
440 (let* ((elements (ly:music-property chord 'elements))
441 (simple-elements (filter (make-music-type-predicate
442 'NoteEvent 'ClusterNoteEvent 'RestEvent
443 'MultiMeasureRestEvent 'SkipEvent 'LyricEvent)
445 (if ((make-music-type-predicate 'StaffSpanEvent 'BreathingEvent) (car elements))
446 ;; first, a special case: StaffSpanEvent (\startStaff, \stopStaff)
447 ;; and BreathingEvent (\breathe)
448 (music->lily-string (car elements) parser)
449 (if (and (not (null? simple-elements))
450 (null? (cdr simple-elements)))
451 ;; simple_element : note | figure | rest | mmrest | lyric_element | skip
452 (let* ((simple-element (car simple-elements))
453 (duration (ly:music-property simple-element 'duration))
454 (lily-string (format #f "~a~a~a~{~a ~}"
455 (music->lily-string simple-element parser)
456 (duration->lily-string duration)
457 (if (and ((make-music-type-predicate 'RestEvent) simple-element)
458 (ly:pitch? (ly:music-property simple-element 'pitch)))
461 (map-in-order (lambda (music)
462 (music->lily-string music parser))
463 (filter post-event? elements)))))
464 (*previous-duration* duration)
466 (let ((chord-elements (filter (make-music-type-predicate
467 'NoteEvent 'ClusterNoteEvent 'BassFigureEvent)
469 (post-events (filter post-event? elements)))
470 (if (not (null? chord-elements))
471 ;; note_chord_element : '<' (notepitch | drumpitch)* '>" duration post_events
472 (let ((lily-string (format #f "< ~{~a ~}>~a~{~a ~}"
473 (map-in-order (lambda (music)
474 (music->lily-string music parser))
476 (duration->lily-string (ly:music-property (car chord-elements)
478 (map-in-order (lambda (music)
479 (music->lily-string music parser))
481 (*previous-duration* (ly:music-property (car chord-elements) 'duration))
484 (format #f "~{~a ~}" (map-in-order (lambda (music)
485 (music->lily-string music parser))
488 (define-display-method MultiMeasureRestMusic (mmrest parser)
489 (let* ((dur (ly:music-property mmrest 'duration))
490 (ly (format #f "R~a~{~a ~}"
491 (duration->lily-string dur)
492 (map-in-order (lambda (music)
493 (music->lily-string music parser))
494 (ly:music-property mmrest 'articulations)))))
495 (*previous-duration* dur)
498 (define-display-method SkipMusic (skip parser)
499 (format #f "\\skip ~a" (duration->lily-string (ly:music-property skip 'duration) #:force-duration #t)))
502 ;;; Notes, rests, skips...
505 (define (simple-note->lily-string event parser)
506 (format #f "~a~a~a~a~{~a~}" ; pitchname octave !? octave-check articulations
507 (note-name->lily-string (ly:music-property event 'pitch) parser)
508 (octave->lily-string (ly:music-property event 'pitch))
509 (let ((forced (ly:music-property event 'force-accidental))
510 (cautionary (ly:music-property event 'cautionary)))
511 (cond ((and (not (null? forced))
513 (not (null? cautionary))
516 ((and (not (null? forced)) forced) "!")
518 (let ((octave-check (ly:music-property event 'absolute-octave)))
519 (if (not (null? octave-check))
520 (format #f "=~a" (cond ((>= octave-check 0)
521 (make-string (1+ octave-check) #\'))
523 (make-string (1- (* -1 octave-check)) #\,))
526 (map-in-order (lambda (event)
527 (music->lily-string event parser))
528 (ly:music-property event 'articulations))))
530 (define-display-method NoteEvent (note parser)
531 (cond ((not (null? (ly:music-property note 'pitch))) ;; note
532 (simple-note->lily-string note parser))
533 ((not (null? (ly:music-property note 'drum-type))) ;; drum
534 (format #f "~a" (ly:music-property note 'drum-type)))
538 (define-display-method ClusterNoteEvent (note parser)
539 (simple-note->lily-string note parser))
541 (define-display-method RestEvent (rest parser)
542 (if (not (null? (ly:music-property rest 'pitch)))
543 (simple-note->lily-string rest parser)
546 (define-display-method MultiMeasureRestEvent (rest parser)
549 (define-display-method SkipEvent (rest parser)
552 (define-display-method MarkEvent (mark parser)
553 (let ((label (ly:music-property mark 'label)))
556 (format #f "\\mark ~a" (markup->lily-string label)))))
558 (define-display-method KeyChangeEvent (key parser)
559 (let ((pitch-alist (ly:music-property key 'pitch-alist))
560 (tonic (ly:music-property key 'tonic)))
561 (if (or (null? pitch-alist)
564 (let ((c-pitch-alist (ly:transpose-key-alist pitch-alist
565 (ly:pitch-diff (ly:make-pitch 0 0 0) tonic))))
566 (format #f "\\key ~a \\~a~a"
567 (note-name->lily-string (ly:music-property key 'tonic) parser)
570 (equal? (ly:parser-lookup parser mode) c-pitch-alist))
571 (symbol->string mode)
573 '(major minor ionian locrian aeolian mixolydian lydian phrygian dorian))
574 (new-line->lily-string))))))
576 (define-display-method RelativeOctaveCheck (octave parser)
577 (let ((pitch (ly:music-property octave 'pitch)))
578 (format #f "\\octave ~a~a"
579 (note-name->lily-string pitch parser)
580 (octave->lily-string pitch))))
582 (define-display-method VoiceSeparator (sep parser)
585 (define-display-method LigatureEvent (ligature parser)
586 (if (= START (ly:music-property ligature 'span-direction))
590 (define-display-method BarCheck (check parser)
591 (format #f "|~a" (new-line->lily-string)))
593 (define-display-method PesOrFlexaEvent (expr parser)
596 (define-display-method BassFigureEvent (figure parser)
597 (let ((alteration (ly:music-property figure 'alteration))
598 (fig (ly:music-property figure 'figure))
599 (bracket-start (ly:music-property figure 'bracket-start))
600 (bracket-stop (ly:music-property figure 'bracket-stop)))
601 (format #f "~a~a~a~a"
602 (if (null? bracket-start) "" "[")
603 (cond ((null? fig) "_")
604 ((markup? fig) (second fig)) ;; fig: (<number-markup> "number")
606 (if (null? alteration)
615 (if (null? bracket-stop) "" "]"))))
617 (define-display-method LyricEvent (lyric parser)
618 (let ((text (ly:music-property lyric 'text)))
619 (if (or (string? text)
620 (eqv? (first text) simple-markup))
621 ;; a string or a simple markup
622 (let ((string (if (string? text)
625 (if (string-match "(\"| |[0-9])" string)
626 ;; TODO check exactly in which cases double quotes should be used
627 (format #f "~s" string)
629 (markup->lily-string text))))
631 (define-display-method BreathingEvent (event parser)
638 (define-display-method AutoChangeMusic (m parser)
639 (format #f "\\autochange ~a"
640 (music->lily-string (ly:music-property m 'element) parser)))
642 (define-display-method ContextChange (m parser)
643 (format #f "\\change ~a = \"~a\""
644 (ly:music-property m 'change-to-type)
645 (ly:music-property m 'change-to-id)))
649 (define-display-method TimeScaledMusic (times parser)
650 (let* ((num (ly:music-property times 'numerator))
651 (den (ly:music-property times 'denominator))
652 (nd-gcd (gcd num den)))
653 (parameterize ((*force-line-break* #f)
654 (*time-factor-numerator* (/ num nd-gcd))
655 (*time-factor-denominator* (/ den nd-gcd)))
656 (format #f "\\times ~a/~a ~a"
659 (music->lily-string (ly:music-property times 'element) parser)))))
661 (define-display-method RelativeOctaveMusic (m parser)
662 (music->lily-string (ly:music-property m 'element) parser))
664 (define-display-method TransposedMusic (m parser)
665 (music->lily-string (ly:music-property m 'element) parser))
671 (define (repeat->lily-string expr repeat-type parser)
672 (format #f "\\repeat ~a ~a ~a ~a"
674 (ly:music-property expr 'repeat-count)
675 (music->lily-string (ly:music-property expr 'element) parser)
676 (let ((alternatives (ly:music-property expr 'elements)))
677 (if (null? alternatives)
679 (format #f "\\alternative { ~{~a ~}}"
680 (map-in-order (lambda (music)
681 (music->lily-string music parser))
684 (define-display-method VoltaRepeatedMusic (expr parser)
685 (repeat->lily-string expr "volta" parser))
687 (define-display-method UnfoldedRepeatedMusic (expr parser)
688 (repeat->lily-string expr "unfold" parser))
690 (define-display-method FoldedRepeatedMusic (expr parser)
691 (repeat->lily-string expr "fold" parser))
693 (define-display-method PercentRepeatedMusic (expr parser)
694 (repeat->lily-string expr "percent" parser))
696 (define-display-method TremoloRepeatedMusic (expr parser)
697 (let* ((count (ly:music-property expr 'repeat-count))
698 (dots (if (= 0 (modulo count 3)) 0 1))
699 (shift (- (log2 (if (= 0 dots)
702 (element (ly:music-property expr 'element))
704 (if (eqv? (ly:music-property element 'name) 'SequentialMusic)
706 (set! shift (1- shift))
707 (set! den-mult (length (ly:music-property element 'elements)))))
708 (music-map (lambda (m)
709 (let ((duration (ly:music-property m 'duration)))
710 (if (ly:duration? duration)
711 (let* ((dlog (ly:duration-log duration))
712 (ddots (ly:duration-dot-count duration))
713 (dfactor (ly:duration-factor duration))
715 (dden (cdr dfactor)))
716 (set! (ly:music-property m 'duration)
717 (ly:make-duration (- dlog shift)
718 ddots ;;(- ddots dots) ; ????
720 (/ dden den-mult))))))
723 (format #f "\\repeat tremolo ~a ~a"
725 (music->lily-string element parser))))
731 (define-display-method ContextSpeccedMusic (expr parser)
732 (let ((id (ly:music-property expr 'context-id))
733 (create-new (ly:music-property expr 'create-new))
734 (music (ly:music-property expr 'element))
735 (operations (ly:music-property expr 'property-operations))
736 (ctype (ly:music-property expr 'context-type)))
737 (format #f "~a ~a~a~a ~a"
738 (if (and (not (null? create-new)) create-new)
744 (format #f " = ~s" id))
745 (if (null? operations)
747 (format #f " \\with {~{~a~}~%~v_}"
748 (parameterize ((*indent* (+ (*indent*) 2)))
750 (format #f "~%~v_\\~a ~s"
754 (reverse operations)))
756 (parameterize ((*current-context* ctype))
757 (music->lily-string music parser)))))
759 ;; special cases: \figures \lyrics \drums
760 (define-extra-display-method ContextSpeccedMusic (expr parser)
761 (with-music-match (expr (music 'ContextSpeccedMusic
763 property-operations ?op
764 context-type ?context-type
767 (parameterize ((*explicit-mode* #f))
770 (format #f "\\figures ~a" (music->lily-string ?sequence parser)))
772 (format #f "\\lyrics ~a" (music->lily-string ?sequence parser)))
774 (format #f "\\drums ~a" (music->lily-string ?sequence parser)))
779 ;;; Context properties
781 (define-extra-display-method ContextSpeccedMusic (expr parser)
782 (let ((element (ly:music-property expr 'element))
783 (property-tuning? (make-music-type-predicate 'PropertySet
787 (sequence? (make-music-type-predicate 'SequentialMusic)))
788 (if (and (ly:music? element)
789 (or (property-tuning? element)
790 (and (sequence? element)
791 (every property-tuning? (ly:music-property element 'elements)))))
792 (parameterize ((*current-context* (ly:music-property expr 'context-type)))
793 (music->lily-string element parser))
796 (define (property-value->lily-string arg parser)
797 (cond ((ly:music? arg)
798 (music->lily-string arg parser))
800 (format #f "#~s" arg))
802 (markup->lily-string arg))
804 (format #f "#~a" (scheme-expr->lily-string arg)))))
806 (define-display-method PropertySet (expr parser)
807 (let ((property (ly:music-property expr 'symbol))
808 (value (ly:music-property expr 'value))
809 (once (ly:music-property expr 'once)))
810 (format #f "~a\\set ~a~a = ~a~a"
811 (if (and (not (null? once)))
814 (if (eqv? (*current-context*) 'Bottom)
816 (format #f "~a . " (*current-context*)))
818 (property-value->lily-string value parser)
819 (new-line->lily-string))))
821 (define-display-method PropertyUnset (expr parser)
822 (format #f "\\unset ~a~a~a"
823 (if (eqv? (*current-context*) 'Bottom)
825 (format #f "~a . " (*current-context*)))
826 (ly:music-property expr 'symbol)
827 (new-line->lily-string)))
829 ;;; Layout properties
831 (define-display-method OverrideProperty (expr parser)
832 (let ((symbol (ly:music-property expr 'symbol))
833 (properties (ly:music-property expr 'grob-property-path))
834 (value (ly:music-property expr 'grob-value))
835 (once (ly:music-property expr 'once)))
836 (format #f "~a\\override ~a~a #'~a = ~a~a"
841 (if (eqv? (*current-context*) 'Bottom)
843 (format #f "~a . " (*current-context*)))
845 (if (null? (cdr properties))
848 (property-value->lily-string value parser)
849 (new-line->lily-string))))
851 (define-display-method RevertProperty (expr parser)
852 (let ((symbol (ly:music-property expr 'symbol))
853 (properties (ly:music-property expr 'grob-property-path)))
854 (format #f "\\revert ~a~a #'~a~a"
855 (if (eqv? (*current-context*) 'Bottom)
857 (format #f "~a . " (*current-context*)))
859 (if (null? (cdr properties))
862 (new-line->lily-string))))
864 ;;; \melisma and \melismaEnd
865 (define-extra-display-method ContextSpeccedMusic (expr parser)
866 "If expr is a melisma, return \"\\melisma\", otherwise, return #f."
867 (with-music-match (expr (music 'ContextSpeccedMusic
868 element (music 'PropertySet
870 symbol 'melismaBusy)))
873 (define-extra-display-method ContextSpeccedMusic (expr parser)
874 "If expr is a melisma end, return \"\\melismaEnd\", otherwise, return #f."
875 (with-music-match (expr (music 'ContextSpeccedMusic
876 element (music 'PropertyUnset
877 symbol 'melismaBusy)))
881 (define-extra-display-method ContextSpeccedMusic (expr parser)
882 "If expr is a tempo, return \"\\tempo x = nnn\", otherwise return #f."
883 (with-music-match (expr (music 'ContextSpeccedMusic
884 element (music 'SequentialMusic
885 elements ((music 'PropertySet
886 symbol 'tempoWholesPerMinute)
889 symbol 'tempoUnitDuration)
892 symbol 'tempoUnitCount)))))
893 (format #f "\\tempo ~a = ~a"
894 (duration->lily-string ?unit-duration #:force-duration #t)
898 (define clef-name-alist (map (lambda (name+vals)
899 (cons (cdr name+vals)
903 (define-extra-display-method ContextSpeccedMusic (expr parser)
904 "If `expr' is a clef change, return \"\\clef ...\"
905 Otherwise, return #f."
906 (with-music-match (expr (music 'ContextSpeccedMusic
908 element (music 'SequentialMusic
909 elements ((music 'PropertySet
913 symbol 'middleCPosition)
916 symbol 'clefPosition)
918 value ?clef-octavation
919 symbol 'clefOctavation)))))
920 (let ((clef-prop+name (assoc (list ?clef-glyph ?clef-position 0)
923 (format #f "\\clef \"~a~{~a~a~}\"~a"
925 (cond ((= 0 ?clef-octavation)
927 ((> ?clef-octavation 0)
928 (list "^" (1+ ?clef-octavation)))
930 (list "_" (- 1 ?clef-octavation))))
931 (new-line->lily-string))
935 (define-extra-display-method ContextSpeccedMusic (expr parser)
936 "If `expr' is a time signature set, return \"\\time ...\".
937 Otherwise, return #f."
938 (with-music-match (expr (music
948 symbol 'timeSignatureFraction)
954 symbol 'measureLength)
958 symbol 'beatGrouping))))))
959 (if (null? ?grouping)
960 (format #f "\\time ~a/~a~a" (car ?num+den) (cdr ?num+den) (new-line->lily-string))
961 (format #f "#(set-time-signature ~a ~a '~s)~a"
962 (car ?num+den) (cdr ?num+den) ?grouping (new-line->lily-string)))))
965 (define-extra-display-method ContextSpeccedMusic (expr parser)
966 "If `expr' is a bar, return \"\\bar ...\".
967 Otherwise, return #f."
968 (with-music-match (expr (music 'ContextSpeccedMusic
970 element (music 'PropertySet
973 (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string))))
976 (define (duration->moment ly-duration)
977 (let ((log2 (ly:duration-log ly-duration))
978 (dots (ly:duration-dot-count ly-duration))
979 (num+den (ly:duration-factor ly-duration)))
980 (let* ((m (expt 2 (- log2)))
981 (factor (/ (car num+den) (cdr num+den))))
983 (delta (/ m 2) (/ delta 2)))
985 (set! m (+ m delta)))
987 (define moment-duration-alist (map (lambda (duration)
988 (cons (duration->moment duration)
990 (append-map (lambda (log2)
992 (ly:make-duration log2 dots 1 1))
996 (define (moment->duration moment)
997 (let ((result (assoc (- moment) moment-duration-alist =)))
1001 (define-extra-display-method ContextSpeccedMusic (expr parser)
1002 "If `expr' is a partial measure, return \"\\partial ...\".
1003 Otherwise, return #f."
1004 (with-music-match (expr (music
1005 'ContextSpeccedMusic
1007 'ContextSpeccedMusic
1008 context-type 'Timing
1012 symbol 'measurePosition))))
1013 (let ((duration (moment->duration (/ (ly:moment-main-numerator ?moment)
1014 (ly:moment-main-denominator ?moment)))))
1015 (and duration (format #f "\\partial ~a" (duration->lily-string duration
1016 #:force-duration #t))))))
1021 (define-display-method ApplyOutputEvent (applyoutput parser)
1022 (let ((proc (ly:music-property applyoutput 'procedure))
1023 (ctx (ly:music-property applyoutput 'context-type)))
1024 (format #f "\\applyOutput #'~a #~a"
1026 (or (procedure-name proc)
1027 (with-output-to-string
1029 (pretty-print (procedure-source proc))))))))
1031 (define-display-method ApplyContext (applycontext parser)
1032 (let ((proc (ly:music-property applycontext 'procedure)))
1033 (format #f "\\applyContext #~a"
1034 (or (procedure-name proc)
1035 (with-output-to-string
1037 (pretty-print (procedure-source proc))))))))
1040 (define-display-method PartCombineMusic (expr parser)
1041 (format #f "\\partcombine ~{~a ~}"
1042 (map-in-order (lambda (music)
1043 (music->lily-string music parser))
1044 (ly:music-property expr 'elements))))
1046 (define-extra-display-method PartCombineMusic (expr parser)
1047 (with-music-match (expr (music 'PartCombineMusic
1048 elements ((music 'UnrelativableMusic
1049 element (music 'ContextSpeccedMusic
1052 element ?sequence1))
1053 (music 'UnrelativableMusic
1054 element (music 'ContextSpeccedMusic
1057 element ?sequence2)))))
1058 (format #f "\\partcombine ~a~a~a"
1059 (music->lily-string ?sequence1 parser)
1060 (new-line->lily-string)
1061 (music->lily-string ?sequence2 parser))))
1063 (define-display-method UnrelativableMusic (expr parser)
1064 (music->lily-string (ly:music-property expr 'element) parser))
1067 (define-display-method QuoteMusic (expr parser)
1068 (or (with-music-match (expr (music
1070 quoted-voice-direction ?quoted-voice-direction
1071 quoted-music-name ?quoted-music-name
1072 quoted-context-id "cue"
1073 quoted-context-type 'Voice
1075 (format #f "\\cueDuring #~s #~a ~a"
1077 ?quoted-voice-direction
1078 (music->lily-string ?music parser)))
1079 (format #f "\\quoteDuring #~s ~a"
1080 (ly:music-property expr 'quoted-music-name)
1081 (music->lily-string (ly:music-property expr 'element) parser))))
1086 (define-display-method LineBreakEvent (expr parser)
1087 (if (null? (ly:music-property expr 'break-permission))
1091 (define-display-method PageBreakEvent (expr parser)
1092 (if (null? (ly:music-property expr 'break-permission))
1096 (define-display-method PageTurnEvent (expr parser)
1097 (if (null? (ly:music-property expr 'break-permission))
1101 (define-extra-display-method EventChord (expr parser)
1102 (with-music-match (expr (music 'EventChord
1103 elements ((music 'LineBreakEvent
1104 break-permission 'force)
1105 (music 'PageBreakEvent
1106 break-permission 'force))))
1109 (define-extra-display-method EventChord (expr parser)
1110 (with-music-match (expr (music 'EventChord
1111 elements ((music 'LineBreakEvent
1112 break-permission 'force)
1113 (music 'PageBreakEvent
1114 break-permission 'force)
1115 (music 'PageTurnEvent
1116 break-permission 'force))))
1124 (define-display-method LyricCombineMusic (expr parser)
1125 (format #f "\\lyricsto ~s ~a"
1126 (ly:music-property expr 'associated-context)
1127 (parameterize ((*explicit-mode* #f))
1128 (music->lily-string (ly:music-property expr 'element) parser))))
1131 (define-extra-display-method SimultaneousMusic (expr parser)
1132 (with-music-match (expr (music 'SimultaneousMusic
1133 elements ((music 'ContextSpeccedMusic
1136 element ?note-sequence)
1137 (music 'ContextSpeccedMusic
1138 context-type 'Lyrics
1140 element (music 'LyricCombineMusic
1141 associated-context ?associated-id
1142 element ?lyric-sequence)))))
1143 (if (string=? ?id ?associated-id)
1144 (format #f "~a~a \\addlyrics ~a"
1145 (music->lily-string ?note-sequence parser)
1146 (new-line->lily-string)
1147 (parameterize ((*explicit-mode* #f))
1148 (music->lily-string ?lyric-sequence parser)))