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     (define specified-frets '())
 280     (define free-strings (iota (length tuning) 1))
 281
 282     (define (calc-fret pitch string tuning)
 283       "Calculate the fret to play @var{pitch} on @var{string} with
 284 @var{tuning}."
 285       (- (ly:pitch-semitones pitch) (ly:pitch-semitones (list-ref tuning (1- string)))))
 286
 287     (define (note-pitch note)
 288       "Get the pitch (in semitones) from @var{note}."
 289       (ly:event-property note 'pitch))
 290
 291     (define (note-finger ev)
 292       "Get the fingering from @var{ev}.  Return @var{#f}
 293 if no fingering is present."
 294       (let* ((articulations (ly:event-property ev 'articulations))
 295              (finger-found #f))
 296         (map (lambda (art)
 297                (let* ((num (ly:event-property art 'digit)))
 298
 299                  (if (and (eq? 'fingering-event (ly:event-property art 'class))
 300                           (number? num)
 301                           (> num 0))
 302                    (set! finger-found num))))
 303              articulations)
 304         finger-found))
 305
 306     (define (string-number event)
 307       "Get the string-number from @var{event}.  Return @var{#f}
 308 if no string-number is present."
 309       (let ((num (ly:event-property event 'string-number)))
 310         (if (number? num)
 311           num
 312           #f)))
 313
 314     (define (delete-free-string string)
 315       (if (number? string)
 316         (set! free-strings
 317           (delete string free-strings))))
 318
 319     (define (close-enough fret)
 320       "Decide if @var{fret} is acceptable, given the already used frets."
 321       (if (null? specified-frets)
 322         #t
 323         (reduce
 324           (lambda (x y)
 325             (and x y))
 326           #t
 327           (map (lambda (specced-fret)
 328                  (or (eq? 0 specced-fret)
 329                      (eq? 0 fret)
 330                      (>= maximum-stretch (abs (- fret specced-fret)))))
 331                specified-frets))))
 332
 333     (define (string-qualifies string pitch)
 334       "Can @var{pitch} be played on @var{string}, given already placed
 335 notes?"
 336       (let* ((fret (calc-fret pitch string tuning)))
 337         (and (or (eq? fret 0) (>= fret minimum-fret))
 338              (close-enough fret))))
 339
 340     (define (open-string string pitch)
 341       "Is @var{pitch} and open-string note on @var{string}, given
 342 the current tuning?"
 343       (let* ((fret (calc-fret pitch string tuning)))
 344         (eq? fret 0)))
 345
 346     (define (set-fret! pitch-entry string finger)
 347       (let ((this-fret (calc-fret (car pitch-entry)
 348                                   string
 349                                   tuning)))
 350         (if (< this-fret 0)
 351           (ly:warning (_ "Negative fret for pitch ~a on string ~a")
 352                       (car pitch-entry) string))
 353         (delete-free-string string)
 354         (set! specified-frets (cons this-fret specified-frets))
 355         (list-set! string-fret-fingers
 356                    (cdr pitch-entry)
 357                    (list string this-fret finger))))
 358
 359     (define (kill-note! string-fret-fingers note-index)
 360       (list-set! string-fret-fingers note-index (list #f #t)))
 361
 362     (define string-fret-fingers
 363              (map (lambda (string finger)
 364                     (if (null? finger)
 365                         (list string #f)
 366                         (list string #f finger)))
 367                   defined-strings defined-fingers))
 368
 369     ;;; body of determine-frets-and-strings
 370     (let* ((pitch-alist (apply (lambda (mylist)
 371                                  (let ((index -1))
 372                                    (map (lambda (note)
 373                                           (begin
 374                                             (set! index (1+ index))
 375                                             (cons (note-pitch note)
 376                                                   index)))
 377                                         mylist)))
 378                                notes '()))
 379            (pitches (map note-pitch notes)))
 380
 381       ;; handle notes with strings assigned and fingering of 0
 382       (for-each
 383         (lambda (pitch-entry string-fret-finger)
 384           (let* ((string (list-ref string-fret-finger 0))
 385                  (finger (if (eq? (length string-fret-finger) 3)
 386                              (list-ref string-fret-finger 2)
 387                              '()))
 388                  (pitch (car pitch-entry))
 389                  (digit (if (null? finger)
 390                             #f
 391                             finger)))
 392             (if (or (not (null? string))
 393                     (eq? digit 0))
 394                 (if (eq? digit 0)
 395                     ;; here we handle fingers of 0 -- open strings
 396                     (let ((fit-string
 397                             (find (lambda (string)
 398                                     (open-string string pitch))
 399                                   free-strings)))
 400                       (if fit-string
 401                           (set-fret! pitch-entry fit-string #f)
 402                           (ly:warning (_ "No open string for pitch ~a")
 403                                       pitch)))
 404                     ;; here we handle assigned strings
 405                     (let ((this-fret
 406                             (calc-fret pitch string tuning))
 407                           (handle-negative
 408                             (ly:context-property context
 409                                                  'handleNegativeFrets
 410                                                  'recalculate)))
 411                       (cond ((or (>= this-fret 0)
 412                                  (eq? handle-negative 'include))
 413                              (set-fret! pitch-entry string finger))
 414                             ((eq? handle-negative 'recalculate)
 415                              (begin
 416                                (ly:warning
 417                                  (_ "Requested string for pitch requires negative fret: string ~a pitch ~a")
 418                                  string
 419                                  pitch)
 420                                (ly:warning (_ "Ignoring string request and recalculating."))
 421                                (list-set! string-fret-fingers
 422                                           (cdr pitch-entry)
 423                                           (if (null? finger)
 424                                               (list '() #f)
 425                                               (list '() #f finger)))))
 426                             ((eq? handle-negative 'ignore)
 427                              (begin
 428                                (ly:warning
 429                                  (_ "Requested string for pitch requires negative fret: string ~a pitch ~a")
 430                                  string
 431                                  pitch)
 432                                (ly:warning (_ "Ignoring note in tablature."))
 433                                (kill-note! string-fret-fingers
 434                                            (cdr pitch-entry))))))))))
 435         pitch-alist string-fret-fingers)
 436     ;; handle notes without strings assigned -- sorted by pitch, so
 437     ;; we need to use the alist to have the note number available
 438     (for-each
 439       (lambda (pitch-entry)
 440         (let* ((string-fret-finger (list-ref string-fret-fingers
 441                                              (cdr pitch-entry)))
 442                (string (list-ref string-fret-finger 0))
 443                (finger (if (eq? (length string-fret-finger) 3)
 444                            (list-ref string-fret-finger 2)
 445                            '()))
 446                (pitch (car pitch-entry))
 447                (fit-string
 448                  (find (lambda (string)
 449                          (string-qualifies string pitch))
 450                        free-strings)))
 451           (if (not (list-ref string-fret-finger 1))
 452               (if fit-string
 453                   (set-fret! pitch-entry fit-string finger)
 454                   (begin
 455                     (ly:warning (_ "No string for pitch ~a (given frets ~a)")
 456                                 pitch
 457                                 specified-frets)
 458                     (kill-note! string-fret-fingers
 459                                 (cdr pitch-entry)))))))
 460       (sort pitch-alist (lambda (pitch-entry-a pitch-entry-b)
 461                           (ly:pitch<? (car pitch-entry-b)
 462                                       (car pitch-entry-a)))))
 463     string-fret-fingers)) ;; end of determine-frets-and-strings
 464
 465   (define (get-predefined-fretboard predefined-fret-table tuning pitches)
 466     "Search through @var{predefined-fret-table} looking for a predefined
 467 fretboard with a key of @var{(tuning . pitches)}.  The search will check
 468 both up and down an octave in order to accomodate transposition of the
 469 chords.  Returns a placement-list."
 470
 471     (define (get-fretboard key)
 472       (let ((hash-handle
 473              (hash-get-handle predefined-fret-table key)))
 474         (if hash-handle
 475             (cdr hash-handle)  ; return table entry
 476             '())))
 477
 478     ;; body of get-predefined-fretboard
 479     (let ((test-fretboard (get-fretboard (cons tuning pitches))))
 480       (if (not (null? test-fretboard))
 481           test-fretboard
 482           (let ((test-fretboard
 483                  (get-fretboard
 484                   (cons tuning (map (lambda (x) (shift-octave x 1)) pitches)))))
 485             (if (not (null? test-fretboard))
 486                 test-fretboard
 487                 (get-fretboard
 488                  (cons tuning (map (lambda (x) (shift-octave x -1))
 489                                    pitches))))))))
 490
 491   ;; body of determine-frets
 492   (let* ((predefined-fret-table
 493           (ly:context-property context 'predefinedDiagramTable))
 494          (tunings (ly:context-property context 'stringTunings))
 495          (string-count (length tunings))
 496          (grob (if (null? rest) '() (car rest)))
 497          (pitches (map (lambda (x) (ly:event-property x 'pitch)) notes))
 498          (defined-strings (map (lambda (x)
 499                                  (if (null? x)
 500                                      x
 501                                      (ly:event-property x 'string-number)))
 502                                (car specified-info)))
 503          (defined-fingers (map (lambda (x)
 504                                  (if (null? x)
 505                                      x
 506                                      (ly:event-property x 'digit)))
 507                                (cadr specified-info)))
 508          (default-strings (ly:context-property context 'defaultStrings '()))
 509          (strings-used (if (and (zero? (entry-count defined-strings))
 510                                 (not (zero? (entry-count default-strings))))
 511                            default-strings
 512                            defined-strings))
 513          (predefined-fretboard
 514           (if predefined-fret-table
 515               (get-predefined-fretboard
 516                predefined-fret-table
 517                tunings
 518                pitches)
 519               '())))
 520      (if (null? predefined-fretboard)
 521          (let ((string-frets
 522                 (determine-frets-and-strings
 523                  notes
 524                  strings-used
 525                  defined-fingers
 526                  (ly:context-property context 'minimumFret 0)
 527                  (ly:context-property context 'maximumFretStretch 4)
 528                  tunings)))
 529             (if (null? grob)
 530                 string-frets
 531                 (create-fretboard
 532                  context grob (string-frets->placement-list
 533                                 (filter (lambda (entry)
 534                                           (car entry))
 535                                         string-frets)
 536                                 string-count))))
 537          (if (null? grob)
 538              (placement-list->string-frets predefined-fretboard)
 539              (create-fretboard context grob predefined-fretboard)))))
 540
 541
 542
 543 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 544 ;; tablature
 545
 546 ;; The TabNoteHead tablatureFormat callbacks.
 547
 548 ;; Calculate the fret from pitch and string number as letter
 549 ;; The fret letter is taken from 'fretLabels if present
 550 (define-public (fret-letter-tablature-format
 551                 context string-number fret-number)
 552  (let ((labels (ly:context-property context 'fretLabels)))
 553   (make-vcenter-markup
 554    (cond
 555     ((= 0 (length labels))
 556      (string (integer->char (+ fret-number (char->integer #\a)))))
 557     ((and (<= 0 fret-number) (< fret-number (length labels)))
 558      (list-ref labels fret-number))
 559     (else
 560      (ly:warning (_ "No label for fret ~a (on string ~a);
 561 only ~a fret labels provided")
 562                 fret-number string-number (length labels))
 563      ".")))))
 564
 565 ;; Display the fret number as a number
 566 (define-public (fret-number-tablature-format
 567                 context string-number fret-number)
 568   (make-vcenter-markup
 569     (format #f "~a" fret-number)))
 570
 571 ;; The 5-string banjo has got a extra string, the fifth (duh), which
 572 ;; starts at the fifth fret on the neck.  Frets on the fifth string
 573 ;; are referred to relative to the other frets:
 574 ;;   the "first fret" on the fifth string is really the sixth fret
 575 ;;   on the banjo neck.
 576 ;; We solve this by defining a new fret-number-tablature function:
 577 (define-public (fret-number-tablature-format-banjo
 578                 context string-number fret-number)
 579  (make-vcenter-markup
 580   (number->string (cond
 581                    ((and (> fret-number 0) (= string-number 5))
 582                     (+ fret-number 5))
 583                    (else fret-number)))))
 584
 585 ;;  Tab note head staff position functions
 586 ;;
 587 ;;  Define where in the staff to display a given string.  Some forms of
 588 ;;  tablature put the tab note heads in the spaces, rather than on the
 589 ;;  lines
 590
 591 (define-public (tablature-position-on-lines context string-number)
 592  (let* ((string-tunings (ly:context-property context 'stringTunings))
 593         (string-count (length string-tunings))
 594         (string-one-topmost (ly:context-property context 'stringOneTopmost))
 595         (staff-line (- (* 2 string-number) string-count 1)))
 596   (if string-one-topmost
 597       (- staff-line)
 598       staff-line)))
 599
 600 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 601 ;; bar numbers
 602
 603 (define-public ((every-nth-bar-number-visible n) barnum mp)
 604   (= 0 (modulo barnum n)))
 605
 606 (define-public ((modulo-bar-number-visible n m) barnum mp)
 607   (and (> barnum 1) (= m (modulo barnum n))))
 608
 609 (define-public ((set-bar-number-visibility n) tr)
 610   (let ((bn (ly:context-property tr 'currentBarNumber)))
 611     (ly:context-set-property! tr 'barNumberVisibility
 612                               (modulo-bar-number-visible n (modulo bn n)))))
 613
 614 (define-public (first-bar-number-invisible barnum mp)
 615   (> barnum 1))
 616
 617 (define-public (first-bar-number-invisible-save-broken-bars barnum mp)
 618   (or (> barnum 1)
 619       (> (ly:moment-main-numerator mp) 0)))
 620
 621 (define-public (first-bar-number-invisible-and-no-parenthesized-bar-numbers barnum mp)
 622   (and (> barnum 1)
 623        (= (ly:moment-main-numerator mp) 0)))
 624
 625 (define-public (robust-bar-number-function barnum measure-pos alt-number context)
 626   (define (get-number-and-power an pow)
 627     (if (<= an alt-number)
 628         (get-number-and-power (+ an (expt 26 (1+ pow))) (1+ pow))
 629         (cons (+ alt-number (- (expt 26 pow) an)) (1- pow))))
 630   (define (make-letter so-far an pow)
 631     (if (< pow 0)
 632       so-far
 633       (let ((pos (modulo (quotient an (expt 26 pow)) 26)))
 634         (make-letter (string-append so-far
 635                                     (substring "abcdefghijklmnopqrstuvwxyz"
 636                                                pos
 637                                                (1+ pos)))
 638                    an
 639                    (1- pow)))))
 640   (let* ((number-and-power (get-number-and-power 0 0))
 641          (begin-measure (= 0 (ly:moment-main-numerator measure-pos)))
 642          (maybe-open-parenthesis (if begin-measure "" "("))
 643          (maybe-close-parenthesis (if begin-measure "" ")")))
 644     (markup (string-append maybe-open-parenthesis
 645                            (number->string barnum)
 646                            (make-letter ""
 647                                         (car number-and-power)
 648                                         (cdr number-and-power))
 649                            maybe-close-parenthesis))))
 650
 651 (define-public (all-bar-numbers-visible barnum mp) #t)
 652
 653
 654 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 655 ;; percent repeat counters
 656
 657 (define-public ((every-nth-repeat-count-visible n) count context)
 658   (= 0 (modulo count n)))
 659
 660 (define-public (all-repeat-counts-visible count context) #t)
 661
 662 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 663 ;; make-engraver helper macro
 664
 665 (defmacro-public make-engraver forms
 666   "Helper macro for creating Scheme engravers.
 667
 668 The usual form for an engraver is an association list (or alist)
 669 mapping symbols to either anonymous functions or to another such
 670 alist.
 671
 672 @code{make-engraver} accepts forms where the first element is either
 673 an argument list starting with the respective symbol, followed by the
 674 function body (comparable to the way @code{define} is used for
 675 defining functions), or a single symbol followed by subordinate forms
 676 in the same manner.  You can also just make an alist pair
 677 literally (the @samp{car} is quoted automatically) as long as the
 678 unevaluated @samp{cdr} is not a pair.  This is useful if you already
 679 have defined your engraver functions separately.
 680
 681 Symbols mapping to a function would be @code{initialize},
 682 @code{start-translation-timestep}, @code{process-music},
 683 @code{process-acknowledged}, @code{stop-translation-timestep}, and
 684 @code{finalize}.  Symbols mapping to another alist specified in the
 685 same manner are @code{listeners} with the subordinate symbols being
 686 event classes, and @code{acknowledgers} and @code{end-acknowledgers}
 687 with the subordinate symbols being interfaces."
 688   (let loop ((forms forms))
 689     (if (cheap-list? forms)
 690         `(list
 691           ,@(map (lambda (form)
 692                    (if (pair? (car form))
 693                        `(cons ',(caar form) (lambda ,(cdar form) ,@(cdr form)))
 694                        `(cons ',(car form) ,(loop (cdr form)))))
 695                  forms))
 696         forms)))