This file is indexed.

/usr/share/lilypond/2.18.2/scm/tablature.scm is in lilypond-data 2.18.2-4.1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
;;;; Copyright (C) 2009--2012 Marc Hohl <marc@hohlart.de>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; LilyPond is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.


;; for more control over glyph-name calculations,
;; we use a custom callback for tab note heads
;; which will ignore 'style = 'do
(define-public (tab-note-head::calc-glyph-name grob)
  (let ((style (ly:grob-property grob 'style)))

    (case style
      ((cross) "2cross"))))

;; ensure we only call note head callback when
;; 'style = 'cross
(define-public (tab-note-head::whiteout-if-style-set grob)
  (let ((style (ly:grob-property grob 'style)))

    (if (and (symbol? style)
             (eq? style 'cross))
        (stencil-whiteout (ly:note-head::print grob))
        (tab-note-head::print grob))))

;; definitions for the "moderntab" clef:
;; the "moderntab" clef will be added to the list of known clefs,
;; so it can be used as any other clef: \clef "moderntab"
(add-new-clef "moderntab" "markup.moderntab" 0 0 0)

;; define sans serif-style tab-Clefs as a markup:
(define-markup-command (customTabClef
                        layout props num-strings staff-space)
  (integer? number?)
  #:category music
  "Draw a tab clef sans-serif style."
  (define (square x) (* x x))
  (let* ((scale-factor (/ staff-space 1.5))
         (font-size (- (* num-strings 1.5 scale-factor) 7))
         (base-skip (* (square (+ (* num-strings 0.195) 0.4)) scale-factor)))

    (interpret-markup layout props
                      (markup #:vcenter #:bold
                              #:override (cons 'font-family 'sans)
                              #:fontsize font-size
                              #:override (cons 'baseline-skip base-skip)
                              #:left-align #:center-column ("T" "A" "B")))))

;; this function decides which clef to take
(define-public (clef::print-modern-tab-if-set grob)
  (let ((glyph (ly:grob-property grob 'glyph)))

    ;; which clef is wanted?
    (if (string=? glyph "markup.moderntab")
        ;; if it is "moderntab", we'll draw it
        (let* ((staff-symbol (ly:grob-object grob 'staff-symbol))
               (line-count (if (ly:grob? staff-symbol)
                               (ly:grob-property staff-symbol 'line-count)
                               0))
               (staff-space (ly:staff-symbol-staff-space grob)))

          (grob-interpret-markup grob (make-customTabClef-markup line-count
                                                                 staff-space)))
        ;; otherwise, we simply use the default printing routine
        (ly:clef::print grob))))

;; if stems are drawn, it is nice to have a double stem for
;; (dotted) half notes to distinguish them from quarter notes:
(define-public (tabvoice::make-double-stem-width-for-half-notes grob)
  (let ((X-extent (ly:stem::width grob)))

    ;; is the note a (dotted) half note?
    (if (= 1 (ly:grob-property grob 'duration-log))
        ;; yes -> return double stem width
        (cons (car X-extent) (+ 0.5 (* 2 (cdr X-extent))))
        ;; no -> return simple stem width
        X-extent)))

(define-public (tabvoice::draw-double-stem-for-half-notes grob)
  (let ((stem (ly:stem::print grob)))

    ;; is the note a (dotted) half note?
    (if (= 1 (ly:grob-property grob 'duration-log))
        ;; yes -> draw double stem
        (ly:stencil-combine-at-edge stem X RIGHT stem 0.5)
        ;; no -> draw simple stem
        stem)))

;; as default, the glissando line between fret numbers goes
;; upwards, here we have a function to correct this behavior:
(define-public (glissando::calc-tab-extra-dy grob)
  (let* ((original (ly:grob-original grob))
         (left-bound (ly:spanner-bound original LEFT))
         (right-bound (ly:spanner-bound original RIGHT))
         (left-pitch (ly:event-property (event-cause left-bound) 'pitch))
         (right-pitch (ly:event-property (event-cause right-bound) 'pitch)))

    (if (< (ly:pitch-tones right-pitch) (ly:pitch-tones left-pitch))
        -0.75
        0.75)))

;; the handler for ties in tablature; according to TabNoteHead #'details,
;; the 'tied to' note is handled differently after a line break
(define-public (tie::handle-tab-note-head grob)
  (let* ((original (ly:grob-original grob))
         (tied-tab-note-head (ly:spanner-bound grob RIGHT))
         (spanner-start (ly:grob-property tied-tab-note-head 'span-start #f))
         (siblings (if (ly:grob? original)
                       (ly:spanner-broken-into original) '())))

    (if spanner-start
        ;; tab note head is right bound of a tie and left of spanner,
        ;; -> parenthesize it at all events
        (begin
          (ly:grob-set-property! tied-tab-note-head 'display-cautionary #t)
          (ly:grob-set-property! tied-tab-note-head 'stencil tab-note-head::print))
        ;; otherwise, check whether tie is split:
        (if (and (>= (length siblings) 2)
                 (eq? (car (last-pair siblings)) grob))
            ;; tie is split -> get TabNoteHead #'details
            (let* ((details (ly:grob-property tied-tab-note-head 'details))
                   (tied-properties (assoc-get 'tied-properties details '()))
                   (tab-note-head-parenthesized (assoc-get 'parenthesize tied-properties #t))
                   ;; we need the begin-of-line entry in the 'break-visibility vector
                   (tab-note-head-visible
                    (vector-ref (assoc-get 'break-visibility
                                           tied-properties #(#f #f #t)) 2)))

              (if tab-note-head-visible
                  ;; tab note head is visible
                  (if tab-note-head-parenthesized
                      (begin
                        (ly:grob-set-property! tied-tab-note-head 'display-cautionary #t)
                        (ly:grob-set-property! tied-tab-note-head 'stencil tab-note-head::print)))
                  ;; tab note head is invisible
                  (ly:grob-set-property! tied-tab-note-head 'transparent #t)))

            ;; tie is not split
            (ly:grob-set-property! tied-tab-note-head 'transparent #t)))))



;; repeat ties occur within alternatives in a repeat construct;
;; TabNoteHead #'details handles the appearance in this case
(define-public (repeat-tie::handle-tab-note-head grob)
  (let* ((tied-tab-note-head (ly:grob-object grob 'note-head))
         (spanner-start (ly:grob-property tied-tab-note-head 'span-start #f)))
    (if spanner-start
        ;; tab note head is between a tie and a slur/glissando
        ;; -> parenthesize it at all events
        (begin
          (ly:grob-set-property! tied-tab-note-head 'display-cautionary #t)
          (ly:grob-set-property! tied-tab-note-head 'stencil tab-note-head::print))
        ;; otherwise check 'details
        (let* ((details (ly:grob-property tied-tab-note-head 'details))
               (repeat-tied-properties (assoc-get 'repeat-tied-properties details '()))
               (tab-note-head-visible (assoc-get 'note-head-visible repeat-tied-properties #t))
               (tab-note-head-parenthesized (assoc-get 'parenthesize repeat-tied-properties #t)))

          (if tab-note-head-visible
              ;; tab note head is visible
              (if tab-note-head-parenthesized
                  (begin
                    (ly:grob-set-property! tied-tab-note-head 'display-cautionary #t)
                    (ly:grob-set-property! tied-tab-note-head 'stencil tab-note-head::print)))
              ;; tab note head is invisible
              (ly:grob-set-property! tied-tab-note-head 'transparent #t))))))

;; the slurs should not be too far apart from the corresponding fret number, so
;; we move the slur towards the TabNoteHeads; moreover, if the left fret number is
;; the right-bound of a tie, we'll set it in parentheses:
(define-public (slur::draw-tab-slur grob)
  ;; TODO: use a less "brute-force" method to decrease
  ;; the distance between the slur ends and the fret numbers
  (let* ((original (ly:grob-original grob))
         (left-bound (ly:spanner-bound original LEFT))
         (left-tab-note-head (ly:grob-property left-bound 'cause))
         (staff-space (ly:staff-symbol-staff-space grob))
         (control-points (ly:grob-property grob 'control-points))
         (new-control-points (map
                              (lambda (p)
                                (cons (car p)
                                      (- (cdr p)
                                         (* staff-space
                                            (ly:grob-property grob 'direction)
                                            0.35))))
                              control-points)))

    (ly:grob-set-property! grob 'control-points new-control-points)
    (ly:slur::print grob)))

;; The glissando routine works similarly to the slur routine; if the
;; fret number is "tied to", it should become parenthesized.
(define-public (glissando::draw-tab-glissando grob)
  (let* ((original (ly:grob-original grob))
         (left-tab-note-head (ly:spanner-bound original LEFT))
         (cautionary (ly:grob-property left-tab-note-head 'display-cautionary #f)))

    (and cautionary
         ;; increase left padding to avoid collision between
         ;; closing parenthesis and glissando line
         (ly:grob-set-nested-property! grob '(bound-details left padding) 0.5))
    (ly:line-spanner::print grob)))

;; for \tabFullNotation, the stem tremolo beams are too big in comparison to
;; normal staves; this wrapper function scales accordingly:
(define-public (stem-tremolo::calc-tab-width grob)
  (let ((width (ly:stem-tremolo::calc-width grob))
        (staff-space (ly:staff-symbol-staff-space grob)))
    (/ width staff-space)))


;; a callback for custom fret labels
(define-public ((tab-note-head::print-custom-fret-label fret) grob)
  (ly:grob-set-property! grob 'text fret)
  (tab-note-head::print grob))

(define-public (tab-note-head::print grob)
  (define (is-harmonic? grob)
    (let ((arts (ly:event-property (event-cause grob) 'articulations)))
      (or (pair? (filter (lambda (a)
                           (ly:in-event-class? a 'harmonic-event))
                         arts))
          (eq? (ly:grob-property grob 'style) 'harmonic))))

  (let* ((cautionary (ly:grob-property grob 'display-cautionary #f))
         (details (ly:grob-property grob 'details '()))
         (harmonic-props (assoc-get 'harmonic-properties details '()))
         (harmonic-angularity (assoc-get 'angularity harmonic-props 2))
         (harmonic-half-thick (assoc-get 'half-thickness harmonic-props 0.075))
         (harmonic-padding (assoc-get 'padding harmonic-props 0))
         (harmonic-proc (assoc-get 'procedure harmonic-props parenthesize-stencil))
         (harmonic-width (assoc-get 'width harmonic-props 0.25))
         (cautionary-props (assoc-get 'cautionary-properties details '()))
         (cautionary-angularity (assoc-get 'angularity cautionary-props 2))
         (cautionary-half-thick (assoc-get 'half-thickness cautionary-props 0.075))
         (cautionary-padding (assoc-get 'padding cautionary-props 0))
         (cautionary-proc (assoc-get 'procedure cautionary-props parenthesize-stencil))
         (cautionary-width (assoc-get 'width cautionary-props 0.25))
         (output-grob (ly:text-interface::print grob))
         (ref-grob (grob-interpret-markup grob "8"))
         (offset-factor (assoc-get 'head-offset details 3/5))
         (column-offset (* offset-factor
                           (interval-length
                            (ly:stencil-extent
                             (grob-interpret-markup grob "8")
                             X)))))

    (if (is-harmonic? grob)
        (set! output-grob (harmonic-proc output-grob
                                         harmonic-half-thick
                                         harmonic-width
                                         harmonic-angularity
                                         harmonic-padding)))
    (if cautionary
        (set! output-grob (cautionary-proc output-grob
                                           cautionary-half-thick
                                           cautionary-width
                                           cautionary-angularity
                                           cautionary-padding)))
    (ly:stencil-translate-axis (centered-stencil output-grob)
                               column-offset
                               X)))

;; Harmonic definitions

(define node-positions
  ;; for the node on m/n-th of the string length, we get the corresponding
  ;; (exact) fret position by calculating p=(-12/log 2)*log(1-(m/n));
  ;; since guitarists normally use the forth fret and not the 3.8th, here
  ;; are rounded values, ordered by
  ;; 1/2
  ;; 1/3 2/3
  ;; 1/4 2/4 3/4 etc.
  ;; The value for 2/4 is irrelevant in practical, bacause the string sounds
  ;; only one octave higher, not two, but since scheme normalizes the fractions
  ;; anyway, these values are simply placeholders for easier indexing.
  ;; According to the arithmetic sum, the position of m/n is at 1/2*(n-2)(n-1)+(m-1)
  ;; if we start counting from zero
  (vector 12
          7   19
          5   12    24
          4    9    16   28
          3    7    12   19    31
          2.7  5.8  9.7  14.7  21.7  33.7
          2.3  5    8    12    17    24    36
          2    4.4  7    10    14    19    26  38 ))

(define partial-pitch
  (vector '(0 0 0)
          '(1 0 0)
          '(1 4 0)
          '(2 0 0)
          '(2 2 0)
          '(2 4 0)
          '(2 6 -1/2)
          '(3 0 0)
          '(3 1 0)))

(define fret-partials
  '(("0" . 0)
    ("12" . 1)
    ("7" . 2)
    ("19" . 2)
    ("5" . 3)
    ("24" . 3)
    ("4" . 4)
    ("9" . 4)
    ("16" . 4)
    ("3" . 5)
    ("2.7" . 6)
    ("2.3" . 7)
    ("2" . 8)))

(define-public (ratio->fret ratio)
  "Calculate a fret number given @var{ratio} for the harmonic."
  (let* ((nom (numerator ratio))
         (den (denominator ratio))
         (index (+ (* (- den 2)
                      (- den 1)
                      1/2)
                   nom -1)))
    (number->string (vector-ref node-positions index))))

(define-public (ratio->pitch ratio)
  "Calculate a pitch given @var{ratio} for the harmonic."
  (let* ((partial (1- (denominator ratio)))
         (pitch (vector-ref partial-pitch partial)))

    (ly:make-pitch (first pitch)
                   (second pitch)
                   (third pitch))))

(define-public (fret->pitch fret)
  "Calculate a pitch given @var{fret} for the harmonic."
  (let* ((partial (assoc-get fret fret-partials 0))
         (pitch (vector-ref partial-pitch partial)))

    (ly:make-pitch (first pitch)
                   (second pitch)
                   (third pitch))))

(define-public (calc-harmonic-pitch pitch music)
  "Calculate the harmonic pitches in @var{music} given
@var{pitch} as the non-harmonic pitch."
  (let ((es (ly:music-property music 'elements))
        (e (ly:music-property music 'element))
        (p (ly:music-property music 'pitch)))
    (cond
     ((pair? es)
      (ly:music-set-property! music 'elements
                              (map (lambda (x) (calc-harmonic-pitch pitch x)) es)))
     ((ly:music? e)
      (ly:music-set-property! music 'element (calc-harmonic-pitch pitch e)))
     ((ly:pitch? p)
      (begin
        (set! p (ly:pitch-transpose p pitch))
        (ly:music-set-property! music 'pitch p))))
    music))

(define-public (make-harmonic mus)
  "Convert music variable @var{mus} to harmonics."
  (let ((elts (ly:music-property mus 'elements))
        (elt (ly:music-property mus 'element)))
    (cond
     ((pair? elts)
      (for-each make-harmonic elts))
     ((ly:music? elt)
      (make-harmonic elt))
     ((music-is-of-type? mus 'note-event)
      (set! (ly:music-property mus 'articulations)
            (append
             (ly:music-property mus 'articulations)
             (list (make-music 'HarmonicEvent))))))
    mus))