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