scm/tablature.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 2009--2010 Marc Hohl <marc@hohlart.de>
   4 ;;;;
   5 ;;;; LilyPond is free software: you can redistribute it and/or modify
   6 ;;;; it under the terms of the GNU General Public License as published by
   7 ;;;; the Free Software Foundation, either version 3 of the License, or
   8 ;;;; (at your option) any later version.
   9 ;;;;
  10 ;;;; LilyPond is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;;;; GNU General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU General Public License
  16 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 ;; default tunings for common string instruments
  19 ;; guitar tunings
  20 (define-public guitar-tuning '(4 -1 -5 -10 -15 -20))
  21 (define-public guitar-seven-string-tuning '(4 -1 -5 -10 -15 -20 -25))
  22 (define-public guitar-drop-d-tuning '(4 -1 -5 -10 -15 -22))
  23 (define-public guitar-open-g-tuning '(2 -1 -5 -10 -17 -22))
  24 (define-public guitar-open-d-tuning '(2 -3 -6 -10 -15 -22))
  25 (define-public guitar-dadgad-tuning '(2 -3 -5 -10 -15 -22))
  26 (define-public guitar-lute-tuning '(4 -1 -6 -10 -15 -20))
  27 (define-public guitar-asus4-tuning '(4 -3 -8 -10 -15 -20))
  28 ;; bass tunings
  29 (define-public bass-tuning '(-17 -22 -27 -32))
  30 (define-public bass-four-string-tuning '(-17 -22 -27 -32))
  31 (define-public bass-drop-d-tuning '(-17 -22 -27 -34))
  32 (define-public bass-five-string-tuning '(-17 -22 -27 -32 -37))
  33 (define-public bass-six-string-tuning '(-12 -17 -22 -27 -32 -37))
  34 ;; mandolin
  35 (define-public mandolin-tuning '(16 9 2 -5))
  36 ;; tunings for 5-string banjo
  37 (define-public banjo-open-g-tuning '(2 -1 -5 -10 7))
  38 (define-public banjo-c-tuning '(2 -1 -5 -12 7))
  39 (define-public banjo-modal-tuning '(2 0 -5 -10 7))
  40 (define-public banjo-open-d-tuning '(2 -3 -6 -10 9))
  41 (define-public banjo-open-dm-tuning '(2 -3 -6 -10 9))
  42 ;; convert 5-string banjo tuning to 4-string by removing the 5th string
  43 (define-public (four-string-banjo tuning)
  44   (reverse (cdr (reverse tuning))))
  45 ;; ukulele tunings
  46 (define-public ukulele-tuning '(9 4 0 7)) ;ukulele  a' e' c' g'
  47 (define-public ukulele-d-tuning '(11 6 2 9)) ;ukulele d tuning, b' fis' d' a'
  48 (define-public ukulele-tenor-tuning '(-5 0 4 9)) ;tenor ukulele, g c' e' a'
  49 (define-public ukulele-baritone-tuning '(-10 -5 -1 4)) ;baritone ukulele, d g b e'
  50
  51
  52 ;; for more control over glyph-name calculations,
  53 ;; we use a custom callback for tab note heads
  54 ;; which will ignore 'style = 'do
  55 (define-public (tab-note-head::calc-glyph-name grob)
  56   (let ((style (ly:grob-property grob 'style)))
  57
  58     (case style
  59       ((cross) "2cross"))))
  60
  61 ;; ensure we only call note head callback when
  62 ;; 'style = 'cross
  63 (define-public (tab-note-head::whiteout-if-style-set grob)
  64   (let ((style (ly:grob-property grob 'style)))
  65
  66     (if (and (symbol? style)
  67              (eq? style 'cross))
  68         (stencil-whiteout (ly:note-head::print grob))
  69         (tab-note-head::print grob))))
  70
  71 ;; definitions for the "moderntab" clef:
  72 ;; the "moderntab" clef will be added to the list of known clefs,
  73 ;; so it can be used as any other clef: \clef "moderntab"
  74 (add-new-clef "moderntab" "markup.moderntab" 0 0 0)
  75
  76 ;; define sans serif-style tab-Clefs as a markup:
  77 (define-markup-command (customTabClef
  78                                 layout props num-strings staff-space)
  79   (integer? number?)
  80   #:category music
  81   "Draw a tab clef sans-serif style."
  82   (define (square x) (* x x))
  83   (let* ((scale-factor (/ staff-space 1.5))
  84          (font-size (- (* num-strings 1.5 scale-factor) 7))
  85          (base-skip (* (square (+ (* num-strings 0.195) 0.4)) scale-factor)))
  86
  87     (interpret-markup layout props
  88                       (markup #:vcenter #:bold
  89                               #:override (cons 'font-family 'sans)
  90                               #:fontsize font-size
  91                               #:override (cons 'baseline-skip base-skip)
  92                               #:left-align #:center-column ("T" "A" "B")))))
  93
  94 ;; this function decides which clef to take
  95 (define-public (clef::print-modern-tab-if-set grob)
  96   (let ((glyph (ly:grob-property grob 'glyph)))
  97
  98     ;; which clef is wanted?
  99     (if (string=? glyph "markup.moderntab")
 100         ;; if it is "moderntab", we'll draw it
 101         (let* ((staff-symbol (ly:grob-object grob 'staff-symbol))
 102                (line-count (if (ly:grob? staff-symbol)
 103                                (ly:grob-property staff-symbol 'line-count)
 104                                0))
 105                (staff-space (ly:staff-symbol-staff-space grob)))
 106
 107           (grob-interpret-markup grob (make-customTabClef-markup line-count
 108                                                                  staff-space)))
 109         ;; otherwise, we simply use the default printing routine
 110         (ly:clef::print grob))))
 111
 112 ;; if stems are drawn, it is nice to have a double stem for
 113 ;; (dotted) half notes to distinguish them from quarter notes:
 114 (define-public (tabvoice::draw-double-stem-for-half-notes grob)
 115   (let ((stem (ly:stem::print grob)))
 116
 117     ;; is the note a (dotted) half note?
 118     (if (= 1 (ly:grob-property grob 'duration-log))
 119         ;; yes -> draw double stem
 120         (ly:stencil-combine-at-edge stem X RIGHT stem 0.5)
 121         ;; no -> draw simple stem
 122         stem)))
 123
 124 ;; as default, the glissando line between fret numbers goes
 125 ;; upwards, here we have a function to correct this behavior:
 126 (define-public (glissando::calc-tab-extra-dy grob)
 127   (let* ((original (ly:grob-original grob))
 128          (left-bound (ly:spanner-bound original LEFT))
 129          (right-bound (ly:spanner-bound original RIGHT))
 130          (left-pitch (ly:event-property (event-cause left-bound) 'pitch))
 131          (right-pitch (ly:event-property (event-cause right-bound) 'pitch)))
 132
 133     (if (< (ly:pitch-semitones right-pitch) (ly:pitch-semitones left-pitch))
 134         -0.75
 135         0.75)))
 136
 137 ;; the handler for ties in tablature; according to TabNoteHead #'details,
 138 ;; the 'tied to' note is handled differently after a line break
 139 (define-public (tie::handle-tab-note-head grob)
 140   (let* ((original (ly:grob-original grob))
 141          (tied-tab-note-head (ly:spanner-bound grob RIGHT))
 142          (spanner-start (ly:grob-property tied-tab-note-head 'span-start #f))
 143          (siblings (if (ly:grob? original)
 144                        (ly:spanner-broken-into original) '())))
 145
 146     (if spanner-start
 147         ;; tab note head is right bound of a tie and left of spanner,
 148         ;; -> parenthesize it at all events
 149         (begin
 150           (ly:grob-set-property! tied-tab-note-head 'display-cautionary #t)
 151           (ly:grob-set-property! tied-tab-note-head 'stencil tab-note-head::print))
 152         ;; otherwise, check whether tie is split:
 153         (if (and (>= (length siblings) 2)
 154                  (eq? (car (last-pair siblings)) grob))
 155             ;; tie is split -> get TabNoteHead #'details
 156             (let* ((details (ly:grob-property tied-tab-note-head 'details))
 157                    (tied-properties (assoc-get 'tied-properties details '()))
 158                    (tab-note-head-parenthesized (assoc-get 'parenthesize tied-properties #t))
 159                    ;; we need the begin-of-line entry in the 'break-visibility vector
 160                    (tab-note-head-visible
 161                     (vector-ref (assoc-get 'break-visibility
 162                                            tied-properties #(#f #f #t)) 2)))
 163
 164               (if tab-note-head-visible
 165                   ;; tab note head is visible
 166                   (if tab-note-head-parenthesized
 167                       (begin
 168                         (ly:grob-set-property! tied-tab-note-head 'display-cautionary #t)
 169                         (ly:grob-set-property! tied-tab-note-head 'stencil tab-note-head::print)))
 170                   ;; tab note head is invisible
 171                  (ly:grob-set-property! tied-tab-note-head 'transparent #t)))
 172
 173             ;; tie is not split
 174             (ly:grob-set-property! tied-tab-note-head 'transparent #t)))))
 175
 176
 177
 178 ;; repeat ties occur within alternatives in a repeat construct;
 179 ;; TabNoteHead #'details handles the appearance in this case
 180 (define-public (repeat-tie::handle-tab-note-head grob)
 181   (let* ((tied-tab-note-head (ly:grob-object grob 'note-head))
 182          (spanner-start (ly:grob-property tied-tab-note-head 'span-start #f)))
 183     (if spanner-start
 184         ;; tab note head is between a tie and a slur/glissando
 185         ;; -> parenthesize it at all events
 186         (begin
 187           (ly:grob-set-property! tied-tab-note-head 'display-cautionary #t)
 188           (ly:grob-set-property! tied-tab-note-head 'stencil tab-note-head::print))
 189         ;; otherwise check 'details
 190         (let* ((details (ly:grob-property tied-tab-note-head 'details))
 191                (repeat-tied-properties (assoc-get 'repeat-tied-properties details '()))
 192                (tab-note-head-visible (assoc-get 'note-head-visible repeat-tied-properties #t))
 193                (tab-note-head-parenthesized (assoc-get 'parenthesize repeat-tied-properties #t)))
 194
 195         (if tab-note-head-visible
 196             ;; tab note head is visible
 197             (if tab-note-head-parenthesized
 198                 (begin
 199                   (ly:grob-set-property! tied-tab-note-head 'display-cautionary #t)
 200                   (ly:grob-set-property! tied-tab-note-head 'stencil tab-note-head::print)))
 201             ;; tab note head is invisible
 202             (ly:grob-set-property! tied-tab-note-head 'transparent #t))))))
 203
 204 ;; the slurs should not be too far apart from the corresponding fret number, so
 205 ;; we move the slur towards the TabNoteHeads; moreover, if the left fret number is
 206 ;; the right-bound of a tie, we'll set it in parentheses:
 207 (define-public (slur::draw-tab-slur grob)
 208   ;; TODO: use a less "brute-force" method to decrease
 209   ;; the distance between the slur ends and the fret numbers
 210   (let* ((original (ly:grob-original grob))
 211          (left-bound (ly:spanner-bound original LEFT))
 212          (left-tab-note-head (ly:grob-property left-bound 'cause))
 213          (staff-space (ly:staff-symbol-staff-space grob))
 214          (control-points (ly:grob-property grob 'control-points))
 215          (new-control-points (map
 216                               (lambda (p)
 217                                 (cons (car p)
 218                                       (- (cdr p)
 219                                          (* staff-space
 220                                             (ly:grob-property grob 'direction)
 221                                             0.35))))
 222                              control-points)))
 223
 224     (ly:grob-set-property! grob 'control-points new-control-points)
 225     (ly:slur::print grob)))
 226
 227 ;; The glissando routine works similarly to the slur routine; if the
 228 ;; fret number is "tied to", it should become parenthesized.
 229 (define-public (glissando::draw-tab-glissando grob)
 230   (let* ((original (ly:grob-original grob))
 231          (left-tab-note-head (ly:spanner-bound original LEFT))
 232          (cautionary (ly:grob-property left-tab-note-head 'display-cautionary #f)))
 233
 234     (and cautionary
 235          ;; increase left padding to avoid collision between
 236          ;; closing parenthesis and glissando line
 237          (ly:grob-set-nested-property! grob '(bound-details left padding) 0.5))
 238     (ly:line-spanner::print grob)))
 239
 240 ;; for \tabFullNotation, the stem tremolo beams are too big in comparison to
 241 ;; normal staves; this wrapper function scales accordingly:
 242 (define-public (stem-tremolo::calc-tab-width grob)
 243   (let ((width (ly:stem-tremolo::calc-width grob))
 244         (staff-space (ly:staff-symbol-staff-space grob)))
 245     (/ width staff-space)))
 246
 247
 248 ;; a callback for custom fret labels
 249 (define-public ((tab-note-head::print-custom-fret-label fret) grob)
 250   (ly:grob-set-property! grob 'text fret)
 251   (tab-note-head::print grob))
 252
 253 (define-public (tab-note-head::print grob)
 254   (define (is-harmonic? grob)
 255     (let ((arts (ly:event-property (event-cause grob) 'articulations)))
 256       (not (null? (filter (lambda (a)
 257                             (ly:in-event-class? a 'harmonic-event))
 258                           arts)))))
 259
 260   (let* ((cautionary (ly:grob-property grob 'display-cautionary #f))
 261          (details (ly:grob-property grob 'details '()))
 262          (harmonic-props (assoc-get 'harmonic-properties details '()))
 263          (harmonic-angularity (assoc-get 'angularity harmonic-props 2))
 264          (harmonic-half-thick (assoc-get 'half-thickness harmonic-props 0.075))
 265          (harmonic-padding (assoc-get 'padding harmonic-props 0))
 266          (harmonic-proc (assoc-get 'procedure harmonic-props parenthesize-stencil))
 267          (harmonic-width (assoc-get 'width harmonic-props 0.25))
 268          (cautionary-props (assoc-get 'cautionary-properties details '()))
 269          (cautionary-angularity (assoc-get 'angularity cautionary-props 2))
 270          (cautionary-half-thick (assoc-get 'half-thickness cautionary-props 0.075))
 271          (cautionary-padding (assoc-get 'padding cautionary-props 0))
 272          (cautionary-proc (assoc-get 'procedure cautionary-props parenthesize-stencil))
 273          (cautionary-width (assoc-get 'width cautionary-props 0.25))
 274          (output-grob (ly:text-interface::print grob))
 275          (ref-grob (grob-interpret-markup grob "8"))
 276          (column-offset (interval-length
 277                             (ly:stencil-extent
 278                               (grob-interpret-markup grob "8")
 279                               X))))
 280
 281     (if (is-harmonic? grob)
 282         (set! output-grob (harmonic-proc output-grob
 283                                          harmonic-half-thick
 284                                          harmonic-width
 285                                          harmonic-angularity
 286                                          harmonic-padding)))
 287     (if cautionary
 288         (set! output-grob (cautionary-proc output-grob
 289                                            cautionary-half-thick
 290                                            cautionary-width
 291                                            cautionary-angularity
 292                                            cautionary-padding)))
 293     (ly:stencil-translate-axis (centered-stencil output-grob)
 294                                column-offset
 295                                X)))
 296
 297 ;; Harmonic definitions
 298
 299 (define node-positions
 300   ;; for the node on m/n-th of the string length, we get the corresponding
 301   ;; (exact) fret position by calculating p=(-12/log 2)*log(1-(m/n));
 302   ;; since guitarists normally use the forth fret and not the 3.8th, here
 303   ;; are rounded values, ordered by
 304   ;; 1/2
 305   ;; 1/3 2/3
 306   ;; 1/4 2/4 3/4 etc.
 307   ;; The value for 2/4 is irrelevant in practical, bacause the string sounds
 308   ;; only one octave higher, not two, but since scheme normalizes the fractions
 309   ;; anyway, these values are simply placeholders for easier indexing.
 310   ;; According to the arithmetic sum, the position of m/n is at 1/2*(n-2)(n-1)+(m-1)
 311   ;; if we start counting from zero
 312   (vector 12
 313            7   19
 314            5   12    24
 315            4    9    16   28
 316            3    7    12   19    31
 317            2.7  5.8  9.7  14.7  21.7  33.7
 318            2.3  5    8    12    17    24    36
 319            2    4.4  7    10    14    19    26  38 ))
 320
 321 (define partial-pitch
 322   (vector '(0 0 0)
 323           '(1 0 0)
 324           '(1 4 0)
 325           '(2 0 0)
 326           '(2 2 0)
 327           '(2 4 0)
 328           '(2 6 -1/2)
 329           '(3 0 0)
 330           '(3 1 0)))
 331
 332 (define fret-partials
 333   '(("0" . 0)
 334     ("12" . 1)
 335     ("7" . 2)
 336     ("19" . 2)
 337     ("5" . 3)
 338     ("24" . 3)
 339     ("4" . 4)
 340     ("9" . 4)
 341     ("16" . 4)
 342     ("3" . 5)
 343     ("2.7" . 6)
 344     ("2.3" . 7)
 345     ("2" . 8)))
 346
 347 (define-public (ratio->fret ratio)
 348   "Calculate a fret number given @var{ratio} for the harmonic."
 349   (let* ((nom (numerator ratio))
 350          (den (denominator ratio))
 351          (index (+ (* (- den 2)
 352                       (- den 1)
 353                       1/2)
 354                    nom -1)))
 355      (number->string (vector-ref node-positions index))))
 356
 357 (define-public (ratio->pitch ratio)
 358   "Calculate a pitch given @var{ratio} for the harmonic."
 359   (let* ((partial (1- (denominator ratio)))
 360          (pitch (vector-ref partial-pitch partial)))
 361
 362   (ly:make-pitch (first pitch)
 363                  (second pitch)
 364                  (third pitch))))
 365
 366 (define-public (fret->pitch fret)
 367   "Calculate a pitch given @var{fret} for the harmonic."
 368   (let* ((partial (assoc-get fret fret-partials 0))
 369          (pitch (vector-ref partial-pitch partial)))
 370
 371   (ly:make-pitch (first pitch)
 372                  (second pitch)
 373                  (third pitch))))
 374
 375 (define-public (calc-harmonic-pitch pitch music)
 376   "Calculate the harmonic pitches in @var{music} given
 377 @var{pitch} as the non-harmonic pitch."
 378   (let ((es (ly:music-property music 'elements))
 379         (e (ly:music-property music 'element))
 380         (p (ly:music-property music 'pitch)))
 381     (cond
 382       ((pair? es)
 383        (ly:music-set-property! music 'elements
 384                                (map (lambda (x) (calc-harmonic-pitch pitch x)) es)))
 385       ((ly:music? e)
 386        (ly:music-set-property! music 'element (calc-harmonic-pitch pitch e)))
 387       ((ly:pitch? p)
 388        (begin
 389          (set! p (ly:pitch-transpose p pitch))
 390          (ly:music-set-property! music 'pitch p))))
 391     music))
 392
 393 (define-public (make-harmonic mus)
 394   "Convert music variable @var{mus} to harmonics."
 395   (let ((elts (ly:music-property mus 'elements))
 396         (elt (ly:music-property mus 'element)))
 397        (cond
 398         ((pair? elts)
 399          (map make-harmonic elts))
 400         ((ly:music? elt)
 401          (make-harmonic elt))
 402         ((music-is-of-type? mus 'note-event)
 403          (set! (ly:music-property mus 'articulations)
 404                (append
 405                  (ly:music-property mus 'articulations)
 406                  (list (make-music 'HarmonicEvent))))))
 407        mus))