scm/tablature.scm

   1 ;;;; tablature.scm
   2 ;;;;
   3 ;;;; source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c) 2009 Marc Hohl <marc@hohlart.de>
   6
   7 ;; default tunings for common string instruments
   8 ;; guitar tunings
   9 (define-public guitar-tuning '(4 -1 -5 -10 -15 -20))
  10 (define-public guitar-seven-string-tuning '(4 -1 -5 -10 -15 -20 -25))
  11 (define-public guitar-drop-d-tuning '(4 -1 -5 -10 -15 -22))
  12 (define-public guitar-open-g-tuning '(2 -1 -5 -10 -17 -22))
  13 (define-public guitar-open-d-tuning '(2 -3 -6 -10 -15 -22))
  14 (define-public guitar-dadgad-tuning '(2 -3 -7 -10 -15 -22))
  15 (define-public guitar-lute-tuning '(4 -1 -6 -10 -15 -20))
  16 (define-public guitar-asus4-tuning '(4 -3 -8 -10 -15 -20))
  17 ;; bass tunings
  18 (define-public bass-tuning '(-17 -22 -27 -32))
  19 (define-public bass-four-string-tuning '(-17 -22 -27 -32))
  20 (define-public bass-drop-d-tuning '(-17 -22 -27 -34))
  21 (define-public bass-five-string-tuning '(-17 -22 -27 -32 -37))
  22 (define-public bass-six-string-tuning '(-12 -17 -22 -27 -32 -37))
  23 ;; mandolin
  24 (define-public mandolin-tuning '(16 9 2 -5))
  25 ;; tunings for 5-string banjo
  26 (define-public banjo-open-g-tuning '(2 -1 -5 -10 7))
  27 (define-public banjo-c-tuning '(2 -1 -5 -12 7))
  28 (define-public banjo-modal-tuning '(2 0 -5 -10 7))
  29 (define-public banjo-open-d-tuning '(2 -3 -6 -10 9))
  30 (define-public banjo-open-dm-tuning '(2 -3 -6 -10 9))
  31 ;; convert 5-string banjo tuning to 4-string by removing the 5th string
  32 (define-public (four-string-banjo tuning)
  33   (reverse (cdr (reverse tuning))))
  34
  35 ;; for more control over glyph-name calculations,
  36 ;; we use a custom callback for tab noteheads
  37 ;; which will ignore 'style = 'do
  38 (define-public (tab-note-head::calc-glyph-name grob)
  39   (let ((style (ly:grob-property grob 'style)))
  40
  41     (case style
  42       ((cross) "2cross"))))
  43
  44 ;; ensure we only call notehead callback when
  45 ;; 'style = 'cross
  46 (define-public (tab-note-head::whiteout-if-style-set grob)
  47   (let ((style (ly:grob-property grob 'style)))
  48
  49     (if (and (symbol? style)
  50              (eq? style 'cross))
  51         (stencil-whiteout (ly:note-head::print grob))
  52         (ly:text-interface::print grob))))
  53
  54 ;; definitions for the "moderntab" clef:
  55 ;; the "moderntab" clef will be added to the list of known clefs,
  56 ;; so it can be used as any other clef: \clef "moderntab"
  57 (add-new-clef "moderntab" "markup.moderntab" 0 0 0)
  58
  59 ;; define sans serif-style tab-Clefs as a markup:
  60 (define-builtin-markup-command (customTabClef
  61                                 layout props num-strings staff-space)
  62   (integer? number?)
  63   music
  64   ()
  65   "Draw a tab clef sans-serif style."
  66   (define (square x) (* x x))
  67   (let* ((scale-factor (/ staff-space 1.5))
  68          (font-size (- (* num-strings 1.5 scale-factor) 7))
  69          (base-skip (* (square (+ (* num-strings 0.195) 0.4)) scale-factor)))
  70
  71     (interpret-markup layout props
  72                       (markup #:vcenter #:bold
  73                               #:override (cons 'font-family 'sans)
  74                               #:fontsize font-size
  75                               #:override (cons 'baseline-skip base-skip)
  76                               #:left-align #:center-column ("T" "A" "B")))))
  77
  78 ;; this function decides which clef to take
  79 (define-public (clef::print-modern-tab-if-set grob)
  80   (let ((glyph (ly:grob-property grob 'glyph)))
  81
  82     ;; which clef is wanted?
  83     (if (string=? glyph "markup.moderntab")
  84         ;; if it is "moderntab", we'll draw it
  85         (let* ((staff-symbol (ly:grob-object grob 'staff-symbol))
  86                (line-count (ly:grob-property staff-symbol 'line-count))
  87                (staff-space (ly:staff-symbol-staff-space grob)))
  88
  89           (grob-interpret-markup grob (make-customTabClef-markup line-count
  90                                                                  staff-space)))
  91         ;; otherwise, we simply use the default printing routine
  92         (ly:clef::print grob))))
  93
  94 ;; if stems are drawn, it is nice to have a double stem for
  95 ;; (dotted) half notes to distinguish them from quarter notes:
  96 (define-public (tabvoice::draw-double-stem-for-half-notes grob)
  97   (let ((stem (ly:stem::print grob)))
  98
  99     ;; is the note a (dotted) half note?
 100     (if (= 1 (ly:grob-property grob 'duration-log))
 101         ;; yes -> draw double stem
 102         (ly:stencil-combine-at-edge stem X RIGHT stem 0.5)
 103         ;; no -> draw simple stem
 104         stem)))
 105
 106 ;; as default, the glissando line between fret numbers goes
 107 ;; upwards, here we have a function to correct this behavior:
 108 (define-public (glissando::calc-tab-extra-dy grob)
 109   (let* ((original (ly:grob-original grob))
 110          (left-bound (ly:spanner-bound original LEFT))
 111          (right-bound (ly:spanner-bound original RIGHT))
 112          (left-pitch (ly:event-property (event-cause left-bound) 'pitch))
 113          (right-pitch (ly:event-property (event-cause right-bound) 'pitch)))
 114
 115     (if (< (ly:pitch-semitones right-pitch) (ly:pitch-semitones left-pitch))
 116         -0.75
 117         0.75)))
 118
 119 ;; for ties in tablature, fret numbers that are tied to should be invisible,
 120 ;; except for 'tied to' numbers after a line break;; these will be
 121 ;; parenthesized (thanks to Neil for his solution):
 122 (define-public (parenthesize-tab-note-head grob)
 123   ;; Helper function to parenthesize tab noteheads,
 124   ;; since we can't use ParenthesesItem at this stage
 125   ;; This is basically the same as the C++ function
 126   ;; in accidental.cc, converted to Scheme
 127   (let* ((font (ly:grob-default-font grob))
 128          (open (stencil-whiteout
 129                 (ly:font-get-glyph font "accidentals.leftparen")))
 130          (close (stencil-whiteout
 131                  (ly:font-get-glyph font "accidentals.rightparen")))
 132          (me (ly:text-interface::print grob)))
 133
 134     (ly:stencil-combine-at-edge
 135      (ly:stencil-combine-at-edge me X LEFT open) X RIGHT close)))
 136
 137 ;; ParenthesesItem doesn't work very well for TabNoteHead, since
 138 ;; the parentheses are too small and clash with the staff-lines
 139 ;; Define a callback for the 'stencils property which will tweak
 140 ;; the parentheses' appearance for TabNoteHead
 141 (define-public (parentheses-item::calc-tabstaff-parenthesis-stencils grob)
 142   ;; the grob we want to parenthesize
 143   (let ((victim (ly:grob-array-ref (ly:grob-object grob 'elements) 0)))
 144
 145     ;; check whether it's a note head
 146     (if (grob::has-interface victim 'note-head-interface)
 147         (begin
 148           ;; tweak appearance before retrieving
 149           ;; list of stencils '(left-paren right-paren)
 150           ;; get the font-size from victim (=TabNoteHead) to handle
 151           ;; grace notes properly
 152           (ly:grob-set-property! grob 'font-size
 153                                  (ly:grob-property victim 'font-size))
 154           (ly:grob-set-property! grob 'padding 0)
 155           ;; apply whiteout to each element of the list
 156           (map stencil-whiteout
 157                (parentheses-item::calc-parenthesis-stencils grob)))
 158         (parentheses-item::calc-parenthesis-stencils grob))))
 159
 160 ;; the handler for ties in tablature; according to TabNoteHead #'details,
 161 ;; the 'tied to' note is handled differently after a line break
 162 (define-public (tie::handle-tab-note-head grob)
 163   (let* ((original (ly:grob-original grob))
 164          (tied-tab-note-head (ly:spanner-bound grob RIGHT))
 165          (siblings (if (ly:grob? original)
 166                        (ly:spanner-broken-into original) '())))
 167
 168     (if (and (>= (length siblings) 2)
 169              (eq? (car (last-pair siblings)) grob))
 170         ;; tie is split -> get TabNoteHead #'details
 171         (let* ((details (ly:grob-property tied-tab-note-head 'details))
 172                (tied-properties (assoc-get 'tied-properties details '()))
 173                (tab-note-head-parenthesized (assoc-get 'parenthesize tied-properties #t))
 174                ;; we need the begin-of-line entry in the 'break-visibility vector
 175                (tab-note-head-visible
 176                 (vector-ref (assoc-get 'break-visibility
 177                                        tied-properties #(#f #f #t)) 2)))
 178
 179               (if tab-note-head-visible
 180                  ;; tab note head is visible
 181                  (if tab-note-head-parenthesized
 182                      (ly:grob-set-property! tied-tab-note-head 'stencil
 183                                             (lambda (grob)
 184                                                     (parenthesize-tab-note-head grob))))
 185                  ;; tab note head is invisible
 186                  (ly:grob-set-property! tied-tab-note-head 'transparent #t)))
 187
 188         ;; tie is not split -> make fret number invisible
 189         (ly:grob-set-property! tied-tab-note-head 'transparent #t))))
 190
 191 ;; repeat ties occur within alternatives in a repeat construct;
 192 ;; TabNoteHead #'details handles the appearance in this case
 193 (define-public (repeat-tie::handle-tab-note-head grob)
 194   (let* ((tied-tab-note-head (ly:grob-object grob 'note-head))
 195          (details (ly:grob-property tied-tab-note-head 'details))
 196          (repeat-tied-properties (assoc-get 'repeat-tied-properties details '()))
 197          (tab-note-head-visible (assoc-get 'note-head-visible repeat-tied-properties #t))
 198          (tab-note-head-parenthesized (assoc-get 'parenthesize repeat-tied-properties #t)))
 199
 200         (if tab-note-head-visible
 201             ;; tab note head is visible
 202             ( if tab-note-head-parenthesized
 203                  (ly:grob-set-property! tied-tab-note-head 'stencil
 204                                         (lambda (grob)
 205                                                 (parenthesize-tab-note-head grob))))
 206             ;; tab note head is invisible
 207             (ly:grob-set-property! tied-tab-note-head 'transparent #t))))