1;;; define-music-display-methods.scm -- data for displaying music 2;;; expressions using LilyPond notation. 3;;; 4;;; Copyright (C) 2005--2021 Nicolas Sceaux <nicolas.sceaux@free.fr> 5;;; 6 7;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8;;; 9;;; Display method implementation 10;;; 11 12(define-module (lily display-lily)) 13(use-modules ((ice-9 list) 14 #:select (rassoc))) 15 16 17;;; 18;;; Scheme forms 19;;; 20(define (number-list->lily-string scm-arg) 21 (string-join (map number->string scm-arg) ",")) 22 23(define (scheme-expr->lily-string scm-arg) 24 (cond ((or (number? scm-arg) 25 (string? scm-arg) 26 (boolean? scm-arg)) 27 (format #f "~s" scm-arg)) 28 ((or (symbol? scm-arg) 29 (list? scm-arg)) 30 (format #f "'~s" scm-arg)) 31 ((procedure? scm-arg) 32 (format #f "~a" 33 (or (procedure-name scm-arg) 34 (with-output-to-string 35 (lambda () 36 (pretty-print (procedure-source scm-arg))))))) 37 (else 38 (format #f "~a" 39 (with-output-to-string 40 (lambda () 41 (display-scheme-music scm-arg))))))) 42 43;;; 44;;; Markups 45;;; 46 47(define-public (markup->lily-string markup-expr) 48 "Return a string describing, in LilyPond syntax, the given markup 49expression." 50 (define (proc->command proc) 51 (let ((cmd-markup (symbol->string (procedure-name proc)))) 52 (substring cmd-markup 0 (- (string-length cmd-markup) 53 (string-length "-markup"))))) 54 (define (arg->string arg) 55 (cond ((string? arg) 56 (format #f "~s" arg)) 57 ((markup? arg) ;; a markup 58 (markup->lily-string-aux arg)) 59 ((and (pair? arg) (every markup? arg)) ;; a markup list 60 (format #f "{~{ ~a~}}" (map-in-order markup->lily-string-aux arg))) 61 (else ;; a scheme argument 62 (format #f "#~a" (scheme-expr->lily-string arg))))) 63 (define (markup->lily-string-aux expr) 64 (if (string? expr) 65 (format #f "~s" expr) 66 (let ((cmd (car expr)) 67 (args (cdr expr))) 68 (if (eqv? cmd simple-markup) ;; a simple markup 69 (format #f "~s" (car args)) 70 (format #f "\\~a~{ ~a~}" 71 (proc->command cmd) 72 (map-in-order arg->string args)))))) 73 (cond ((string? markup-expr) 74 (format #f "~s" markup-expr)) 75 ((eqv? (car markup-expr) simple-markup) 76 (format #f "~s" (second markup-expr))) 77 (else 78 (format #f "\\markup ~a" 79 (markup->lily-string-aux markup-expr))))) 80 81;;; 82;;; pitch names 83;;; 84 85(define-public (note-name->lily-string ly-pitch) 86 ;; here we define a custom pitch= function, since we do not want to 87 ;; test whether octaves are also equal. (otherwise, we would be using equal?) 88 (define (pitch= pitch1 pitch2) 89 (and (= (ly:pitch-notename pitch1) (ly:pitch-notename pitch2)) 90 (= (ly:pitch-alteration pitch1) (ly:pitch-alteration pitch2)))) 91 (let* ((result (rassoc ly-pitch pitchnames pitch=))) 92 (and result (car result)))) 93 94(define-public (octave->lily-string pitch) 95 (let ((octave (ly:pitch-octave pitch))) 96 (cond ((>= octave 0) 97 (make-string (1+ octave) #\')) 98 ((< octave -1) 99 (make-string (1- (* -1 octave)) #\,)) 100 (else "")))) 101 102;;; 103;;; durations 104;;; 105(define*-public (duration->lily-string ly-duration #:key 106 (force-duration #f) 107 (time-scale (*time-scale*))) 108 (let ((log2 (ly:duration-log ly-duration)) 109 (dots (ly:duration-dot-count ly-duration)) 110 (scale (ly:duration-scale ly-duration))) 111 (if (or force-duration (not (*omit-duration*))) 112 (string-append (case log2 113 ((-1) "\\breve") 114 ((-2) "\\longa") 115 ((-3) "\\maxima") 116 (else (number->string (expt 2 log2)))) 117 (make-string dots #\.) 118 (let ((end-scale (/ scale time-scale))) 119 (if (= end-scale 1) "" 120 (format #f "*~a" end-scale)))) 121 ""))) 122 123;;; 124;;; post events 125;;; 126 127(define post-event? (music-type-predicate 'post-event)) 128 129(define* (event-direction->lily-string event #:optional (required #t)) 130 (let ((direction (ly:music-property event 'direction))) 131 (cond ((or (not direction) (null? direction) (= CENTER direction)) 132 (if required "-" "")) 133 ((= UP direction) "^") 134 ((= DOWN direction) "_") 135 (else "")))) 136 137(define-macro (define-post-event-display-method type vars direction-required str) 138 `(define-display-method ,type ,vars 139 (format #f "~a~a" 140 (event-direction->lily-string ,(car vars) ,direction-required) 141 ,str))) 142 143(define-macro (define-span-event-display-method type vars direction-required str-start str-stop) 144 `(define-display-method ,type ,vars 145 (format #f "~a~a" 146 (event-direction->lily-string ,(car vars) ,direction-required) 147 (if (= START (ly:music-property ,(car vars) 'span-direction)) 148 ,str-start 149 ,str-stop)))) 150 151(define-display-method HyphenEvent (event) 152 " --") 153(define-display-method ExtenderEvent (event) 154 " __") 155(define-display-method TieEvent (event) 156 " ~") 157(define-display-method DurationLineEvent (event) 158 "\\-") 159(define-display-method BendSpanEvent (event) 160 "\\^") 161(define-display-method BeamForbidEvent (event) 162 "\\noBeam") 163(define-display-method StringNumberEvent (event) 164 (format #f "\\~a" (ly:music-property event 'string-number))) 165 166 167(define-display-method TremoloEvent (event) 168 (let ((tremolo-type (ly:music-property event 'tremolo-type 8))) 169 (format #f ":~a" tremolo-type))) 170 171(define-display-method ArticulationEvent (event) #t 172 (let* ((articulation (ly:music-property event 'articulation-type)) 173 (shorthand 174 (case (string->symbol articulation) 175 ((marcato) "^") 176 ((stopped) "+") 177 ((tenuto) "-") 178 ((staccatissimo) "!") 179 ((accent) ">") 180 ((staccato) ".") 181 ((portato) "_") 182 (else #f)))) 183 (format #f "~a~:[\\~;~]~a" 184 (event-direction->lily-string event shorthand) 185 shorthand 186 (or shorthand articulation)))) 187 188(define-display-method MultiMeasureArticulationEvent (event) #t 189 (let* ((articulation (ly:music-property event 'articulation-type)) 190 (shorthand 191 (case (string->symbol articulation) 192 ((marcato) "^") 193 ((stopped) "+") 194 ((tenuto) "-") 195 ((staccatissimo) "!") 196 ((accent) ">") 197 ((staccato) ".") 198 ((portato) "_") 199 (else #f)))) 200 (format #f "~a~:[\\~;~]~a" 201 (event-direction->lily-string event shorthand) 202 shorthand 203 (or shorthand articulation)))) 204 205(define-post-event-display-method FingeringEvent (event) #t 206 (ly:music-property event 'digit)) 207 208(define-post-event-display-method TextScriptEvent (event) #t 209 (markup->lily-string (ly:music-property event 'text))) 210 211(define-post-event-display-method MultiMeasureTextEvent (event) #t 212 (markup->lily-string (ly:music-property event 'text))) 213 214(define-post-event-display-method BendAfterEvent (event) #f 215 (format #f "\\bendAfter #~a " (ly:music-property event 'delta-step))) 216 217(define-post-event-display-method FingerGlideEvent (event) #f "\\glide") 218(define-post-event-display-method HarmonicEvent (event) #f "\\harmonic") 219(define-post-event-display-method GlissandoEvent (event) #f "\\glissando") 220(define-post-event-display-method ArpeggioEvent (event) #f "\\arpeggio") 221(define-post-event-display-method AbsoluteDynamicEvent (event) #f 222 (format #f "\\~a" (ly:music-property event 'text))) 223 224(define-post-event-display-method StrokeFingerEvent (event) #f 225 (format #f "\\rightHandFinger #~a " (ly:music-property event 'digit))) 226 227(define-span-event-display-method BeamEvent (event) #f "[" "]") 228(define-span-event-display-method SlurEvent (event) #f "(" ")") 229(define-span-event-display-method CrescendoEvent (event) #f "\\<" "\\!") 230(define-span-event-display-method DecrescendoEvent (event) #f "\\>" "\\!") 231(define-span-event-display-method EpisemaEvent (event) #f "\\episemInitium" "\\episemFinis") 232(define-span-event-display-method PhrasingSlurEvent (event) #f "\\(" "\\)") 233(define-span-event-display-method SustainEvent (event) #f "\\sustainOn" "\\sustainOff") 234(define-span-event-display-method SostenutoEvent (event) #f "\\sostenutoOn" "\\sostenutoOff") 235(define-span-event-display-method TextSpanEvent (event) #f "\\startTextSpan" "\\stopTextSpan") 236(define-span-event-display-method TrillSpanEvent (event) #f "\\startTrillSpan" "\\stopTrillSpan") 237(define-span-event-display-method StaffSpanEvent (event) #f "\\startStaff" "\\stopStaff") 238(define-span-event-display-method NoteGroupingEvent (event) #f "\\startGroup" "\\stopGroup") 239(define-span-event-display-method UnaCordaEvent (event) #f "\\unaCorda" "\\treCorde") 240 241;;; 242;;; Graces 243;;; 244 245(define-display-method GraceMusic (expr) 246 (format #f "\\grace ~a" 247 (music->lily-string (ly:music-property expr 'element)))) 248 249;; \acciaccatura \appoggiatura \grace 250;; TODO: it would be better to compare ?start and ?stop 251;; with startAppoggiaturaMusic and stopAppoggiaturaMusic, 252;; using a custom music equality predicate. 253(define-extra-display-method GraceMusic (expr) 254 "Display method for appoggiatura." 255 (with-music-match (expr (music 256 'GraceMusic 257 element (music 258 'SequentialMusic 259 elements (?start 260 ?music 261 ?stop)))) 262 ;; we check whether ?start and ?stop look like 263 ;; startAppoggiaturaMusic stopAppoggiaturaMusic 264 (and (with-music-match (?start (music 265 'SequentialMusic 266 elements ((music 267 'EventChord 268 elements 269 ((music 270 'SlurEvent 271 span-direction START)))))) 272 #t) 273 (with-music-match (?stop (music 274 'SequentialMusic 275 elements ((music 276 'EventChord 277 elements 278 ((music 279 'SlurEvent 280 span-direction STOP)))))) 281 (format #f "\\appoggiatura ~a" (music->lily-string ?music)))))) 282 283 284(define-extra-display-method GraceMusic (expr) 285 "Display method for acciaccatura." 286 (with-music-match (expr (music 287 'GraceMusic 288 element (music 289 'SequentialMusic 290 elements (?start 291 ?music 292 ?stop)))) 293 ;; we check whether ?start and ?stop look like 294 ;; startAcciaccaturaMusic stopAcciaccaturaMusic 295 (and (with-music-match (?start (music 296 'SequentialMusic 297 elements ((music 298 'EventChord 299 elements 300 ((music 301 'SlurEvent 302 span-direction START))) 303 (music 304 'ContextSpeccedMusic 305 element (music 306 'OverrideProperty 307 grob-property-path '(stroke-style) 308 grob-value "grace" 309 symbol 'Flag))))) 310 #t) 311 (with-music-match (?stop (music 312 'SequentialMusic 313 elements ((music 314 'ContextSpeccedMusic 315 element (music 316 'RevertProperty 317 grob-property-path '(stroke-style) 318 symbol 'Flag)) 319 320 (music 321 'EventChord 322 elements 323 ((music 324 'SlurEvent 325 span-direction STOP)))))) 326 (format #f "\\acciaccatura ~a" (music->lily-string ?music)))))) 327 328(define-extra-display-method GraceMusic (expr) 329 "Display method for grace." 330 (with-music-match (expr (music 331 'GraceMusic 332 element (music 333 'SequentialMusic 334 elements (?start 335 ?music 336 ?stop)))) 337 ;; we check whether ?start and ?stop look like 338 ;; startGraceMusic stopGraceMusic 339 (and (null? (ly:music-property ?start 'elements)) 340 (null? (ly:music-property ?stop 'elements)) 341 (format #f "\\grace ~a" (music->lily-string ?music))))) 342 343;;; 344;;; Music sequences 345;;; 346 347(define-display-method SequentialMusic (seq) 348 (let ((force-line-break (and (*force-line-break*) 349 ;; hm 350 (> (length (ly:music-property seq 'elements)) 351 (*max-element-number-before-break*)))) 352 (elements (ly:music-property seq 'elements)) 353 (chord? (make-music-type-predicate 'EventChord)) 354 (note-or-chord? (make-music-type-predicate 'EventChord 'NoteEvent 355 'LyricEvent 'RestEvent 356 'ClusterNoteEvent)) 357 (cluster? (make-music-type-predicate 'ClusterNoteEvent)) 358 (note? (make-music-type-predicate 'NoteEvent))) 359 (format #f "~a~a{~v%~v_~{~a~^ ~}~v%~v_}" 360 (if (any (lambda (e) 361 (or (cluster? e) 362 (and (chord? e) 363 (any cluster? (ly:music-property e 'elements))))) 364 elements) 365 "\\makeClusters " 366 "") 367 (if (*explicit-mode*) 368 ;; if the sequence contains EventChord which contains figures ==> figuremode 369 ;; if the sequence contains EventChord which contains lyrics ==> lyricmode 370 ;; if the sequence contains EventChord which contains drum notes ==> drummode 371 (cond ((any (lambda (chord) 372 (any (make-music-type-predicate 'BassFigureEvent) 373 (ly:music-property chord 'elements))) 374 (filter chord? elements)) 375 "\\figuremode ") 376 ((any (lambda (chord) 377 (any (make-music-type-predicate 'LyricEvent) 378 (cons chord 379 (ly:music-property chord 'elements)))) 380 (filter note-or-chord? elements)) 381 "\\lyricmode ") 382 ((any (lambda (chord) 383 (any (lambda (event) 384 (and (note? event) 385 (not (null? (ly:music-property event 'drum-type))))) 386 (cons chord 387 (ly:music-property chord 'elements)))) 388 (filter note-or-chord? elements)) 389 "\\drummode ") 390 (else ;; TODO: other modes? 391 "")) 392 "") 393 (if force-line-break 1 0) 394 (if force-line-break (+ 2 (*indent*)) 1) 395 (parameterize ((*indent* (+ 2 (*indent*)))) 396 (map-in-order (lambda (music) 397 (music->lily-string music)) 398 elements)) 399 (if force-line-break 1 0) 400 (if force-line-break (*indent*) 1)))) 401 402(define-display-method SimultaneousMusic (sim) 403 (parameterize ((*indent* (+ 3 (*indent*)))) 404 (format #f "<< ~{~a ~}>>" 405 (map-in-order (lambda (music) 406 (music->lily-string music)) 407 (ly:music-property sim 'elements))))) 408 409;;; 410;;; Chords 411;;; 412 413(define-display-method EventChord (chord) 414 ;; event_chord : command_element 415 ;; | note_chord_element 416 417 ;; TODO : tagged post_events 418 ;; post_events : ( post_event | tagged_post_event )* 419 ;; tagged_post_event: '-' \tag embedded_scm post_event 420 421 (let* ((elements (append (ly:music-property chord 'elements) 422 (ly:music-property chord 'articulations))) 423 (chord-repeat (ly:music-property chord 'duration))) 424 (call-with-values 425 (lambda () 426 (partition (music-type-predicate 'rhythmic-event) 427 elements)) 428 (lambda (chord-elements other-elements) 429 (cond ((pair? chord-elements) 430 ;; note_chord_element : 431 ;; '<' (notepitch | drumpitch)* '>" duration post_events 432 (let ((duration (duration->lily-string (ly:music-property 433 (car chord-elements) 434 'duration)))) 435 ;; Format duration first so that it does not appear on 436 ;; chord elements 437 (format #f "< ~{~a ~}>~a~:{~:[-~;~]~a~^ ~}" 438 (parameterize ((*omit-duration* #t)) 439 (map-in-order 440 (lambda (music) 441 (music->lily-string music)) 442 chord-elements)) 443 duration 444 (map-in-order (lambda (music) 445 (list 446 (post-event? music) 447 (music->lily-string music))) 448 other-elements)))) 449 ((ly:duration? chord-repeat) 450 (let ((duration (duration->lily-string chord-repeat))) 451 (format #f "q~a~:{~:[-~;~]~a~^ ~}" 452 duration 453 (map-in-order (lambda (music) 454 (list 455 (post-event? music) 456 (music->lily-string music))) 457 other-elements)))) 458 459 ((and (= 1 (length other-elements)) 460 (not (post-event? (car other-elements)))) 461 (format #f (music->lily-string (car other-elements)))) 462 (else 463 (format #f "< >~:{~:[-~;~]~a~^ ~}" 464 (map-in-order (lambda (music) 465 (list 466 (post-event? music) 467 (music->lily-string music))) 468 other-elements)))))))) 469 470(define-display-method MultiMeasureRestMusic (mmrest) 471 (format #f "R~a~{~a~^ ~}" 472 (duration->lily-string (ly:music-property mmrest 'duration)) 473 (map-in-order (lambda (music) 474 (music->lily-string music)) 475 (ly:music-property mmrest 'articulations)))) 476 477(define-display-method SkipMusic (skip) 478 (format #f "\\skip ~a" (duration->lily-string (ly:music-property skip 'duration) #:force-duration #t))) 479 480(define-display-method OttavaEvent (ottava) 481 (format #f "\\ottava #~a" (ly:music-property ottava 'ottava-number))) 482 483;;; 484;;; Notes, rests, skips... 485;;; 486 487(define (simple-note->lily-string event) 488 (format #f "~a~a~a~a~a~a~:{~:[-~;~]~a~}" ; pitchname octave !? octave-check duration optional_rest articulations 489 (note-name->lily-string (ly:music-property event 'pitch)) 490 (octave->lily-string (ly:music-property event 'pitch)) 491 (let ((forced (ly:music-property event 'force-accidental)) 492 (cautionary (ly:music-property event 'cautionary))) 493 (cond ((and (not (null? forced)) 494 forced 495 (not (null? cautionary)) 496 cautionary) 497 "?") 498 ((and (not (null? forced)) forced) "!") 499 (else ""))) 500 (let ((octave-check (ly:music-property event 'absolute-octave))) 501 (if (not (null? octave-check)) 502 (format #f "=~a" (cond ((>= octave-check 0) 503 (make-string (1+ octave-check) #\')) 504 ((< octave-check -1) 505 (make-string (1- (* -1 octave-check)) #\,)) 506 (else ""))) 507 "")) 508 (duration->lily-string (ly:music-property event 'duration)) 509 (if ((make-music-type-predicate 'RestEvent) event) 510 "\\rest" "") 511 (map-in-order (lambda (event) 512 (list 513 (post-event? event) 514 (music->lily-string event))) 515 (ly:music-property event 'articulations)))) 516 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~a~{~a~}" (ly:music-property note 'drum-type) 522 (duration->lily-string (ly:music-property note 'duration)) 523 (map-in-order (lambda (event) 524 (music->lily-string event)) 525 (ly:music-property note 'articulations)))) 526 (else 527 ;; pure duration 528 (format #f "~a~{~a~}" 529 (duration->lily-string (ly:music-property note 'duration) 530 #:force-duration #t) 531 (map-in-order (lambda (event) 532 (music->lily-string event)) 533 (ly:music-property note 'articulations)))))) 534 535(define-display-method ClusterNoteEvent (note) 536 (simple-note->lily-string note)) 537 538(define-display-method RestEvent (rest) 539 (if (not (null? (ly:music-property rest 'pitch))) 540 (simple-note->lily-string rest) 541 (format #f "r~a~{~a~}" 542 (duration->lily-string (ly:music-property rest 'duration)) 543 (map-in-order (lambda (event) 544 (music->lily-string event)) 545 (ly:music-property rest 'articulations))))) 546 547(define-display-method MultiMeasureRestEvent (rest) 548 (string-append "R" (duration->lily-string (ly:music-property rest 'duration)))) 549 550(define-display-method SkipEvent (rest) 551 (format #f "s~a~{~a~}" 552 (duration->lily-string (ly:music-property rest 'duration)) 553 (map-in-order (lambda (event) 554 (music->lily-string event)) 555 (ly:music-property rest 'articulations)))) 556 557(define-display-method RepeatedChord (chord) 558 (music->lily-string (ly:music-property chord 'element))) 559 560(define-display-method AdHocMarkEvent (mark) 561 (string-append "\\mark " 562 (markup->lily-string (ly:music-property mark 'text)))) 563 564(define-display-method RehearsalMarkEvent (mark) 565 (let ((label (ly:music-property mark 'label #f))) 566 (string-append "\\mark " 567 (if label (value->lily-string label) "\\default")))) 568 569(define-display-method KeyChangeEvent (key) 570 (let ((pitch-alist (ly:music-property key 'pitch-alist)) 571 (tonic (ly:music-property key 'tonic))) 572 (if (or (null? pitch-alist) 573 (null? tonic)) 574 "\\key \\default" 575 (let ((c-pitch-alist (ly:transpose-key-alist pitch-alist 576 (ly:pitch-diff (ly:make-pitch 0 0 0) tonic)))) 577 (format #f "\\key ~a \\~a~a" 578 (note-name->lily-string (ly:music-property key 'tonic)) 579 (any (lambda (mode) 580 (and (equal? (ly:parser-lookup mode) c-pitch-alist) 581 (symbol->string mode))) 582 '(major minor ionian locrian aeolian mixolydian lydian phrygian dorian)) 583 (new-line->lily-string)))))) 584 585(define-display-method RelativeOctaveCheck (octave) 586 (let ((pitch (ly:music-property octave 'pitch))) 587 (format #f "\\octaveCheck ~a~a" 588 (note-name->lily-string pitch) 589 (octave->lily-string pitch)))) 590 591(define-display-method VoiceSeparator (sep) 592 "\\\\") 593 594(define-display-method LigatureEvent (ligature) 595 (if (= START (ly:music-property ligature 'span-direction)) 596 "\\[" 597 "\\]")) 598 599(define-display-method BarCheck (check) 600 (format #f "|~a" (new-line->lily-string))) 601 602(define-display-method PesOrFlexaEvent (expr) 603 "\\~") 604 605(define-display-method BassFigureEvent (figure) 606 ;; TODO handle \+, / and friends as well as arbitrary levels of alteration 607 (define (bracketify content) (format #f "[~a]" content)) 608 (let ((alteration (ly:music-property figure 'alteration)) 609 (alteration-bracket (ly:music-property figure 'alteration-bracket)) 610 (fig (ly:music-property figure 'figure)) 611 (bracket-start (ly:music-property figure 'bracket-start)) 612 (bracket-stop (ly:music-property figure 'bracket-stop))) 613 614 (format #f "~a~a~a~a" 615 (if (null? bracket-start) "" "[") 616 (cond ((null? fig) "_") 617 ((markup? fig) (second fig)) ;; fig: (<number-markup> "number") 618 (else fig)) 619 (if (null? alteration) 620 "" 621 ((if (null? alteration-bracket) identity bracketify) 622 (cond 623 ((= alteration DOUBLE-FLAT) "--") 624 ((= alteration FLAT) "-") 625 ((= alteration NATURAL) "!") 626 ((= alteration SHARP) "+") 627 ((= alteration DOUBLE-SHARP) "++") 628 (else "")))) 629 (if (null? bracket-stop) "" "]")))) 630 631(define-display-method LyricEvent (lyric) 632 (format #f "~a~{~a~^ ~}" 633 (let ((text (ly:music-property lyric 'text))) 634 (if (or (string? text) 635 (eqv? (first text) simple-markup)) 636 ;; a string or a simple markup 637 (let ((string (if (string? text) 638 text 639 (second text)))) 640 (if (string-match "(\"| |[0-9])" string) 641 ;; TODO check exactly in which cases double quotes should be used 642 (format #f "~s" string) 643 string)) 644 (markup->lily-string text))) 645 (map-in-order music->lily-string 646 (ly:music-property lyric 'articulations)))) 647 648(define-display-method BreathingEvent (event) 649 "\\breathe") 650 651;;; 652;;; Staff switches 653;;; 654 655(define-display-method ContextChange (m) 656 (format #f "\\change ~a = \"~a\"" 657 (ly:music-property m 'change-to-type) 658 (ly:music-property m 'change-to-id))) 659 660;;; 661 662(define-display-method TimeScaledMusic (times) 663 (let* ((num (ly:music-property times 'numerator)) 664 (den (ly:music-property times 'denominator)) 665 (span (ly:music-property times 'duration #f)) 666 ;; need to format before changing time scale 667 (formatted-span 668 (and span (duration->lily-string span #:force-duration #t))) 669 (scale (/ num den)) 670 (time-scale (*time-scale*))) 671 (let ((result 672 (parameterize ((*force-line-break* #f) 673 (*time-scale* (* time-scale scale))) 674 (format #f "\\tuplet ~a/~a ~@[~a ~]~a" 675 den 676 num 677 formatted-span 678 (music->lily-string (ly:music-property times 'element)))))) 679 result))) 680 681(define-display-method RelativeOctaveMusic (m) 682 (format #f "\\absolute ~a" 683 (music->lily-string (ly:music-property m 'element)))) 684 685(define-display-method TransposedMusic (m) 686 (music->lily-string (ly:music-property m 'element))) 687 688;;; 689;;; Repeats 690;;; 691 692(define-display-method AlternativeEvent (alternative) "") 693 694(define (repeat->lily-string expr repeat-type) 695 (let* ((main (music->lily-string (ly:music-property expr 'element)))) 696 (format #f "\\repeat ~a ~a ~a ~a" 697 repeat-type 698 (ly:music-property expr 'repeat-count) 699 main 700 (let ((alternatives (ly:music-property expr 'elements))) 701 (if (null? alternatives) 702 "" 703 (format #f "\\alternative { ~{~a ~}}" 704 (map-in-order (lambda (music) 705 (music->lily-string music)) 706 alternatives))))))) 707 708(define-display-method SequentialAlternativeMusic (expr) 709 (format #f "\\alternative { ~{~a ~}}" 710 (map-in-order (lambda (music) 711 (music->lily-string music)) 712 (ly:music-property expr 'elements)))) 713 714(define-display-method VoltaRepeatedMusic (expr) 715 (repeat->lily-string expr "volta")) 716 717(define-display-method UnfoldedRepeatedMusic (expr) 718 (repeat->lily-string expr "unfold")) 719 720(define-display-method PercentRepeatedMusic (expr) 721 (repeat->lily-string expr "percent")) 722 723(define-display-method TremoloRepeatedMusic (expr) 724 (repeat->lily-string expr "tremolo")) 725 726(define-display-method UnfoldedSpeccedMusic (m) 727 (format #f "\\unfolded ~a" 728 (music->lily-string (ly:music-property m 'element)))) 729 730(define-display-method VoltaSpeccedMusic (m) 731 (format #f "\\volta ~a ~a" 732 (number-list->lily-string (ly:music-property m 'volta-numbers)) 733 (music->lily-string (ly:music-property m 'element)))) 734 735;;; 736;;; Contexts 737;;; 738 739(define-display-method ContextSpeccedMusic (expr) 740 (let ((id (ly:music-property expr 'context-id)) 741 (create-new (ly:music-property expr 'create-new)) 742 (music (ly:music-property expr 'element)) 743 (operations (ly:music-property expr 'property-operations)) 744 (ctype (ly:music-property expr 'context-type))) 745 (format #f "~a ~a~a~a ~a" 746 (if (and (not (null? create-new)) create-new) 747 "\\new" 748 "\\context") 749 ctype 750 (if (null? id) 751 "" 752 (format #f " = ~s" id)) 753 (if (null? operations) 754 "" 755 (format #f " \\with {~{~a~}~%~v_}" 756 (parameterize ((*indent* (+ (*indent*) 2))) 757 (map (lambda (op) 758 (format #f "~%~v_\\~a ~s" 759 (*indent*) 760 (first op) 761 (second op))) 762 operations)) 763 (*indent*))) 764 (parameterize ((*current-context* ctype)) 765 (music->lily-string music))))) 766 767;; \after 768(define-extra-display-method ContextSpeccedMusic (expr) 769 "If `expr' is an \\after expression with a post-event, return 770\"\\after ...\". Otherwise, return #f." 771 (with-music-match 772 (expr (music 'ContextSpeccedMusic 773 context-type 'Bottom 774 element 775 (music 'SimultaneousMusic 776 elements ((music 'SequentialMusic 777 elements ((music 'SkipMusic 778 duration ?delta) 779 (music 'EventChord 780 elements ?ev))) 781 ?mus)))) 782 (format #f "\\after ~a ~a ~a" 783 (duration->lily-string ?delta) 784 (music->lily-string (car ?ev)) 785 (music->lily-string ?mus)))) 786 787(define-extra-display-method ContextSpeccedMusic (expr) 788 "If `expr' is an \\after expression with a standalone music event, return 789\"\\after ...\". Otherwise, return #f." 790 (with-music-match 791 (expr (music 'ContextSpeccedMusic 792 context-type 'Bottom 793 element 794 (music 'SimultaneousMusic 795 elements ((music 'SequentialMusic 796 elements ((music 'SkipMusic 797 duration ?delta) 798 (music 'EventChord) 799 ?ev)) 800 ?mus)))) 801 (format #f "\\after ~a ~a ~a" 802 (duration->lily-string ?delta) 803 (music->lily-string ?ev) 804 (music->lily-string ?mus)))) 805 806;; \afterGrace 807(define-extra-display-method ContextSpeccedMusic (expr) 808 "If `expr' is an \\afterGrace expression, return \"\\afterGrace ...\". 809Otherwise, return #f." 810 (with-music-match 811 (expr (music 'ContextSpeccedMusic 812 context-type 'Bottom 813 element 814 (music 'SimultaneousMusic 815 elements (?main 816 (music 'SequentialMusic 817 elements ((music 'SkipMusic 818 duration ?delay-dur) 819 (music 'GraceMusic 820 element ?grace))))))) 821 (format #f "\\afterGrace ~a ~a ~a" 822 (/ (ly:duration-scale ?delay-dur) 823 (ly:moment-main (ly:music-length ?main))) 824 (music->lily-string ?main) 825 (music->lily-string ?grace)))) 826 827 828;; special cases: \figures \lyrics \drums 829(define-extra-display-method ContextSpeccedMusic (expr) 830 (with-music-match (expr (music 'ContextSpeccedMusic 831 create-new #t 832 property-operations ?op 833 context-type ?context-type 834 element ?sequence)) 835 (if (null? ?op) 836 (parameterize ((*explicit-mode* #f)) 837 (case ?context-type 838 ((FiguredBass) 839 (format #f "\\figures ~a" (music->lily-string ?sequence))) 840 ((Lyrics) 841 (format #f "\\lyrics ~a" (music->lily-string ?sequence))) 842 ((DrumStaff) 843 (format #f "\\drums ~a" (music->lily-string ?sequence))) 844 (else 845 #f))) 846 #f))) 847 848;;; Context properties 849 850(define-extra-display-method ContextSpeccedMusic (expr) 851 (let ((element (ly:music-property expr 'element)) 852 (property-tuning? (make-music-type-predicate 'PropertySet 853 'PropertyUnset 854 'OverrideProperty 855 'RevertProperty)) 856 (sequence? (make-music-type-predicate 'SequentialMusic))) 857 (if (and (ly:music? element) 858 (or (property-tuning? element) 859 (and (sequence? element) 860 (every property-tuning? (ly:music-property element 'elements))))) 861 (parameterize ((*current-context* (ly:music-property expr 'context-type))) 862 (music->lily-string element)) 863 #f))) 864 865(define-public (value->lily-string arg) 866 (cond ((ly:music? arg) 867 (music->lily-string arg)) 868 ((markup? arg) 869 (markup->lily-string arg)) 870 ((ly:duration? arg) 871 (format #f "##{ ~a #}" (duration->lily-string arg #:force-duration #t))) 872 ((ly:pitch? arg) 873 (format #f "~a~a" 874 (note-name->lily-string arg) 875 (octave->lily-string arg))) 876 (else 877 (format #f "#~a" (scheme-expr->lily-string arg))))) 878 879(define-display-method PropertySet (expr) 880 (let ((property (ly:music-property expr 'symbol)) 881 (value (ly:music-property expr 'value)) 882 (once (ly:music-property expr 'once))) 883 (format #f "~a\\set ~a~a = ~a~a" 884 (if (and (not (null? once))) 885 "\\once " 886 "") 887 (if (eq? (*current-context*) 'Bottom) 888 "" 889 (format #f "~a." (*current-context*))) 890 property 891 (value->lily-string value) 892 (new-line->lily-string)))) 893 894(define-display-method PropertyUnset (expr) 895 (format #f "~a\\unset ~a~a~a" 896 (if (ly:music-property expr 'once #f) "\\once " "") 897 (if (eq? (*current-context*) 'Bottom) 898 "" 899 (format #f "~a." (*current-context*))) 900 (ly:music-property expr 'symbol) 901 (new-line->lily-string))) 902 903;;; Layout properties 904 905(define-display-method OverrideProperty (expr) 906 (let* ((symbol (ly:music-property expr 'symbol)) 907 (properties (ly:music-property expr 'grob-property-path 908 (list (ly:music-property expr 'grob-property)))) 909 (value (ly:music-property expr 'grob-value)) 910 (once (ly:music-property expr 'once))) 911 912 (format #f "~a\\override ~{~a~^.~} = ~a~a" 913 (if (or (null? once) 914 (not once)) 915 "" 916 "\\once ") 917 (if (eqv? (*current-context*) 'Bottom) 918 (cons symbol properties) 919 (cons* (*current-context*) symbol properties)) 920 (value->lily-string value) 921 (new-line->lily-string)))) 922 923(define-display-method RevertProperty (expr) 924 (let* ((symbol (ly:music-property expr 'symbol)) 925 (properties (ly:music-property expr 'grob-property-path 926 (list (ly:music-property expr 927 'grob-property)))) 928 (once (ly:music-property expr 'once #f))) 929 (format #f "~a\\revert ~{~a~^.~}~a" 930 (if once "\\once " "") 931 (if (eqv? (*current-context*) 'Bottom) 932 (cons symbol properties) 933 (cons* (*current-context*) symbol properties)) 934 (new-line->lily-string)))) 935 936(define-display-method TimeSignatureMusic (expr) 937 (let* ((num (ly:music-property expr 'numerator)) 938 (den (ly:music-property expr 'denominator)) 939 (structure (ly:music-property expr 'beat-structure))) 940 (if (null? structure) 941 (format #f 942 "\\time ~a/~a~a" 943 num den 944 (new-line->lily-string)) 945 (format #f 946 ;; This is silly but the latter will also work for #f 947 ;; and other 948 (if (key-list? structure) 949 "\\time ~{~a~^,~} ~a/~a~a" 950 "\\time #'~a ~a/~a~a") 951 structure num den 952 (new-line->lily-string))))) 953 954;;; \melisma and \melismaEnd 955(define-extra-display-method ContextSpeccedMusic (expr) 956 "If expr is a melisma, return \"\\melisma\", otherwise, return #f." 957 (with-music-match (expr (music 'ContextSpeccedMusic 958 element (music 'PropertySet 959 value #t 960 symbol 'melismaBusy))) 961 "\\melisma")) 962 963(define-extra-display-method ContextSpeccedMusic (expr) 964 "If expr is a melisma end, return \"\\melismaEnd\", otherwise, return #f." 965 (with-music-match (expr (music 'ContextSpeccedMusic 966 element (music 'PropertyUnset 967 symbol 'melismaBusy))) 968 "\\melismaEnd")) 969 970;;; \tempo 971(define-extra-display-method SequentialMusic (expr) 972 (with-music-match (expr (music 'SequentialMusic 973 elements ((music 'TempoChangeEvent 974 text ?text 975 tempo-unit ?unit 976 metronome-count ?count) 977 (music 'ContextSpeccedMusic 978 element (music 'PropertySet 979 symbol 'tempoWholesPerMinute))))) 980 (format #f "\\tempo ~{~a~a~}~a = ~a~a" 981 (if (markup? ?text) 982 (list (markup->lily-string ?text) " ") 983 '()) 984 (duration->lily-string ?unit #:force-duration #t) 985 (if (pair? ?count) 986 (format #f "~a - ~a" (car ?count) (cdr ?count)) 987 ?count) 988 (new-line->lily-string)))) 989 990(define-display-method TempoChangeEvent (expr) 991 (let ((text (ly:music-property expr 'text))) 992 (format #f "\\tempo ~a~a" 993 (markup->lily-string text) 994 (new-line->lily-string)))) 995 996;;; \clef 997(define clef-name-alist #f) 998(define-public (memoize-clef-names clefs) 999 "Initialize @code{clef-name-alist}, if not already set." 1000 (if (not clef-name-alist) 1001 (set! clef-name-alist 1002 (map (lambda (name+vals) 1003 (cons (cdr name+vals) 1004 (car name+vals))) 1005 clefs)))) 1006 1007(define-extra-display-method ContextSpeccedMusic (expr) 1008 "If @var{expr} is a clef change, return \"\\clef ...\". 1009Otherwise, return @code{#f}." 1010 (with-music-match (expr (music 'ContextSpeccedMusic 1011 context-type 'Staff 1012 element (music 'SequentialMusic 1013 elements ((music 'PropertySet 1014 value ?clef-glyph 1015 symbol 'clefGlyph) 1016 (music 'PropertySet 1017 symbol 'middleCClefPosition) 1018 (music 'PropertySet 1019 value ?clef-position 1020 symbol 'clefPosition) 1021 (music 'PropertySet 1022 value ?clef-transposition 1023 symbol 'clefTransposition) 1024 (music 'PropertySet 1025 value ?clef-transposition-style 1026 symbol 'clefTranspositionStyle) 1027 (music 'ApplyContext 1028 procedure ly:set-middle-C!))))) 1029 (let ((clef-name (assoc-get (list ?clef-glyph ?clef-position 0) 1030 clef-name-alist))) 1031 (and clef-name 1032 (format #f "\\clef \"~a~?\"~a" 1033 clef-name 1034 (case ?clef-transposition-style 1035 ((parenthesized) "~a(~a)") 1036 ((bracketed) "~a[~a]") 1037 (else "~a~a")) 1038 (cond ((zero? ?clef-transposition) 1039 (list "" "")) 1040 ((positive? ?clef-transposition) 1041 (list "^" (1+ ?clef-transposition))) 1042 (else (list "_" (- 1 ?clef-transposition)))) 1043 (new-line->lily-string)))))) 1044 1045;;; \bar 1046(define-extra-display-method ContextSpeccedMusic (expr) 1047 "If `expr' is a bar, return \"\\bar ...\". 1048Otherwise, return #f." 1049 (with-music-match (expr (music 'ContextSpeccedMusic 1050 context-type 'Timing 1051 element (music 'PropertySet 1052 value ?bar-type 1053 symbol 'whichBar))) 1054 (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string)))) 1055 1056(define-display-method FineEvent (expr) 1057 "\\fine") 1058 1059(define-display-method SectionEvent (expr) 1060 "\\section") 1061 1062;;; \partial 1063(define-extra-display-method ContextSpeccedMusic (expr) 1064 "If `expr' is a partial measure, return \"\\partial ...\". 1065Otherwise, return #f." 1066 (with-music-match (expr (music 1067 'ContextSpeccedMusic 1068 context-type 'Timing 1069 element (music 1070 'PartialSet 1071 duration ?duration))) 1072 1073 (and ?duration 1074 (format #f "\\partial ~a" 1075 (duration->lily-string ?duration #:force-duration #t))))) 1076 1077;;; 1078;;; 1079 1080(define-display-method ApplyOutputEvent (applyoutput) 1081 (let ((proc (ly:music-property applyoutput 'procedure)) 1082 (ctx (ly:music-property applyoutput 'context-type)) 1083 (grob (ly:music-property applyoutput 'symbol))) 1084 (format #f "\\applyOutput ~a~@[.~a~] #~a" 1085 ctx 1086 (and (symbol? grob) grob) 1087 (or (procedure-name proc) 1088 (with-output-to-string 1089 (lambda () 1090 (pretty-print (procedure-source proc)))))))) 1091 1092(define-display-method ApplyContext (applycontext) 1093 (let ((proc (ly:music-property applycontext 'procedure))) 1094 (format #f "\\applyContext #~a" 1095 (or (procedure-name proc) 1096 (with-output-to-string 1097 (lambda () 1098 (pretty-print (procedure-source proc)))))))) 1099 1100;;; \partCombine 1101(define-display-method PartCombineMusic (expr) 1102 (with-music-match 1103 (expr (music 'PartCombineMusic 1104 direction ?dir 1105 elements ((music 'ContextSpeccedMusic 1106 element 1107 (music 'SimultaneousMusic 1108 tags (list '$partCombine) 1109 elements (?part-one-changes 1110 ?part-one))) 1111 (music 'ContextSpeccedMusic 1112 element 1113 (music 'SimultaneousMusic 1114 tags (list '$partCombine) 1115 elements (?part-two-changes 1116 ?part-two)))))) 1117 (format #f "\\partCombine~a ~a~a~a" 1118 (cond ((equal? ?dir UP) "Up") 1119 ((equal? ?dir DOWN) "Down") 1120 (else "")) 1121 (music->lily-string ?part-one) 1122 (new-line->lily-string) 1123 (music->lily-string ?part-two)))) 1124 1125(define-extra-display-method ContextSpeccedMusic (expr) 1126 "If `expr' is a \\partCombine expression, return \"\\partCombine ...\". 1127Otherwise, return #f." 1128 (with-music-match 1129 (expr (music 'ContextSpeccedMusic 1130 context-type 'Staff 1131 element (music 'SimultaneousMusic 1132 elements ((music 'ContextSpeccedMusic 1133 context-id "one" 1134 context-type 'Voice) 1135 (music 'ContextSpeccedMusic 1136 context-id "two" 1137 context-type 'Voice) 1138 (music 'ContextSpeccedMusic 1139 context-id "shared" 1140 context-type 'Voice) 1141 (music 'ContextSpeccedMusic 1142 context-id "solo" 1143 context-type 'Voice) 1144 (music 'ContextSpeccedMusic 1145 context-id "null" 1146 context-type 'NullVoice) 1147 ?pc-music 1148 ?pc-marks)))) 1149 (with-music-match 1150 (?pc-music (music 'PartCombineMusic)) 1151 (format #f "~a" (music->lily-string ?pc-music))))) 1152 1153(define-display-method UnrelativableMusic (expr) 1154 (music->lily-string (ly:music-property expr 'element))) 1155 1156;;; Cue notes 1157(define-display-method QuoteMusic (expr) 1158 (or (with-music-match (expr (music 1159 'QuoteMusic 1160 quoted-voice-direction ?quoted-voice-direction 1161 quoted-music-name ?quoted-music-name 1162 quoted-context-id "cue" 1163 quoted-context-type 'CueVoice 1164 element ?music)) 1165 (format #f "\\cueDuring ~s #~a ~a" 1166 ?quoted-music-name 1167 ?quoted-voice-direction 1168 (music->lily-string ?music))) 1169 (format #f "\\quoteDuring ~s ~a" 1170 (ly:music-property expr 'quoted-music-name) 1171 (music->lily-string (ly:music-property expr 'element))))) 1172 1173;;; 1174;;; Breaks 1175;;; 1176(define-display-method LineBreakEvent (expr) 1177 (if (null? (ly:music-property expr 'break-permission)) 1178 "\\noBreak" 1179 "\\break")) 1180 1181(define-display-method PageBreakEvent (expr) 1182 (if (null? (ly:music-property expr 'break-permission)) 1183 "\\noPageBreak" 1184 "\\pageBreak")) 1185 1186(define-display-method PageTurnEvent (expr) 1187 (if (null? (ly:music-property expr 'break-permission)) 1188 "\\noPageTurn" 1189 "\\pageTurn")) 1190 1191(define-extra-display-method EventChord (expr) 1192 (with-music-match (expr (music 'EventChord 1193 elements ((music 'LineBreakEvent 1194 break-permission 'force) 1195 (music 'PageBreakEvent 1196 break-permission 'force)))) 1197 "\\pageBreak")) 1198 1199(define-extra-display-method EventChord (expr) 1200 (with-music-match (expr (music 'EventChord 1201 elements ((music 'LineBreakEvent 1202 break-permission 'force) 1203 (music 'PageBreakEvent 1204 break-permission 'force) 1205 (music 'PageTurnEvent 1206 break-permission 'force)))) 1207 "\\pageTurn")) 1208 1209;;; 1210;;; Lyrics 1211;;; 1212 1213;;; \lyricsto 1214(define-display-method LyricCombineMusic (expr) 1215 (format #f "\\lyricsto ~s ~a" 1216 (ly:music-property expr 'associated-context) 1217 (parameterize ((*explicit-mode* #f) 1218 (*omit-duration* #t)) 1219 (music->lily-string (ly:music-property expr 'element))))) 1220 1221;; \autoChange 1222(define-extra-display-method SimultaneousMusic (expr) 1223 (with-music-match 1224 (expr (music 'SimultaneousMusic 1225 elements ((music 'ContextSpeccedMusic 1226 context-id "up" 1227 context-type 'Staff 1228 element ?ac-music) 1229 (music 'ContextSpeccedMusic 1230 context-id "up" 1231 context-type 'Staff) 1232 (music 'ContextSpeccedMusic 1233 context-id "down" 1234 context-type 'Staff)))) 1235 (with-music-match 1236 (?ac-music (music 'ContextSpeccedMusic 1237 element (music 'SimultaneousMusic 1238 tags (list '$autoChange) 1239 elements (?changes 1240 ?inner-music)))) 1241 (format #f "\\autoChange ~a" (music->lily-string ?inner-music))))) 1242 1243;; \addlyrics 1244(define-extra-display-method SimultaneousMusic (expr) 1245 (with-music-match (expr (music 'SimultaneousMusic 1246 elements ((music 'ContextSpeccedMusic 1247 context-id ?id 1248 context-type 'Voice 1249 element ?note-sequence) 1250 (music 'ContextSpeccedMusic 1251 context-type 'Lyrics 1252 create-new #t 1253 element (music 'LyricCombineMusic 1254 associated-context ?associated-id 1255 element ?lyric-sequence))))) 1256 (if (string=? ?id ?associated-id) 1257 (format #f "~a~a \\addlyrics ~a" 1258 (music->lily-string ?note-sequence) 1259 (new-line->lily-string) 1260 (parameterize ((*explicit-mode* #f) 1261 (*omit-duration* #t)) 1262 (music->lily-string ?lyric-sequence))) 1263 #f))) 1264 1265;; Silence internal event sent at end of each lyrics block 1266(define-display-method CompletizeExtenderEvent (expr) 1267 "") 1268