scm/define-music-display-methods.scm

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