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          (property-path   (ly:music-property expr 'grob-property-path))
 860          (properties      (if (pair? property-path)
 861                               property-path
 862                               (list (ly:music-property expr 'grob-property))))
 863          (value   (ly:music-property expr 'grob-value))
 864          (once    (ly:music-property expr 'once)))
 865
 866     (format #f "~a\\override ~a~a #'~a = ~a~a"
 867             (if (or (null? once)
 868                     (not once))
 869                 ""
 870                 "\\once ")
 871             (if (eqv? (*current-context*) 'Bottom)
 872                 ""
 873                 (format #f "~a . " (*current-context*)))
 874             symbol
 875             (if (null? (cdr properties))
 876                 (car properties)
 877                 properties)
 878             (property-value->lily-string value parser)
 879             (new-line->lily-string))))
 880
 881 (define-display-method RevertProperty (expr parser)
 882   (let ((symbol (ly:music-property expr 'symbol))
 883         (properties (ly:music-property expr 'grob-property-path)))
 884     (format #f "\\revert ~a~a #'~a~a"
 885             (if (eqv? (*current-context*) 'Bottom)
 886                 ""
 887                 (format #f "~a . " (*current-context*)))
 888             symbol
 889             (if (null? (cdr properties))
 890                 (car properties)
 891                 properties)
 892             (new-line->lily-string))))
 893
 894 (define-display-method TimeSignatureMusic (expr parser)
 895   (let* ((num (ly:music-property expr 'numerator))
 896          (den (ly:music-property expr 'denominator))
 897          (structure (ly:music-property expr 'beat-structure)))
 898     (if (null? structure)
 899         (format #f
 900                 "\\time ~a/~a~a"
 901                 num den
 902                 (new-line->lily-string))
 903         (format #f
 904                 "#(set-time-signature ~a ~a '~a)~a"
 905                 num den structure
 906                 (new-line->lily-string)))))
 907
 908 ;;; \melisma and \melismaEnd
 909 (define-extra-display-method ContextSpeccedMusic (expr parser)
 910   "If expr is a melisma, return \"\\melisma\", otherwise, return #f."
 911   (with-music-match (expr (music 'ContextSpeccedMusic
 912                                  element (music 'PropertySet
 913                                                 value #t
 914                                                 symbol 'melismaBusy)))
 915     "\\melisma"))
 916
 917 (define-extra-display-method ContextSpeccedMusic (expr parser)
 918   "If expr is a melisma end, return \"\\melismaEnd\", otherwise, return #f."
 919   (with-music-match (expr (music 'ContextSpeccedMusic
 920                                  element (music 'PropertyUnset
 921                                                 symbol 'melismaBusy)))
 922     "\\melismaEnd"))
 923
 924 ;;; \tempo
 925 (define-extra-display-method SequentialMusic (expr parser)
 926   (with-music-match (expr (music 'SequentialMusic
 927                                  elements ((music 'TempoChangeEvent
 928                                                   text ?text
 929                                                   tempo-unit ?unit
 930                                                   metronome-count ?count)
 931                                            (music 'ContextSpeccedMusic
 932                                                   element (music 'PropertySet
 933                                                                  symbol 'tempoWholesPerMinute)))))
 934     (format #f "\\tempo ~{~a~a~}~a = ~a~a"
 935             (if (markup? ?text)
 936                 (list (markup->lily-string ?text) " ")
 937                 '())
 938             (duration->lily-string ?unit #:force-duration #t)
 939             (if (pair? ?count)
 940                 (format #f "~a ~~ ~a" (car ?count) (cdr ?count))
 941                 ?count)
 942             (new-line->lily-string))))
 943
 944 (define-display-method TempoChangeEvent (expr parser)
 945   (let ((text (ly:music-property expr 'text)))
 946     (format #f "\\tempo ~a~a"
 947             (markup->lily-string text)
 948             (new-line->lily-string))))
 949
 950 ;;; \clef
 951 (define clef-name-alist #f)
 952 (define-public (memoize-clef-names clefs)
 953   "Initialize @code{clef-name-alist}, if not already set."
 954   (if (not clef-name-alist)
 955       (set! clef-name-alist
 956             (map (lambda (name+vals)
 957                    (cons (cdr name+vals)
 958                          (car name+vals)))
 959                  clefs))))
 960
 961 (define-extra-display-method ContextSpeccedMusic (expr parser)
 962   "If @var{expr} is a clef change, return \"\\clef ...\".
 963 Otherwise, return @code{#f}."
 964   (with-music-match (expr (music 'ContextSpeccedMusic
 965                                  context-type 'Staff
 966                                  element (music 'SequentialMusic
 967                                                 elements ((music 'PropertySet
 968                                                                  value ?clef-glyph
 969                                                                  symbol 'clefGlyph)
 970                                                           (music 'PropertySet
 971                                                                  symbol 'middleCClefPosition)
 972                                                           (music 'PropertySet
 973                                                                  value ?clef-position
 974                                                                  symbol 'clefPosition)
 975                                                           (music 'PropertySet
 976                                                                  value ?clef-octavation
 977                                                                  symbol 'clefOctavation)
 978                                                           (music 'ApplyContext
 979                                                                  procedure ly:set-middle-C!)))))
 980     (let ((clef-name (assoc-get (list ?clef-glyph ?clef-position 0)
 981                                 clef-name-alist)))
 982       (if clef-name
 983           (format #f "\\clef \"~a~{~a~a~}\"~a"
 984                   clef-name
 985                   (cond ((= 0 ?clef-octavation)
 986                          (list "" ""))
 987                         ((> ?clef-octavation 0)
 988                          (list "^" (1+ ?clef-octavation)))
 989                         (else
 990                          (list "_" (- 1 ?clef-octavation))))
 991                   (new-line->lily-string))
 992           #f))))
 993
 994 ;;; \bar
 995 (define-extra-display-method ContextSpeccedMusic (expr parser)
 996   "If `expr' is a bar, return \"\\bar ...\".
 997 Otherwise, return #f."
 998   (with-music-match (expr (music 'ContextSpeccedMusic
 999                                  context-type 'Timing
1000                                  element (music 'PropertySet
1001                                                 value ?bar-type
1002                                                 symbol 'whichBar)))
1003     (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string))))
1004
1005 ;;; \partial
1006 (define-extra-display-method ContextSpeccedMusic (expr parser)
1007   "If `expr' is a partial measure, return \"\\partial ...\".
1008 Otherwise, return #f."
1009   (with-music-match (expr (music
1010                            'ContextSpeccedMusic
1011                            element (music
1012                                     'ContextSpeccedMusic
1013                                     context-type 'Timing
1014                                     element (music
1015                                              'PartialSet
1016                                              partial-duration ?duration))))
1017
1018     (and ?duration
1019          (format #f "\\partial ~a"
1020                  (duration->lily-string ?duration #:force-duration #t)))))
1021
1022 ;;;
1023 ;;;
1024
1025 (define-display-method ApplyOutputEvent (applyoutput parser)
1026   (let ((proc (ly:music-property applyoutput 'procedure))
1027         (ctx  (ly:music-property applyoutput 'context-type)))
1028     (format #f "\\applyOutput #'~a #~a"
1029             ctx
1030             (or (procedure-name proc)
1031                 (with-output-to-string
1032                   (lambda ()
1033                     (pretty-print (procedure-source proc))))))))
1034
1035 (define-display-method ApplyContext (applycontext parser)
1036   (let ((proc (ly:music-property applycontext 'procedure)))
1037     (format #f "\\applyContext #~a"
1038             (or (procedure-name proc)
1039                 (with-output-to-string
1040                   (lambda ()
1041                     (pretty-print (procedure-source proc))))))))
1042
1043 ;;; \partcombine
1044 (define-display-method PartCombineMusic (expr parser)
1045   (format #f "\\partcombine ~{~a ~}"
1046           (map-in-order (lambda (music)
1047                           (music->lily-string music parser))
1048                         (ly:music-property expr 'elements))))
1049
1050 (define-extra-display-method PartCombineMusic (expr parser)
1051   (with-music-match (expr (music 'PartCombineMusic
1052                                  elements ((music 'UnrelativableMusic
1053                                                   element (music 'ContextSpeccedMusic
1054                                                                  context-id "one"
1055                                                                  context-type 'Voice
1056                                                                  element ?sequence1))
1057                                            (music 'UnrelativableMusic
1058                                                   element (music 'ContextSpeccedMusic
1059                                                                  context-id "two"
1060                                                                  context-type 'Voice
1061                                                                  element ?sequence2)))))
1062     (format #f "\\partcombine ~a~a~a"
1063             (music->lily-string ?sequence1 parser)
1064             (new-line->lily-string)
1065             (music->lily-string ?sequence2 parser))))
1066
1067 (define-display-method UnrelativableMusic (expr parser)
1068   (music->lily-string (ly:music-property expr 'element) parser))
1069
1070 ;;; Cue notes
1071 (define-display-method QuoteMusic (expr parser)
1072   (or (with-music-match (expr (music
1073                                'QuoteMusic
1074                                quoted-voice-direction ?quoted-voice-direction
1075                                quoted-music-name ?quoted-music-name
1076                                quoted-context-id "cue"
1077                                quoted-context-type 'Voice
1078                                element ?music))
1079         (format #f "\\cueDuring #~s #~a ~a"
1080                 ?quoted-music-name
1081                 ?quoted-voice-direction
1082                 (music->lily-string ?music parser)))
1083       (format #f "\\quoteDuring #~s ~a"
1084               (ly:music-property expr 'quoted-music-name)
1085               (music->lily-string (ly:music-property expr 'element) parser))))
1086
1087 ;;;
1088 ;;; Breaks
1089 ;;;
1090 (define-display-method LineBreakEvent (expr parser)
1091   (if (null? (ly:music-property expr 'break-permission))
1092       "\\noBreak"
1093       "\\break"))
1094
1095 (define-display-method PageBreakEvent (expr parser)
1096   (if (null? (ly:music-property expr 'break-permission))
1097       "\\noPageBreak"
1098       "\\pageBreak"))
1099
1100 (define-display-method PageTurnEvent (expr parser)
1101   (if (null? (ly:music-property expr 'break-permission))
1102       "\\noPageTurn"
1103       "\\pageTurn"))
1104
1105 (define-extra-display-method EventChord (expr parser)
1106   (with-music-match (expr (music 'EventChord
1107                             elements ((music 'LineBreakEvent
1108                                              break-permission 'force)
1109                                       (music 'PageBreakEvent
1110                                              break-permission 'force))))
1111     "\\pageBreak"))
1112
1113 (define-extra-display-method EventChord (expr parser)
1114   (with-music-match (expr (music 'EventChord
1115                             elements ((music 'LineBreakEvent
1116                                              break-permission 'force)
1117                                       (music 'PageBreakEvent
1118                                              break-permission 'force)
1119                                       (music 'PageTurnEvent
1120                                              break-permission 'force))))
1121     "\\pageTurn"))
1122
1123 ;;;
1124 ;;; Lyrics
1125 ;;;
1126
1127 ;;; \lyricsto
1128 (define-display-method LyricCombineMusic (expr parser)
1129   (format #f "\\lyricsto ~s ~a"
1130           (ly:music-property expr 'associated-context)
1131           (parameterize ((*explicit-mode* #f))
1132             (music->lily-string (ly:music-property expr 'element) parser))))
1133
1134 ;; \addlyrics
1135 (define-extra-display-method SimultaneousMusic (expr parser)
1136   (with-music-match (expr (music 'SimultaneousMusic
1137                                  elements ((music 'ContextSpeccedMusic
1138                                                   context-id ?id
1139                                                   context-type 'Voice
1140                                                   element ?note-sequence)
1141                                            (music 'ContextSpeccedMusic
1142                                                   context-type 'Lyrics
1143                                                   create-new #t
1144                                                   element (music 'LyricCombineMusic
1145                                                                  associated-context ?associated-id
1146                                                                  element ?lyric-sequence)))))
1147     (if (string=? ?id ?associated-id)
1148         (format #f "~a~a \\addlyrics ~a"
1149                 (music->lily-string ?note-sequence parser)
1150                 (new-line->lily-string)
1151                 (parameterize ((*explicit-mode* #f))
1152                   (music->lily-string ?lyric-sequence parser)))
1153         #f)))
1154
1155 ;; Silence internal event sent at end of each lyrics block
1156 (define-display-method CompletizeExtenderEvent (expr parser)
1157   "")