1 ;;; define-music-display-methods.scm -- data for displaying music
2 ;;; expressions using LilyPond notation.
4 ;;; (c) 2005--2006 Nicolas Sceaux <nicolas.sceaux@free.fr>
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9 ;;; Display method implementation
12 (define-module (scm display-lily))
14 ;;; `display-lily-init' must be called before using `display-lily-music'. It
15 ;;; takes a parser object as an argument.
16 (define-public (display-lily-init parser)
23 (define (scheme-expr->lily-string scm-arg)
24 (cond ((or (number? scm-arg)
26 (format #f "~s" scm-arg))
27 ((or (symbol? scm-arg)
29 (format #f "'~s" scm-arg))
32 (or (procedure-name scm-arg)
33 (with-output-to-string
35 (pretty-print (procedure-source scm-arg)))))))
38 (with-output-to-string
40 (display-scheme-music scm-arg)))))))
45 (define-public (markup->lily-string markup-expr)
46 "Return a string describing, in LilyPond syntax, the given markup expression."
47 (define (proc->command proc)
48 (let ((cmd-markup (symbol->string (procedure-name proc))))
49 (substring cmd-markup 0 (- (string-length cmd-markup)
50 (string-length "-markup")))))
51 (define (arg->string arg)
54 ((markup? arg) ;; a markup
55 (markup->lily-string-aux arg))
56 ((and (pair? arg) (every markup? arg)) ;; a markup list
57 (format #f "{~{ ~a~}}" (map-in-order markup->lily-string-aux arg)))
58 (else ;; a scheme argument
59 (format #f "#~a" (scheme-expr->lily-string arg)))))
60 (define (markup->lily-string-aux expr)
63 (let ((cmd (car expr))
65 (if (eqv? cmd simple-markup) ;; a simple markup
66 (format #f "~s" (car args))
67 (format #f "\\~a~{ ~a~}"
69 (map-in-order arg->string args))))))
70 (cond ((string? markup-expr)
71 (format #f "~s" markup-expr))
72 ((eqv? (car markup-expr) simple-markup)
73 (format #f "~s" (second markup-expr)))
75 (format #f "\\markup ~a"
76 (markup->lily-string-aux markup-expr)))))
82 ;; It is a pity that there is no rassoc in Scheme.
83 (define* (rassoc item alist #:optional (test equal?))
84 (do ((alist alist (cdr alist))
86 ((or result (null? alist)) result)
87 (if (and (car alist) (test item (cdar alist)))
88 (set! result (car alist)))))
90 (define (note-name->lily-string ly-pitch)
91 ;; here we define a custom pitch= function, since we do not want to
92 ;; test whether octaves are also equal. (otherwise, we would be using equal?)
93 (define (pitch= pitch1 pitch2)
94 (and (= (ly:pitch-notename pitch1) (ly:pitch-notename pitch2))
95 (= (ly:pitch-alteration pitch1) (ly:pitch-alteration pitch2))))
96 (let ((result (rassoc ly-pitch (ly:parser-lookup (*parser*) 'pitchnames) pitch=)))
101 (define (octave->lily-string pitch)
102 (let ((octave (ly:pitch-octave pitch)))
104 (make-string (1+ octave) #\'))
106 (make-string (1- (* -1 octave)) #\,))
112 (define* (duration->lily-string ly-duration #:key (prev-duration (*previous-duration*))
113 (force-duration (*force-duration*))
114 (time-factor-numerator (*time-factor-numerator*))
115 (time-factor-denominator (*time-factor-denominator*)))
116 (let ((log2 (ly:duration-log ly-duration))
117 (dots (ly:duration-dot-count ly-duration))
118 (num+den (ly:duration-factor ly-duration)))
119 (if (or force-duration (not prev-duration) (not (equal? ly-duration prev-duration)))
120 (string-append (case log2
124 (else (number->string (expt 2 log2))))
125 (make-string dots #\.)
126 (let ((num? (not (or (= 1 (car num+den))
127 (and time-factor-numerator
128 (= (car num+den) time-factor-numerator)))))
129 (den? (not (or (= 1 (cdr num+den))
130 (and time-factor-denominator
131 (= (cdr num+den) time-factor-denominator))))))
133 (format #f "*~a/~a" (car num+den) (cdr num+den)))
135 (format #f "*~a" (car num+den)))
143 (define post-event? (make-music-type-predicate
148 'MultiMeasureTextEvent
164 'AbsoluteDynamicEvent
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)
195 (define-display-method ExtenderEvent (event)
197 (define-display-method TieEvent (event)
199 (define-display-method BeamForbidEvent (event)
201 (define-display-method StringNumberEvent (event)
202 (format #f "\\~a" (ly:music-property event 'string-number)))
205 (define-display-method TremoloEvent (event)
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) #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) #t
224 (ly:music-property event 'digit))
226 (define-post-event-display-method TextScriptEvent (event) #t
227 (markup->lily-string (ly:music-property event 'text)))
229 (define-post-event-display-method MultiMeasureTextEvent (event) #t
230 (markup->lily-string (ly:music-property event 'text)))
232 (define-post-event-display-method HarmonicEvent (event) #t "\\harmonic")
233 (define-post-event-display-method GlissandoEvent (event) #t "\\glissando")
234 (define-post-event-display-method ArpeggioEvent (event) #t "\\arpeggio")
235 (define-post-event-display-method AbsoluteDynamicEvent (event) #f
236 (format #f "\\~a" (ly:music-property event 'text)))
238 (define-span-event-display-method BeamEvent (event) #f "[" "]")
239 (define-span-event-display-method SlurEvent (event) #f "(" ")")
240 (define-span-event-display-method CrescendoEvent (event) #f "\\<" "\\!")
241 (define-span-event-display-method DecrescendoEvent (event) #f "\\>" "\\!")
242 (define-span-event-display-method PhrasingSlurEvent (event) #f "\\(" "\\)")
243 (define-span-event-display-method SustainEvent (event) #f "\\sustainDown" "\\sustainUp")
244 (define-span-event-display-method SostenutoEvent (event) #f "\\sostenutoDown" "\\sostenutoUp")
245 (define-span-event-display-method ManualMelismaEvent (event) #f "\\melisma" "\\melismaEnd")
246 (define-span-event-display-method TextSpanEvent (event) #f "\\startTextSpan" "\\stopTextSpan")
247 (define-span-event-display-method TrillSpanEvent (event) #f "\\startTrillSpan" "\\stopTrillSpan")
248 (define-span-event-display-method StaffSpanEvent (event) #f "\\startStaff" "\\stopStaff")
249 (define-span-event-display-method NoteGroupingEvent (event) #f "\\startGroup" "\\stopGroup")
250 (define-span-event-display-method UnaCordaEvent (event) #f "\\unaCorda" "\\treCorde")
256 (define-display-method GraceMusic (expr)
257 (format #f "\\grace ~a"
258 (music->lily-string (ly:music-property expr 'element))))
260 ;; \acciaccatura \appoggiatura \grace
261 ;; TODO: it would be better to compare ?start and ?stop
262 ;; with startAppoggiaturaMusic and stopAppoggiaturaMusic,
263 ;; using a custom music equality predicate.
264 (define-extra-display-method GraceMusic (expr)
265 "Display method for appoggiatura."
266 (with-music-match (expr (music
273 ;; we check whether ?start and ?stop look like
274 ;; startAppoggiaturaMusic stopAppoggiaturaMusic
275 (and (with-music-match (?start (music
281 duration (ly:make-duration 0 0 0 1))
284 span-direction START))))))
286 (with-music-match (?stop (music
292 duration (ly:make-duration 0 0 0 1))
295 span-direction STOP))))))
296 (format #f "\\appoggiatura ~a" (music->lily-string ?music))))))
299 (define-extra-display-method GraceMusic (expr)
300 "Display method for acciaccatura."
301 (with-music-match (expr (music
308 ;; we check whether ?start and ?stop look like
309 ;; startAcciaccaturaMusic stopAcciaccaturaMusic
310 (and (with-music-match (?start (music
316 duration (ly:make-duration 0 0 0 1))
319 span-direction START)))
324 grob-property-path '(stroke-style)
328 (with-music-match (?stop (music
334 grob-property-path '(stroke-style)
340 duration (ly:make-duration 0 0 0 1))
343 span-direction STOP))))))
344 (format #f "\\acciaccatura ~a" (music->lily-string ?music))))))
346 (define-extra-display-method GraceMusic (expr)
347 "Display method for grace."
348 (with-music-match (expr (music
355 ;; we check whether ?start and ?stop look like
356 ;; startGraceMusic stopGraceMusic
357 (and (null? (ly:music-property ?start 'elements))
358 (null? (ly:music-property ?stop 'elements))
359 (format #f "\\grace ~a" (music->lily-string ?music)))))
365 (define-display-method SequentialMusic (seq)
366 (let ((force-line-break (and (*force-line-break*)
368 (> (length (ly:music-property seq 'elements))
369 (*max-element-number-before-break*))))
370 (elements (ly:music-property seq 'elements))
371 (chord? (make-music-type-predicate 'EventChord))
372 (cluster? (make-music-type-predicate 'ClusterNoteEvent))
373 (note? (make-music-type-predicate 'NoteEvent)))
374 (format #f "~a~a{~v%~v_~{~a ~}~v%~v_}"
377 (any cluster? (ly:music-property e 'elements))))
381 (if (*explicit-mode*)
382 ;; if the sequence contains EventChord which contains figures ==> figuremode
383 ;; if the sequence contains EventChord which contains lyrics ==> lyricmode
384 ;; if the sequence contains EventChord which contains drum notes ==> drummode
385 (cond ((any (lambda (chord)
386 (any (make-music-type-predicate 'BassFigureEvent)
387 (ly:music-property chord 'elements)))
388 (filter chord? elements))
390 ((any (lambda (chord)
391 (any (make-music-type-predicate 'LyricEvent)
392 (ly:music-property chord 'elements)))
393 (filter chord? elements))
395 ((any (lambda (chord)
398 (not (null? (ly:music-property event 'drum-type)))))
399 (ly:music-property chord 'elements)))
400 (filter chord? elements))
402 (else ;; TODO: other modes?
405 (if force-line-break 1 0)
406 (if force-line-break (+ 2 (*indent*)) 1)
407 (parameterize ((*indent* (+ 2 (*indent*))))
408 (map-in-order music->lily-string elements))
409 (if force-line-break 1 0)
410 (if force-line-break (*indent*) 0))))
412 (define-display-method SimultaneousMusic (sim)
413 (parameterize ((*indent* (+ 3 (*indent*))))
414 (format #f "<< ~{~a ~}>>"
415 (map-in-order music->lily-string (ly:music-property sim 'elements)))))
417 (define-extra-display-method SimultaneousMusic (expr)
418 "If `sim' is an \afterGrace expression, return \"\\afterGrace ...\".
419 Otherwise, return #f."
420 ;; TODO: do something with afterGraceFraction?
421 (with-music-match (expr (music 'SimultaneousMusic
422 elements (?before-grace
423 (music 'SequentialMusic
424 elements ((music 'SkipMusic)
427 (format #f "\\afterGrace ~a ~a"
428 (music->lily-string ?before-grace)
429 (music->lily-string ?grace))))
435 (define-display-method EventChord (chord)
436 ;; event_chord : simple_element post_events
438 ;; | note_chord_element
440 ;; TODO : tagged post_events
441 ;; post_events : ( post_event | tagged_post_event )*
442 ;; tagged_post_event: '-' \tag embedded_scm post_event
444 (let* ((elements (ly:music-property chord 'elements))
445 (simple-elements (filter (make-music-type-predicate
446 'NoteEvent 'ClusterNoteEvent 'RestEvent
447 'MultiMeasureRestEvent 'SkipEvent 'LyricEvent)
449 (if ((make-music-type-predicate 'StaffSpanEvent 'BreathingSignEvent) (car elements))
450 ;; first, a special case: StaffSpanEvent (\startStaff, \stopStaff)
451 ;; and BreathingSignEvent (\breathe)
452 (music->lily-string (car elements))
453 (if (and (not (null? simple-elements))
454 (null? (cdr simple-elements)))
455 ;; simple_element : note | figure | rest | mmrest | lyric_element | skip
456 (let* ((simple-element (car simple-elements))
457 (duration (ly:music-property simple-element 'duration))
458 (lily-string (format #f "~a~a~a~{~a ~}"
459 (music->lily-string simple-element)
460 (duration->lily-string duration)
461 (if (and ((make-music-type-predicate 'RestEvent) simple-element)
462 (ly:pitch? (ly:music-property simple-element 'pitch)))
465 (map-in-order music->lily-string (filter post-event? elements)))))
466 (*previous-duration* duration)
468 (let ((chord-elements (filter (make-music-type-predicate
469 'NoteEvent 'ClusterNoteEvent 'BassFigureEvent)
471 (post-events (filter post-event? elements)))
472 (if (not (null? chord-elements))
473 ;; note_chord_element : '<' (notepitch | drumpitch)* '>" duration post_events
474 (let ((lily-string (format #f "< ~{~a ~}>~a~{~a ~}"
475 (map-in-order music->lily-string chord-elements)
476 (duration->lily-string (ly:music-property (car chord-elements)
478 (map-in-order music->lily-string post-events))))
479 (*previous-duration* (ly:music-property (car chord-elements) 'duration))
482 (format #f "~{~a ~}" (map-in-order music->lily-string elements))))))))
484 (define-display-method MultiMeasureRestMusic (mmrest)
485 (let* ((dur (ly:music-property mmrest 'duration))
486 (ly (format #f "R~a~{~a ~}"
487 (duration->lily-string dur)
488 (map-in-order music->lily-string
489 (ly:music-property mmrest 'articulations)))))
490 (*previous-duration* dur)
493 (define-display-method SkipMusic (skip)
494 (format #f "\\skip ~a" (duration->lily-string (ly:music-property skip 'duration) #:force-duration #t)))
497 ;;; Notes, rests, skips...
500 (define (simple-note->lily-string event)
501 (format #f "~a~a~a~a~{~a~}" ; pitchname octave !? octave-check articulations
502 (note-name->lily-string (ly:music-property event 'pitch))
503 (octave->lily-string (ly:music-property event 'pitch))
504 (let ((forced (ly:music-property event 'force-accidental))
505 (cautionary (ly:music-property event 'cautionary)))
506 (cond ((and (not (null? forced))
508 (not (null? cautionary))
511 ((and (not (null? forced)) forced) "!")
513 (let ((octave-check (ly:music-property event 'absolute-octave)))
514 (if (not (null? octave-check))
515 (format #f "=~a" (cond ((>= octave-check 0)
516 (make-string (1+ octave-check) #\'))
518 (make-string (1- (* -1 octave-check)) #\,))
521 (map-in-order music->lily-string (ly:music-property event 'articulations))))
523 (define-display-method NoteEvent (note)
524 (cond ((not (null? (ly:music-property note 'pitch))) ;; note
525 (simple-note->lily-string note))
526 ((not (null? (ly:music-property note 'drum-type))) ;; drum
527 (format #f "~a" (ly:music-property note 'drum-type)))
531 (define-display-method ClusterNoteEvent (note)
532 (simple-note->lily-string note))
534 (define-display-method RestEvent (rest)
535 (if (not (null? (ly:music-property rest 'pitch)))
536 (simple-note->lily-string rest)
539 (define-display-method MultiMeasureRestEvent (rest)
542 (define-display-method SkipEvent (rest)
545 (define-display-method MarkEvent (mark)
546 (let ((label (ly:music-property mark 'label)))
549 (format #f "\\mark ~a" (markup->lily-string label)))))
551 (define-display-method MetronomeChangeEvent (tempo)
552 (format #f "\\tempo ~a = ~a"
553 (duration->lily-string (ly:music-property tempo 'tempo-unit) #:force-duration #t #:prev-duration #f)
554 (ly:music-property tempo 'metronome-count)))
556 (define-display-method KeyChangeEvent (key)
557 (let ((pitch-alist (ly:music-property key 'pitch-alist))
558 (tonic (ly:music-property key 'tonic)))
559 (if (or (null? pitch-alist)
562 (let ((c-pitch-alist (ly:transpose-key-alist pitch-alist
563 (ly:pitch-diff (ly:make-pitch 0 0 0) tonic))))
564 (format #f "\\key ~a \\~a~a"
565 (note-name->lily-string (ly:music-property key 'tonic))
568 (equal? (ly:parser-lookup (*parser*) mode) c-pitch-alist))
569 (symbol->string mode)
571 '(major minor ionian locrian aeolian mixolydian lydian phrygian dorian))
572 (new-line->lily-string))))))
574 (define-display-method RelativeOctaveCheck (octave)
575 (let ((pitch (ly:music-property octave 'pitch)))
576 (format #f "\\octave ~a~a"
577 (note-name->lily-string pitch)
578 (octave->lily-string pitch))))
580 (define-display-method VoiceSeparator (sep)
583 (define-display-method LigatureEvent (ligature)
584 (if (= START (ly:music-property ligature 'span-direction))
588 (define-display-method BarCheck (check)
589 (format #f "|~a" (new-line->lily-string)))
591 (define-display-method PesOrFlexaEvent (expr)
594 (define-display-method BassFigureEvent (figure)
595 (let ((alteration (ly:music-property figure 'alteration))
596 (fig (ly:music-property figure 'figure))
597 (bracket-start (ly:music-property figure 'bracket-start))
598 (bracket-stop (ly:music-property figure 'bracket-stop)))
599 (format #f "~a~a~a~a"
600 (if (null? bracket-start) "" "[")
601 (cond ((null? fig) "_")
602 ((markup? fig) (second fig)) ;; fig: (<number-markup> "number")
604 (if (null? alteration)
613 (if (null? bracket-stop) "" "]"))))
615 (define-display-method LyricEvent (lyric)
616 (let ((text (ly:music-property lyric 'text)))
617 (if (or (string? text)
618 (eqv? (first text) simple-markup))
619 ;; a string or a simple markup
620 (let ((string (if (string? text)
623 (if (string-match "(\"| |[0-9])" string)
624 ;; TODO check exactly in which cases double quotes should be used
625 (format #f "~s" string)
627 (markup->lily-string text))))
629 (define-display-method BreathingSignEvent (event)
636 (define-display-method AutoChangeMusic (m)
637 (format #f "\\autochange ~a"
638 (music->lily-string (ly:music-property m 'element))))
640 (define-display-method ContextChange (m)
641 (format #f "\\change ~a = \"~a\""
642 (ly:music-property m 'change-to-type)
643 (ly:music-property m 'change-to-id)))
647 (define-display-method TimeScaledMusic (times)
648 (let* ((num (ly:music-property times 'numerator))
649 (den (ly:music-property times 'denominator))
650 (nd-gcd (gcd num den)))
651 (parameterize ((*force-line-break* #f)
652 (*time-factor-numerator* (/ num nd-gcd))
653 (*time-factor-denominator* (/ den nd-gcd)))
654 (format #f "\\times ~a/~a ~a"
657 (music->lily-string (ly:music-property times 'element))))))
659 (define-display-method RelativeOctaveMusic (m)
660 (music->lily-string (ly:music-property m 'element)))
662 (define-display-method TransposedMusic (m)
663 (music->lily-string (ly:music-property m 'element)))
669 (define (repeat->lily-string expr repeat-type)
670 (format #f "\\repeat ~a ~a ~a ~a"
672 (ly:music-property expr 'repeat-count)
673 (music->lily-string (ly:music-property expr 'element))
674 (let ((alternatives (ly:music-property expr 'elements)))
675 (if (null? alternatives)
677 (format #f "\\alternative { ~{~a ~}}"
678 (map-in-order music->lily-string alternatives))))))
680 (define-display-method VoltaRepeatedMusic (expr)
681 (repeat->lily-string expr "volta"))
683 (define-display-method UnfoldedRepeatedMusic (expr)
684 (repeat->lily-string expr "unfold"))
686 (define-display-method FoldedRepeatedMusic (expr)
687 (repeat->lily-string expr "fold"))
689 (define-display-method PercentRepeatedMusic (expr)
690 (repeat->lily-string expr "percent"))
692 (define-display-method TremoloRepeatedMusic (expr)
693 (let* ((count (ly:music-property expr 'repeat-count))
694 (dots (if (= 0 (modulo count 3)) 0 1))
695 (shift (- (log2 (if (= 0 dots)
698 (element (ly:music-property expr 'element))
700 (if (eqv? (ly:music-property element 'name) 'SequentialMusic)
702 (set! shift (1- shift))
703 (set! den-mult (length (ly:music-property element 'elements)))))
704 (music-map (lambda (m)
705 (let ((duration (ly:music-property m 'duration)))
706 (if (ly:duration? duration)
707 (let* ((dlog (ly:duration-log duration))
708 (ddots (ly:duration-dot-count duration))
709 (dfactor (ly:duration-factor duration))
711 (dden (cdr dfactor)))
712 (set! (ly:music-property m 'duration)
713 (ly:make-duration (- dlog shift)
714 ddots ;;(- ddots dots) ; ????
716 (/ dden den-mult))))))
719 (format #f "\\repeat tremolo ~a ~a"
721 (music->lily-string element))))
727 (define-display-method ContextSpeccedMusic (expr)
728 (let ((id (ly:music-property expr 'context-id))
729 (create-new (ly:music-property expr 'create-new))
730 (music (ly:music-property expr 'element))
731 (operations (ly:music-property expr 'property-operations))
732 (ctype (ly:music-property expr 'context-type)))
733 (format #f "~a ~a~a~a ~a"
734 (if (and (not (null? create-new)) create-new)
740 (format #f " = ~s" id))
741 (if (null? operations)
743 (format #f " \\with {~{~a~}~%~v_}"
744 (parameterize ((*indent* (+ (*indent*) 2)))
746 (format #f "~%~v_\\~a ~s"
750 (reverse operations)))
752 (parameterize ((*current-context* ctype))
753 (music->lily-string music)))))
755 ;; special cases: \figures \lyrics \drums
756 (define-extra-display-method ContextSpeccedMusic (expr)
757 (with-music-match (expr (music 'ContextSpeccedMusic
759 property-operations ?op
760 context-type ?context-type
763 (parameterize ((*explicit-mode* #f))
766 (format #f "\\figures ~a" (music->lily-string ?sequence)))
768 (format #f "\\lyrics ~a" (music->lily-string ?sequence)))
770 (format #f "\\drums ~a" (music->lily-string ?sequence)))
775 ;;; Context properties
777 (define-extra-display-method ContextSpeccedMusic (expr)
778 (let ((element (ly:music-property expr 'element))
779 (property-tuning? (make-music-type-predicate 'PropertySet
783 (sequence? (make-music-type-predicate 'SequentialMusic)))
784 (if (and (ly:music? element)
785 (or (property-tuning? element)
786 (and (sequence? element)
787 (every property-tuning? (ly:music-property element 'elements)))))
788 (parameterize ((*current-context* (ly:music-property expr 'context-type)))
789 (music->lily-string element))
792 (define (property-value->lily-string arg)
793 (cond ((ly:music? arg)
794 (music->lily-string arg))
796 (format #f "#~s" arg))
798 (markup->lily-string arg))
800 (format #f "#~a" (scheme-expr->lily-string arg)))))
802 (define-display-method PropertySet (expr)
803 (let ((property (ly:music-property expr 'symbol))
804 (value (ly:music-property expr 'value))
805 (once (ly:music-property expr 'once)))
806 (format #f "~a\\set ~a~a = ~a~a"
807 (if (and (not (null? once)))
810 (if (eqv? (*current-context*) 'Bottom)
812 (format #f "~a . " (*current-context*)))
814 (property-value->lily-string value)
815 (new-line->lily-string))))
817 (define-display-method PropertyUnset (expr)
818 (format #f "\\unset ~a~a~a"
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 (value (ly:music-property expr 'grob-value))
831 (once (ly:music-property expr 'once)))
832 (format #f "~a\\override ~a~a #'~a = ~a~a"
837 (if (eqv? (*current-context*) 'Bottom)
839 (format #f "~a . " (*current-context*)))
841 (if (null? (cdr properties))
844 (property-value->lily-string value)
845 (new-line->lily-string))))
847 (define-display-method RevertProperty (expr)
848 (let ((symbol (ly:music-property expr 'symbol))
849 (properties (ly:music-property expr 'grob-property-path)))
850 (format #f "\\revert ~a~a #'~a~a"
851 (if (eqv? (*current-context*) 'Bottom)
853 (format #f "~a . " (*current-context*)))
855 (if (null? (cdr properties))
858 (new-line->lily-string))))
861 (define clef-name-alist (map (lambda (name+vals)
862 (cons (cdr name+vals)
866 (define-extra-display-method ContextSpeccedMusic (expr)
867 "If `expr' is a clef change, return \"\\clef ...\"
868 Otherwise, return #f."
869 (with-music-match (expr (music 'ContextSpeccedMusic
871 element (music 'SequentialMusic
872 elements ((music 'PropertySet
876 symbol 'middleCPosition)
879 symbol 'clefPosition)
881 value ?clef-octavation
882 symbol 'clefOctavation)))))
883 (let ((clef-prop+name (assoc (list ?clef-glyph ?clef-position 0)
886 (format #f "\\clef \"~a~{~a~a~}\"~a"
888 (cond ((= 0 ?clef-octavation)
890 ((> ?clef-octavation 0)
891 (list "^" (1+ ?clef-octavation)))
893 (list "_" (- 1 ?clef-octavation))))
894 (new-line->lily-string))
898 (define-extra-display-method ContextSpeccedMusic (expr)
899 "If `expr' is a time signature set, return \"\\time ...\".
900 Otherwise, return #f."
901 (with-music-match (expr (music
911 symbol 'timeSignatureFraction)
917 symbol 'measureLength)
921 symbol 'beatGrouping))))))
922 (if (null? ?grouping)
923 (format #f "\\time ~a/~a~a" (car ?num+den) (cdr ?num+den) (new-line->lily-string))
924 (format #f "#(set-time-signature ~a ~a '~s)~a"
925 (car ?num+den) (cdr ?num+den) ?grouping (new-line->lily-string)))))
928 (define-extra-display-method ContextSpeccedMusic (expr)
929 "If `expr' is a bar, return \"\\bar ...\".
930 Otherwise, return #f."
931 (with-music-match (expr (music 'ContextSpeccedMusic
933 element (music 'PropertySet
936 (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string))))
939 (define (duration->moment ly-duration)
940 (let ((log2 (ly:duration-log ly-duration))
941 (dots (ly:duration-dot-count ly-duration))
942 (num+den (ly:duration-factor ly-duration)))
943 (let* ((m (expt 2 (- log2)))
944 (factor (/ (car num+den) (cdr num+den))))
946 (delta (/ m 2) (/ delta 2)))
948 (set! m (+ m delta)))
950 (define moment-duration-alist (map (lambda (duration)
951 (cons (duration->moment duration)
953 (append-map (lambda (log2)
955 (ly:make-duration log2 dots 1 1))
959 (define (moment->duration moment)
960 (let ((result (assoc (- moment) moment-duration-alist)))
964 (define-extra-display-method ContextSpeccedMusic (expr)
965 "If `expr' is a partial measure, return \"\\partial ...\".
966 Otherwise, return #f."
967 (with-music-match (expr (music
975 symbol 'measurePosition))))
976 (let ((duration (moment->duration (/ (ly:moment-main-numerator ?moment)
977 (ly:moment-main-denominator ?moment)))))
978 (and duration (format #f "\\partial ~a" (duration->lily-string duration #:force-duration #t))))))
983 (define-display-method ApplyOutputEvent (applyoutput)
984 (let ((proc (ly:music-property applyoutput 'procedure))
985 (ctx (ly:music-property applyoutput 'context-type)))
986 (format #f "\\applyOutput #'~a #~a"
988 (or (procedure-name proc)
989 (with-output-to-string
991 (pretty-print (procedure-source proc))))))))
993 (define-display-method ApplyContext (applycontext)
994 (let ((proc (ly:music-property applycontext 'procedure)))
995 (format #f "\\applyContext #~a"
996 (or (procedure-name proc)
997 (with-output-to-string
999 (pretty-print (procedure-source proc))))))))
1002 (define-display-method PartCombineMusic (expr)
1003 (format #f "\\partcombine ~{~a ~}"
1004 (map-in-order music->lily-string (ly:music-property expr 'elements))))
1006 (define-extra-display-method PartCombineMusic (expr)
1007 (with-music-match (expr (music 'PartCombineMusic
1008 elements ((music 'UnrelativableMusic
1009 element (music 'ContextSpeccedMusic
1012 element ?sequence1))
1013 (music 'UnrelativableMusic
1014 element (music 'ContextSpeccedMusic
1017 element ?sequence2)))))
1018 (format #f "\\partcombine ~a~a~a"
1019 (music->lily-string ?sequence1)
1020 (new-line->lily-string)
1021 (music->lily-string ?sequence2))))
1023 (define-display-method UnrelativableMusic (expr)
1024 (music->lily-string (ly:music-property expr 'element)))
1027 (define-display-method QuoteMusic (expr)
1028 (or (with-music-match (expr (music
1030 quoted-voice-direction ?quoted-voice-direction
1031 quoted-music-name ?quoted-music-name
1032 quoted-context-id "cue"
1033 quoted-context-type 'Voice
1035 (format #f "\\cueDuring #~s #~a ~a"
1037 ?quoted-voice-direction
1038 (music->lily-string ?music)))
1039 (format #f "\\quoteDuring #~s ~a"
1040 (ly:music-property expr 'quoted-music-name)
1041 (music->lily-string (ly:music-property expr 'element)))))
1046 (define-display-method LineBreakEvent (expr)
1047 (if (null? (ly:music-property expr 'break-permission))
1051 (define-display-method PageBreakEvent (expr)
1052 (if (null? (ly:music-property expr 'break-permission))
1056 (define-display-method PageTurnEvent (expr)
1057 (if (null? (ly:music-property expr 'break-permission))
1061 (define-extra-display-method EventChord (expr)
1062 (with-music-match (expr (music 'EventChord
1063 elements ((music 'LineBreakEvent
1064 break-permission 'force)
1065 (music 'PageBreakEvent
1066 break-permission 'force))))
1069 (define-extra-display-method EventChord (expr)
1070 (with-music-match (expr (music 'EventChord
1071 elements ((music 'LineBreakEvent
1072 break-permission 'force)
1073 (music 'PageBreakEvent
1074 break-permission 'force)
1075 (music 'PageTurnEvent
1076 break-permission 'force))))
1084 (define-display-method LyricCombineMusic (expr)
1085 (format #f "\\lyricsto ~s ~a"
1086 (ly:music-property expr 'associated-context)
1087 (parameterize ((*explicit-mode* #f))
1088 (music->lily-string (ly:music-property expr 'element)))))
1091 (define-extra-display-method SimultaneousMusic (expr)
1092 (with-music-match (expr (music 'SimultaneousMusic
1093 elements ((music 'ContextSpeccedMusic
1096 element ?note-sequence)
1097 (music 'ContextSpeccedMusic
1098 context-type 'Lyrics
1100 element (music 'LyricCombineMusic
1101 associated-context ?associated-id
1102 element ?lyric-sequence)))))
1103 (if (string=? ?id ?associated-id)
1104 (format #f "~a~a \\addlyrics ~a"
1105 (music->lily-string ?note-sequence)
1106 (new-line->lily-string)
1107 (parameterize ((*explicit-mode* #f))
1108 (music->lily-string ?lyric-sequence)))