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