scm/translation-functions.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; (c) 1998--2012 Han-Wen Nienhuys <hanwen@xs4all.nl>
   4 ;;;;                 Jan Nieuwenhuizen <janneke@gnu.org>
   5 ;;;;
   6 ;;;; LilyPond is free software: you can redistribute it and/or modify
   7 ;;;; it under the terms of the GNU General Public License as published by
   8 ;;;; the Free Software Foundation, either version 3 of the License, or
   9 ;;;; (at your option) any later version.
  10 ;;;;
  11 ;;;; LilyPond is distributed in the hope that it will be useful,
  12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;;; GNU General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU General Public License
  17 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  18
  19
  20 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21 ;; metronome marks
  22
  23 (define-public (format-metronome-markup event context)
  24   (let ((hide-note (ly:context-property context 'tempoHideNote #f))
  25         (text (ly:event-property event 'text))
  26         (dur (ly:event-property event 'tempo-unit))
  27         (count (ly:event-property event 'metronome-count)))
  28
  29     (metronome-markup text dur count hide-note)))
  30
  31 (define-public (metronome-markup text dur count hide-note)
  32   (let* ((note-mark (if (and (not hide-note) (ly:duration? dur))
  33                         (make-smaller-markup
  34                          (make-note-by-number-markup (ly:duration-log dur)
  35                                                      (ly:duration-dot-count dur)
  36                                                      1))
  37                         #f))
  38          (count-markup (cond ((number? count)
  39                               (if (> count 0)
  40                                   (make-simple-markup (number->string count))
  41                                   #f))
  42                              ((pair? count)
  43                               (make-concat-markup
  44                                (list
  45                                 (make-simple-markup (number->string (car count)))
  46                                 (make-simple-markup " ")
  47                                 (make-simple-markup "–")
  48                                 (make-simple-markup " ")
  49                                 (make-simple-markup (number->string (cdr count))))))
  50                              (else #f)))
  51          (note-markup (if (and (not hide-note) count-markup)
  52                           (make-concat-markup
  53                            (list
  54                             (make-general-align-markup Y DOWN note-mark)
  55                             (make-simple-markup " ")
  56                             (make-simple-markup "=")
  57                             (make-simple-markup " ")
  58                             count-markup))
  59                           #f))
  60          (text-markup (if (not (null? text))
  61                           (make-bold-markup text)
  62                           #f)))
  63     (if text-markup
  64         (if (and note-markup (not hide-note))
  65             (make-line-markup (list text-markup
  66                                     (make-concat-markup
  67                                      (list (make-simple-markup "(")
  68                                            note-markup
  69                                            (make-simple-markup ")")))))
  70             (make-line-markup (list text-markup)))
  71         (if note-markup
  72             (make-line-markup (list note-markup))
  73             (make-null-markup)))))
  74
  75 (define-public (format-mark-alphabet mark context)
  76   (make-bold-markup (make-markalphabet-markup (1- mark))))
  77
  78 (define-public (format-mark-box-alphabet mark context)
  79   (make-bold-markup (make-box-markup (make-markalphabet-markup (1- mark)))))
  80
  81 (define-public (format-mark-circle-alphabet mark context)
  82   (make-bold-markup (make-circle-markup (make-markalphabet-markup (1- mark)))))
  83
  84 (define-public (format-mark-letters mark context)
  85   (make-bold-markup (make-markletter-markup (1- mark))))
  86
  87 (define-public (format-mark-numbers mark context)
  88   (make-bold-markup (number->string mark)))
  89
  90 (define-public (format-mark-barnumbers mark context)
  91   (make-bold-markup (number->string (ly:context-property context
  92                                                          'currentBarNumber))))
  93
  94 (define-public (format-mark-box-letters mark context)
  95   (make-bold-markup (make-box-markup (make-markletter-markup (1- mark)))))
  96
  97 (define-public (format-mark-circle-letters mark context)
  98   (make-bold-markup (make-circle-markup (make-markletter-markup (1- mark)))))
  99
 100 (define-public (format-mark-box-numbers mark context)
 101   (make-bold-markup (make-box-markup (number->string mark))))
 102
 103 (define-public (format-mark-circle-numbers mark context)
 104   (make-bold-markup (make-circle-markup (number->string mark))))
 105
 106 (define-public (format-mark-box-barnumbers mark context)
 107   (make-bold-markup (make-box-markup
 108                      (number->string (ly:context-property context
 109                                                           'currentBarNumber)))))
 110
 111 (define-public (format-mark-circle-barnumbers mark context)
 112   (make-bold-markup (make-circle-markup
 113                      (number->string (ly:context-property context
 114                                                           'currentBarNumber)))))
 115
 116
 117 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 118 ;; Bass figures.
 119
 120 (define-public (format-bass-figure figure event context)
 121   (let* ((fig (ly:event-property event 'figure))
 122          (fig-markup (if (number? figure)
 123
 124                          ;; this is not very elegant, but center-aligning
 125                          ;; all digits is problematic with other markups,
 126                          ;; and shows problems in the (lack of) overshoot
 127                          ;; of feta-alphabet glyphs.
 128                          ((if (<= 10 figure)
 129                               (lambda (y) (make-translate-scaled-markup
 130                                            (cons -0.7 0) y))
 131                               identity)
 132
 133                           (cond
 134                            ((eq? #t (ly:event-property event 'diminished))
 135                             (markup #:slashed-digit figure))
 136                            ((eq? #t (ly:event-property event 'augmented-slash))
 137                             (markup #:backslashed-digit figure))
 138                            (else (markup #:number (number->string figure 10)))))
 139                          #f))
 140
 141          (alt (ly:event-property event 'alteration))
 142          (alt-markup
 143           (if (number? alt)
 144               (markup
 145                #:general-align Y DOWN #:fontsize
 146                (if (not (= alt DOUBLE-SHARP))
 147                    -2 2)
 148                (alteration->text-accidental-markup alt))
 149               #f))
 150
 151          (plus-markup (if (eq? #t (ly:event-property event 'augmented))
 152                           (markup #:number "+")
 153                           #f))
 154
 155          (alt-dir (ly:context-property context 'figuredBassAlterationDirection))
 156          (plus-dir (ly:context-property context 'figuredBassPlusDirection)))
 157
 158     (if (and (not fig-markup) alt-markup)
 159         (begin
 160           (set! fig-markup (markup #:left-align #:pad-around 0.3 alt-markup))
 161           (set! alt-markup #f)))
 162
 163
 164     ;; hmm, how to get figures centered between note, and
 165     ;; lone accidentals too?
 166
 167     ;;    (if (markup? fig-markup)
 168     ;;  (set!
 169     ;;   fig-markup (markup #:translate (cons 1.0 0)
 170     ;;                      #:center-align fig-markup)))
 171
 172     (if alt-markup
 173         (set! fig-markup
 174               (markup #:put-adjacent
 175                       X (if (number? alt-dir)
 176                             alt-dir
 177                             LEFT)
 178                       fig-markup
 179                       #:pad-x 0.2 alt-markup)))
 180
 181     (if plus-markup
 182         (set! fig-markup
 183               (if fig-markup
 184                   (markup #:put-adjacent
 185                           X (if (number? plus-dir)
 186                                 plus-dir
 187                                 LEFT)
 188                           fig-markup
 189                           #:pad-x 0.2 plus-markup)
 190                   plus-markup)))
 191
 192     (if (markup? fig-markup)
 193         (markup #:fontsize -2 fig-markup)
 194         empty-markup)))
 195
 196
 197 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 198 ;; fret diagrams
 199
 200 (define (create-fretboard context grob placement-list)
 201   "Convert @var{placement-list} into a fretboard @var{grob}."
 202
 203   (let* ((tunings (ly:context-property context 'stringTunings))
 204          (my-string-count (length tunings))
 205          (details (ly:grob-property grob 'fret-diagram-details)))
 206
 207     ;; Add string-count from string-tunings to fret-diagram-details.
 208     (set! (ly:grob-property grob 'fret-diagram-details)
 209             (acons 'string-count my-string-count details))
 210     ;; Create the dot-placement list for the grob
 211     (set! (ly:grob-property grob 'dot-placement-list) placement-list)))
 212
 213 (define-public
 214   (determine-frets context notes specified-info . rest)
 215   "Determine string numbers and frets for playing @var{notes}
 216 as a chord, given specified information @var{specified-info}.
 217 @var{specified-info} is a list with two list elements,
 218 specified strings @code{defined-strings} and
 219 specified fingerings @code{defined-fingers}.  Only a fingering of@tie{}0
 220 will affect the fret selection, as it specifies an open string.
 221 If @code{defined-strings} is @code{'()}, the context property
 222 @code{defaultStrings} will be used as a list of defined strings.
 223 Will look for predefined fretboards if @code{predefinedFretboardTable}
 224 is not @code {#f}.  If @var{rest} is present, it contains the
 225 @code{FretBoard} grob, and a fretboard will be
 226 created.  Otherwise, a list of @code{(string fret finger)} lists will
 227 be returned."
 228
 229   ;;  helper functions
 230
 231   (define (string-frets->placement-list string-frets string-count)
 232     "Convert @var{string-frets} to @code{fret-diagram-verbose}
 233 dot placement entries."
 234     (let* ((placements (list->vector
 235                         (map (lambda (x) (list 'mute  x))
 236                              (iota string-count 1)))))
 237
 238       (for-each (lambda (sf)
 239                   (let* ((string (car sf))
 240                          (fret (cadr sf))
 241                          (finger (caddr sf)))
 242                     (vector-set!
 243                       placements
 244                       (1- string)
 245                       (if (= 0 fret)
 246                           (list 'open string)
 247                           (if finger
 248                               (list 'place-fret string fret finger)
 249                               (list 'place-fret string fret))))))
 250                 string-frets)
 251       (vector->list placements)))
 252
 253   (define (placement-list->string-frets placement-list)
 254     "Convert @var{placement-list} to string-fret list."
 255     (map (lambda (x) (if (eq? (car x) 'place-fret)
 256                          (cdr x)
 257                          (list (cadr x) 0)))
 258          (filter (lambda (l) (or (eq? (car l) 'place-fret)
 259                                  (eq? (car l) 'open)))
 260                  placement-list)))
 261
 262   (define (entry-count art-list)
 263     "Count the number of entries in a list of articulations."
 264     (length (filter (lambda (x) (not (null? x)))
 265                     art-list)))
 266
 267   (define (determine-frets-and-strings
 268             notes
 269             defined-strings
 270             defined-fingers
 271             minimum-fret
 272             maximum-stretch
 273             tuning)
 274     "Determine the frets and strings used to play the notes in
 275 @var{notes}, given @var{defined-strings} and @var{defined-fingers}
 276 along with @var{minimum-fret}, @var{maximum-stretch}, and
 277 @var{tuning}.  Returns a list of @code{(string fret finger) lists."
 278
 279
 280     (define restrain-open-strings (ly:context-property context
 281                                                        'restrainOpenStrings
 282                                                        #f))
 283     (define specified-frets '())
 284     (define free-strings (iota (length tuning) 1))
 285
 286     (define (calc-fret pitch string tuning)
 287       "Calculate the fret to play @var{pitch} on @var{string} with
 288 @var{tuning}."
 289       (- (ly:pitch-semitones pitch) (ly:pitch-semitones (list-ref tuning (1- string)))))
 290
 291     (define (note-pitch note)
 292       "Get the pitch (in semitones) from @var{note}."
 293       (ly:event-property note 'pitch))
 294
 295     (define (note-finger ev)
 296       "Get the fingering from @var{ev}.  Return @var{#f}
 297 if no fingering is present."
 298       (let* ((articulations (ly:event-property ev 'articulations))
 299              (finger-found #f))
 300         (map (lambda (art)
 301                (let* ((num (ly:event-property art 'digit)))
 302
 303                  (if (and (eq? 'fingering-event (ly:event-property art 'class))
 304                           (number? num)
 305                           (> num 0))
 306                    (set! finger-found num))))
 307              articulations)
 308         finger-found))
 309
 310     (define (string-number event)
 311       "Get the string-number from @var{event}.  Return @var{#f}
 312 if no string-number is present."
 313       (let ((num (ly:event-property event 'string-number)))
 314         (if (number? num)
 315           num
 316           #f)))
 317
 318     (define (delete-free-string string)
 319       (if (number? string)
 320         (set! free-strings
 321           (delete string free-strings))))
 322
 323     (define (close-enough fret)
 324       "Decide if @var{fret} is acceptable, given the already used frets."
 325       (if (null? specified-frets)
 326         #t
 327         (reduce
 328           (lambda (x y)
 329             (and x y))
 330           #t
 331           (map (lambda (specced-fret)
 332                  (or (eq? 0 specced-fret)
 333                      (and (not restrain-open-strings)
 334                      (eq? 0 fret))
 335                      (>= maximum-stretch (abs (- fret specced-fret)))))
 336                specified-frets))))
 337
 338     (define (string-qualifies string pitch)
 339       "Can @var{pitch} be played on @var{string}, given already placed
 340 notes?"
 341       (let* ((fret (calc-fret pitch string tuning)))
 342         (and (or (and (not restrain-open-strings)
 343                       (eq? fret 0))
 344                  (>= fret minimum-fret))
 345              (close-enough fret))))
 346
 347     (define (open-string string pitch)
 348       "Is @var{pitch} and open-string note on @var{string}, given
 349 the current tuning?"
 350       (let* ((fret (calc-fret pitch string tuning)))
 351         (eq? fret 0)))
 352
 353     (define (set-fret! pitch-entry string finger)
 354       (let ((this-fret (calc-fret (car pitch-entry)
 355                                   string
 356                                   tuning)))
 357         (if (< this-fret 0)
 358           (ly:warning (_ "Negative fret for pitch ~a on string ~a")
 359                       (car pitch-entry) string))
 360         (delete-free-string string)
 361         (set! specified-frets (cons this-fret specified-frets))
 362         (list-set! string-fret-fingers
 363                    (cdr pitch-entry)
 364                    (list string this-fret finger))))
 365
 366     (define (kill-note! string-fret-fingers note-index)
 367       (list-set! string-fret-fingers note-index (list #f #t)))
 368
 369     (define string-fret-fingers
 370              (map (lambda (string finger)
 371                     (if (null? finger)
 372                         (list string #f)
 373                         (list string #f finger)))
 374                   defined-strings defined-fingers))
 375
 376     ;;; body of determine-frets-and-strings
 377     (let* ((pitch-alist (apply (lambda (mylist)
 378                                  (let ((index -1))
 379                                    (map (lambda (note)
 380                                           (begin
 381                                             (set! index (1+ index))
 382                                             (cons (note-pitch note)
 383                                                   index)))
 384                                         mylist)))
 385                                notes '()))
 386            (pitches (map note-pitch notes)))
 387
 388       ;; handle notes with strings assigned and fingering of 0
 389       (for-each
 390         (lambda (pitch-entry string-fret-finger)
 391           (let* ((string (list-ref string-fret-finger 0))
 392                  (finger (if (eq? (length string-fret-finger) 3)
 393                              (list-ref string-fret-finger 2)
 394                              '()))
 395                  (pitch (car pitch-entry))
 396                  (digit (if (null? finger)
 397                             #f
 398                             finger)))
 399             (if (or (not (null? string))
 400                     (eq? digit 0))
 401                 (if (eq? digit 0)
 402                     ;; here we handle fingers of 0 -- open strings
 403                     (let ((fit-string
 404                             (find (lambda (string)
 405                                     (open-string string pitch))
 406                                   free-strings)))
 407                       (if fit-string
 408                           (set-fret! pitch-entry fit-string #f)
 409                           (ly:warning (_ "No open string for pitch ~a")
 410                                       pitch)))
 411                     ;; here we handle assigned strings
 412                     (let ((this-fret
 413                             (calc-fret pitch string tuning))
 414                           (handle-negative
 415                             (ly:context-property context
 416                                                  'handleNegativeFrets
 417                                                  'recalculate)))
 418                       (cond ((or (>= this-fret 0)
 419                                  (eq? handle-negative 'include))
 420                              (set-fret! pitch-entry string finger))
 421                             ((eq? handle-negative 'recalculate)
 422                              (begin
 423                                (ly:warning
 424                                  (_ "Requested string for pitch requires negative fret: string ~a pitch ~a")
 425                                  string
 426                                  pitch)
 427                                (ly:warning (_ "Ignoring string request and recalculating."))
 428                                (list-set! string-fret-fingers
 429                                           (cdr pitch-entry)
 430                                           (if (null? finger)
 431                                               (list '() #f)
 432                                               (list '() #f finger)))))
 433                             ((eq? handle-negative 'ignore)
 434                              (begin
 435                                (ly:warning
 436                                  (_ "Requested string for pitch requires negative fret: string ~a pitch ~a")
 437                                  string
 438                                  pitch)
 439                                (ly:warning (_ "Ignoring note in tablature."))
 440                                (kill-note! string-fret-fingers
 441                                            (cdr pitch-entry))))))))))
 442         pitch-alist string-fret-fingers)
 443     ;; handle notes without strings assigned -- sorted by pitch, so
 444     ;; we need to use the alist to have the note number available
 445     (for-each
 446       (lambda (pitch-entry)
 447         (let* ((string-fret-finger (list-ref string-fret-fingers
 448                                              (cdr pitch-entry)))
 449                (string (list-ref string-fret-finger 0))
 450                (finger (if (eq? (length string-fret-finger) 3)
 451                            (list-ref string-fret-finger 2)
 452                            '()))
 453                (pitch (car pitch-entry))
 454                (fit-string
 455                  (find (lambda (string)
 456                          (string-qualifies string pitch))
 457                        free-strings)))
 458           (if (not (list-ref string-fret-finger 1))
 459               (if fit-string
 460                   (set-fret! pitch-entry fit-string finger)
 461                   (begin
 462                     (ly:warning (_ "No string for pitch ~a (given frets ~a)")
 463                                 pitch
 464                                 specified-frets)
 465                     (kill-note! string-fret-fingers
 466                                 (cdr pitch-entry)))))))
 467       (sort pitch-alist (lambda (pitch-entry-a pitch-entry-b)
 468                           (ly:pitch<? (car pitch-entry-b)
 469                                       (car pitch-entry-a)))))
 470     string-fret-fingers)) ;; end of determine-frets-and-strings
 471
 472   (define (get-predefined-fretboard predefined-fret-table tuning pitches)
 473     "Search through @var{predefined-fret-table} looking for a predefined
 474 fretboard with a key of @var{(tuning . pitches)}.  The search will check
 475 both up and down an octave in order to accomodate transposition of the
 476 chords.  Returns a placement-list."
 477
 478     (define (get-fretboard key)
 479       (let ((hash-handle
 480              (hash-get-handle predefined-fret-table key)))
 481         (if hash-handle
 482             (cdr hash-handle)  ; return table entry
 483             '())))
 484
 485     ;; body of get-predefined-fretboard
 486     (let ((test-fretboard (get-fretboard (cons tuning pitches))))
 487       (if (not (null? test-fretboard))
 488           test-fretboard
 489           (let ((test-fretboard
 490                  (get-fretboard
 491                   (cons tuning (map (lambda (x) (shift-octave x 1)) pitches)))))
 492             (if (not (null? test-fretboard))
 493                 test-fretboard
 494                 (get-fretboard
 495                  (cons tuning (map (lambda (x) (shift-octave x -1))
 496                                    pitches))))))))
 497
 498   ;; body of determine-frets
 499   (let* ((predefined-fret-table
 500           (ly:context-property context 'predefinedDiagramTable))
 501          (tunings (ly:context-property context 'stringTunings))
 502          (string-count (length tunings))
 503          (grob (if (null? rest) '() (car rest)))
 504          (pitches (map (lambda (x) (ly:event-property x 'pitch)) notes))
 505          (defined-strings (map (lambda (x)
 506                                  (if (null? x)
 507                                      x
 508                                      (ly:event-property x 'string-number)))
 509                                (car specified-info)))
 510          (defined-fingers (map (lambda (x)
 511                                  (if (null? x)
 512                                      x
 513                                      (ly:event-property x 'digit)))
 514                                (cadr specified-info)))
 515          (default-strings (ly:context-property context 'defaultStrings '()))
 516          (strings-used (if (and (zero? (entry-count defined-strings))
 517                                 (not (zero? (entry-count default-strings))))
 518                            default-strings
 519                            defined-strings))
 520          (predefined-fretboard
 521           (if predefined-fret-table
 522               (get-predefined-fretboard
 523                predefined-fret-table
 524                tunings
 525                pitches)
 526               '())))
 527      (if (null? predefined-fretboard)
 528          (let ((string-frets
 529                 (determine-frets-and-strings
 530                  notes
 531                  strings-used
 532                  defined-fingers
 533                  (ly:context-property context 'minimumFret 0)
 534                  (ly:context-property context 'maximumFretStretch 4)
 535                  tunings)))
 536             (if (null? grob)
 537                 string-frets
 538                 (create-fretboard
 539                  context grob (string-frets->placement-list
 540                                 (filter (lambda (entry)
 541                                           (car entry))
 542                                         string-frets)
 543                                 string-count))))
 544          (if (null? grob)
 545              (placement-list->string-frets predefined-fretboard)
 546              (create-fretboard context grob predefined-fretboard)))))
 547
 548
 549
 550 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 551 ;; tablature
 552
 553 ;; The TabNoteHead tablatureFormat callbacks.
 554
 555 ;; Calculate the fret from pitch and string number as letter
 556 ;; The fret letter is taken from 'fretLabels if present
 557 (define-public (fret-letter-tablature-format
 558                 context string-number fret-number)
 559  (let ((labels (ly:context-property context 'fretLabels)))
 560   (make-vcenter-markup
 561    (cond
 562     ((= 0 (length labels))
 563      (string (integer->char (+ fret-number (char->integer #\a)))))
 564     ((and (<= 0 fret-number) (< fret-number (length labels)))
 565      (list-ref labels fret-number))
 566     (else
 567      (ly:warning (_ "No label for fret ~a (on string ~a);
 568 only ~a fret labels provided")
 569                 fret-number string-number (length labels))
 570      ".")))))
 571
 572 ;; Display the fret number as a number
 573 (define-public (fret-number-tablature-format
 574                 context string-number fret-number)
 575   (make-vcenter-markup
 576     (format #f "~a" fret-number)))
 577
 578 ;; The 5-string banjo has got a extra string, the fifth (duh), which
 579 ;; starts at the fifth fret on the neck.  Frets on the fifth string
 580 ;; are referred to relative to the other frets:
 581 ;;   the "first fret" on the fifth string is really the sixth fret
 582 ;;   on the banjo neck.
 583 ;; We solve this by defining a new fret-number-tablature function:
 584 (define-public (fret-number-tablature-format-banjo
 585                 context string-number fret-number)
 586  (make-vcenter-markup
 587   (number->string (cond
 588                    ((and (> fret-number 0) (= string-number 5))
 589                     (+ fret-number 5))
 590                    (else fret-number)))))
 591
 592 ;;  Tab note head staff position functions
 593 ;;
 594 ;;  Define where in the staff to display a given string.  Some forms of
 595 ;;  tablature put the tab note heads in the spaces, rather than on the
 596 ;;  lines
 597
 598 (define-public (tablature-position-on-lines context string-number)
 599  (let* ((string-tunings (ly:context-property context 'stringTunings))
 600         (string-count (length string-tunings))
 601         (string-one-topmost (ly:context-property context 'stringOneTopmost))
 602         (staff-line (- (* 2 string-number) string-count 1)))
 603   (if string-one-topmost
 604       (- staff-line)
 605       staff-line)))
 606
 607 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 608 ;; bar numbers
 609
 610 (define-public ((every-nth-bar-number-visible n) barnum mp)
 611   (= 0 (modulo barnum n)))
 612
 613 (define-public ((modulo-bar-number-visible n m) barnum mp)
 614   (and (> barnum 1) (= m (modulo barnum n))))
 615
 616 (define-public ((set-bar-number-visibility n) tr)
 617   (let ((bn (ly:context-property tr 'currentBarNumber)))
 618     (ly:context-set-property! tr 'barNumberVisibility
 619                               (modulo-bar-number-visible n (modulo bn n)))))
 620
 621 (define-public (first-bar-number-invisible barnum mp)
 622   (> barnum 1))
 623
 624 (define-public (first-bar-number-invisible-save-broken-bars barnum mp)
 625   (or (> barnum 1)
 626       (> (ly:moment-main-numerator mp) 0)))
 627
 628 (define-public (first-bar-number-invisible-and-no-parenthesized-bar-numbers barnum mp)
 629   (and (> barnum 1)
 630        (= (ly:moment-main-numerator mp) 0)))
 631
 632 (define-public (robust-bar-number-function barnum measure-pos alt-number context)
 633   (define (get-number-and-power an pow)
 634     (if (<= an alt-number)
 635         (get-number-and-power (+ an (expt 26 (1+ pow))) (1+ pow))
 636         (cons (+ alt-number (- (expt 26 pow) an)) (1- pow))))
 637   (define (make-letter so-far an pow)
 638     (if (< pow 0)
 639       so-far
 640       (let ((pos (modulo (quotient an (expt 26 pow)) 26)))
 641         (make-letter (string-append so-far
 642                                     (substring "abcdefghijklmnopqrstuvwxyz"
 643                                                pos
 644                                                (1+ pos)))
 645                    an
 646                    (1- pow)))))
 647   (let* ((number-and-power (get-number-and-power 0 0))
 648          (begin-measure (= 0 (ly:moment-main-numerator measure-pos)))
 649          (maybe-open-parenthesis (if begin-measure "" "("))
 650          (maybe-close-parenthesis (if begin-measure "" ")")))
 651     (markup (string-append maybe-open-parenthesis
 652                            (number->string barnum)
 653                            (make-letter ""
 654                                         (car number-and-power)
 655                                         (cdr number-and-power))
 656                            maybe-close-parenthesis))))
 657
 658 (define-public (all-bar-numbers-visible barnum mp) #t)
 659
 660
 661 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 662 ;; percent repeat counters
 663
 664 (define-public ((every-nth-repeat-count-visible n) count context)
 665   (= 0 (modulo count n)))
 666
 667 (define-public (all-repeat-counts-visible count context) #t)
 668
 669 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 670 ;; make-engraver helper macro
 671
 672 (defmacro-public make-engraver forms
 673   "Helper macro for creating Scheme engravers.
 674
 675 The usual form for an engraver is an association list (or alist)
 676 mapping symbols to either anonymous functions or to another such
 677 alist.
 678
 679 @code{make-engraver} accepts forms where the first element is either
 680 an argument list starting with the respective symbol, followed by the
 681 function body (comparable to the way @code{define} is used for
 682 defining functions), or a single symbol followed by subordinate forms
 683 in the same manner.  You can also just make an alist pair
 684 literally (the @samp{car} is quoted automatically) as long as the
 685 unevaluated @samp{cdr} is not a pair.  This is useful if you already
 686 have defined your engraver functions separately.
 687
 688 Symbols mapping to a function would be @code{initialize},
 689 @code{start-translation-timestep}, @code{process-music},
 690 @code{process-acknowledged}, @code{stop-translation-timestep}, and
 691 @code{finalize}.  Symbols mapping to another alist specified in the
 692 same manner are @code{listeners} with the subordinate symbols being
 693 event classes, and @code{acknowledgers} and @code{end-acknowledgers}
 694 with the subordinate symbols being interfaces."
 695   (let loop ((forms forms))
 696     (if (cheap-list? forms)
 697         `(list
 698           ,@(map (lambda (form)
 699                    (if (pair? (car form))
 700                        `(cons ',(caar form) (lambda ,(cdar form) ,@(cdr form)))
 701                        `(cons ',(car form) ,(loop (cdr form)))))
 702                  forms))
 703         forms)))