1 ;;; define-music-display-methods.scm -- data for displaying music
2 ;;; expressions using LilyPond notation.
4 ;;; Copyright (C) 2005--2012 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 parser)
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 (ly:parser-lookup parser 'pitchnames) pitch=)))
97 (define-public (octave->lily-string pitch)
98 (let ((octave (ly:pitch-octave pitch)))
100 (make-string (1+ octave) #\'))
102 (make-string (1- (* -1 octave)) #\,))
108 (define*-public (duration->lily-string ly-duration #:key (prev-duration (*previous-duration*))
109 (force-duration (*force-duration*))
110 (time-scale (*time-scale*))
112 (if remember (*previous-duration* ly-duration))
113 (let ((log2 (ly:duration-log ly-duration))
114 (dots (ly:duration-dot-count ly-duration))
115 (scale (ly:duration-scale ly-duration)))
116 (if (or force-duration (not prev-duration) (not (equal? ly-duration prev-duration)))
117 (string-append (case log2
121 (else (number->string (expt 2 log2))))
122 (make-string dots #\.)
123 (let ((end-scale (/ scale time-scale)))
124 (if (= end-scale 1) ""
125 (format #f "*~a" end-scale))))
132 (define (post-event? m)
133 (music-is-of-type? m 'post-event))
135 (define* (event-direction->lily-string event #:optional (required #t))
136 (let ((direction (ly:music-property event 'direction)))
137 (cond ((or (not direction) (null? direction) (= CENTER direction))
138 (if required "-" ""))
139 ((= UP direction) "^")
140 ((= DOWN direction) "_")
143 (define-macro (define-post-event-display-method type vars direction-required str)
144 `(define-display-method ,type ,vars
146 (event-direction->lily-string ,(car vars) ,direction-required)
149 (define-macro (define-span-event-display-method type vars direction-required str-start str-stop)
150 `(define-display-method ,type ,vars
152 (event-direction->lily-string ,(car vars) ,direction-required)
153 (if (= START (ly:music-property ,(car vars) 'span-direction))
157 (define-display-method HyphenEvent (event parser)
159 (define-display-method ExtenderEvent (event parser)
161 (define-display-method TieEvent (event parser)
163 (define-display-method BeamForbidEvent (event parser)
165 (define-display-method StringNumberEvent (event parser)
166 (format #f "\\~a" (ly:music-property event 'string-number)))
169 (define-display-method TremoloEvent (event parser)
170 (let ((tremolo-type (ly:music-property event 'tremolo-type)))
171 (format #f ":~a" (if (= 0 tremolo-type)
175 (define-display-method ArticulationEvent (event parser) #t
176 (let* ((articulation (ly:music-property event 'articulation-type))
178 (case (string->symbol articulation)
182 ((staccatissimo) "|")
187 (format #f "~a~:[\\~;~]~a"
188 (event-direction->lily-string event shorthand)
190 (or shorthand articulation))))
192 (define-post-event-display-method FingeringEvent (event parser) #t
193 (ly:music-property event 'digit))
195 (define-post-event-display-method TextScriptEvent (event parser) #t
196 (markup->lily-string (ly:music-property event 'text)))
198 (define-post-event-display-method MultiMeasureTextEvent (event parser) #t
199 (markup->lily-string (ly:music-property event 'text)))
201 (define-post-event-display-method BendAfterEvent (event parser) #f
202 (format #f "\\bendAfter #~a " (ly:music-property event 'delta-step)))
204 (define-post-event-display-method HarmonicEvent (event parser) #f "\\harmonic")
205 (define-post-event-display-method GlissandoEvent (event parser) #f "\\glissando")
206 (define-post-event-display-method ArpeggioEvent (event parser) #f "\\arpeggio")
207 (define-post-event-display-method AbsoluteDynamicEvent (event parser) #f
208 (format #f "\\~a" (ly:music-property event 'text)))
210 (define-post-event-display-method StrokeFingerEvent (event parser) #f
211 (format #f "\\rightHandFinger #~a " (ly:music-property event 'digit)))
213 (define-span-event-display-method BeamEvent (event parser) #f "[" "]")
214 (define-span-event-display-method SlurEvent (event parser) #f "(" ")")
215 (define-span-event-display-method CrescendoEvent (event parser) #f "\\<" "\\!")
216 (define-span-event-display-method DecrescendoEvent (event parser) #f "\\>" "\\!")
217 (define-span-event-display-method EpisemaEvent (event parser) #f "\\episemInitium" "\\episemFinis")
218 (define-span-event-display-method PhrasingSlurEvent (event parser) #f "\\(" "\\)")
219 (define-span-event-display-method SustainEvent (event parser) #f "\\sustainOn" "\\sustainOff")
220 (define-span-event-display-method SostenutoEvent (event parser) #f "\\sostenutoOn" "\\sostenutoOff")
221 (define-span-event-display-method TextSpanEvent (event parser) #f "\\startTextSpan" "\\stopTextSpan")
222 (define-span-event-display-method TrillSpanEvent (event parser) #f "\\startTrillSpan" "\\stopTrillSpan")
223 (define-span-event-display-method StaffSpanEvent (event parser) #f "\\startStaff" "\\stopStaff")
224 (define-span-event-display-method NoteGroupingEvent (event parser) #f "\\startGroup" "\\stopGroup")
225 (define-span-event-display-method UnaCordaEvent (event parser) #f "\\unaCorda" "\\treCorde")
231 (define-display-method GraceMusic (expr parser)
232 (format #f "\\grace ~a"
233 (music->lily-string (ly:music-property expr 'element) parser)))
235 ;; \acciaccatura \appoggiatura \grace
236 ;; TODO: it would be better to compare ?start and ?stop
237 ;; with startAppoggiaturaMusic and stopAppoggiaturaMusic,
238 ;; using a custom music equality predicate.
239 (define-extra-display-method GraceMusic (expr parser)
240 "Display method for appoggiatura."
241 (with-music-match (expr (music
248 ;; we check whether ?start and ?stop look like
249 ;; startAppoggiaturaMusic stopAppoggiaturaMusic
250 (and (with-music-match (?start (music
257 span-direction START))))))
259 (with-music-match (?stop (music
266 span-direction STOP))))))
267 (format #f "\\appoggiatura ~a" (music->lily-string ?music parser))))))
270 (define-extra-display-method GraceMusic (expr parser)
271 "Display method for acciaccatura."
272 (with-music-match (expr (music
279 ;; we check whether ?start and ?stop look like
280 ;; startAcciaccaturaMusic stopAcciaccaturaMusic
281 (and (with-music-match (?start (music
288 span-direction START)))
293 grob-property-path '(stroke-style)
297 (with-music-match (?stop (music
303 grob-property-path '(stroke-style)
311 span-direction STOP))))))
312 (format #f "\\acciaccatura ~a" (music->lily-string ?music parser))))))
314 (define-extra-display-method GraceMusic (expr parser)
315 "Display method for grace."
316 (with-music-match (expr (music
323 ;; we check whether ?start and ?stop look like
324 ;; startGraceMusic stopGraceMusic
325 (and (null? (ly:music-property ?start 'elements))
326 (null? (ly:music-property ?stop 'elements))
327 (format #f "\\grace ~a" (music->lily-string ?music parser)))))
333 (define-display-method SequentialMusic (seq parser)
334 (let ((force-line-break (and (*force-line-break*)
336 (> (length (ly:music-property seq 'elements))
337 (*max-element-number-before-break*))))
338 (elements (ly:music-property seq 'elements))
339 (chord? (make-music-type-predicate 'EventChord))
340 (note-or-chord? (make-music-type-predicate 'EventChord 'NoteEvent
341 'LyricEvent 'RestEvent
343 (cluster? (make-music-type-predicate 'ClusterNoteEvent))
344 (note? (make-music-type-predicate 'NoteEvent)))
345 (format #f "~a~a{~v%~v_~{~a~^ ~}~v%~v_}"
349 (any cluster? (ly:music-property e 'elements)))))
353 (if (*explicit-mode*)
354 ;; if the sequence contains EventChord which contains figures ==> figuremode
355 ;; if the sequence contains EventChord which contains lyrics ==> lyricmode
356 ;; if the sequence contains EventChord which contains drum notes ==> drummode
357 (cond ((any (lambda (chord)
358 (any (make-music-type-predicate 'BassFigureEvent)
359 (ly:music-property chord 'elements)))
360 (filter chord? elements))
362 ((any (lambda (chord)
363 (any (make-music-type-predicate 'LyricEvent)
365 (ly:music-property chord 'elements))))
366 (filter note-or-chord? elements))
368 ((any (lambda (chord)
371 (not (null? (ly:music-property event 'drum-type)))))
373 (ly:music-property chord 'elements))))
374 (filter note-or-chord? elements))
376 (else ;; TODO: other modes?
379 (if force-line-break 1 0)
380 (if force-line-break (+ 2 (*indent*)) 1)
381 (parameterize ((*indent* (+ 2 (*indent*))))
382 (map-in-order (lambda (music)
383 (music->lily-string music parser))
385 (if force-line-break 1 0)
386 (if force-line-break (*indent*) 1))))
388 (define-display-method SimultaneousMusic (sim parser)
389 (parameterize ((*indent* (+ 3 (*indent*))))
390 (format #f "<< ~{~a ~}>>"
391 (map-in-order (lambda (music)
392 (music->lily-string music parser))
393 (ly:music-property sim 'elements)))))
395 (define-extra-display-method SimultaneousMusic (expr parser)
396 "If `sim' is an \afterGrace expression, return \"\\afterGrace ...\".
397 Otherwise, return #f."
398 ;; TODO: do something with afterGraceFraction?
399 (with-music-match (expr (music 'SimultaneousMusic
400 elements (?before-grace
401 (music 'SequentialMusic
402 elements ((music 'SkipMusic)
405 (format #f "\\afterGrace ~a ~a"
406 (music->lily-string ?before-grace parser)
407 (music->lily-string ?grace parser))))
413 (define-display-method EventChord (chord parser)
414 ;; event_chord : command_element
415 ;; | note_chord_element
417 ;; TODO : tagged post_events
418 ;; post_events : ( post_event | tagged_post_event )*
419 ;; tagged_post_event: '-' \tag embedded_scm post_event
421 (let* ((elements (append (ly:music-property chord 'elements)
422 (ly:music-property chord 'articulations)))
423 (chord-repeat (ly:music-property chord 'duration)))
426 (partition (lambda (m) (music-is-of-type? m 'rhythmic-event))
428 (lambda (chord-elements other-elements)
429 (cond ((pair? chord-elements)
430 ;; note_chord_element :
431 ;; '<' (notepitch | drumpitch)* '>" duration post_events
432 (let ((duration (duration->lily-string (ly:music-property
436 ;; Format duration first so that it does not appear on
438 (format #f "< ~{~a ~}>~a~:{~:[-~;~]~a~^ ~}"
439 (map-in-order (lambda (music)
440 (music->lily-string music parser))
443 (map-in-order (lambda (music)
446 (music->lily-string music parser)))
448 ((ly:duration? chord-repeat)
449 (let ((duration (duration->lily-string chord-repeat
451 (format #f "q~a~:{~:[-~;~]~a~^ ~}"
453 (map-in-order (lambda (music)
456 (music->lily-string music parser)))
459 ((and (= 1 (length other-elements))
460 (not (post-event? (car other-elements))))
461 (format #f (music->lily-string (car other-elements) parser)))
463 (format #f "< >~:{~:[-~;~]~a~^ ~}"
464 (map-in-order (lambda (music)
467 (music->lily-string music parser)))
468 other-elements))))))))
470 (define-display-method MultiMeasureRestMusic (mmrest parser)
471 (format #f "R~a~{~a~^ ~}"
472 (duration->lily-string (ly:music-property mmrest 'duration)
474 (map-in-order (lambda (music)
475 (music->lily-string music parser))
476 (ly:music-property mmrest 'articulations))))
478 (define-display-method SkipMusic (skip parser)
479 (format #f "\\skip ~a" (duration->lily-string (ly:music-property skip 'duration) #:force-duration #t)))
481 (define-display-method OttavaMusic (ottava parser)
482 (format #f "\\ottava #~a" (ly:music-property ottava 'ottava-number)))
485 ;;; Notes, rests, skips...
488 (define (simple-note->lily-string event parser)
489 (format #f "~a~a~a~a~a~a~:{~:[-~;~]~a~}" ; pitchname octave !? octave-check duration optional_rest articulations
490 (note-name->lily-string (ly:music-property event 'pitch) parser)
491 (octave->lily-string (ly:music-property event 'pitch))
492 (let ((forced (ly:music-property event 'force-accidental))
493 (cautionary (ly:music-property event 'cautionary)))
494 (cond ((and (not (null? forced))
496 (not (null? cautionary))
499 ((and (not (null? forced)) forced) "!")
501 (let ((octave-check (ly:music-property event 'absolute-octave)))
502 (if (not (null? octave-check))
503 (format #f "=~a" (cond ((>= octave-check 0)
504 (make-string (1+ octave-check) #\'))
506 (make-string (1- (* -1 octave-check)) #\,))
509 (duration->lily-string (ly:music-property event 'duration)
511 (if ((make-music-type-predicate 'RestEvent) event)
513 (map-in-order (lambda (event)
516 (music->lily-string event parser)))
517 (ly:music-property event 'articulations))))
519 (define-display-method NoteEvent (note parser)
520 (cond ((not (null? (ly:music-property note 'pitch))) ;; note
521 (simple-note->lily-string note parser))
522 ((not (null? (ly:music-property note 'drum-type))) ;; drum
523 (format #f "~a~a~{~a~}" (ly:music-property note 'drum-type)
524 (duration->lily-string (ly:music-property note 'duration)
526 (map-in-order (lambda (event)
527 (music->lily-string event parser))
528 (ly:music-property note 'articulations))))
532 (define-display-method ClusterNoteEvent (note parser)
533 (simple-note->lily-string note parser))
535 (define-display-method RestEvent (rest parser)
536 (if (not (null? (ly:music-property rest 'pitch)))
537 (simple-note->lily-string rest parser)
538 (format #f "r~a~{~a~}"
539 (duration->lily-string (ly:music-property rest 'duration)
541 (map-in-order (lambda (event)
542 (music->lily-string event parser))
543 (ly:music-property rest 'articulations)))))
545 (define-display-method MultiMeasureRestEvent (rest parser)
546 (string-append "R" (duration->lily-string (ly:music-property rest 'duration)
549 (define-display-method SkipEvent (rest parser)
550 (format #f "s~a~{~a~}"
551 (duration->lily-string (ly:music-property rest 'duration)
553 (map-in-order (lambda (event)
554 (music->lily-string event parser))
555 (ly:music-property rest 'articulations))))
557 (define-display-method RepeatedChord (chord parser)
558 (music->lily-string (ly:music-property chord 'element) parser))
560 (define-display-method MarkEvent (mark parser)
561 (let ((label (ly:music-property mark 'label)))
564 (format #f "\\mark ~a" (markup->lily-string label)))))
566 (define-display-method KeyChangeEvent (key parser)
567 (let ((pitch-alist (ly:music-property key 'pitch-alist))
568 (tonic (ly:music-property key 'tonic)))
569 (if (or (null? pitch-alist)
572 (let ((c-pitch-alist (ly:transpose-key-alist pitch-alist
573 (ly:pitch-diff (ly:make-pitch 0 0 0) tonic))))
574 (format #f "\\key ~a \\~a~a"
575 (note-name->lily-string (ly:music-property key 'tonic) parser)
578 (equal? (ly:parser-lookup parser mode) c-pitch-alist))
579 (symbol->string mode)
581 '(major minor ionian locrian aeolian mixolydian lydian phrygian dorian))
582 (new-line->lily-string))))))
584 (define-display-method RelativeOctaveCheck (octave parser)
585 (let ((pitch (ly:music-property octave 'pitch)))
586 (format #f "\\octaveCheck ~a~a"
587 (note-name->lily-string pitch parser)
588 (octave->lily-string pitch))))
590 (define-display-method VoiceSeparator (sep parser)
593 (define-display-method LigatureEvent (ligature parser)
594 (if (= START (ly:music-property ligature 'span-direction))
598 (define-display-method BarCheck (check parser)
599 (format #f "|~a" (new-line->lily-string)))
601 (define-display-method PesOrFlexaEvent (expr parser)
604 (define-display-method BassFigureEvent (figure parser)
605 (let ((alteration (ly:music-property figure 'alteration))
606 (fig (ly:music-property figure 'figure))
607 (bracket-start (ly:music-property figure 'bracket-start))
608 (bracket-stop (ly:music-property figure 'bracket-stop)))
610 (format #f "~a~a~a~a"
611 (if (null? bracket-start) "" "[")
612 (cond ((null? fig) "_")
613 ((markup? fig) (second fig)) ;; fig: (<number-markup> "number")
615 (if (null? alteration)
618 ((= alteration DOUBLE-FLAT) "--")
619 ((= alteration FLAT) "-")
620 ((= alteration NATURAL) "!")
621 ((= alteration SHARP) "+")
622 ((= alteration DOUBLE-SHARP) "++")
624 (if (null? bracket-stop) "" "]"))))
626 (define-display-method LyricEvent (lyric parser)
627 (format "~a~{~a~^ ~}"
628 (let ((text (ly:music-property lyric 'text)))
629 (if (or (string? text)
630 (eqv? (first text) simple-markup))
631 ;; a string or a simple markup
632 (let ((string (if (string? text)
635 (if (string-match "(\"| |[0-9])" string)
636 ;; TODO check exactly in which cases double quotes should be used
637 (format #f "~s" string)
639 (markup->lily-string text)))
640 (map-in-order (lambda (m) (music->lily-string m parser))
641 (ly:music-property lyric 'articulations))))
643 (define-display-method BreathingEvent (event parser)
650 (define-display-method AutoChangeMusic (m parser)
651 (format #f "\\autochange ~a"
652 (music->lily-string (ly:music-property m 'element) parser)))
654 (define-display-method ContextChange (m parser)
655 (format #f "\\change ~a = \"~a\""
656 (ly:music-property m 'change-to-type)
657 (ly:music-property m 'change-to-id)))
661 (define-display-method TimeScaledMusic (times parser)
662 (let* ((num (ly:music-property times 'numerator))
663 (den (ly:music-property times 'denominator))
664 (span (ly:music-property times 'duration #f))
665 ;; need to format before changing time scale
667 (and span (duration->lily-string span #:force-duration #t)))
669 (time-scale (*time-scale*)))
670 (*previous-duration* #f)
672 (parameterize ((*force-line-break* #f)
673 (*time-scale* (* time-scale scale)))
674 (format #f "\\tuplet ~a/~a ~@[~a ~]~a"
678 (music->lily-string (ly:music-property times 'element) parser)))))
679 (*previous-duration* #f)
682 (define-display-method RelativeOctaveMusic (m parser)
683 (music->lily-string (ly:music-property m 'element) parser))
685 (define-display-method TransposedMusic (m parser)
686 (music->lily-string (ly:music-property m 'element) parser))
692 (define-display-method AlternativeEvent (alternative parser) "")
694 (define (repeat->lily-string expr repeat-type parser)
695 (let* ((main (music->lily-string (ly:music-property expr 'element) parser)))
696 (format #f "\\repeat ~a ~a ~a ~a"
698 (ly:music-property expr 'repeat-count)
700 (let ((alternatives (ly:music-property expr 'elements)))
701 (if (null? alternatives)
703 (format #f "\\alternative { ~{~a ~}}"
704 (map-in-order (lambda (music)
705 (music->lily-string music parser))
708 (define-display-method VoltaRepeatedMusic (expr parser)
709 (repeat->lily-string expr "volta" parser))
711 (define-display-method UnfoldedRepeatedMusic (expr parser)
712 (repeat->lily-string expr "unfold" parser))
714 (define-display-method PercentRepeatedMusic (expr parser)
715 (repeat->lily-string expr "percent" parser))
717 (define-display-method TremoloRepeatedMusic (expr parser)
718 (let* ((main (ly:music-property expr 'element))
719 (children (if (music-is-of-type? main 'sequential-music)
720 ;; \repeat tremolo n { ... }
721 (length (extract-named-music main '(EventChord
723 ;; \repeat tremolo n c4
725 (times (ly:music-property expr 'repeat-count))
727 ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
728 (dots (1- (logcount (* times children))))
729 ;; The remaining missing multiplicator to scale the notes by
731 (mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots))))
732 (shift (- (ly:intlog2 (floor mult)))))
733 (set! main (ly:music-deep-copy main))
734 ;; Adjust the time of the notes
735 (ly:music-compress main (ly:make-moment children 1))
736 ;; Adjust the displayed note durations
737 (shift-duration-log main (- shift) (- dots))
738 (format #f "\\repeat tremolo ~a ~a"
740 (music->lily-string main parser))))
746 (define-display-method ContextSpeccedMusic (expr parser)
747 (let ((id (ly:music-property expr 'context-id))
748 (create-new (ly:music-property expr 'create-new))
749 (music (ly:music-property expr 'element))
750 (operations (ly:music-property expr 'property-operations))
751 (ctype (ly:music-property expr 'context-type)))
752 (format #f "~a ~a~a~a ~a"
753 (if (and (not (null? create-new)) create-new)
759 (format #f " = ~s" id))
760 (if (null? operations)
762 (format #f " \\with {~{~a~}~%~v_}"
763 (parameterize ((*indent* (+ (*indent*) 2)))
765 (format #f "~%~v_\\~a ~s"
771 (parameterize ((*current-context* ctype))
772 (music->lily-string music parser)))))
774 ;; special cases: \figures \lyrics \drums
775 (define-extra-display-method ContextSpeccedMusic (expr parser)
776 (with-music-match (expr (music 'ContextSpeccedMusic
778 property-operations ?op
779 context-type ?context-type
782 (parameterize ((*explicit-mode* #f))
785 (format #f "\\figures ~a" (music->lily-string ?sequence parser)))
787 (format #f "\\lyrics ~a" (music->lily-string ?sequence parser)))
789 (format #f "\\drums ~a" (music->lily-string ?sequence parser)))
794 ;;; Context properties
796 (define-extra-display-method ContextSpeccedMusic (expr parser)
797 (let ((element (ly:music-property expr 'element))
798 (property-tuning? (make-music-type-predicate 'PropertySet
802 (sequence? (make-music-type-predicate 'SequentialMusic)))
803 (if (and (ly:music? element)
804 (or (property-tuning? element)
805 (and (sequence? element)
806 (every property-tuning? (ly:music-property element 'elements)))))
807 (parameterize ((*current-context* (ly:music-property expr 'context-type)))
808 (music->lily-string element parser))
811 (define (property-value->lily-string arg parser)
812 (cond ((ly:music? arg)
813 (music->lily-string arg parser))
815 (format #f "#~s" arg))
817 (markup->lily-string arg))
819 (format #f "#~a" (scheme-expr->lily-string arg)))))
821 (define-display-method PropertySet (expr parser)
822 (let ((property (ly:music-property expr 'symbol))
823 (value (ly:music-property expr 'value))
824 (once (ly:music-property expr 'once)))
825 (format #f "~a\\set ~a~a = ~a~a"
826 (if (and (not (null? once)))
829 (if (eqv? (*current-context*) 'Bottom)
831 (format #f "~a . " (*current-context*)))
833 (property-value->lily-string value parser)
834 (new-line->lily-string))))
836 (define-display-method PropertyUnset (expr parser)
837 (format #f "\\unset ~a~a~a"
838 (if (eqv? (*current-context*) 'Bottom)
840 (format #f "~a . " (*current-context*)))
841 (ly:music-property expr 'symbol)
842 (new-line->lily-string)))
844 ;;; Layout properties
846 (define-display-method OverrideProperty (expr parser)
847 (let* ((symbol (ly:music-property expr 'symbol))
848 (properties (ly:music-property expr 'grob-property-path
849 (list (ly:music-property expr 'grob-property))))
850 (value (ly:music-property expr 'grob-value))
851 (once (ly:music-property expr 'once)))
853 (format #f "~a\\override ~{~a~^.~} = ~a~a"
858 (if (eqv? (*current-context*) 'Bottom)
859 (cons symbol properties)
860 (cons* (*current-context*) symbol properties))
861 (property-value->lily-string value parser)
862 (new-line->lily-string))))
864 (define-display-method RevertProperty (expr parser)
865 (let* ((symbol (ly:music-property expr 'symbol))
866 (properties (ly:music-property expr 'grob-property-path
867 (list (ly:music-property expr 'grob-property)))))
868 (format #f "\\revert ~{~a~^.~}~a"
869 (if (eqv? (*current-context*) 'Bottom)
870 (cons symbol properties)
871 (cons* (*current-context*) symbol properties))
872 (new-line->lily-string))))
874 (define-display-method TimeSignatureMusic (expr parser)
875 (let* ((num (ly:music-property expr 'numerator))
876 (den (ly:music-property expr 'denominator))
877 (structure (ly:music-property expr 'beat-structure)))
878 (if (null? structure)
882 (new-line->lily-string))
884 "\\time #'~a ~a/~a~a"
886 (new-line->lily-string)))))
888 ;;; \melisma and \melismaEnd
889 (define-extra-display-method ContextSpeccedMusic (expr parser)
890 "If expr is a melisma, return \"\\melisma\", otherwise, return #f."
891 (with-music-match (expr (music 'ContextSpeccedMusic
892 element (music 'PropertySet
894 symbol 'melismaBusy)))
897 (define-extra-display-method ContextSpeccedMusic (expr parser)
898 "If expr is a melisma end, return \"\\melismaEnd\", otherwise, return #f."
899 (with-music-match (expr (music 'ContextSpeccedMusic
900 element (music 'PropertyUnset
901 symbol 'melismaBusy)))
905 (define-extra-display-method SequentialMusic (expr parser)
906 (with-music-match (expr (music 'SequentialMusic
907 elements ((music 'TempoChangeEvent
910 metronome-count ?count)
911 (music 'ContextSpeccedMusic
912 element (music 'PropertySet
913 symbol 'tempoWholesPerMinute)))))
914 (format #f "\\tempo ~{~a~a~}~a = ~a~a"
916 (list (markup->lily-string ?text) " ")
918 (duration->lily-string ?unit #:force-duration #t)
920 (format #f "~a ~~ ~a" (car ?count) (cdr ?count))
922 (new-line->lily-string))))
924 (define-display-method TempoChangeEvent (expr parser)
925 (let ((text (ly:music-property expr 'text)))
926 (format #f "\\tempo ~a~a"
927 (markup->lily-string text)
928 (new-line->lily-string))))
931 (define clef-name-alist #f)
932 (define-public (memoize-clef-names clefs)
933 "Initialize @code{clef-name-alist}, if not already set."
934 (if (not clef-name-alist)
935 (set! clef-name-alist
936 (map (lambda (name+vals)
937 (cons (cdr name+vals)
941 (define-extra-display-method ContextSpeccedMusic (expr parser)
942 "If @var{expr} is a clef change, return \"\\clef ...\".
943 Otherwise, return @code{#f}."
944 (with-music-match (expr (music 'ContextSpeccedMusic
946 element (music 'SequentialMusic
947 elements ((music 'PropertySet
951 symbol 'middleCClefPosition)
954 symbol 'clefPosition)
956 value ?clef-transposition
957 symbol 'clefTransposition)
959 procedure ly:set-middle-C!)))))
960 (let ((clef-name (assoc-get (list ?clef-glyph ?clef-position 0)
963 (format #f "\\clef \"~a~{~a~a~}\"~a"
965 (cond ((= 0 ?clef-transposition)
967 ((> ?clef-transposition 0)
968 (list "^" (1+ ?clef-transposition)))
970 (list "_" (- 1 ?clef-transposition))))
971 (new-line->lily-string))
975 (define-extra-display-method ContextSpeccedMusic (expr parser)
976 "If `expr' is a bar, return \"\\bar ...\".
977 Otherwise, return #f."
978 (with-music-match (expr (music 'ContextSpeccedMusic
980 element (music 'PropertySet
983 (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string))))
986 (define-extra-display-method ContextSpeccedMusic (expr parser)
987 "If `expr' is a partial measure, return \"\\partial ...\".
988 Otherwise, return #f."
989 (with-music-match (expr (music
996 partial-duration ?duration))))
999 (format #f "\\partial ~a"
1000 (duration->lily-string ?duration #:force-duration #t)))))
1005 (define-display-method ApplyOutputEvent (applyoutput parser)
1006 (let ((proc (ly:music-property applyoutput 'procedure))
1007 (ctx (ly:music-property applyoutput 'context-type)))
1008 (format #f "\\applyOutput #'~a #~a"
1010 (or (procedure-name proc)
1011 (with-output-to-string
1013 (pretty-print (procedure-source proc))))))))
1015 (define-display-method ApplyContext (applycontext parser)
1016 (let ((proc (ly:music-property applycontext 'procedure)))
1017 (format #f "\\applyContext #~a"
1018 (or (procedure-name proc)
1019 (with-output-to-string
1021 (pretty-print (procedure-source proc))))))))
1024 (define-display-method PartCombineMusic (expr parser)
1025 (format #f "\\partcombine ~{~a ~}"
1026 (map-in-order (lambda (music)
1027 (music->lily-string music parser))
1028 (ly:music-property expr 'elements))))
1030 (define-extra-display-method PartCombineMusic (expr parser)
1031 (with-music-match (expr (music 'PartCombineMusic
1032 elements ((music 'UnrelativableMusic
1033 element (music 'ContextSpeccedMusic
1036 element ?sequence1))
1037 (music 'UnrelativableMusic
1038 element (music 'ContextSpeccedMusic
1041 element ?sequence2)))))
1042 (format #f "\\partcombine ~a~a~a"
1043 (music->lily-string ?sequence1 parser)
1044 (new-line->lily-string)
1045 (music->lily-string ?sequence2 parser))))
1047 (define-display-method UnrelativableMusic (expr parser)
1048 (music->lily-string (ly:music-property expr 'element) parser))
1051 (define-display-method QuoteMusic (expr parser)
1052 (or (with-music-match (expr (music
1054 quoted-voice-direction ?quoted-voice-direction
1055 quoted-music-name ?quoted-music-name
1056 quoted-context-id "cue"
1057 quoted-context-type 'Voice
1059 (format #f "\\cueDuring #~s #~a ~a"
1061 ?quoted-voice-direction
1062 (music->lily-string ?music parser)))
1063 (format #f "\\quoteDuring #~s ~a"
1064 (ly:music-property expr 'quoted-music-name)
1065 (music->lily-string (ly:music-property expr 'element) parser))))
1070 (define-display-method LineBreakEvent (expr parser)
1071 (if (null? (ly:music-property expr 'break-permission))
1075 (define-display-method PageBreakEvent (expr parser)
1076 (if (null? (ly:music-property expr 'break-permission))
1080 (define-display-method PageTurnEvent (expr parser)
1081 (if (null? (ly:music-property expr 'break-permission))
1085 (define-extra-display-method EventChord (expr parser)
1086 (with-music-match (expr (music 'EventChord
1087 elements ((music 'LineBreakEvent
1088 break-permission 'force)
1089 (music 'PageBreakEvent
1090 break-permission 'force))))
1093 (define-extra-display-method EventChord (expr parser)
1094 (with-music-match (expr (music 'EventChord
1095 elements ((music 'LineBreakEvent
1096 break-permission 'force)
1097 (music 'PageBreakEvent
1098 break-permission 'force)
1099 (music 'PageTurnEvent
1100 break-permission 'force))))
1108 (define-display-method LyricCombineMusic (expr parser)
1109 (format #f "\\lyricsto ~s ~a"
1110 (ly:music-property expr 'associated-context)
1111 (parameterize ((*explicit-mode* #f))
1112 (music->lily-string (ly:music-property expr 'element) parser))))
1115 (define-extra-display-method SimultaneousMusic (expr parser)
1116 (with-music-match (expr (music 'SimultaneousMusic
1117 elements ((music 'ContextSpeccedMusic
1120 element ?note-sequence)
1121 (music 'ContextSpeccedMusic
1122 context-type 'Lyrics
1124 element (music 'LyricCombineMusic
1125 associated-context ?associated-id
1126 element ?lyric-sequence)))))
1127 (if (string=? ?id ?associated-id)
1128 (format #f "~a~a \\addlyrics ~a"
1129 (music->lily-string ?note-sequence parser)
1130 (new-line->lily-string)
1131 (parameterize ((*explicit-mode* #f))
1132 (music->lily-string ?lyric-sequence parser)))
1135 ;; Silence internal event sent at end of each lyrics block
1136 (define-display-method CompletizeExtenderEvent (expr parser)