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