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)
63 (let ((cmd (car expr))
65 (if (eqv? cmd simple-markup) ;; a simple string
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)))))
80 (define note-names '())
82 (define (set-note-names! pitchnames)
83 (set! note-names (map-in-order (lambda (name+lypitch)
84 (cons (cdr name+lypitch) (car name+lypitch)))
87 (define (note-name->lily-string ly-pitch)
88 ;; here we define a custom pitch= function, since we do not want to
89 ;; test whether octaves are also equal. (otherwise, we would be using equal?)
90 (define (pitch= pitch1 pitch2)
91 (and (= (ly:pitch-notename pitch1) (ly:pitch-notename pitch2))
92 (= (ly:pitch-alteration pitch1) (ly:pitch-alteration pitch2))))
93 (let ((result (assoc ly-pitch note-names pitch=))) ;; assoc from srfi-1
98 (define (octave->lily-string pitch)
99 (let ((octave (ly:pitch-octave pitch)))
101 (make-string (1+ octave) #\'))
103 (make-string (1- (* -1 octave)) #\,))
109 (define* (duration->lily-string ly-duration #:key (prev-duration (*previous-duration*))
110 (force-duration (*force-duration*))
111 (time-factor-numerator (*time-factor-numerator*))
112 (time-factor-denominator (*time-factor-denominator*)))
113 (let ((log2 (ly:duration-log ly-duration))
114 (dots (ly:duration-dot-count ly-duration))
115 (num+den (ly:duration-factor ly-duration)))
116 (if (or force-duration (not prev-duration) (not (equal? ly-duration prev-duration)))
117 (string-append (case log2
121 (else (number->string (expt 2 log2))))
122 (make-string dots #\.)
123 (let ((num? (not (or (= 1 (car num+den))
124 (and time-factor-numerator
125 (= (car num+den) time-factor-numerator)))))
126 (den? (not (or (= 1 (cdr num+den))
127 (and time-factor-denominator
128 (= (cdr num+den) time-factor-denominator))))))
130 (format #f "*~a/~a" (car num+den) (cdr num+den)))
132 (format #f "*~a" (car num+den)))
140 (define post-event? (make-music-type-predicate
145 'MultiMeasureTextEvent
161 'AbsoluteDynamicEvent
168 (define* (event-direction->lily-string event #:optional (required #t))
169 (let ((direction (ly:music-property event 'direction)))
170 (cond ((or (not direction) (null? direction) (= 0 direction))
171 (if required "-" ""))
172 ((= 1 direction) "^")
173 ((= -1 direction) "_")
176 (define-macro (define-post-event-display-method type vars direction-required str)
177 `(define-display-method ,type ,vars
179 (event-direction->lily-string ,(car vars) ,direction-required)
182 (define-macro (define-span-event-display-method type vars direction-required str-start str-stop)
183 `(define-display-method ,type ,vars
185 (event-direction->lily-string ,(car vars) ,direction-required)
186 (if (= -1 (ly:music-property ,(car vars) 'span-direction))
190 (define-display-method HyphenEvent (event)
192 (define-display-method ExtenderEvent (event)
194 (define-display-method TieEvent (event)
196 (define-display-method BeamForbidEvent (event)
198 (define-display-method StringNumberEvent (event)
199 (format #f "\\~a" (ly:music-property event 'string-number)))
202 (define-display-method TremoloEvent (event)
203 (let ((tremolo-type (ly:music-property event 'tremolo-type)))
204 (format #f ":~a" (if (= 0 tremolo-type)
208 (define-post-event-display-method ArticulationEvent (event) #t
209 (let ((articulation (ly:music-property event 'articulation-type)))
210 (case (string->symbol articulation)
214 ((staccatissimo) "|")
218 (else (format #f "\\~a" articulation)))))
220 (define-post-event-display-method FingerEvent (event) #t
221 (ly:music-property event 'digit))
223 (define-post-event-display-method TextScriptEvent (event) #t
224 (markup->lily-string (ly:music-property event 'text)))
226 (define-post-event-display-method MultiMeasureTextEvent (event) #t
227 (markup->lily-string (ly:music-property event 'text)))
229 (define-post-event-display-method HarmonicEvent (event) #t "\\harmonic")
230 (define-post-event-display-method GlissandoEvent (event) #t "\\glissando")
231 (define-post-event-display-method ArpeggioEvent (event) #t "\\arpeggio")
232 (define-post-event-display-method AbsoluteDynamicEvent (event) #f
233 (format #f "\\~a" (ly:music-property event 'text)))
235 (define-span-event-display-method BeamEvent (event) #f "[" "]")
236 (define-span-event-display-method SlurEvent (event) #f "(" ")")
237 (define-span-event-display-method CrescendoEvent (event) #f "\\<" "\\!")
238 (define-span-event-display-method DecrescendoEvent (event) #f "\\>" "\\!")
239 (define-span-event-display-method PhrasingSlurEvent (event) #f "\\(" "\\)")
240 (define-span-event-display-method SustainEvent (event) #f "\\sustainDown" "\\sustainUp")
241 (define-span-event-display-method SostenutoEvent (event) #f "\\sostenutoDown" "\\sostenutoUp")
242 (define-span-event-display-method ManualMelismaEvent (event) #f "\\melisma" "\\melismaEnd")
243 (define-span-event-display-method TextSpanEvent (event) #f "\\startTextSpan" "\\stopTextSpan")
244 (define-span-event-display-method TrillSpanEvent (event) #f "\\startTrillSpan" "\\stopTrillSpan")
245 (define-span-event-display-method StaffSpanEvent (event) #f "\\startStaff" "\\stopStaff")
246 (define-span-event-display-method NoteGroupingEvent (event) #f "\\startGroup" "\\stopGroup")
247 (define-span-event-display-method UnaCordaEvent (event) #f "\\unaCorda" "\\treCorde")
253 (define-display-method GraceMusic (expr)
254 (format #f "\\grace ~a"
255 (music->lily-string (ly:music-property expr 'element))))
257 ;; \acciaccatura \appoggiatura \grace
258 ;; TODO: it would be better to compare ?start and ?stop
259 ;; with startAppoggiaturaMusic and stopAppoggiaturaMusic,
260 ;; using a custom music equality predicate.
261 (define-extra-display-method GraceMusic (expr)
262 "Display method for appoggiatura."
263 (with-music-match (expr (music
270 ;; we check whether ?start and ?stop look like
271 ;; startAppoggiaturaMusic stopAppoggiaturaMusic
272 (and (with-music-match (?start (music
278 duration (ly:make-duration 0 0 0 1))
281 span-direction -1))))))
283 (with-music-match (?stop (music
289 duration (ly:make-duration 0 0 0 1))
292 span-direction 1))))))
293 (format #f "\\appoggiatura ~a" (music->lily-string ?music))))))
296 (define-extra-display-method GraceMusic (expr)
297 "Display method for acciaccatura."
298 (with-music-match (expr (music
305 ;; we check whether ?start and ?stop look like
306 ;; startAcciaccaturaMusic stopAcciaccaturaMusic
307 (and (with-music-match (?start (music
313 duration (ly:make-duration 0 0 0 1))
321 grob-property 'stroke-style
325 (with-music-match (?stop (music
331 grob-property 'stroke-style
337 duration (ly:make-duration 0 0 0 1))
340 span-direction 1))))))
341 (format #f "\\acciaccatura ~a" (music->lily-string ?music))))))
343 (define-extra-display-method GraceMusic (expr)
344 "Display method for grace."
345 (with-music-match (expr (music
352 ;; we check whether ?start and ?stop look like
353 ;; startGraceMusic stopGraceMusic
354 (and (null? (ly:music-property ?start 'elements))
355 (null? (ly:music-property ?stop 'elements))
356 (format #f "\\grace ~a" (music->lily-string ?music)))))
362 (define-display-method SequentialMusic (seq)
363 (let ((force-line-break (and (*force-line-break*)
365 (> (length (ly:music-property seq 'elements))
366 (*max-element-number-before-break*))))
367 (elements (ly:music-property seq 'elements))
368 (chord? (make-music-type-predicate 'EventChord))
369 (cluster? (make-music-type-predicate 'ClusterNoteEvent))
370 (note? (make-music-type-predicate 'NoteEvent)))
371 (format #f "~a~a{~v%~v_~{~a ~}~v%~v_}"
374 (any cluster? (ly:music-property e 'elements))))
378 (if (*explicit-mode*)
379 ;; if the sequence contains EventChord which contains figures ==> figuremode
380 ;; if the sequence contains EventChord which contains lyrics ==> lyricmode
381 ;; if the sequence contains EventChord which contains drum notes ==> drummode
382 (cond ((any (lambda (chord)
383 (any (make-music-type-predicate 'BassFigureEvent)
384 (ly:music-property chord 'elements)))
385 (filter chord? elements))
387 ((any (lambda (chord)
388 (any (make-music-type-predicate 'LyricEvent)
389 (ly:music-property chord 'elements)))
390 (filter chord? elements))
392 ((any (lambda (chord)
395 (not (null? (ly:music-property event 'drum-type)))))
396 (ly:music-property chord 'elements)))
397 (filter chord? elements))
399 (else ;; TODO: other modes?
402 (if force-line-break 1 0)
403 (if force-line-break (+ 2 (*indent*)) 1)
404 (parameterize ((*indent* (+ 2 (*indent*))))
405 (map-in-order music->lily-string elements))
406 (if force-line-break 1 0)
407 (if force-line-break (*indent*) 0))))
409 (define-display-method SimultaneousMusic (sim)
410 (parameterize ((*indent* (+ 3 (*indent*))))
411 (format #f "<< ~{~a ~}>>"
412 (map-in-order music->lily-string (ly:music-property sim 'elements)))))
414 (define-extra-display-method SimultaneousMusic (expr)
415 "If `sim' is an \afterGrace expression, return \"\\afterGrace ...\".
416 Otherwise, return #f."
417 ;; TODO: do something with afterGraceFraction?
418 (with-music-match (expr (music 'SimultaneousMusic
419 elements (?before-grace
420 (music 'SequentialMusic
421 elements ((music 'SkipMusic)
424 (format #f "\\afterGrace ~a ~a"
425 (music->lily-string ?before-grace)
426 (music->lily-string ?grace))))
432 (define-display-method EventChord (chord)
433 ;; event_chord : simple_element post_events
435 ;; | note_chord_element
437 ;; TODO : tagged post_events
438 ;; post_events : ( post_event | tagged_post_event )*
439 ;; tagged_post_event: '-' \tag embedded_scm post_event
441 (let* ((elements (ly:music-property chord 'elements))
442 (simple-elements (filter (make-music-type-predicate
443 'NoteEvent 'ClusterNoteEvent 'RestEvent
444 'MultiMeasureRestEvent 'SkipEvent 'LyricEvent)
446 (if ((make-music-type-predicate 'StaffSpanEvent 'BreathingSignEvent) (car elements))
447 ;; first, a special case: StaffSpanEvent (\startStaff, \stopStaff)
448 ;; and BreathingSignEvent (\breathe)
449 (music->lily-string (car elements))
450 (if (and (not (null? simple-elements))
451 (null? (cdr simple-elements)))
452 ;; simple_element : note | figure | rest | mmrest | lyric_element | skip
453 (let* ((simple-element (car simple-elements))
454 (duration (ly:music-property simple-element 'duration))
455 (lily-string (format #f "~a~a~a~{~a ~}"
456 (music->lily-string simple-element)
457 (duration->lily-string duration)
458 (if (and ((make-music-type-predicate 'RestEvent) simple-element)
459 (ly:pitch? (ly:music-property simple-element 'pitch)))
462 (map-in-order music->lily-string (filter post-event? elements)))))
463 (*previous-duration* duration)
465 (let ((chord-elements (filter (make-music-type-predicate
466 'NoteEvent 'ClusterNoteEvent 'BassFigureEvent)
468 (post-events (filter post-event? elements)))
469 (if (not (null? chord-elements))
470 ;; note_chord_element : '<' (notepitch | drumpitch)* '>" duration post_events
471 (let ((lily-string (format #f "< ~{~a ~}>~a~{~a ~}"
472 (map-in-order music->lily-string chord-elements)
473 (duration->lily-string (ly:music-property (car chord-elements)
475 (map-in-order music->lily-string post-events))))
476 (*previous-duration* (ly:music-property (car chord-elements) 'duration))
479 (format #f "~{~a ~}" (map-in-order music->lily-string elements))))))))
481 (define-display-method MultiMeasureRestMusicGroup (mmrest)
483 (map-in-order music->lily-string
484 (remove (make-music-type-predicate 'BarCheck)
485 (ly:music-property mmrest 'elements)))))
487 (define-display-method SkipMusic (skip)
488 (format #f "\\skip ~a" (duration->lily-string (ly:music-property skip 'duration) #:force-duration #t)))
491 ;;; Notes, rests, skips...
494 (define (simple-note->lily-string event)
495 (format #f "~a~a~a~a~{~a~}" ; pitchname octave !? octave-check articulations
496 (note-name->lily-string (ly:music-property event 'pitch))
497 (octave->lily-string (ly:music-property event 'pitch))
498 (let ((forced (ly:music-property event 'force-accidental))
499 (cautionary (ly:music-property event 'cautionary)))
500 (cond ((and (not (null? forced))
502 (not (null? cautionary))
505 ((and (not (null? forced)) forced) "!")
507 (let ((octave-check (ly:music-property event 'absolute-octave)))
508 (if (not (null? octave-check))
509 (format #f "=~a" (cond ((>= octave-check 0)
510 (make-string (1+ octave-check) #\'))
512 (make-string (1- (* -1 octave-check)) #\,))
515 (map-in-order music->lily-string (ly:music-property event 'articulations))))
517 (define-display-method NoteEvent (note)
518 (cond ((not (null? (ly:music-property note 'pitch))) ;; note
519 (simple-note->lily-string note))
520 ((not (null? (ly:music-property note 'drum-type))) ;; drum
521 (format #f "~a" (ly:music-property note 'drum-type)))
525 (define-display-method ClusterNoteEvent (note)
526 (simple-note->lily-string note))
528 (define-display-method RestEvent (rest)
529 (if (not (null? (ly:music-property rest 'pitch)))
530 (simple-note->lily-string rest)
533 (define-display-method MultiMeasureRestEvent (rest)
536 (define-display-method SkipEvent (rest)
539 (define-display-method MarkEvent (mark)
540 (let ((label (ly:music-property mark 'label)))
543 (format #f "\\mark ~a" (markup->lily-string label)))))
545 (define-display-method MetronomeChangeEvent (tempo)
546 (format #f "\\tempo ~a = ~a"
547 (duration->lily-string (ly:music-property tempo 'tempo-unit) #:force-duration #f #:prev-duration #f)
548 (ly:music-property tempo 'metronome-count)))
550 (define-display-method KeyChangeEvent (key)
551 (let ((pitch-alist (ly:music-property key 'pitch-alist))
552 (tonic (ly:music-property key 'tonic)))
553 (if (or (null? pitch-alist)
556 (let ((c-pitch-alist (ly:transpose-key-alist pitch-alist
557 (ly:pitch-diff (ly:make-pitch 0 0 0) tonic))))
558 (format #f "\\key ~a \\~a~a"
559 (note-name->lily-string (ly:music-property key 'tonic))
561 (if (equal? (ly:parser-lookup (*parser*) mode) c-pitch-alist)
562 (symbol->string mode)
564 '(major minor ionian locrian aeolian mixolydian lydian phrygian dorian))
565 (new-line->lily-string))))))
567 (define-display-method RelativeOctaveCheck (octave)
568 (let ((pitch (ly:music-property octave 'pitch)))
569 (format #f "\\octave ~a~a"
570 (note-name->lily-string pitch)
571 (octave->lily-string pitch))))
573 (define-display-method VoiceSeparator (sep)
576 (define-display-method LigatureEvent (ligature)
577 (if (= -1 (ly:music-property ligature 'span-direction))
581 (define-display-method BarCheck (check)
582 (format #f "|~a" (new-line->lily-string)))
584 (define-display-method BreakEvent (br)
585 "\\break") ;; TODO: use page-penalty, penalty properties?
587 (define-display-method PesOrFlexaEvent (expr)
590 (define-display-method BassFigureEvent (figure)
591 (let ((alteration (ly:music-property figure 'alteration))
592 (fig (ly:music-property figure 'figure))
593 (bracket-start (ly:music-property figure 'bracket-start))
594 (bracket-stop (ly:music-property figure 'bracket-stop)))
595 (format #f "~a~a~a~a"
596 (if (null? bracket-start) "" "[")
599 (second fig)) ;; fig: (<number-markup> "number")
600 (if (null? alteration)
609 (if (null? bracket-stop) "" "]"))))
611 (define-display-method LyricEvent (lyric)
612 (let ((text (ly:music-property lyric 'text)))
613 (if (or (string? text)
614 (eqv? (first text) simple-markup))
615 ;; a string or a simple markup
616 (let ((string (if (string? text)
619 (if (string-match "(\"| |[0-9])" string)
620 ;; TODO check exactly in which cases double quotes should be used
621 (format #f "~s" string)
623 (markup->lily-string text))))
625 (define-display-method BreathingSignEvent (event)
632 (define-display-method AutoChangeMusic (m)
633 (format #f "\\autochange ~a"
634 (music->lily-string (ly:music-property m 'element))))
636 (define-display-method ContextChange (m)
637 (format #f "\\change ~a = \"~a\""
638 (ly:music-property m 'change-to-type)
639 (ly:music-property m 'change-to-id)))
643 (define-display-method TimeScaledMusic (times)
644 (let* ((num (ly:music-property times 'numerator))
645 (den (ly:music-property times 'denominator))
646 (nd-gcd (gcd num den)))
647 (parameterize ((*force-line-break* #f)
648 (*time-factor-numerator* (/ num nd-gcd))
649 (*time-factor-denominator* (/ den nd-gcd)))
650 (format #f "\\times ~a/~a ~a"
653 (music->lily-string (ly:music-property times 'element))))))
655 (define-display-method RelativeOctaveMusic (m)
656 (music->lily-string (ly:music-property m 'element)))
658 (define-display-method TransposedMusic (m)
659 (music->lily-string (ly:music-property m 'element)))
665 (define (repeat->lily-string expr repeat-type)
666 (format #f "\\repeat ~a ~a ~a ~a"
668 (ly:music-property expr 'repeat-count)
669 (music->lily-string (ly:music-property expr 'element))
670 (let ((alternatives (ly:music-property expr 'elements)))
671 (if (null? alternatives)
673 (format #f "\\alternative { ~{~a ~}}"
674 (map-in-order music->lily-string alternatives))))))
676 (define-display-method VoltaRepeatedMusic (expr)
677 (repeat->lily-string expr "volta"))
679 (define-display-method UnfoldedRepeatedMusic (expr)
680 (repeat->lily-string expr "unfold"))
682 (define-display-method FoldedRepeatedMusic (expr)
683 (repeat->lily-string expr "fold"))
685 (define-display-method PercentRepeatedMusic (expr)
686 (repeat->lily-string expr "percent"))
688 (define-display-method TremoloRepeatedMusic (expr)
689 (let* ((count (ly:music-property expr 'repeat-count))
690 (dots (if (= 0 (modulo count 3)) 0 1))
691 (shift (- (log2 (if (= 0 dots)
694 (element (ly:music-property expr 'element))
696 (if (eqv? (ly:music-property element 'name) 'SequentialMusic)
698 (set! shift (1- shift))
699 (set! den-mult (length (ly:music-property element 'elements)))))
700 (music-map (lambda (m)
701 (let ((duration (ly:music-property m 'duration)))
702 (if (ly:duration? duration)
703 (let* ((dlog (ly:duration-log duration))
704 (ddots (ly:duration-dot-count duration))
705 (dfactor (ly:duration-factor duration))
707 (dden (cdr dfactor)))
708 (set! (ly:music-property m 'duration)
709 (ly:make-duration (- dlog shift)
710 ddots ;;(- ddots dots) ; ????
712 (/ dden den-mult))))))
715 (format #f "\\repeat tremolo ~a ~a"
717 (music->lily-string element))))
723 (define-display-method ContextSpeccedMusic (expr)
724 (let ((id (ly:music-property expr 'context-id))
725 (music (ly:music-property expr 'element))
726 (operations (ly:music-property expr 'property-operations))
727 (ctype (ly:music-property expr 'context-type)))
728 (format #f "~a ~a~a~a ~a"
729 (if (and (not (null? id))
730 (equal? id "$uniqueContextId"))
735 (equal? id "$uniqueContextId"))
737 (format #f " = ~s" id))
738 (if (null? operations)
740 (format #f " \\with {~{~a~}~%~v_}"
741 (parameterize ((*indent* (+ (*indent*) 2)))
743 (format #f "~%~v_\\~a ~s"
747 (reverse operations)))
749 (parameterize ((*current-context* ctype))
750 (music->lily-string music)))))
752 ;; special cases: \figures \lyrics \drums
753 (define-extra-display-method ContextSpeccedMusic (expr)
754 (with-music-match (expr (music 'ContextSpeccedMusic
755 context-id "$uniqueContextId"
756 property-operations ?op
757 context-type ?context-type
760 (parameterize ((*explicit-mode* #f))
763 (format #f "\\figures ~a" (music->lily-string ?sequence)))
765 (format #f "\\lyrics ~a" (music->lily-string ?sequence)))
767 (format #f "\\drums ~a" (music->lily-string ?sequence)))
772 ;;; Context properties
774 (define-extra-display-method ContextSpeccedMusic (expr)
775 (let ((element (ly:music-property expr 'element))
776 (property-tuning? (make-music-type-predicate 'PropertySet
780 (sequence? (make-music-type-predicate 'SequentialMusic)))
781 (if (and (ly:music? element)
782 (or (property-tuning? element)
783 (and (sequence? element)
784 (every property-tuning? (ly:music-property element 'elements)))))
785 (parameterize ((*current-context* (ly:music-property expr 'context-type)))
786 (music->lily-string element))
789 (define (property-value->lily-string arg)
790 (cond ((ly:music? arg)
791 (music->lily-string arg))
793 (format #f "#~s" arg))
795 (markup->lily-string arg))
797 (format #f "#~a" (scheme-expr->lily-string arg)))))
799 (define-display-method PropertySet (expr)
800 (let ((property (ly:music-property expr 'symbol))
801 (value (ly:music-property expr 'value))
802 (once (ly:music-property expr 'once)))
803 (format #f "~a\\set ~a~a = ~a~a"
804 (if (and (not (null? once)))
807 (if (eqv? (*current-context*) 'Bottom)
809 (format #f "~a . " (*current-context*)))
811 (property-value->lily-string value)
812 (new-line->lily-string))))
814 (define-display-method PropertyUnset (expr)
815 (format #f "\\unset ~a~a~a"
816 (if (eqv? (*current-context*) 'Bottom)
818 (format #f "~a . " (*current-context*)))
819 (ly:music-property expr 'symbol)
820 (new-line->lily-string)))
822 ;;; Layout properties
824 (define-display-method OverrideProperty (expr)
825 (let ((symbol (ly:music-property expr 'symbol))
826 (property (ly:music-property expr 'grob-property))
827 (value (ly:music-property expr 'grob-value))
828 (once (ly:music-property expr 'once)))
829 (format #f "~a\\override ~a~a #'~a = ~a~a"
834 (if (eqv? (*current-context*) 'Bottom)
836 (format #f "~a . " (*current-context*)))
839 (property-value->lily-string value)
840 (new-line->lily-string))))
842 (define-display-method RevertProperty (expr)
843 (let ((symbol (ly:music-property expr 'symbol))
844 (property (ly:music-property expr 'grob-property)))
845 (format #f "\\revert ~a~a #'~a~a"
846 (if (eqv? (*current-context*) 'Bottom)
848 (format #f "~a . " (*current-context*)))
851 (new-line->lily-string))))
854 (define clef-name-alist (map (lambda (name+vals)
855 (cons (cdr name+vals)
859 (define-extra-display-method ContextSpeccedMusic (expr)
860 "If `expr' is a clef change, return \"\\clef ...\"
861 Otherwise, return #f."
862 (with-music-match (expr (music 'ContextSpeccedMusic
864 element (music 'SequentialMusic
865 elements ((music 'PropertySet
869 symbol 'middleCPosition)
872 symbol 'clefPosition)
874 value ?clef-octavation
875 symbol 'clefOctavation)))))
876 (let ((clef-prop+name (assoc (list ?clef-glyph ?clef-position 0)
879 (format #f "\\clef \"~a~{~a~a~}\"~a"
881 (cond ((= 0 ?clef-octavation)
883 ((> ?clef-octavation 0)
884 (list "^" (1+ ?clef-octavation)))
886 (list "_" (- 1 ?clef-octavation))))
887 (new-line->lily-string))
891 (define-extra-display-method ContextSpeccedMusic (expr)
892 "If `expr' is a time signature set, return \"\\time ...\".
893 Otherwise, return #f."
894 (with-music-match (expr (music
904 symbol 'timeSignatureFraction)
910 symbol 'measureLength)
914 symbol 'beatGrouping))))))
915 (if (null? ?grouping)
916 (format #f "\\time ~a/~a~a" (car ?num+den) (cdr ?num+den) (new-line->lily-string))
917 (format #f "#(set-time-signature ~a ~a '~s)~a"
918 (car ?num+den) (cdr ?num+den) ?grouping (new-line->lily-string)))))
921 (define-extra-display-method ContextSpeccedMusic (expr)
922 "If `expr' is a bar, return \"\\bar ...\".
923 Otherwise, return #f."
924 (with-music-match (expr (music
933 (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string))))
936 (define (duration->moment ly-duration)
937 (let ((log2 (ly:duration-log ly-duration))
938 (dots (ly:duration-dot-count ly-duration))
939 (num+den (ly:duration-factor ly-duration)))
940 (let* ((m (expt 2 (- log2)))
941 (factor (/ (car num+den) (cdr num+den))))
943 (delta (/ m 2) (/ delta 2)))
945 (set! m (+ m delta)))
947 (define moment-duration-alist (map (lambda (duration)
948 (cons (duration->moment duration)
950 (append-map (lambda (log2)
952 (ly:make-duration log2 dots 1 1))
956 (define (moment->duration moment)
957 (let ((result (assoc (- moment) moment-duration-alist)))
961 (define-extra-display-method ContextSpeccedMusic (expr)
962 "If `expr' is a partial measure, return \"\\partial ...\".
963 Otherwise, return #f."
964 (with-music-match (expr (music
972 symbol 'measurePosition))))
973 (let ((duration (moment->duration (/ (ly:moment-main-numerator ?moment)
974 (ly:moment-main-denominator ?moment)))))
975 (and duration (format #f "\\partial ~a" (duration->lily-string duration #:force-duration #t))))))
980 (define-display-method ApplyOutputEvent (applyoutput)
981 (let ((proc (ly:music-property applyoutput 'procedure))))
982 (format #f "\\applyoutput #~a"
983 (or (procedure-name proc)
984 (with-output-to-string
986 (pretty-print (procedure-source proc)))))))
988 (define-display-method ApplyContext (applycontext)
989 (let ((proc (ly:music-property applycontext 'procedure))))
990 (format #f "\\applycontext #~a"
991 (or (procedure-name proc)
992 (with-output-to-string
994 (pretty-print (procedure-source proc)))))))
997 (define-display-method PartCombineMusic (expr)
998 (format #f "\\partcombine ~{~a ~}"
999 (map-in-order music->lily-string (ly:music-property expr 'elements))))
1001 (define-extra-display-method PartCombineMusic (expr)
1002 (with-music-match (expr (music 'PartCombineMusic
1003 elements ((music 'UnrelativableMusic
1004 element (music 'ContextSpeccedMusic
1007 element ?sequence1))
1008 (music 'UnrelativableMusic
1009 element (music 'ContextSpeccedMusic
1012 element ?sequence2)))))
1013 (format #f "\\partcombine ~a~a~a"
1014 (music->lily-string ?sequence1)
1015 (new-line->lily-string)
1016 (music->lily-string ?sequence2))))
1018 (define-display-method UnrelativableMusic (expr)
1019 (music->lily-string (ly:music-property expr 'element)))
1022 (define-display-method QuoteMusic (expr)
1023 (or (with-music-match (expr (music
1025 quoted-voice-direction ?quoted-voice-direction
1026 quoted-music-name ?quoted-music-name
1027 quoted-context-id "cue"
1028 quoted-context-type 'Voice
1030 (format #f "\\cueDuring #~s #~a ~a"
1032 ?quoted-voice-direction
1033 (music->lily-string ?music)))
1034 (format #f "\\quoteDuring #~s ~a"
1035 (ly:music-property expr 'quoted-music-name)
1036 (music->lily-string (ly:music-property expr 'element)))))
1043 (define-display-method LyricCombineMusic (expr)
1044 (format #f "\\lyricsto ~s ~a"
1045 (ly:music-property expr 'associated-context)
1046 (parameterize ((*explicit-mode* #f))
1047 (music->lily-string (ly:music-property expr 'element)))))
1049 (define-display-method OldLyricCombineMusic (expr)
1050 (format #f "\\oldaddlyrics ~a~a~a"
1051 (music->lily-string (first (ly:music-property expr 'elements)))
1052 (new-line->lily-string)
1053 (music->lily-string (second (ly:music-property expr 'elements)))))
1056 (define-extra-display-method SimultaneousMusic (expr)
1057 (with-music-match (expr (music 'SimultaneousMusic
1058 elements ((music 'ContextSpeccedMusic
1060 ;;property-operations '()
1062 element ?note-sequence)
1063 (music 'ContextSpeccedMusic
1064 context-id "$uniqueContextId"
1065 ;;property-operations '()
1066 context-type 'Lyrics
1067 element (music 'LyricCombineMusic
1068 associated-context ?associated-id
1069 element ?lyric-sequence)))))
1070 (if (string=? ?id ?associated-id)
1071 (format #f "~a~a \\addlyrics ~a"
1072 (music->lily-string ?note-sequence)
1073 (new-line->lily-string)
1074 (parameterize ((*explicit-mode* #f))
1075 (music->lily-string ?lyric-sequence)))