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))
565 (equal? (ly:parser-lookup (*parser*) mode) c-pitch-alist))
566 (symbol->string mode)
568 '(major minor ionian locrian aeolian mixolydian lydian phrygian dorian))
569 (new-line->lily-string))))))
571 (define-display-method RelativeOctaveCheck (octave)
572 (let ((pitch (ly:music-property octave 'pitch)))
573 (format #f "\\octave ~a~a"
574 (note-name->lily-string pitch)
575 (octave->lily-string pitch))))
577 (define-display-method VoiceSeparator (sep)
580 (define-display-method LigatureEvent (ligature)
581 (if (= -1 (ly:music-property ligature 'span-direction))
585 (define-display-method BarCheck (check)
586 (format #f "|~a" (new-line->lily-string)))
588 (define-display-method BreakEvent (br)
589 "\\break") ;; TODO: use page-penalty, penalty properties?
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) "" "[")
603 (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 (music (ly:music-property expr 'element))
730 (operations (ly:music-property expr 'property-operations))
731 (ctype (ly:music-property expr 'context-type)))
732 (format #f "~a ~a~a~a ~a"
733 (if (and (not (null? id))
734 (equal? id "$uniqueContextId"))
739 (equal? id "$uniqueContextId"))
741 (format #f " = ~s" id))
742 (if (null? operations)
744 (format #f " \\with {~{~a~}~%~v_}"
745 (parameterize ((*indent* (+ (*indent*) 2)))
747 (format #f "~%~v_\\~a ~s"
751 (reverse operations)))
753 (parameterize ((*current-context* ctype))
754 (music->lily-string music)))))
756 ;; special cases: \figures \lyrics \drums
757 (define-extra-display-method ContextSpeccedMusic (expr)
758 (with-music-match (expr (music 'ContextSpeccedMusic
759 context-id "$uniqueContextId"
760 property-operations ?op
761 context-type ?context-type
764 (parameterize ((*explicit-mode* #f))
767 (format #f "\\figures ~a" (music->lily-string ?sequence)))
769 (format #f "\\lyrics ~a" (music->lily-string ?sequence)))
771 (format #f "\\drums ~a" (music->lily-string ?sequence)))
776 ;;; Context properties
778 (define-extra-display-method ContextSpeccedMusic (expr)
779 (let ((element (ly:music-property expr 'element))
780 (property-tuning? (make-music-type-predicate 'PropertySet
784 (sequence? (make-music-type-predicate 'SequentialMusic)))
785 (if (and (ly:music? element)
786 (or (property-tuning? element)
787 (and (sequence? element)
788 (every property-tuning? (ly:music-property element 'elements)))))
789 (parameterize ((*current-context* (ly:music-property expr 'context-type)))
790 (music->lily-string element))
793 (define (property-value->lily-string arg)
794 (cond ((ly:music? arg)
795 (music->lily-string arg))
797 (format #f "#~s" arg))
799 (markup->lily-string arg))
801 (format #f "#~a" (scheme-expr->lily-string arg)))))
803 (define-display-method PropertySet (expr)
804 (let ((property (ly:music-property expr 'symbol))
805 (value (ly:music-property expr 'value))
806 (once (ly:music-property expr 'once)))
807 (format #f "~a\\set ~a~a = ~a~a"
808 (if (and (not (null? once)))
811 (if (eqv? (*current-context*) 'Bottom)
813 (format #f "~a . " (*current-context*)))
815 (property-value->lily-string value)
816 (new-line->lily-string))))
818 (define-display-method PropertyUnset (expr)
819 (format #f "\\unset ~a~a~a"
820 (if (eqv? (*current-context*) 'Bottom)
822 (format #f "~a . " (*current-context*)))
823 (ly:music-property expr 'symbol)
824 (new-line->lily-string)))
826 ;;; Layout properties
828 (define-display-method OverrideProperty (expr)
829 (let ((symbol (ly:music-property expr 'symbol))
830 (property (ly:music-property expr 'grob-property))
831 (value (ly:music-property expr 'grob-value))
832 (once (ly:music-property expr 'once)))
833 (format #f "~a\\override ~a~a #'~a = ~a~a"
838 (if (eqv? (*current-context*) 'Bottom)
840 (format #f "~a . " (*current-context*)))
843 (property-value->lily-string value)
844 (new-line->lily-string))))
846 (define-display-method RevertProperty (expr)
847 (let ((symbol (ly:music-property expr 'symbol))
848 (property (ly:music-property expr 'grob-property)))
849 (format #f "\\revert ~a~a #'~a~a"
850 (if (eqv? (*current-context*) 'Bottom)
852 (format #f "~a . " (*current-context*)))
855 (new-line->lily-string))))
858 (define clef-name-alist (map (lambda (name+vals)
859 (cons (cdr name+vals)
863 (define-extra-display-method ContextSpeccedMusic (expr)
864 "If `expr' is a clef change, return \"\\clef ...\"
865 Otherwise, return #f."
866 (with-music-match (expr (music 'ContextSpeccedMusic
868 element (music 'SequentialMusic
869 elements ((music 'PropertySet
873 symbol 'middleCPosition)
876 symbol 'clefPosition)
878 value ?clef-octavation
879 symbol 'clefOctavation)))))
880 (let ((clef-prop+name (assoc (list ?clef-glyph ?clef-position 0)
883 (format #f "\\clef \"~a~{~a~a~}\"~a"
885 (cond ((= 0 ?clef-octavation)
887 ((> ?clef-octavation 0)
888 (list "^" (1+ ?clef-octavation)))
890 (list "_" (- 1 ?clef-octavation))))
891 (new-line->lily-string))
895 (define-extra-display-method ContextSpeccedMusic (expr)
896 "If `expr' is a time signature set, return \"\\time ...\".
897 Otherwise, return #f."
898 (with-music-match (expr (music
908 symbol 'timeSignatureFraction)
914 symbol 'measureLength)
918 symbol 'beatGrouping))))))
919 (if (null? ?grouping)
920 (format #f "\\time ~a/~a~a" (car ?num+den) (cdr ?num+den) (new-line->lily-string))
921 (format #f "#(set-time-signature ~a ~a '~s)~a"
922 (car ?num+den) (cdr ?num+den) ?grouping (new-line->lily-string)))))
925 (define-extra-display-method ContextSpeccedMusic (expr)
926 "If `expr' is a bar, return \"\\bar ...\".
927 Otherwise, return #f."
928 (with-music-match (expr (music
937 (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string))))
940 (define (duration->moment ly-duration)
941 (let ((log2 (ly:duration-log ly-duration))
942 (dots (ly:duration-dot-count ly-duration))
943 (num+den (ly:duration-factor ly-duration)))
944 (let* ((m (expt 2 (- log2)))
945 (factor (/ (car num+den) (cdr num+den))))
947 (delta (/ m 2) (/ delta 2)))
949 (set! m (+ m delta)))
951 (define moment-duration-alist (map (lambda (duration)
952 (cons (duration->moment duration)
954 (append-map (lambda (log2)
956 (ly:make-duration log2 dots 1 1))
960 (define (moment->duration moment)
961 (let ((result (assoc (- moment) moment-duration-alist)))
965 (define-extra-display-method ContextSpeccedMusic (expr)
966 "If `expr' is a partial measure, return \"\\partial ...\".
967 Otherwise, return #f."
968 (with-music-match (expr (music
976 symbol 'measurePosition))))
977 (let ((duration (moment->duration (/ (ly:moment-main-numerator ?moment)
978 (ly:moment-main-denominator ?moment)))))
979 (and duration (format #f "\\partial ~a" (duration->lily-string duration #:force-duration #t))))))
984 (define-display-method ApplyOutputEvent (applyoutput)
985 (let ((proc (ly:music-property applyoutput 'procedure))))
986 (format #f "\\applyoutput #~a"
987 (or (procedure-name proc)
988 (with-output-to-string
990 (pretty-print (procedure-source proc)))))))
992 (define-display-method ApplyContext (applycontext)
993 (let ((proc (ly:music-property applycontext 'procedure))))
994 (format #f "\\applycontext #~a"
995 (or (procedure-name proc)
996 (with-output-to-string
998 (pretty-print (procedure-source proc)))))))
1001 (define-display-method PartCombineMusic (expr)
1002 (format #f "\\partcombine ~{~a ~}"
1003 (map-in-order music->lily-string (ly:music-property expr 'elements))))
1005 (define-extra-display-method PartCombineMusic (expr)
1006 (with-music-match (expr (music 'PartCombineMusic
1007 elements ((music 'UnrelativableMusic
1008 element (music 'ContextSpeccedMusic
1011 element ?sequence1))
1012 (music 'UnrelativableMusic
1013 element (music 'ContextSpeccedMusic
1016 element ?sequence2)))))
1017 (format #f "\\partcombine ~a~a~a"
1018 (music->lily-string ?sequence1)
1019 (new-line->lily-string)
1020 (music->lily-string ?sequence2))))
1022 (define-display-method UnrelativableMusic (expr)
1023 (music->lily-string (ly:music-property expr 'element)))
1026 (define-display-method QuoteMusic (expr)
1027 (or (with-music-match (expr (music
1029 quoted-voice-direction ?quoted-voice-direction
1030 quoted-music-name ?quoted-music-name
1031 quoted-context-id "cue"
1032 quoted-context-type 'Voice
1034 (format #f "\\cueDuring #~s #~a ~a"
1036 ?quoted-voice-direction
1037 (music->lily-string ?music)))
1038 (format #f "\\quoteDuring #~s ~a"
1039 (ly:music-property expr 'quoted-music-name)
1040 (music->lily-string (ly:music-property expr 'element)))))
1047 (define-display-method LyricCombineMusic (expr)
1048 (format #f "\\lyricsto ~s ~a"
1049 (ly:music-property expr 'associated-context)
1050 (parameterize ((*explicit-mode* #f))
1051 (music->lily-string (ly:music-property expr 'element)))))
1053 (define-display-method OldLyricCombineMusic (expr)
1054 (format #f "\\oldaddlyrics ~a~a~a"
1055 (music->lily-string (first (ly:music-property expr 'elements)))
1056 (new-line->lily-string)
1057 (music->lily-string (second (ly:music-property expr 'elements)))))
1060 (define-extra-display-method SimultaneousMusic (expr)
1061 (with-music-match (expr (music 'SimultaneousMusic
1062 elements ((music 'ContextSpeccedMusic
1064 ;;property-operations '()
1066 element ?note-sequence)
1067 (music 'ContextSpeccedMusic
1068 context-id "$uniqueContextId"
1069 ;;property-operations '()
1070 context-type 'Lyrics
1071 element (music 'LyricCombineMusic
1072 associated-context ?associated-id
1073 element ?lyric-sequence)))))
1074 (if (string=? ?id ?associated-id)
1075 (format #f "~a~a \\addlyrics ~a"
1076 (music->lily-string ?note-sequence)
1077 (new-line->lily-string)
1078 (parameterize ((*explicit-mode* #f))
1079 (music->lily-string ?lyric-sequence)))