1 ;;; define-music-display-methods.scm -- data for displaying music
2 ;;; expressions using LilyPond notation.
4 ;;; (c) 2005 Nicolas Sceaux <nicolas.sceaux@free.fr>
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9 ;;; Display method implementation
12 (define-module (scm display-lily))
15 ;;; `display-lily-init' must be called before using `display-lily-music'. It
16 ;;; takes a parser object as an argument.
17 (define-public (display-lily-init parser)
19 (set-note-names! (ly:parser-lookup (*parser*) 'pitchnames))
25 (define (scheme-expr->lily-string scm-arg)
26 (cond ((or (number? scm-arg)
28 (format #f "~s" scm-arg))
29 ((or (symbol? scm-arg)
31 (format #f "'~s" scm-arg))
34 (or (procedure-name scm-arg)
35 (with-output-to-string
37 (pretty-print (procedure-source scm-arg)))))))
40 (with-output-to-string
42 (display-scheme-music scm-arg)))))))
47 (define-public (markup->lily-string markup-expr)
48 "Return a string describing, in LilyPond syntax, the given markup expression."
49 (define (proc->command proc)
50 (let ((cmd-markup (symbol->string (procedure-name proc))))
51 (substring cmd-markup 0 (- (string-length cmd-markup)
52 (string-length "-markup")))))
53 (define (arg->string arg)
56 ((markup? arg) ;; a markup
57 (markup->lily-string-aux arg))
58 ((and (pair? arg) (every markup? arg)) ;; a markup list
59 (format #f "{~{ ~a~}}" (map-in-order markup->lily-string-aux arg)))
60 (else ;; a scheme argument
61 (format #f "#~a" (scheme-expr->lily-string arg)))))
62 (define (markup->lily-string-aux expr)
65 (let ((cmd (car expr))
67 (if (eqv? cmd simple-markup) ;; a simple markup
68 (format #f "~s" (car args))
69 (format #f "\\~a~{ ~a~}"
71 (map-in-order arg->string args))))))
72 (cond ((string? markup-expr)
73 (format #f "~s" markup-expr))
74 ((eqv? (car markup-expr) simple-markup)
75 (format #f "~s" (second markup-expr)))
77 (format #f "\\markup ~a"
78 (markup->lily-string-aux markup-expr)))))
83 (define note-names '())
85 (define (set-note-names! pitchnames)
86 (set! note-names (map-in-order (lambda (name+lypitch)
87 (cons (cdr name+lypitch) (car name+lypitch)))
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 (assoc ly-pitch note-names pitch=))) ;; assoc from srfi-1
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) (= 0 direction))
174 (if required "-" ""))
175 ((= 1 direction) "^")
176 ((= -1 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 (= -1 (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 FingerEvent (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 -1))))))
286 (with-music-match (?stop (music
292 duration (ly:make-duration 0 0 0 1))
295 span-direction 1))))))
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))
324 grob-property 'stroke-style
328 (with-music-match (?stop (music
334 grob-property 'stroke-style
340 duration (ly:make-duration 0 0 0 1))
343 span-direction 1))))))
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 MultiMeasureRestMusicGroup (mmrest)
486 (map-in-order music->lily-string
487 (remove (make-music-type-predicate 'BarCheck)
488 (ly:music-property mmrest 'elements)))))
490 (define-display-method SkipMusic (skip)
491 (format #f "\\skip ~a" (duration->lily-string (ly:music-property skip 'duration) #:force-duration #t)))
494 ;;; Notes, rests, skips...
497 (define (simple-note->lily-string event)
498 (format #f "~a~a~a~a~{~a~}" ; pitchname octave !? octave-check articulations
499 (note-name->lily-string (ly:music-property event 'pitch))
500 (octave->lily-string (ly:music-property event 'pitch))
501 (let ((forced (ly:music-property event 'force-accidental))
502 (cautionary (ly:music-property event 'cautionary)))
503 (cond ((and (not (null? forced))
505 (not (null? cautionary))
508 ((and (not (null? forced)) forced) "!")
510 (let ((octave-check (ly:music-property event 'absolute-octave)))
511 (if (not (null? octave-check))
512 (format #f "=~a" (cond ((>= octave-check 0)
513 (make-string (1+ octave-check) #\'))
515 (make-string (1- (* -1 octave-check)) #\,))
518 (map-in-order music->lily-string (ly:music-property event 'articulations))))
520 (define-display-method NoteEvent (note)
521 (cond ((not (null? (ly:music-property note 'pitch))) ;; note
522 (simple-note->lily-string note))
523 ((not (null? (ly:music-property note 'drum-type))) ;; drum
524 (format #f "~a" (ly:music-property note 'drum-type)))
528 (define-display-method ClusterNoteEvent (note)
529 (simple-note->lily-string note))
531 (define-display-method RestEvent (rest)
532 (if (not (null? (ly:music-property rest 'pitch)))
533 (simple-note->lily-string rest)
536 (define-display-method MultiMeasureRestEvent (rest)
539 (define-display-method SkipEvent (rest)
542 (define-display-method MarkEvent (mark)
543 (let ((label (ly:music-property mark 'label)))
546 (format #f "\\mark ~a" (markup->lily-string label)))))
548 (define-display-method MetronomeChangeEvent (tempo)
549 (format #f "\\tempo ~a = ~a"
550 (duration->lily-string (ly:music-property tempo 'tempo-unit) #:force-duration #f #:prev-duration #f)
551 (ly:music-property tempo 'metronome-count)))
553 (define-display-method KeyChangeEvent (key)
554 (let ((pitch-alist (ly:music-property key 'pitch-alist))
555 (tonic (ly:music-property key 'tonic)))
556 (if (or (null? pitch-alist)
559 (let ((c-pitch-alist (ly:transpose-key-alist pitch-alist
560 (ly:pitch-diff (ly:make-pitch 0 0 0) tonic))))
561 (format #f "\\key ~a \\~a~a"
562 (note-name->lily-string (ly:music-property key 'tonic))
564 (if (equal? (ly:parser-lookup (*parser*) mode) c-pitch-alist)
565 (symbol->string mode)
567 '(major minor ionian locrian aeolian mixolydian lydian phrygian dorian))
568 (new-line->lily-string))))))
570 (define-display-method RelativeOctaveCheck (octave)
571 (let ((pitch (ly:music-property octave 'pitch)))
572 (format #f "\\octave ~a~a"
573 (note-name->lily-string pitch)
574 (octave->lily-string pitch))))
576 (define-display-method VoiceSeparator (sep)
579 (define-display-method LigatureEvent (ligature)
580 (if (= -1 (ly:music-property ligature 'span-direction))
584 (define-display-method BarCheck (check)
585 (format #f "|~a" (new-line->lily-string)))
587 (define-display-method BreakEvent (br)
588 "\\break") ;; TODO: use page-penalty, penalty properties?
590 (define-display-method PesOrFlexaEvent (expr)
593 (define-display-method BassFigureEvent (figure)
594 (let ((alteration (ly:music-property figure 'alteration))
595 (fig (ly:music-property figure 'figure))
596 (bracket-start (ly:music-property figure 'bracket-start))
597 (bracket-stop (ly:music-property figure 'bracket-stop)))
598 (format #f "~a~a~a~a"
599 (if (null? bracket-start) "" "[")
602 (second fig)) ;; fig: (<number-markup> "number")
603 (if (null? alteration)
612 (if (null? bracket-stop) "" "]"))))
614 (define-display-method LyricEvent (lyric)
615 (let ((text (ly:music-property lyric 'text)))
616 (if (or (string? text)
617 (eqv? (first text) simple-markup))
618 ;; a string or a simple markup
619 (let ((string (if (string? text)
622 (if (string-match "(\"| |[0-9])" string)
623 ;; TODO check exactly in which cases double quotes should be used
624 (format #f "~s" string)
626 (markup->lily-string text))))
628 (define-display-method BreathingSignEvent (event)
635 (define-display-method AutoChangeMusic (m)
636 (format #f "\\autochange ~a"
637 (music->lily-string (ly:music-property m 'element))))
639 (define-display-method ContextChange (m)
640 (format #f "\\change ~a = \"~a\""
641 (ly:music-property m 'change-to-type)
642 (ly:music-property m 'change-to-id)))
646 (define-display-method TimeScaledMusic (times)
647 (let* ((num (ly:music-property times 'numerator))
648 (den (ly:music-property times 'denominator))
649 (nd-gcd (gcd num den)))
650 (parameterize ((*force-line-break* #f)
651 (*time-factor-numerator* (/ num nd-gcd))
652 (*time-factor-denominator* (/ den nd-gcd)))
653 (format #f "\\times ~a/~a ~a"
656 (music->lily-string (ly:music-property times 'element))))))
658 (define-display-method RelativeOctaveMusic (m)
659 (music->lily-string (ly:music-property m 'element)))
661 (define-display-method TransposedMusic (m)
662 (music->lily-string (ly:music-property m 'element)))
668 (define (repeat->lily-string expr repeat-type)
669 (format #f "\\repeat ~a ~a ~a ~a"
671 (ly:music-property expr 'repeat-count)
672 (music->lily-string (ly:music-property expr 'element))
673 (let ((alternatives (ly:music-property expr 'elements)))
674 (if (null? alternatives)
676 (format #f "\\alternative { ~{~a ~}}"
677 (map-in-order music->lily-string alternatives))))))
679 (define-display-method VoltaRepeatedMusic (expr)
680 (repeat->lily-string expr "volta"))
682 (define-display-method UnfoldedRepeatedMusic (expr)
683 (repeat->lily-string expr "unfold"))
685 (define-display-method FoldedRepeatedMusic (expr)
686 (repeat->lily-string expr "fold"))
688 (define-display-method PercentRepeatedMusic (expr)
689 (repeat->lily-string expr "percent"))
691 (define-display-method TremoloRepeatedMusic (expr)
692 (let* ((count (ly:music-property expr 'repeat-count))
693 (dots (if (= 0 (modulo count 3)) 0 1))
694 (shift (- (log2 (if (= 0 dots)
697 (element (ly:music-property expr 'element))
699 (if (eqv? (ly:music-property element 'name) 'SequentialMusic)
701 (set! shift (1- shift))
702 (set! den-mult (length (ly:music-property element 'elements)))))
703 (music-map (lambda (m)
704 (let ((duration (ly:music-property m 'duration)))
705 (if (ly:duration? duration)
706 (let* ((dlog (ly:duration-log duration))
707 (ddots (ly:duration-dot-count duration))
708 (dfactor (ly:duration-factor duration))
710 (dden (cdr dfactor)))
711 (set! (ly:music-property m 'duration)
712 (ly:make-duration (- dlog shift)
713 ddots ;;(- ddots dots) ; ????
715 (/ dden den-mult))))))
718 (format #f "\\repeat tremolo ~a ~a"
720 (music->lily-string element))))
726 (define-display-method ContextSpeccedMusic (expr)
727 (let ((id (ly:music-property expr 'context-id))
728 (music (ly:music-property expr 'element))
729 (operations (ly:music-property expr 'property-operations))
730 (ctype (ly:music-property expr 'context-type)))
731 (format #f "~a ~a~a~a ~a"
732 (if (and (not (null? id))
733 (equal? id "$uniqueContextId"))
738 (equal? id "$uniqueContextId"))
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
758 context-id "$uniqueContextId"
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 (property (ly:music-property expr 'grob-property))
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*)))
842 (property-value->lily-string value)
843 (new-line->lily-string))))
845 (define-display-method RevertProperty (expr)
846 (let ((symbol (ly:music-property expr 'symbol))
847 (property (ly:music-property expr 'grob-property)))
848 (format #f "\\revert ~a~a #'~a~a"
849 (if (eqv? (*current-context*) 'Bottom)
851 (format #f "~a . " (*current-context*)))
854 (new-line->lily-string))))
857 (define clef-name-alist (map (lambda (name+vals)
858 (cons (cdr name+vals)
862 (define-extra-display-method ContextSpeccedMusic (expr)
863 "If `expr' is a clef change, return \"\\clef ...\"
864 Otherwise, return #f."
865 (with-music-match (expr (music 'ContextSpeccedMusic
867 element (music 'SequentialMusic
868 elements ((music 'PropertySet
872 symbol 'middleCPosition)
875 symbol 'clefPosition)
877 value ?clef-octavation
878 symbol 'clefOctavation)))))
879 (let ((clef-prop+name (assoc (list ?clef-glyph ?clef-position 0)
882 (format #f "\\clef \"~a~{~a~a~}\"~a"
884 (cond ((= 0 ?clef-octavation)
886 ((> ?clef-octavation 0)
887 (list "^" (1+ ?clef-octavation)))
889 (list "_" (- 1 ?clef-octavation))))
890 (new-line->lily-string))
894 (define-extra-display-method ContextSpeccedMusic (expr)
895 "If `expr' is a time signature set, return \"\\time ...\".
896 Otherwise, return #f."
897 (with-music-match (expr (music
907 symbol 'timeSignatureFraction)
913 symbol 'measureLength)
917 symbol 'beatGrouping))))))
918 (if (null? ?grouping)
919 (format #f "\\time ~a/~a~a" (car ?num+den) (cdr ?num+den) (new-line->lily-string))
920 (format #f "#(set-time-signature ~a ~a '~s)~a"
921 (car ?num+den) (cdr ?num+den) ?grouping (new-line->lily-string)))))
924 (define-extra-display-method ContextSpeccedMusic (expr)
925 "If `expr' is a bar, return \"\\bar ...\".
926 Otherwise, return #f."
927 (with-music-match (expr (music
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 (format #f "\\applyoutput #~a"
986 (or (procedure-name proc)
987 (with-output-to-string
989 (pretty-print (procedure-source proc)))))))
991 (define-display-method ApplyContext (applycontext)
992 (let ((proc (ly:music-property applycontext 'procedure))))
993 (format #f "\\applycontext #~a"
994 (or (procedure-name proc)
995 (with-output-to-string
997 (pretty-print (procedure-source proc)))))))
1000 (define-display-method PartCombineMusic (expr)
1001 (format #f "\\partcombine ~{~a ~}"
1002 (map-in-order music->lily-string (ly:music-property expr 'elements))))
1004 (define-extra-display-method PartCombineMusic (expr)
1005 (with-music-match (expr (music 'PartCombineMusic
1006 elements ((music 'UnrelativableMusic
1007 element (music 'ContextSpeccedMusic
1010 element ?sequence1))
1011 (music 'UnrelativableMusic
1012 element (music 'ContextSpeccedMusic
1015 element ?sequence2)))))
1016 (format #f "\\partcombine ~a~a~a"
1017 (music->lily-string ?sequence1)
1018 (new-line->lily-string)
1019 (music->lily-string ?sequence2))))
1021 (define-display-method UnrelativableMusic (expr)
1022 (music->lily-string (ly:music-property expr 'element)))
1025 (define-display-method QuoteMusic (expr)
1026 (or (with-music-match (expr (music
1028 quoted-voice-direction ?quoted-voice-direction
1029 quoted-music-name ?quoted-music-name
1030 quoted-context-id "cue"
1031 quoted-context-type 'Voice
1033 (format #f "\\cueDuring #~s #~a ~a"
1035 ?quoted-voice-direction
1036 (music->lily-string ?music)))
1037 (format #f "\\quoteDuring #~s ~a"
1038 (ly:music-property expr 'quoted-music-name)
1039 (music->lily-string (ly:music-property expr 'element)))))
1046 (define-display-method LyricCombineMusic (expr)
1047 (format #f "\\lyricsto ~s ~a"
1048 (ly:music-property expr 'associated-context)
1049 (parameterize ((*explicit-mode* #f))
1050 (music->lily-string (ly:music-property expr 'element)))))
1052 (define-display-method OldLyricCombineMusic (expr)
1053 (format #f "\\oldaddlyrics ~a~a~a"
1054 (music->lily-string (first (ly:music-property expr 'elements)))
1055 (new-line->lily-string)
1056 (music->lily-string (second (ly:music-property expr 'elements)))))
1059 (define-extra-display-method SimultaneousMusic (expr)
1060 (with-music-match (expr (music 'SimultaneousMusic
1061 elements ((music 'ContextSpeccedMusic
1063 ;;property-operations '()
1065 element ?note-sequence)
1066 (music 'ContextSpeccedMusic
1067 context-id "$uniqueContextId"
1068 ;;property-operations '()
1069 context-type 'Lyrics
1070 element (music 'LyricCombineMusic
1071 associated-context ?associated-id
1072 element ?lyric-sequence)))))
1073 (if (string=? ?id ?associated-id)
1074 (format #f "~a~a \\addlyrics ~a"
1075 (music->lily-string ?note-sequence)
1076 (new-line->lily-string)
1077 (parameterize ((*explicit-mode* #f))
1078 (music->lily-string ?lyric-sequence)))