1 ;;; define-music-display-methods.scm -- data for displaying music
2 ;;; expressions using LilyPond notation.
4 ;;; Copyright (C) 2005--2015 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)
21 (format #f "~s" scm-arg))
22 ((or (symbol? scm-arg)
24 (format #f "'~s" scm-arg))
27 (or (procedure-name scm-arg)
28 (with-output-to-string
30 (pretty-print (procedure-source scm-arg)))))))
33 (with-output-to-string
35 (display-scheme-music scm-arg)))))))
40 (define-public (markup->lily-string markup-expr)
41 "Return a string describing, in LilyPond syntax, the given markup
43 (define (proc->command proc)
44 (let ((cmd-markup (symbol->string (procedure-name proc))))
45 (substring cmd-markup 0 (- (string-length cmd-markup)
46 (string-length "-markup")))))
47 (define (arg->string arg)
50 ((markup? arg) ;; a markup
51 (markup->lily-string-aux arg))
52 ((and (pair? arg) (every markup? arg)) ;; a markup list
53 (format #f "{~{ ~a~}}" (map-in-order markup->lily-string-aux arg)))
54 (else ;; a scheme argument
55 (format #f "#~a" (scheme-expr->lily-string arg)))))
56 (define (markup->lily-string-aux expr)
59 (let ((cmd (car expr))
61 (if (eqv? cmd simple-markup) ;; a simple markup
62 (format #f "~s" (car args))
63 (format #f "\\~a~{ ~a~}"
65 (map-in-order arg->string args))))))
66 (cond ((string? markup-expr)
67 (format #f "~s" markup-expr))
68 ((eqv? (car markup-expr) simple-markup)
69 (format #f "~s" (second markup-expr)))
71 (format #f "\\markup ~a"
72 (markup->lily-string-aux markup-expr)))))
78 ;; It is a pity that there is no rassoc in Scheme.
79 (define* (rassoc item alist #:optional (test equal?))
80 (do ((alist alist (cdr alist))
82 ((or result (null? alist)) result)
83 (if (and (car alist) (test item (cdar alist)))
84 (set! result (car alist)))))
86 (define-public (note-name->lily-string ly-pitch)
87 ;; here we define a custom pitch= function, since we do not want to
88 ;; test whether octaves are also equal. (otherwise, we would be using equal?)
89 (define (pitch= pitch1 pitch2)
90 (and (= (ly:pitch-notename pitch1) (ly:pitch-notename pitch2))
91 (= (ly:pitch-alteration pitch1) (ly:pitch-alteration pitch2))))
92 (let* ((result (rassoc ly-pitch pitchnames pitch=)))
93 (and result (car result))))
95 (define-public (octave->lily-string pitch)
96 (let ((octave (ly:pitch-octave pitch)))
98 (make-string (1+ octave) #\'))
100 (make-string (1- (* -1 octave)) #\,))
106 (define*-public (duration->lily-string ly-duration #:key
108 (time-scale (*time-scale*)))
109 (let ((log2 (ly:duration-log ly-duration))
110 (dots (ly:duration-dot-count ly-duration))
111 (scale (ly:duration-scale ly-duration)))
112 (if (or force-duration (not (*omit-duration*)))
113 (string-append (case log2
117 (else (number->string (expt 2 log2))))
118 (make-string dots #\.)
119 (let ((end-scale (/ scale time-scale)))
120 (if (= end-scale 1) ""
121 (format #f "*~a" end-scale))))
128 (define post-event? (music-type-predicate 'post-event))
130 (define* (event-direction->lily-string event #:optional (required #t))
131 (let ((direction (ly:music-property event 'direction)))
132 (cond ((or (not direction) (null? direction) (= CENTER direction))
133 (if required "-" ""))
134 ((= UP direction) "^")
135 ((= DOWN direction) "_")
138 (define-macro (define-post-event-display-method type vars direction-required str)
139 `(define-display-method ,type ,vars
141 (event-direction->lily-string ,(car vars) ,direction-required)
144 (define-macro (define-span-event-display-method type vars direction-required str-start str-stop)
145 `(define-display-method ,type ,vars
147 (event-direction->lily-string ,(car vars) ,direction-required)
148 (if (= START (ly:music-property ,(car vars) 'span-direction))
152 (define-display-method HyphenEvent (event)
154 (define-display-method ExtenderEvent (event)
156 (define-display-method TieEvent (event)
158 (define-display-method BeamForbidEvent (event)
160 (define-display-method StringNumberEvent (event)
161 (format #f "\\~a" (ly:music-property event 'string-number)))
164 (define-display-method TremoloEvent (event)
165 (let ((tremolo-type (ly:music-property event 'tremolo-type 8)))
166 (format #f ":~a" tremolo-type)))
168 (define-display-method ArticulationEvent (event) #t
169 (let* ((articulation (ly:music-property event 'articulation-type))
171 (case (string->symbol articulation)
175 ((staccatissimo) "!")
180 (format #f "~a~:[\\~;~]~a"
181 (event-direction->lily-string event shorthand)
183 (or shorthand articulation))))
185 (define-post-event-display-method FingeringEvent (event) #t
186 (ly:music-property event 'digit))
188 (define-post-event-display-method TextScriptEvent (event) #t
189 (markup->lily-string (ly:music-property event 'text)))
191 (define-post-event-display-method MultiMeasureTextEvent (event) #t
192 (markup->lily-string (ly:music-property event 'text)))
194 (define-post-event-display-method BendAfterEvent (event) #f
195 (format #f "\\bendAfter #~a " (ly:music-property event 'delta-step)))
197 (define-post-event-display-method HarmonicEvent (event) #f "\\harmonic")
198 (define-post-event-display-method GlissandoEvent (event) #f "\\glissando")
199 (define-post-event-display-method ArpeggioEvent (event) #f "\\arpeggio")
200 (define-post-event-display-method AbsoluteDynamicEvent (event) #f
201 (format #f "\\~a" (ly:music-property event 'text)))
203 (define-post-event-display-method StrokeFingerEvent (event) #f
204 (format #f "\\rightHandFinger #~a " (ly:music-property event 'digit)))
206 (define-span-event-display-method BeamEvent (event) #f "[" "]")
207 (define-span-event-display-method SlurEvent (event) #f "(" ")")
208 (define-span-event-display-method CrescendoEvent (event) #f "\\<" "\\!")
209 (define-span-event-display-method DecrescendoEvent (event) #f "\\>" "\\!")
210 (define-span-event-display-method EpisemaEvent (event) #f "\\episemInitium" "\\episemFinis")
211 (define-span-event-display-method PhrasingSlurEvent (event) #f "\\(" "\\)")
212 (define-span-event-display-method SustainEvent (event) #f "\\sustainOn" "\\sustainOff")
213 (define-span-event-display-method SostenutoEvent (event) #f "\\sostenutoOn" "\\sostenutoOff")
214 (define-span-event-display-method TextSpanEvent (event) #f "\\startTextSpan" "\\stopTextSpan")
215 (define-span-event-display-method TrillSpanEvent (event) #f "\\startTrillSpan" "\\stopTrillSpan")
216 (define-span-event-display-method StaffSpanEvent (event) #f "\\startStaff" "\\stopStaff")
217 (define-span-event-display-method NoteGroupingEvent (event) #f "\\startGroup" "\\stopGroup")
218 (define-span-event-display-method UnaCordaEvent (event) #f "\\unaCorda" "\\treCorde")
224 (define-display-method GraceMusic (expr)
225 (format #f "\\grace ~a"
226 (music->lily-string (ly:music-property expr 'element))))
228 ;; \acciaccatura \appoggiatura \grace
229 ;; TODO: it would be better to compare ?start and ?stop
230 ;; with startAppoggiaturaMusic and stopAppoggiaturaMusic,
231 ;; using a custom music equality predicate.
232 (define-extra-display-method GraceMusic (expr)
233 "Display method for appoggiatura."
234 (with-music-match (expr (music
241 ;; we check whether ?start and ?stop look like
242 ;; startAppoggiaturaMusic stopAppoggiaturaMusic
243 (and (with-music-match (?start (music
250 span-direction START))))))
252 (with-music-match (?stop (music
259 span-direction STOP))))))
260 (format #f "\\appoggiatura ~a" (music->lily-string ?music))))))
263 (define-extra-display-method GraceMusic (expr)
264 "Display method for acciaccatura."
265 (with-music-match (expr (music
272 ;; we check whether ?start and ?stop look like
273 ;; startAcciaccaturaMusic stopAcciaccaturaMusic
274 (and (with-music-match (?start (music
281 span-direction START)))
286 grob-property-path '(stroke-style)
290 (with-music-match (?stop (music
296 grob-property-path '(stroke-style)
304 span-direction STOP))))))
305 (format #f "\\acciaccatura ~a" (music->lily-string ?music))))))
307 (define-extra-display-method GraceMusic (expr)
308 "Display method for grace."
309 (with-music-match (expr (music
316 ;; we check whether ?start and ?stop look like
317 ;; startGraceMusic stopGraceMusic
318 (and (null? (ly:music-property ?start 'elements))
319 (null? (ly:music-property ?stop 'elements))
320 (format #f "\\grace ~a" (music->lily-string ?music)))))
326 (define-display-method SequentialMusic (seq)
327 (let ((force-line-break (and (*force-line-break*)
329 (> (length (ly:music-property seq 'elements))
330 (*max-element-number-before-break*))))
331 (elements (ly:music-property seq 'elements))
332 (chord? (make-music-type-predicate 'EventChord))
333 (note-or-chord? (make-music-type-predicate 'EventChord 'NoteEvent
334 'LyricEvent 'RestEvent
336 (cluster? (make-music-type-predicate 'ClusterNoteEvent))
337 (note? (make-music-type-predicate 'NoteEvent)))
338 (format #f "~a~a{~v%~v_~{~a~^ ~}~v%~v_}"
342 (any cluster? (ly:music-property e 'elements)))))
346 (if (*explicit-mode*)
347 ;; if the sequence contains EventChord which contains figures ==> figuremode
348 ;; if the sequence contains EventChord which contains lyrics ==> lyricmode
349 ;; if the sequence contains EventChord which contains drum notes ==> drummode
350 (cond ((any (lambda (chord)
351 (any (make-music-type-predicate 'BassFigureEvent)
352 (ly:music-property chord 'elements)))
353 (filter chord? elements))
355 ((any (lambda (chord)
356 (any (make-music-type-predicate 'LyricEvent)
358 (ly:music-property chord 'elements))))
359 (filter note-or-chord? elements))
361 ((any (lambda (chord)
364 (not (null? (ly:music-property event 'drum-type)))))
366 (ly:music-property chord 'elements))))
367 (filter note-or-chord? elements))
369 (else ;; TODO: other modes?
372 (if force-line-break 1 0)
373 (if force-line-break (+ 2 (*indent*)) 1)
374 (parameterize ((*indent* (+ 2 (*indent*))))
375 (map-in-order (lambda (music)
376 (music->lily-string music))
378 (if force-line-break 1 0)
379 (if force-line-break (*indent*) 1))))
381 (define-display-method SimultaneousMusic (sim)
382 (parameterize ((*indent* (+ 3 (*indent*))))
383 (format #f "<< ~{~a ~}>>"
384 (map-in-order (lambda (music)
385 (music->lily-string music))
386 (ly:music-property sim 'elements)))))
392 (define-display-method EventChord (chord)
393 ;; event_chord : command_element
394 ;; | note_chord_element
396 ;; TODO : tagged post_events
397 ;; post_events : ( post_event | tagged_post_event )*
398 ;; tagged_post_event: '-' \tag embedded_scm post_event
400 (let* ((elements (append (ly:music-property chord 'elements)
401 (ly:music-property chord 'articulations)))
402 (chord-repeat (ly:music-property chord 'duration)))
405 (partition (music-type-predicate 'rhythmic-event)
407 (lambda (chord-elements other-elements)
408 (cond ((pair? chord-elements)
409 ;; note_chord_element :
410 ;; '<' (notepitch | drumpitch)* '>" duration post_events
411 (let ((duration (duration->lily-string (ly:music-property
414 ;; Format duration first so that it does not appear on
416 (format #f "< ~{~a ~}>~a~:{~:[-~;~]~a~^ ~}"
417 (parameterize ((*omit-duration* #t))
420 (music->lily-string music))
423 (map-in-order (lambda (music)
426 (music->lily-string music)))
428 ((ly:duration? chord-repeat)
429 (let ((duration (duration->lily-string chord-repeat)))
430 (format #f "q~a~:{~:[-~;~]~a~^ ~}"
432 (map-in-order (lambda (music)
435 (music->lily-string music)))
438 ((and (= 1 (length other-elements))
439 (not (post-event? (car other-elements))))
440 (format #f (music->lily-string (car other-elements))))
442 (format #f "< >~:{~:[-~;~]~a~^ ~}"
443 (map-in-order (lambda (music)
446 (music->lily-string music)))
447 other-elements))))))))
449 (define-display-method MultiMeasureRestMusic (mmrest)
450 (format #f "R~a~{~a~^ ~}"
451 (duration->lily-string (ly:music-property mmrest 'duration))
452 (map-in-order (lambda (music)
453 (music->lily-string music))
454 (ly:music-property mmrest 'articulations))))
456 (define-display-method SkipMusic (skip)
457 (format #f "\\skip ~a" (duration->lily-string (ly:music-property skip 'duration) #:force-duration #t)))
459 (define-display-method OttavaMusic (ottava)
460 (format #f "\\ottava #~a" (ly:music-property ottava 'ottava-number)))
463 ;;; Notes, rests, skips...
466 (define (simple-note->lily-string event)
467 (format #f "~a~a~a~a~a~a~:{~:[-~;~]~a~}" ; pitchname octave !? octave-check duration optional_rest articulations
468 (note-name->lily-string (ly:music-property event 'pitch))
469 (octave->lily-string (ly:music-property event 'pitch))
470 (let ((forced (ly:music-property event 'force-accidental))
471 (cautionary (ly:music-property event 'cautionary)))
472 (cond ((and (not (null? forced))
474 (not (null? cautionary))
477 ((and (not (null? forced)) forced) "!")
479 (let ((octave-check (ly:music-property event 'absolute-octave)))
480 (if (not (null? octave-check))
481 (format #f "=~a" (cond ((>= octave-check 0)
482 (make-string (1+ octave-check) #\'))
484 (make-string (1- (* -1 octave-check)) #\,))
487 (duration->lily-string (ly:music-property event 'duration))
488 (if ((make-music-type-predicate 'RestEvent) event)
490 (map-in-order (lambda (event)
493 (music->lily-string event)))
494 (ly:music-property event 'articulations))))
496 (define-display-method NoteEvent (note)
497 (cond ((not (null? (ly:music-property note 'pitch))) ;; note
498 (simple-note->lily-string note))
499 ((not (null? (ly:music-property note 'drum-type))) ;; drum
500 (format #f "~a~a~{~a~}" (ly:music-property note 'drum-type)
501 (duration->lily-string (ly:music-property note 'duration))
502 (map-in-order (lambda (event)
503 (music->lily-string event))
504 (ly:music-property note 'articulations))))
507 (format #f "~a~{~a~}"
508 (duration->lily-string (ly:music-property note 'duration)
510 (map-in-order (lambda (event)
511 (music->lily-string event))
512 (ly:music-property note 'articulations))))))
514 (define-display-method ClusterNoteEvent (note)
515 (simple-note->lily-string note))
517 (define-display-method RestEvent (rest)
518 (if (not (null? (ly:music-property rest 'pitch)))
519 (simple-note->lily-string rest)
520 (format #f "r~a~{~a~}"
521 (duration->lily-string (ly:music-property rest 'duration))
522 (map-in-order (lambda (event)
523 (music->lily-string event))
524 (ly:music-property rest 'articulations)))))
526 (define-display-method MultiMeasureRestEvent (rest)
527 (string-append "R" (duration->lily-string (ly:music-property rest 'duration))))
529 (define-display-method SkipEvent (rest)
530 (format #f "s~a~{~a~}"
531 (duration->lily-string (ly:music-property rest 'duration))
532 (map-in-order (lambda (event)
533 (music->lily-string event))
534 (ly:music-property rest 'articulations))))
536 (define-display-method RepeatedChord (chord)
537 (music->lily-string (ly:music-property chord 'element)))
539 (define-display-method MarkEvent (mark)
540 (let ((label (ly:music-property mark 'label)))
543 (format #f "\\mark ~a" (markup->lily-string label)))))
545 (define-display-method KeyChangeEvent (key)
546 (let ((pitch-alist (ly:music-property key 'pitch-alist))
547 (tonic (ly:music-property key 'tonic)))
548 (if (or (null? pitch-alist)
551 (let ((c-pitch-alist (ly:transpose-key-alist pitch-alist
552 (ly:pitch-diff (ly:make-pitch 0 0 0) tonic))))
553 (format #f "\\key ~a \\~a~a"
554 (note-name->lily-string (ly:music-property key 'tonic))
556 (and (equal? (ly:parser-lookup mode) c-pitch-alist)
557 (symbol->string mode)))
558 '(major minor ionian locrian aeolian mixolydian lydian phrygian dorian))
559 (new-line->lily-string))))))
561 (define-display-method RelativeOctaveCheck (octave)
562 (let ((pitch (ly:music-property octave 'pitch)))
563 (format #f "\\octaveCheck ~a~a"
564 (note-name->lily-string pitch)
565 (octave->lily-string pitch))))
567 (define-display-method VoiceSeparator (sep)
570 (define-display-method LigatureEvent (ligature)
571 (if (= START (ly:music-property ligature 'span-direction))
575 (define-display-method BarCheck (check)
576 (format #f "|~a" (new-line->lily-string)))
578 (define-display-method PesOrFlexaEvent (expr)
581 (define-display-method BassFigureEvent (figure)
582 (let ((alteration (ly:music-property figure 'alteration))
583 (fig (ly:music-property figure 'figure))
584 (bracket-start (ly:music-property figure 'bracket-start))
585 (bracket-stop (ly:music-property figure 'bracket-stop)))
587 (format #f "~a~a~a~a"
588 (if (null? bracket-start) "" "[")
589 (cond ((null? fig) "_")
590 ((markup? fig) (second fig)) ;; fig: (<number-markup> "number")
592 (if (null? alteration)
595 ((= alteration DOUBLE-FLAT) "--")
596 ((= alteration FLAT) "-")
597 ((= alteration NATURAL) "!")
598 ((= alteration SHARP) "+")
599 ((= alteration DOUBLE-SHARP) "++")
601 (if (null? bracket-stop) "" "]"))))
603 (define-display-method LyricEvent (lyric)
604 (format #f "~a~{~a~^ ~}"
605 (let ((text (ly:music-property lyric 'text)))
606 (if (or (string? text)
607 (eqv? (first text) simple-markup))
608 ;; a string or a simple markup
609 (let ((string (if (string? text)
612 (if (string-match "(\"| |[0-9])" string)
613 ;; TODO check exactly in which cases double quotes should be used
614 (format #f "~s" string)
616 (markup->lily-string text)))
617 (map-in-order music->lily-string
618 (ly:music-property lyric 'articulations))))
620 (define-display-method BreathingEvent (event)
627 (define-display-method AutoChangeMusic (m)
628 (format #f "\\autochange ~a"
630 (ly:music-property (ly:music-property m 'element) 'element))))
632 (define-display-method ContextChange (m)
633 (format #f "\\change ~a = \"~a\""
634 (ly:music-property m 'change-to-type)
635 (ly:music-property m 'change-to-id)))
639 (define-display-method TimeScaledMusic (times)
640 (let* ((num (ly:music-property times 'numerator))
641 (den (ly:music-property times 'denominator))
642 (span (ly:music-property times 'duration #f))
643 ;; need to format before changing time scale
645 (and span (duration->lily-string span #:force-duration #t)))
647 (time-scale (*time-scale*)))
649 (parameterize ((*force-line-break* #f)
650 (*time-scale* (* time-scale scale)))
651 (format #f "\\tuplet ~a/~a ~@[~a ~]~a"
655 (music->lily-string (ly:music-property times 'element))))))
658 (define-display-method RelativeOctaveMusic (m)
659 (music->lily-string (ly:music-property m 'element)))
661 (define-display-method TransposedMusic (m)
662 (music->lily-string (ly:music-property m 'element)))
668 (define-display-method AlternativeEvent (alternative) "")
670 (define (repeat->lily-string expr repeat-type)
671 (let* ((main (music->lily-string (ly:music-property expr 'element))))
672 (format #f "\\repeat ~a ~a ~a ~a"
674 (ly:music-property expr 'repeat-count)
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))
684 (define-display-method VoltaRepeatedMusic (expr)
685 (repeat->lily-string expr "volta"))
687 (define-display-method UnfoldedRepeatedMusic (expr)
688 (repeat->lily-string expr "unfold"))
690 (define-display-method PercentRepeatedMusic (expr)
691 (repeat->lily-string expr "percent"))
693 (define-display-method TremoloRepeatedMusic (expr)
694 (repeat->lily-string expr "tremolo"))
700 (define-display-method ContextSpeccedMusic (expr)
701 (let ((id (ly:music-property expr 'context-id))
702 (create-new (ly:music-property expr 'create-new))
703 (music (ly:music-property expr 'element))
704 (operations (ly:music-property expr 'property-operations))
705 (ctype (ly:music-property expr 'context-type)))
706 (format #f "~a ~a~a~a ~a"
707 (if (and (not (null? create-new)) create-new)
713 (format #f " = ~s" id))
714 (if (null? operations)
716 (format #f " \\with {~{~a~}~%~v_}"
717 (parameterize ((*indent* (+ (*indent*) 2)))
719 (format #f "~%~v_\\~a ~s"
725 (parameterize ((*current-context* ctype))
726 (music->lily-string music)))))
729 (define-extra-display-method ContextSpeccedMusic (expr)
730 "If `sim' is an \afterGrace expression, return \"\\afterGrace ...\".
731 Otherwise, return #f."
732 ;; TODO: do something with afterGraceFraction?
734 (expr (music 'ContextSpeccedMusic
737 (music 'SimultaneousMusic
738 elements (?before-grace
739 (music 'SequentialMusic
740 elements ((music 'SkipMusic)
742 element ?grace)))))))
743 (format #f "\\afterGrace ~a ~a"
744 (music->lily-string ?before-grace)
745 (music->lily-string ?grace))))
748 ;; special cases: \figures \lyrics \drums
749 (define-extra-display-method ContextSpeccedMusic (expr)
750 (with-music-match (expr (music 'ContextSpeccedMusic
752 property-operations ?op
753 context-type ?context-type
756 (parameterize ((*explicit-mode* #f))
759 (format #f "\\figures ~a" (music->lily-string ?sequence)))
761 (format #f "\\lyrics ~a" (music->lily-string ?sequence)))
763 (format #f "\\drums ~a" (music->lily-string ?sequence)))
768 ;;; Context properties
770 (define-extra-display-method ContextSpeccedMusic (expr)
771 (let ((element (ly:music-property expr 'element))
772 (property-tuning? (make-music-type-predicate 'PropertySet
776 (sequence? (make-music-type-predicate 'SequentialMusic)))
777 (if (and (ly:music? element)
778 (or (property-tuning? element)
779 (and (sequence? element)
780 (every property-tuning? (ly:music-property element 'elements)))))
781 (parameterize ((*current-context* (ly:music-property expr 'context-type)))
782 (music->lily-string element))
785 (define-public (value->lily-string arg)
786 (cond ((ly:music? arg)
787 (music->lily-string arg))
789 (format #f "#~s" arg))
791 (markup->lily-string arg))
793 (format #f "##{ ~a #}" (duration->lily-string arg #:force-duration #t)))
796 (note-name->lily-string arg)
797 (octave->lily-string arg)))
799 (format #f "#~a" (scheme-expr->lily-string arg)))))
801 (define-display-method PropertySet (expr)
802 (let ((property (ly:music-property expr 'symbol))
803 (value (ly:music-property expr 'value))
804 (once (ly:music-property expr 'once)))
805 (format #f "~a\\set ~a~a = ~a~a"
806 (if (and (not (null? once)))
809 (if (eqv? (*current-context*) 'Bottom)
811 (format #f "~a . " (*current-context*)))
813 (value->lily-string value)
814 (new-line->lily-string))))
816 (define-display-method PropertyUnset (expr)
817 (format #f "~a\\unset ~a~a~a"
818 (if (ly:music-property expr 'once #f) "\\once " "")
819 (if (eqv? (*current-context*) 'Bottom)
821 (format #f "~a . " (*current-context*)))
822 (ly:music-property expr 'symbol)
823 (new-line->lily-string)))
825 ;;; Layout properties
827 (define-display-method OverrideProperty (expr)
828 (let* ((symbol (ly:music-property expr 'symbol))
829 (properties (ly:music-property expr 'grob-property-path
830 (list (ly:music-property expr 'grob-property))))
831 (value (ly:music-property expr 'grob-value))
832 (once (ly:music-property expr 'once)))
834 (format #f "~a\\override ~{~a~^.~} = ~a~a"
839 (if (eqv? (*current-context*) 'Bottom)
840 (cons symbol properties)
841 (cons* (*current-context*) symbol properties))
842 (value->lily-string value)
843 (new-line->lily-string))))
845 (define-display-method RevertProperty (expr)
846 (let* ((symbol (ly:music-property expr 'symbol))
847 (properties (ly:music-property expr 'grob-property-path
848 (list (ly:music-property expr
850 (once (ly:music-property expr 'once #f)))
851 (format #f "~a\\revert ~{~a~^.~}~a"
852 (if once "\\once " "")
853 (if (eqv? (*current-context*) 'Bottom)
854 (cons symbol properties)
855 (cons* (*current-context*) symbol properties))
856 (new-line->lily-string))))
858 (define-display-method TimeSignatureMusic (expr)
859 (let* ((num (ly:music-property expr 'numerator))
860 (den (ly:music-property expr 'denominator))
861 (structure (ly:music-property expr 'beat-structure)))
862 (if (null? structure)
866 (new-line->lily-string))
868 ;; This is silly but the latter will also work for #f
870 (if (key-list? structure)
871 "\\time ~{~a~^,~} ~a/~a~a"
872 "\\time #'~a ~a/~a~a")
874 (new-line->lily-string)))))
876 ;;; \melisma and \melismaEnd
877 (define-extra-display-method ContextSpeccedMusic (expr)
878 "If expr is a melisma, return \"\\melisma\", otherwise, return #f."
879 (with-music-match (expr (music 'ContextSpeccedMusic
880 element (music 'PropertySet
882 symbol 'melismaBusy)))
885 (define-extra-display-method ContextSpeccedMusic (expr)
886 "If expr is a melisma end, return \"\\melismaEnd\", otherwise, return #f."
887 (with-music-match (expr (music 'ContextSpeccedMusic
888 element (music 'PropertyUnset
889 symbol 'melismaBusy)))
893 (define-extra-display-method SequentialMusic (expr)
894 (with-music-match (expr (music 'SequentialMusic
895 elements ((music 'TempoChangeEvent
898 metronome-count ?count)
899 (music 'ContextSpeccedMusic
900 element (music 'PropertySet
901 symbol 'tempoWholesPerMinute)))))
902 (format #f "\\tempo ~{~a~a~}~a = ~a~a"
904 (list (markup->lily-string ?text) " ")
906 (duration->lily-string ?unit #:force-duration #t)
908 (format #f "~a - ~a" (car ?count) (cdr ?count))
910 (new-line->lily-string))))
912 (define-display-method TempoChangeEvent (expr)
913 (let ((text (ly:music-property expr 'text)))
914 (format #f "\\tempo ~a~a"
915 (markup->lily-string text)
916 (new-line->lily-string))))
919 (define clef-name-alist #f)
920 (define-public (memoize-clef-names clefs)
921 "Initialize @code{clef-name-alist}, if not already set."
922 (if (not clef-name-alist)
923 (set! clef-name-alist
924 (map (lambda (name+vals)
925 (cons (cdr name+vals)
929 (define-extra-display-method ContextSpeccedMusic (expr)
930 "If @var{expr} is a clef change, return \"\\clef ...\".
931 Otherwise, return @code{#f}."
932 (with-music-match (expr (music 'ContextSpeccedMusic
934 element (music 'SequentialMusic
935 elements ((music 'PropertySet
939 symbol 'middleCClefPosition)
942 symbol 'clefPosition)
944 value ?clef-transposition
945 symbol 'clefTransposition)
947 value ?clef-transposition-style
948 symbol 'clefTranspositionStyle)
950 procedure ly:set-middle-C!)))))
951 (let ((clef-name (assoc-get (list ?clef-glyph ?clef-position 0)
954 (format #f "\\clef \"~a~?\"~a"
956 (case ?clef-transposition-style
957 ((parenthesized) "~a(~a)")
958 ((bracketed) "~a[~a]")
960 (cond ((zero? ?clef-transposition)
962 ((positive? ?clef-transposition)
963 (list "^" (1+ ?clef-transposition)))
964 (else (list "_" (- 1 ?clef-transposition))))
965 (new-line->lily-string))))))
968 (define-extra-display-method ContextSpeccedMusic (expr)
969 "If `expr' is a bar, return \"\\bar ...\".
970 Otherwise, return #f."
971 (with-music-match (expr (music 'ContextSpeccedMusic
973 element (music 'PropertySet
976 (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string))))
979 (define-extra-display-method ContextSpeccedMusic (expr)
980 "If `expr' is a partial measure, return \"\\partial ...\".
981 Otherwise, return #f."
982 (with-music-match (expr (music
989 duration ?duration))))
992 (format #f "\\partial ~a"
993 (duration->lily-string ?duration #:force-duration #t)))))
998 (define-display-method ApplyOutputEvent (applyoutput)
999 (let ((proc (ly:music-property applyoutput 'procedure))
1000 (ctx (ly:music-property applyoutput 'context-type))
1001 (grob (ly:music-property applyoutput 'symbol)))
1002 (format #f "\\applyOutput ~a~@[.~a~] #~a"
1004 (and (symbol? grob) grob)
1005 (or (procedure-name proc)
1006 (with-output-to-string
1008 (pretty-print (procedure-source proc))))))))
1010 (define-display-method ApplyContext (applycontext)
1011 (let ((proc (ly:music-property applycontext 'procedure)))
1012 (format #f "\\applyContext #~a"
1013 (or (procedure-name proc)
1014 (with-output-to-string
1016 (pretty-print (procedure-source proc))))))))
1019 (define-display-method PartCombineMusic (expr)
1020 (let ((dir (ly:music-property expr 'direction)))
1021 (format #f "\\partcombine~a ~a~a~a"
1022 (cond ((equal? dir UP) "Up")
1023 ((equal? dir DOWN) "Down")
1025 (music->lily-string (car (ly:music-property expr 'elements)))
1026 (new-line->lily-string)
1027 (music->lily-string (cadr (ly:music-property expr 'elements))))))
1029 (define-display-method PartCombinePartMusic (expr)
1030 (with-music-match ((ly:music-property expr 'element)
1031 (music 'ContextSpeccedMusic element ?part))
1032 (format #f "~a" (music->lily-string ?part))))
1034 (define-extra-display-method ContextSpeccedMusic (expr)
1035 "If `expr' is a \\partcombine expression, return \"\\partcombine ...\".
1036 Otherwise, return #f."
1038 (expr (music 'ContextSpeccedMusic
1040 element (music 'SimultaneousMusic
1041 elements ((music 'ContextSpeccedMusic
1043 context-type 'Voice)
1044 (music 'ContextSpeccedMusic
1046 context-type 'Voice)
1047 (music 'ContextSpeccedMusic
1049 context-type 'Voice)
1050 (music 'ContextSpeccedMusic
1052 context-type 'Voice)
1053 (music 'ContextSpeccedMusic
1055 context-type 'NullVoice)
1059 (?pc-music (music 'PartCombineMusic))
1060 (format #f "~a" (music->lily-string ?pc-music)))))
1062 (define-display-method UnrelativableMusic (expr)
1063 (music->lily-string (ly:music-property expr 'element)))
1066 (define-display-method QuoteMusic (expr)
1067 (or (with-music-match (expr (music
1069 quoted-voice-direction ?quoted-voice-direction
1070 quoted-music-name ?quoted-music-name
1071 quoted-context-id "cue"
1072 quoted-context-type 'CueVoice
1074 (format #f "\\cueDuring #~s #~a ~a"
1076 ?quoted-voice-direction
1077 (music->lily-string ?music)))
1078 (format #f "\\quoteDuring #~s ~a"
1079 (ly:music-property expr 'quoted-music-name)
1080 (music->lily-string (ly:music-property expr 'element)))))
1085 (define-display-method LineBreakEvent (expr)
1086 (if (null? (ly:music-property expr 'break-permission))
1090 (define-display-method PageBreakEvent (expr)
1091 (if (null? (ly:music-property expr 'break-permission))
1095 (define-display-method PageTurnEvent (expr)
1096 (if (null? (ly:music-property expr 'break-permission))
1100 (define-extra-display-method EventChord (expr)
1101 (with-music-match (expr (music 'EventChord
1102 elements ((music 'LineBreakEvent
1103 break-permission 'force)
1104 (music 'PageBreakEvent
1105 break-permission 'force))))
1108 (define-extra-display-method EventChord (expr)
1109 (with-music-match (expr (music 'EventChord
1110 elements ((music 'LineBreakEvent
1111 break-permission 'force)
1112 (music 'PageBreakEvent
1113 break-permission 'force)
1114 (music 'PageTurnEvent
1115 break-permission 'force))))
1123 (define-display-method LyricCombineMusic (expr)
1124 (format #f "\\lyricsto ~s ~a"
1125 (ly:music-property expr 'associated-context)
1126 (parameterize ((*explicit-mode* #f)
1127 (*omit-duration* #t))
1128 (music->lily-string (ly:music-property expr 'element)))))
1131 (define-extra-display-method SimultaneousMusic (expr)
1132 (with-music-match (expr (music 'SimultaneousMusic
1133 elements ((music 'ContextSpeccedMusic
1137 (music 'ContextSpeccedMusic
1139 context-type 'Staff)
1140 (music 'ContextSpeccedMusic
1142 context-type 'Staff))))
1143 (with-music-match (?ac-music (music 'AutoChangeMusic))
1145 (music->lily-string ?ac-music)))))
1148 (define-extra-display-method SimultaneousMusic (expr)
1149 (with-music-match (expr (music 'SimultaneousMusic
1150 elements ((music 'ContextSpeccedMusic
1153 element ?note-sequence)
1154 (music 'ContextSpeccedMusic
1155 context-type 'Lyrics
1157 element (music 'LyricCombineMusic
1158 associated-context ?associated-id
1159 element ?lyric-sequence)))))
1160 (if (string=? ?id ?associated-id)
1161 (format #f "~a~a \\addlyrics ~a"
1162 (music->lily-string ?note-sequence)
1163 (new-line->lily-string)
1164 (parameterize ((*explicit-mode* #f)
1165 (*omit-duration* #t))
1166 (music->lily-string ?lyric-sequence)))
1169 ;; Silence internal event sent at end of each lyrics block
1170 (define-display-method CompletizeExtenderEvent (expr)