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