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-factor-numerator (*time-factor-numerator*))
111 (time-factor-denominator (*time-factor-denominator*)))
112 (let ((log2 (ly:duration-log ly-duration))
113 (dots (ly:duration-dot-count ly-duration))
114 (num+den (ly:duration-factor ly-duration)))
115 (if (or force-duration (not prev-duration) (not (equal? ly-duration prev-duration)))
116 (string-append (case log2
120 (else (number->string (expt 2 log2))))
121 (make-string dots #\.)
122 (let ((num? (not (or (= 1 (car num+den))
123 (and time-factor-numerator
124 (= (car num+den) time-factor-numerator)))))
125 (den? (not (or (= 1 (cdr num+den))
126 (and time-factor-denominator
127 (= (cdr num+den) time-factor-denominator))))))
129 (format #f "*~a/~a" (car num+den) (cdr num+den)))
131 (format #f "*~a" (car num+den)))
140 (make-music-type-predicate
141 'AbsoluteDynamicEvent
155 'MultiMeasureTextEvent
171 (define* (event-direction->lily-string event #:optional (required #t))
172 (let ((direction (ly:music-property event 'direction)))
173 (cond ((or (not direction) (null? direction) (= CENTER direction))
174 (if required "-" ""))
175 ((= UP direction) "^")
176 ((= DOWN direction) "_")
179 (define-macro (define-post-event-display-method type vars direction-required str)
180 `(define-display-method ,type ,vars
182 (event-direction->lily-string ,(car vars) ,direction-required)
185 (define-macro (define-span-event-display-method type vars direction-required str-start str-stop)
186 `(define-display-method ,type ,vars
188 (event-direction->lily-string ,(car vars) ,direction-required)
189 (if (= START (ly:music-property ,(car vars) 'span-direction))
193 (define-display-method HyphenEvent (event parser)
195 (define-display-method ExtenderEvent (event parser)
197 (define-display-method TieEvent (event parser)
199 (define-display-method BeamForbidEvent (event parser)
201 (define-display-method StringNumberEvent (event parser)
202 (format #f "\\~a" (ly:music-property event 'string-number)))
205 (define-display-method TremoloEvent (event parser)
206 (let ((tremolo-type (ly:music-property event 'tremolo-type)))
207 (format #f ":~a" (if (= 0 tremolo-type)
211 (define-post-event-display-method ArticulationEvent (event parser) #t
212 (let ((articulation (ly:music-property event 'articulation-type)))
213 (case (string->symbol articulation)
217 ((staccatissimo) "|")
221 (else (format #f "\\~a" articulation)))))
223 (define-post-event-display-method FingeringEvent (event parser) #t
224 (ly:music-property event 'digit))
226 (define-post-event-display-method TextScriptEvent (event parser) #t
227 (markup->lily-string (ly:music-property event 'text)))
229 (define-post-event-display-method MultiMeasureTextEvent (event parser) #t
230 (markup->lily-string (ly:music-property event 'text)))
232 (define-post-event-display-method BendAfterEvent (event parser) #t
233 (format #f "\\bendAfter #~a" (ly:music-property event 'delta-step)))
235 (define-post-event-display-method HarmonicEvent (event parser) #f "\\harmonic")
236 (define-post-event-display-method GlissandoEvent (event parser) #t "\\glissando")
237 (define-post-event-display-method ArpeggioEvent (event parser) #t "\\arpeggio")
238 (define-post-event-display-method AbsoluteDynamicEvent (event parser) #f
239 (format #f "\\~a" (ly:music-property event 'text)))
241 (define-post-event-display-method StrokeFingerEvent (event parser) #t
242 (format #f "\\rightHandFinger #~a" (ly:music-property event 'digit)))
244 (define-span-event-display-method BeamEvent (event parser) #f "[" "]")
245 (define-span-event-display-method SlurEvent (event parser) #f "(" ")")
246 (define-span-event-display-method CrescendoEvent (event parser) #f "\\<" "\\!")
247 (define-span-event-display-method DecrescendoEvent (event parser) #f "\\>" "\\!")
248 (define-span-event-display-method EpisemaEvent (event parser) #f "\\episemInitium" "\\episemFinis")
249 (define-span-event-display-method PhrasingSlurEvent (event parser) #f "\\(" "\\)")
250 (define-span-event-display-method SustainEvent (event parser) #f "\\sustainOn" "\\sustainOff")
251 (define-span-event-display-method SostenutoEvent (event parser) #f "\\sostenutoOn" "\\sostenutoOff")
252 (define-span-event-display-method TextSpanEvent (event parser) #f "\\startTextSpan" "\\stopTextSpan")
253 (define-span-event-display-method TrillSpanEvent (event parser) #f "\\startTrillSpan" "\\stopTrillSpan")
254 (define-span-event-display-method StaffSpanEvent (event parser) #f "\\startStaff" "\\stopStaff")
255 (define-span-event-display-method NoteGroupingEvent (event parser) #f "\\startGroup" "\\stopGroup")
256 (define-span-event-display-method UnaCordaEvent (event parser) #f "\\unaCorda" "\\treCorde")
262 (define-display-method GraceMusic (expr parser)
263 (format #f "\\grace ~a"
264 (music->lily-string (ly:music-property expr 'element) parser)))
266 ;; \acciaccatura \appoggiatura \grace
267 ;; TODO: it would be better to compare ?start and ?stop
268 ;; with startAppoggiaturaMusic and stopAppoggiaturaMusic,
269 ;; using a custom music equality predicate.
270 (define-extra-display-method GraceMusic (expr parser)
271 "Display method for appoggiatura."
272 (with-music-match (expr (music
279 ;; we check whether ?start and ?stop look like
280 ;; startAppoggiaturaMusic stopAppoggiaturaMusic
281 (and (with-music-match (?start (music
287 duration (ly:make-duration 0 0 0 1))
290 span-direction START))))))
292 (with-music-match (?stop (music
298 duration (ly:make-duration 0 0 0 1))
301 span-direction STOP))))))
302 (format #f "\\appoggiatura ~a" (music->lily-string ?music parser))))))
305 (define-extra-display-method GraceMusic (expr parser)
306 "Display method for acciaccatura."
307 (with-music-match (expr (music
314 ;; we check whether ?start and ?stop look like
315 ;; startAcciaccaturaMusic stopAcciaccaturaMusic
316 (and (with-music-match (?start (music
322 duration (ly:make-duration 0 0 0 1))
325 span-direction START)))
330 grob-property-path '(stroke-style)
334 (with-music-match (?stop (music
340 grob-property-path '(stroke-style)
346 duration (ly:make-duration 0 0 0 1))
349 span-direction STOP))))))
350 (format #f "\\acciaccatura ~a" (music->lily-string ?music parser))))))
352 (define-extra-display-method GraceMusic (expr parser)
353 "Display method for grace."
354 (with-music-match (expr (music
361 ;; we check whether ?start and ?stop look like
362 ;; startGraceMusic stopGraceMusic
363 (and (null? (ly:music-property ?start 'elements))
364 (null? (ly:music-property ?stop 'elements))
365 (format #f "\\grace ~a" (music->lily-string ?music parser)))))
371 (define-display-method SequentialMusic (seq parser)
372 (let ((force-line-break (and (*force-line-break*)
374 (> (length (ly:music-property seq 'elements))
375 (*max-element-number-before-break*))))
376 (elements (ly:music-property seq 'elements))
377 (chord? (make-music-type-predicate 'EventChord))
378 (cluster? (make-music-type-predicate 'ClusterNoteEvent))
379 (note? (make-music-type-predicate 'NoteEvent)))
380 (format #f "~a~a{~v%~v_~{~a~^ ~}~v%~v_}"
383 (any cluster? (ly:music-property e 'elements))))
387 (if (*explicit-mode*)
388 ;; if the sequence contains EventChord which contains figures ==> figuremode
389 ;; if the sequence contains EventChord which contains lyrics ==> lyricmode
390 ;; if the sequence contains EventChord which contains drum notes ==> drummode
391 (cond ((any (lambda (chord)
392 (any (make-music-type-predicate 'BassFigureEvent)
393 (ly:music-property chord 'elements)))
394 (filter chord? elements))
396 ((any (lambda (chord)
397 (any (make-music-type-predicate 'LyricEvent)
398 (ly:music-property chord 'elements)))
399 (filter chord? elements))
401 ((any (lambda (chord)
404 (not (null? (ly:music-property event 'drum-type)))))
405 (ly:music-property chord 'elements)))
406 (filter chord? elements))
408 (else ;; TODO: other modes?
411 (if force-line-break 1 0)
412 (if force-line-break (+ 2 (*indent*)) 1)
413 (parameterize ((*indent* (+ 2 (*indent*))))
414 (map-in-order (lambda (music)
415 (music->lily-string music parser))
417 (if force-line-break 1 0)
418 (if force-line-break (*indent*) 1))))
420 (define-display-method SimultaneousMusic (sim parser)
421 (parameterize ((*indent* (+ 3 (*indent*))))
422 (format #f "<< ~{~a ~}>>"
423 (map-in-order (lambda (music)
424 (music->lily-string music parser))
425 (ly:music-property sim 'elements)))))
427 (define-extra-display-method SimultaneousMusic (expr parser)
428 "If `sim' is an \afterGrace expression, return \"\\afterGrace ...\".
429 Otherwise, return #f."
430 ;; TODO: do something with afterGraceFraction?
431 (with-music-match (expr (music 'SimultaneousMusic
432 elements (?before-grace
433 (music 'SequentialMusic
434 elements ((music 'SkipMusic)
437 (format #f "\\afterGrace ~a ~a"
438 (music->lily-string ?before-grace parser)
439 (music->lily-string ?grace parser))))
445 (define-display-method EventChord (chord parser)
446 ;; event_chord : simple_element post_events
448 ;; | note_chord_element
450 ;; TODO : tagged post_events
451 ;; post_events : ( post_event | tagged_post_event )*
452 ;; tagged_post_event: '-' \tag embedded_scm post_event
454 (let* ((elements (ly:music-property chord 'elements))
455 (simple-elements (filter (make-music-type-predicate
456 'NoteEvent 'ClusterNoteEvent 'RestEvent
457 'MultiMeasureRestEvent 'SkipEvent 'LyricEvent)
459 (if ((make-music-type-predicate 'StaffSpanEvent 'BreathingEvent) (car elements))
460 ;; first, a special case: StaffSpanEvent (\startStaff, \stopStaff)
461 ;; and BreathingEvent (\breathe)
462 (music->lily-string (car elements) parser)
463 (if (and (not (null? simple-elements))
464 (null? (cdr simple-elements))
465 ;; special case: if this simple_element has any post_events in
466 ;; its 'articulations list, it should be interpreted instead
467 ;; as a note_chord_element to prevent spurious output, e.g.,
468 ;; \displayLilyMusic < c-1\4 >8 -> c-1\48
469 (null? (filter post-event?
470 (ly:music-property (car simple-elements) 'articulations)))
471 ;; same for simple_element with \tweak
472 (null? (ly:music-property (car simple-elements) 'tweaks)))
473 ;; simple_element : note | figure | rest | mmrest | lyric_element | skip
474 (let* ((simple-element (car simple-elements))
475 (duration (ly:music-property simple-element 'duration))
476 (lily-string (format #f "~a~a~a~{~a~^ ~}"
477 (music->lily-string simple-element parser)
478 (duration->lily-string duration)
479 (if (and ((make-music-type-predicate 'RestEvent) simple-element)
480 (ly:pitch? (ly:music-property simple-element 'pitch)))
483 (map-in-order (lambda (music)
484 (music->lily-string music parser))
485 (filter post-event? elements)))))
486 (*previous-duration* duration)
488 (let ((chord-elements (filter (make-music-type-predicate
489 'NoteEvent 'ClusterNoteEvent 'BassFigureEvent)
491 (post-events (filter post-event? elements)))
492 (if (not (null? chord-elements))
493 ;; note_chord_element : '<' (notepitch | drumpitch)* '>" duration post_events
494 (let ((lily-string (format #f "< ~{~a ~}>~a~{~a~^ ~}"
495 (map-in-order (lambda (music)
496 (music->lily-string music parser))
498 (duration->lily-string (ly:music-property (car chord-elements)
500 (map-in-order (lambda (music)
501 (music->lily-string music parser))
503 (*previous-duration* (ly:music-property (car chord-elements) 'duration))
506 (format #f "~{~a~^ ~}" (map-in-order (lambda (music)
507 (music->lily-string music parser))
510 (define-display-method MultiMeasureRestMusic (mmrest parser)
511 (let* ((dur (ly:music-property mmrest 'duration))
512 (ly (format #f "R~a~{~a~^ ~}"
513 (duration->lily-string dur)
514 (map-in-order (lambda (music)
515 (music->lily-string music parser))
516 (ly:music-property mmrest 'articulations)))))
517 (*previous-duration* dur)
520 (define-display-method SkipMusic (skip parser)
521 (format #f "\\skip ~a" (duration->lily-string (ly:music-property skip 'duration) #:force-duration #t)))
523 (define-display-method OttavaMusic (ottava parser)
524 (format #f "\\ottava #~a" (ly:music-property ottava 'ottava-number)))
527 ;;; Notes, rests, skips...
530 (define (simple-note->lily-string event parser)
531 (format #f "~a~a~a~a~{~a~}" ; pitchname octave !? octave-check articulations
532 (note-name->lily-string (ly:music-property event 'pitch) parser)
533 (octave->lily-string (ly:music-property event 'pitch))
534 (let ((forced (ly:music-property event 'force-accidental))
535 (cautionary (ly:music-property event 'cautionary)))
536 (cond ((and (not (null? forced))
538 (not (null? cautionary))
541 ((and (not (null? forced)) forced) "!")
543 (let ((octave-check (ly:music-property event 'absolute-octave)))
544 (if (not (null? octave-check))
545 (format #f "=~a" (cond ((>= octave-check 0)
546 (make-string (1+ octave-check) #\'))
548 (make-string (1- (* -1 octave-check)) #\,))
551 (map-in-order (lambda (event)
552 (music->lily-string event parser))
553 (ly:music-property event 'articulations))))
555 (define-display-method NoteEvent (note parser)
556 (cond ((not (null? (ly:music-property note 'pitch))) ;; note
557 (simple-note->lily-string note parser))
558 ((not (null? (ly:music-property note 'drum-type))) ;; drum
559 (format #f "~a" (ly:music-property note 'drum-type)))
563 (define-display-method ClusterNoteEvent (note parser)
564 (simple-note->lily-string note parser))
566 (define-display-method RestEvent (rest parser)
567 (if (not (null? (ly:music-property rest 'pitch)))
568 (simple-note->lily-string rest parser)
571 (define-display-method MultiMeasureRestEvent (rest parser)
574 (define-display-method SkipEvent (rest parser)
577 (define-display-method RepeatedChord (chord parser)
578 (music->lily-string (ly:music-property chord 'element) parser))
580 (define-display-method MarkEvent (mark parser)
581 (let ((label (ly:music-property mark 'label)))
584 (format #f "\\mark ~a" (markup->lily-string label)))))
586 (define-display-method KeyChangeEvent (key parser)
587 (let ((pitch-alist (ly:music-property key 'pitch-alist))
588 (tonic (ly:music-property key 'tonic)))
589 (if (or (null? pitch-alist)
592 (let ((c-pitch-alist (ly:transpose-key-alist pitch-alist
593 (ly:pitch-diff (ly:make-pitch 0 0 0) tonic))))
594 (format #f "\\key ~a \\~a~a"
595 (note-name->lily-string (ly:music-property key 'tonic) parser)
598 (equal? (ly:parser-lookup parser mode) c-pitch-alist))
599 (symbol->string mode)
601 '(major minor ionian locrian aeolian mixolydian lydian phrygian dorian))
602 (new-line->lily-string))))))
604 (define-display-method RelativeOctaveCheck (octave parser)
605 (let ((pitch (ly:music-property octave 'pitch)))
606 (format #f "\\octaveCheck ~a~a"
607 (note-name->lily-string pitch parser)
608 (octave->lily-string pitch))))
610 (define-display-method VoiceSeparator (sep parser)
613 (define-display-method LigatureEvent (ligature parser)
614 (if (= START (ly:music-property ligature 'span-direction))
618 (define-display-method BarCheck (check parser)
619 (format #f "|~a" (new-line->lily-string)))
621 (define-display-method PesOrFlexaEvent (expr parser)
624 (define-display-method BassFigureEvent (figure parser)
625 (let ((alteration (ly:music-property figure 'alteration))
626 (fig (ly:music-property figure 'figure))
627 (bracket-start (ly:music-property figure 'bracket-start))
628 (bracket-stop (ly:music-property figure 'bracket-stop)))
630 (format #f "~a~a~a~a"
631 (if (null? bracket-start) "" "[")
632 (cond ((null? fig) "_")
633 ((markup? fig) (second fig)) ;; fig: (<number-markup> "number")
635 (if (null? alteration)
638 ((= alteration DOUBLE-FLAT) "--")
639 ((= alteration FLAT) "-")
640 ((= alteration NATURAL) "!")
641 ((= alteration SHARP) "+")
642 ((= alteration DOUBLE-SHARP) "++")
644 (if (null? bracket-stop) "" "]"))))
646 (define-display-method LyricEvent (lyric parser)
647 (let ((text (ly:music-property lyric 'text)))
648 (if (or (string? text)
649 (eqv? (first text) simple-markup))
650 ;; a string or a simple markup
651 (let ((string (if (string? text)
654 (if (string-match "(\"| |[0-9])" string)
655 ;; TODO check exactly in which cases double quotes should be used
656 (format #f "~s" string)
658 (markup->lily-string text))))
660 (define-display-method BreathingEvent (event parser)
667 (define-display-method AutoChangeMusic (m parser)
668 (format #f "\\autochange ~a"
669 (music->lily-string (ly:music-property m 'element) parser)))
671 (define-display-method ContextChange (m parser)
672 (format #f "\\change ~a = \"~a\""
673 (ly:music-property m 'change-to-type)
674 (ly:music-property m 'change-to-id)))
678 (define-display-method TimeScaledMusic (times parser)
679 (let* ((num (ly:music-property times 'numerator))
680 (den (ly:music-property times 'denominator))
681 (nd-gcd (gcd num den)))
682 (parameterize ((*force-line-break* #f)
683 (*time-factor-numerator* (/ num nd-gcd))
684 (*time-factor-denominator* (/ den nd-gcd)))
685 (format #f "\\times ~a/~a ~a"
688 (music->lily-string (ly:music-property times 'element) parser)))))
690 (define-display-method RelativeOctaveMusic (m parser)
691 (music->lily-string (ly:music-property m 'element) parser))
693 (define-display-method TransposedMusic (m parser)
694 (music->lily-string (ly:music-property m 'element) parser))
700 (define-display-method AlternativeEvent (alternative parser) "")
702 (define (repeat->lily-string expr repeat-type parser)
703 (format #f "\\repeat ~a ~a ~a ~a"
705 (ly:music-property expr 'repeat-count)
706 (music->lily-string (ly:music-property expr 'element) parser)
707 (let ((alternatives (ly:music-property expr 'elements)))
708 (if (null? alternatives)
710 (format #f "\\alternative { ~{~a ~}}"
711 (map-in-order (lambda (music)
712 (music->lily-string music parser))
715 (define-display-method VoltaRepeatedMusic (expr parser)
716 (repeat->lily-string expr "volta" parser))
718 (define-display-method UnfoldedRepeatedMusic (expr parser)
719 (repeat->lily-string expr "unfold" parser))
721 (define-display-method PercentRepeatedMusic (expr parser)
722 (repeat->lily-string expr "percent" parser))
724 (define-display-method TremoloRepeatedMusic (expr parser)
725 (let* ((count (ly:music-property expr 'repeat-count))
726 (dots (if (= 0 (modulo count 3)) 0 1))
727 (shift (- (log2 (if (= 0 dots)
730 (element (ly:music-property expr 'element))
732 (if (eqv? (ly:music-property element 'name) 'SequentialMusic)
734 (set! shift (1- shift))
735 (set! den-mult (length (ly:music-property element 'elements)))))
736 (music-map (lambda (m)
737 (let ((duration (ly:music-property m 'duration)))
738 (if (ly:duration? duration)
739 (let* ((dlog (ly:duration-log duration))
740 (ddots (ly:duration-dot-count duration))
741 (dfactor (ly:duration-factor duration))
743 (dden (cdr dfactor)))
744 (set! (ly:music-property m 'duration)
745 (ly:make-duration (- dlog shift)
746 ddots ;;(- ddots dots) ; ????
748 (/ dden den-mult))))))
751 (format #f "\\repeat tremolo ~a ~a"
753 (music->lily-string element parser))))
759 (define-display-method ContextSpeccedMusic (expr parser)
760 (let ((id (ly:music-property expr 'context-id))
761 (create-new (ly:music-property expr 'create-new))
762 (music (ly:music-property expr 'element))
763 (operations (ly:music-property expr 'property-operations))
764 (ctype (ly:music-property expr 'context-type)))
765 (format #f "~a ~a~a~a ~a"
766 (if (and (not (null? create-new)) create-new)
772 (format #f " = ~s" id))
773 (if (null? operations)
775 (format #f " \\with {~{~a~}~%~v_}"
776 (parameterize ((*indent* (+ (*indent*) 2)))
778 (format #f "~%~v_\\~a ~s"
784 (parameterize ((*current-context* ctype))
785 (music->lily-string music parser)))))
787 ;; special cases: \figures \lyrics \drums
788 (define-extra-display-method ContextSpeccedMusic (expr parser)
789 (with-music-match (expr (music 'ContextSpeccedMusic
791 property-operations ?op
792 context-type ?context-type
795 (parameterize ((*explicit-mode* #f))
798 (format #f "\\figures ~a" (music->lily-string ?sequence parser)))
800 (format #f "\\lyrics ~a" (music->lily-string ?sequence parser)))
802 (format #f "\\drums ~a" (music->lily-string ?sequence parser)))
807 ;;; Context properties
809 (define-extra-display-method ContextSpeccedMusic (expr parser)
810 (let ((element (ly:music-property expr 'element))
811 (property-tuning? (make-music-type-predicate 'PropertySet
815 (sequence? (make-music-type-predicate 'SequentialMusic)))
816 (if (and (ly:music? element)
817 (or (property-tuning? element)
818 (and (sequence? element)
819 (every property-tuning? (ly:music-property element 'elements)))))
820 (parameterize ((*current-context* (ly:music-property expr 'context-type)))
821 (music->lily-string element parser))
824 (define (property-value->lily-string arg parser)
825 (cond ((ly:music? arg)
826 (music->lily-string arg parser))
828 (format #f "#~s" arg))
830 (markup->lily-string arg))
832 (format #f "#~a" (scheme-expr->lily-string arg)))))
834 (define-display-method PropertySet (expr parser)
835 (let ((property (ly:music-property expr 'symbol))
836 (value (ly:music-property expr 'value))
837 (once (ly:music-property expr 'once)))
838 (format #f "~a\\set ~a~a = ~a~a"
839 (if (and (not (null? once)))
842 (if (eqv? (*current-context*) 'Bottom)
844 (format #f "~a . " (*current-context*)))
846 (property-value->lily-string value parser)
847 (new-line->lily-string))))
849 (define-display-method PropertyUnset (expr parser)
850 (format #f "\\unset ~a~a~a"
851 (if (eqv? (*current-context*) 'Bottom)
853 (format #f "~a . " (*current-context*)))
854 (ly:music-property expr 'symbol)
855 (new-line->lily-string)))
857 ;;; Layout properties
859 (define-display-method OverrideProperty (expr parser)
860 (let* ((symbol (ly:music-property expr 'symbol))
861 (properties (ly:music-property expr 'grob-property-path
862 (list (ly:music-property expr 'grob-property))))
863 (value (ly:music-property expr 'grob-value))
864 (once (ly:music-property expr 'once)))
866 (format #f "~a\\override ~a~a #'~a = ~a~a"
871 (if (eqv? (*current-context*) 'Bottom)
873 (format #f "~a . " (*current-context*)))
875 (if (null? (cdr properties))
878 (property-value->lily-string value parser)
879 (new-line->lily-string))))
881 (define-display-method RevertProperty (expr parser)
882 (let* ((symbol (ly:music-property expr 'symbol))
883 (properties (ly:music-property expr 'grob-property-path
884 (list (ly:music-property expr 'grob-property)))))
885 (format #f "\\revert ~a~a #'~a~a"
886 (if (eqv? (*current-context*) 'Bottom)
888 (format #f "~a . " (*current-context*)))
890 (if (null? (cdr properties))
893 (new-line->lily-string))))
895 (define-display-method TimeSignatureMusic (expr parser)
896 (let* ((num (ly:music-property expr 'numerator))
897 (den (ly:music-property expr 'denominator))
898 (structure (ly:music-property expr 'beat-structure)))
899 (if (null? structure)
903 (new-line->lily-string))
905 "\\time #'~a ~a/~a~a"
907 (new-line->lily-string)))))
909 ;;; \melisma and \melismaEnd
910 (define-extra-display-method ContextSpeccedMusic (expr parser)
911 "If expr is a melisma, return \"\\melisma\", otherwise, return #f."
912 (with-music-match (expr (music 'ContextSpeccedMusic
913 element (music 'PropertySet
915 symbol 'melismaBusy)))
918 (define-extra-display-method ContextSpeccedMusic (expr parser)
919 "If expr is a melisma end, return \"\\melismaEnd\", otherwise, return #f."
920 (with-music-match (expr (music 'ContextSpeccedMusic
921 element (music 'PropertyUnset
922 symbol 'melismaBusy)))
926 (define-extra-display-method SequentialMusic (expr parser)
927 (with-music-match (expr (music 'SequentialMusic
928 elements ((music 'TempoChangeEvent
931 metronome-count ?count)
932 (music 'ContextSpeccedMusic
933 element (music 'PropertySet
934 symbol 'tempoWholesPerMinute)))))
935 (format #f "\\tempo ~{~a~a~}~a = ~a~a"
937 (list (markup->lily-string ?text) " ")
939 (duration->lily-string ?unit #:force-duration #t)
941 (format #f "~a ~~ ~a" (car ?count) (cdr ?count))
943 (new-line->lily-string))))
945 (define-display-method TempoChangeEvent (expr parser)
946 (let ((text (ly:music-property expr 'text)))
947 (format #f "\\tempo ~a~a"
948 (markup->lily-string text)
949 (new-line->lily-string))))
952 (define clef-name-alist #f)
953 (define-public (memoize-clef-names clefs)
954 "Initialize @code{clef-name-alist}, if not already set."
955 (if (not clef-name-alist)
956 (set! clef-name-alist
957 (map (lambda (name+vals)
958 (cons (cdr name+vals)
962 (define-extra-display-method ContextSpeccedMusic (expr parser)
963 "If @var{expr} is a clef change, return \"\\clef ...\".
964 Otherwise, return @code{#f}."
965 (with-music-match (expr (music 'ContextSpeccedMusic
967 element (music 'SequentialMusic
968 elements ((music 'PropertySet
972 symbol 'middleCClefPosition)
975 symbol 'clefPosition)
977 value ?clef-octavation
978 symbol 'clefOctavation)
980 procedure ly:set-middle-C!)))))
981 (let ((clef-name (assoc-get (list ?clef-glyph ?clef-position 0)
984 (format #f "\\clef \"~a~{~a~a~}\"~a"
986 (cond ((= 0 ?clef-octavation)
988 ((> ?clef-octavation 0)
989 (list "^" (1+ ?clef-octavation)))
991 (list "_" (- 1 ?clef-octavation))))
992 (new-line->lily-string))
996 (define-extra-display-method ContextSpeccedMusic (expr parser)
997 "If `expr' is a bar, return \"\\bar ...\".
998 Otherwise, return #f."
999 (with-music-match (expr (music 'ContextSpeccedMusic
1000 context-type 'Timing
1001 element (music 'PropertySet
1004 (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string))))
1007 (define-extra-display-method ContextSpeccedMusic (expr parser)
1008 "If `expr' is a partial measure, return \"\\partial ...\".
1009 Otherwise, return #f."
1010 (with-music-match (expr (music
1011 'ContextSpeccedMusic
1013 'ContextSpeccedMusic
1014 context-type 'Timing
1017 partial-duration ?duration))))
1020 (format #f "\\partial ~a"
1021 (duration->lily-string ?duration #:force-duration #t)))))
1026 (define-display-method ApplyOutputEvent (applyoutput parser)
1027 (let ((proc (ly:music-property applyoutput 'procedure))
1028 (ctx (ly:music-property applyoutput 'context-type)))
1029 (format #f "\\applyOutput #'~a #~a"
1031 (or (procedure-name proc)
1032 (with-output-to-string
1034 (pretty-print (procedure-source proc))))))))
1036 (define-display-method ApplyContext (applycontext parser)
1037 (let ((proc (ly:music-property applycontext 'procedure)))
1038 (format #f "\\applyContext #~a"
1039 (or (procedure-name proc)
1040 (with-output-to-string
1042 (pretty-print (procedure-source proc))))))))
1045 (define-display-method PartCombineMusic (expr parser)
1046 (format #f "\\partcombine ~{~a ~}"
1047 (map-in-order (lambda (music)
1048 (music->lily-string music parser))
1049 (ly:music-property expr 'elements))))
1051 (define-extra-display-method PartCombineMusic (expr parser)
1052 (with-music-match (expr (music 'PartCombineMusic
1053 elements ((music 'UnrelativableMusic
1054 element (music 'ContextSpeccedMusic
1057 element ?sequence1))
1058 (music 'UnrelativableMusic
1059 element (music 'ContextSpeccedMusic
1062 element ?sequence2)))))
1063 (format #f "\\partcombine ~a~a~a"
1064 (music->lily-string ?sequence1 parser)
1065 (new-line->lily-string)
1066 (music->lily-string ?sequence2 parser))))
1068 (define-display-method UnrelativableMusic (expr parser)
1069 (music->lily-string (ly:music-property expr 'element) parser))
1072 (define-display-method QuoteMusic (expr parser)
1073 (or (with-music-match (expr (music
1075 quoted-voice-direction ?quoted-voice-direction
1076 quoted-music-name ?quoted-music-name
1077 quoted-context-id "cue"
1078 quoted-context-type 'Voice
1080 (format #f "\\cueDuring #~s #~a ~a"
1082 ?quoted-voice-direction
1083 (music->lily-string ?music parser)))
1084 (format #f "\\quoteDuring #~s ~a"
1085 (ly:music-property expr 'quoted-music-name)
1086 (music->lily-string (ly:music-property expr 'element) parser))))
1091 (define-display-method LineBreakEvent (expr parser)
1092 (if (null? (ly:music-property expr 'break-permission))
1096 (define-display-method PageBreakEvent (expr parser)
1097 (if (null? (ly:music-property expr 'break-permission))
1101 (define-display-method PageTurnEvent (expr parser)
1102 (if (null? (ly:music-property expr 'break-permission))
1106 (define-extra-display-method EventChord (expr parser)
1107 (with-music-match (expr (music 'EventChord
1108 elements ((music 'LineBreakEvent
1109 break-permission 'force)
1110 (music 'PageBreakEvent
1111 break-permission 'force))))
1114 (define-extra-display-method EventChord (expr parser)
1115 (with-music-match (expr (music 'EventChord
1116 elements ((music 'LineBreakEvent
1117 break-permission 'force)
1118 (music 'PageBreakEvent
1119 break-permission 'force)
1120 (music 'PageTurnEvent
1121 break-permission 'force))))
1129 (define-display-method LyricCombineMusic (expr parser)
1130 (format #f "\\lyricsto ~s ~a"
1131 (ly:music-property expr 'associated-context)
1132 (parameterize ((*explicit-mode* #f))
1133 (music->lily-string (ly:music-property expr 'element) parser))))
1136 (define-extra-display-method SimultaneousMusic (expr parser)
1137 (with-music-match (expr (music 'SimultaneousMusic
1138 elements ((music 'ContextSpeccedMusic
1141 element ?note-sequence)
1142 (music 'ContextSpeccedMusic
1143 context-type 'Lyrics
1145 element (music 'LyricCombineMusic
1146 associated-context ?associated-id
1147 element ?lyric-sequence)))))
1148 (if (string=? ?id ?associated-id)
1149 (format #f "~a~a \\addlyrics ~a"
1150 (music->lily-string ?note-sequence parser)
1151 (new-line->lily-string)
1152 (parameterize ((*explicit-mode* #f))
1153 (music->lily-string ?lyric-sequence parser)))
1156 ;; Silence internal event sent at end of each lyrics block
1157 (define-display-method CompletizeExtenderEvent (expr parser)