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 -7 -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         (ly:text-interface::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 ;; for ties in tablature, fret numbers that are tied to should be invisible,
 138 ;; except for 'tied to' numbers after a line break;; these will be
 139 ;; parenthesized (thanks to Neil for his solution):
 140 (define-public (parenthesize-tab-note-head grob)
 141   ;; Helper function to parenthesize tab noteheads,
 142   ;; since we can't use ParenthesesItem at this stage
 143   ;; This is basically the same as the C++ function
 144   ;; in accidental.cc, converted to Scheme
 145   (let* ((font (ly:grob-default-font grob))
 146          (open (stencil-whiteout
 147                 (ly:font-get-glyph font "accidentals.leftparen")))
 148          (close (stencil-whiteout
 149                  (ly:font-get-glyph font "accidentals.rightparen")))
 150          (me (ly:text-interface::print grob)))
 151
 152     (ly:stencil-combine-at-edge
 153      (ly:stencil-combine-at-edge me X LEFT open) X RIGHT close)))
 154
 155 ;; ParenthesesItem doesn't work very well for TabNoteHead, since
 156 ;; the parentheses are too small and clash with the staff-lines
 157 ;; Define a callback for the 'stencils property which will tweak
 158 ;; the parentheses' appearance for TabNoteHead
 159 (define-public (parentheses-item::calc-tabstaff-parenthesis-stencils grob)
 160   ;; the grob we want to parenthesize
 161   (let ((victim (ly:grob-array-ref (ly:grob-object grob 'elements) 0)))
 162
 163     ;; check whether it's a note head
 164     (if (grob::has-interface victim 'note-head-interface)
 165         (begin
 166           ;; tweak appearance before retrieving
 167           ;; list of stencils '(left-paren right-paren)
 168           ;; get the font-size from victim (=TabNoteHead) to handle
 169           ;; grace notes properly
 170           (ly:grob-set-property! grob 'font-size
 171                                  (ly:grob-property victim 'font-size))
 172           (ly:grob-set-property! grob 'padding 0)
 173           ;; apply whiteout to each element of the list
 174           (map stencil-whiteout
 175                (parentheses-item::calc-parenthesis-stencils grob)))
 176         (parentheses-item::calc-parenthesis-stencils grob))))
 177
 178 ;; the handler for ties in tablature; according to TabNoteHead #'details,
 179 ;; the 'tied to' note is handled differently after a line break
 180 (define-public (tie::handle-tab-note-head grob)
 181   (let* ((original (ly:grob-original grob))
 182          (tied-tab-note-head (ly:spanner-bound grob RIGHT))
 183          (siblings (if (ly:grob? original)
 184                        (ly:spanner-broken-into original) '())))
 185
 186     (if (and (>= (length siblings) 2)
 187              (eq? (car (last-pair siblings)) grob))
 188         ;; tie is split -> get TabNoteHead #'details
 189         (let* ((details (ly:grob-property tied-tab-note-head 'details))
 190                (tied-properties (assoc-get 'tied-properties details '()))
 191                (tab-note-head-parenthesized (assoc-get 'parenthesize tied-properties #t))
 192                ;; we need the begin-of-line entry in the 'break-visibility vector
 193                (tab-note-head-visible
 194                 (vector-ref (assoc-get 'break-visibility
 195                                        tied-properties #(#f #f #t)) 2)))
 196
 197           (if tab-note-head-visible
 198               ;; tab note head is visible
 199               (if tab-note-head-parenthesized
 200                   (ly:grob-set-property! tied-tab-note-head 'stencil
 201                                          (lambda (grob)
 202                                            (parenthesize-tab-note-head grob))))
 203               ;; tab note head is invisible
 204               (begin
 205                 (ly:grob-set-property! tied-tab-note-head 'transparent #t)
 206                 (ly:grob-set-property! tied-tab-note-head 'whiteout #f))))
 207
 208         ;; tie is not split -> make fret number invisible
 209         (begin
 210           (ly:grob-set-property! tied-tab-note-head 'transparent #t)
 211           (ly:grob-set-property! tied-tab-note-head 'whiteout #f)))))
 212
 213 ;; repeat ties occur within alternatives in a repeat construct;
 214 ;; TabNoteHead #'details handles the appearance in this case
 215 (define-public (repeat-tie::handle-tab-note-head grob)
 216   (let* ((tied-tab-note-head (ly:grob-object grob 'note-head))
 217          (details (ly:grob-property tied-tab-note-head 'details))
 218          (repeat-tied-properties (assoc-get 'repeat-tied-properties details '()))
 219          (tab-note-head-visible (assoc-get 'note-head-visible repeat-tied-properties #t))
 220          (tab-note-head-parenthesized (assoc-get 'parenthesize repeat-tied-properties #t)))
 221
 222     (if tab-note-head-visible
 223         ;; tab note head is visible
 224         (if tab-note-head-parenthesized
 225             (ly:grob-set-property! tied-tab-note-head 'stencil
 226                                    (lambda (grob)
 227                                      (parenthesize-tab-note-head grob))))
 228         ;; tab note head is invisible
 229         (begin
 230           (ly:grob-set-property! tied-tab-note-head 'transparent #t)
 231           (ly:grob-set-property! tied-tab-note-head 'whiteout #f)))))
 232
 233 ;; the slurs should not be too far apart from the corresponding fret number, so
 234 ;; we move the slur towards the TabNoteHeads:
 235 (define-public (slur::draw-tab-slur grob)
 236   ;; TODO: use a less "brute-force" method to decrease
 237   ;; the distance between the slur ends and the fret numbers
 238   (let* ((staff-space (ly:staff-symbol-staff-space grob))
 239          (control-points (ly:grob-property grob 'control-points))
 240          (new-control-points (map
 241                               (lambda (p)
 242                                 (cons (car p)
 243                                       (- (cdr p)
 244                                          (* staff-space
 245                                             (ly:grob-property grob 'direction)
 246                                             0.35))))
 247                               control-points)))
 248
 249     (ly:grob-set-property! grob 'control-points new-control-points)
 250     (ly:slur::print grob)))