Editing Clarinet fingering chart and tablatures

[Note that recent LilyPond versions come with built-in woodwind diagram support.]

This snippet defines a new <code>\clarTab</code> markup command to draw tablatures for the clarinet.

The syntax is

<pre>\clarTab twelfthKey? holes keysByFinger</pre>
with

<ul>
<li><p>''twelfthKey?'': a boolean: <code>#t</code> if the twelfth key is pressed, <code>#f</code> for low pitch</p></li>
<li><p>''holes'': a list of closed holes represented by digit:</p>
<ul>
<li>0: for the thumb</li>
<li>1, 2, 3: for the 3 holes of the left hand</li>
<li>4, 5, 6: for the 3 holes of the right hand</li></ul>

<p>for example, <code>#'(0 1 2 3)</code> for the c'.</p></li>
<li><p>''keysByFinger'': a list of pairs composed by the name of the finger and the note that this finger produce when presses the key.</p>
<p>For example, the pair <code>'(&quot;Llittle&quot; . &quot;cis&quot;)</code> is the key pressed by the left little finger to make a cis. See note 5 below.</p></li></ul>

Here is a list of all strings for <code>'(fingerName . noteName)</code> pairs accepted (note that all altered notes are defined with a sharp):

<ul>
<li><p><code>Rlittle</code>: Right little finger. Associated note: &quot;e&quot; &quot;f&quot; &quot;fis&quot; &quot;gis&quot;. See note 3-6.</p></li>
<li><p><code>Llittle</code>: Left little finger. Associated note: &quot;e&quot; &quot;f&quot; &quot;fis&quot; &quot;cis&quot;. (note 6-7-8)</p></li>
<li><p><code>Rfore</code>: Right forefinger. Associated note: &quot;dis&quot; &quot;fis&quot; &quot;ais&quot; &quot;b&quot;</p>
<p>&quot;ees&quot; and &quot;bes&quot; are allowed instead of &quot;dis&quot; and &quot;ais&quot;)</p>
<p>When you use &quot;fis&quot;, the &quot;dis&quot; key is automatically pressed too, because the &quot;fis&quot; key is always used with the &quot;dis&quot; key (note 9-10).</p></li>
<li><p><code>Lfore</code>: Left forefinger. Associated note: &quot;gis&quot; &quot;a&quot;</p>
<p>&quot;gis&quot; is automatically pressed when &quot;a&quot; is pressed.</p></li>
<li><p><code>Rring</code>: Right ring finger. Associated note: &quot;b&quot;</p></li>
<li><p><code>Lring</code>: Left ring finger. Associated note: &quot;dis&quot; (&quot;ees&quot; instead allowed).</p></li></ul>

To see all keys unpressed, specify a dummy value for the noteName, like in 13:

<pre>\clarTab ##t #'() #'((&quot;Rlittle&quot; . &quot;&quot;) (&quot;Llittle&quot; . &quot;&quot;)
                     (&quot;Rfore&quot; . &quot;&quot;)(&quot;Lfore&quot; . &quot;&quot;)
                     (&quot;Rring&quot; . &quot;&quot;)(&quot;Lring&quot; . &quot;&quot;))</pre>
Eventually, you can specify the size of the clarinet tablature by writing at the begining of the <code>.ly</code> file:

<pre>clarTabScale = #x</pre>
By default x=1. Specifying other values multiplies the size by <code>x</code>.

Example: <code>clarTabScale = #1.5</code>

<lilypond version="2.24.0" full>
%% http://lsr.di.unimi.it/LSR/Item?id=615

clarTabScale = #1

#(define postscript-init "
        /ellipsedict 8 dict def
        ellipsedict /mtrx matrix put
        /ellipse
        { ellipsedict begin
          /endangle exch def
          /startangle exch def
          /yrad exch def
          /xrad exch def
          /y exch def
          /x exch def

          /savematrix mtrx currentmatrix def
         x y translate
         xrad yrad scale
         0 0 1 startangle endangle arc
         savematrix setmatrix
       end
       } def
       /LW 0.04 def   LW setlinewidth
       /H 0 def

       /S ~a def
       0 -1.5 S mul translate
       S S scale
       ")

#(define losange-str " newpath -1.3 0 moveto -0.8 0.5 lineto -0.3 0 lineto
                -0.8 -0.5 lineto -1.3 0 lineto closepath ~a ")
#(define circle-str " newpath 0.5 H 0.5 0 360 arc ~a /H -1.3 H add def ")
#(define line-str "  0.15 setlinewidth newpath -0.2 H moveto 1.2 H lineto stroke
                    /H -1 H add def LW setlinewidth ")

#(define Rlittle1-str "newpath -0.7 H 0.65 0.32 30 330 ellipse ~a ") % keys low f# and e
#(define Rlittle2-str "1 setgray newpath 0.3 H 0.81 0.48 110 250 ellipse fill
                        0 setgray newpath 0.3 H 0.65 0.32 0 360 ellipse ~a ") % keys low f g#

#(define Lfore-a-str " newpath 0.5 1.1 0.25 0.4 0 360 ellipse ~a
                        newpath 0.5 1.5 moveto 0.5 1.7 lineto stroke ")
#(define Lfore-gis-str "0.02 setlinewidth
                        newpath 0.70 0.82 0.9 28 78 arc
                                0.70 0.82 0.92 78 14 arcn stroke
                        LW setlinewidth
                        newpath 1.4 0.7 0.25 0.6 0 360 ellipse ~a ")

#(define Llittle-cis-str " -0.6 -0.3 translate 15 rotate
                            newpath 1 -3.4 0.5 0.2 0 360 ellipse ~a
                            newpath 0.5 -2.43 1 -130 -90 arc stroke
                             -15 rotate 0.6 0.3 translate ")
#(define Llittle-f-str " 25 rotate newpath 0 -4.2 0.6 0.2 -135 140 ellipse ~a
                                    newpath 0 -4.2 0.6 0.2 -135 140 ellipse stroke
                         -25 rotate ")
#(define Llittle-e-str "
    1 setgray newpath 1.3 -4.5 0.4 0.7 0 360 ellipse fill 0 setgray
    newpath 1.5 -4.5 moveto 1.5 -6 lineto stroke
    newpath 1.3 -4.5 0.2 0.5 0 260 ellipse stroke
    newpath 1 -5.417 0.5 0 60 arc
     stroke ")
#(define Llittle-e-filled-str
  (string-append
     Llittle-e-str
     " newpath 1.3 -4.5 0.2 0.5 0 360 ellipse fill
       newpath 1.3 -5.0 moveto 1.5 -5.3 lineto 1.5 -4.5 lineto closepath fill "
     ))
#(define Llittle-fis-str "
    newpath 1.6 -4.9 moveto 1.6 -6 lineto stroke
    newpath 1.8 -4.9 0.2 0.5 -80 180 ellipse stroke
    newpath 2.1 -5.817 0.5 120 180 arc stroke")
#(define Llittle-fis-filled-str
  (string-append
    " newpath   1.8 -4.9 0.2 0.5 0 360 ellipse fill
      newpath 1.6 -5 moveto 1.6 -5.7 lineto 2 -5.1 lineto closepath fill "
     Llittle-fis-str ))

#(define Rfore-str " newpath -0.8 H 0.2 0.1 0 360 ellipse stroke
                     /H 0.3 H add def ")
#(define Rfore-str-filled
   (string-append " newpath -0.8 H 0.2 0.1 0 360 ellipse fill " Rfore-str))

#(define Lring-str " newpath 0.8 -1.95 0.5 0.08 0 360 ellipse  ~a ")
#(define Rring-str " newpath 0.2 -6.85 0.5 0.08 0 360 ellipse  ~a ")

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The main function %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#(define-markup-command (clarTab layout props twelfthKey? holes keysByFinger)
                        (boolean? list? list?)
 (let* (
   (finger-note #f)
   (state->string (lambda (fill?)(if fill? "fill" "stroke")))
   (closed? (lambda (n) (memq n holes)))
   (pressed? (lambda (note)(equal? note (cdr finger-note))))
   (twelfth-markup
     (if twelfthKey?
         (make-fontsize-markup -2
           (make-translate-markup '(-2.2 . -1.2)
             (make-number-markup "12")))
         ""))
   (s (string-append
        (begin
          (set! finger-note (assoc "Lfore" keysByFinger))
          (if finger-note
              (string-append
                (format #f Lfore-a-str (state->string (pressed? "a")))
                (format #f Lfore-gis-str
                           (state->string (or (pressed? "gis")(pressed? "a")))))
               ""))
        (format #f losange-str (state->string (closed? 0)))
        (format #f circle-str (state->string (closed? 1)))
        (format #f circle-str (state->string (closed? 2)))
        (format #f circle-str (state->string (closed? 3)))
        line-str
        (format #f circle-str (state->string (closed? 4)))
        (format #f circle-str (state->string (closed? 5)))
        (format #f circle-str (state->string (closed? 6)))
        (begin
          (set! finger-note (assoc "Rlittle" keysByFinger))
          (if finger-note
              (string-append
                  "/H 0.3 H add def "
                  (format #f Rlittle1-str (state->string (pressed? "fis")))
                  (format #f Rlittle2-str (state->string (pressed? "gis")))
                  "/H -0.8 H add def "
                  (format #f Rlittle1-str (state->string (pressed? "e")))
                  (format #f Rlittle2-str (state->string (pressed? "f"))))
               ""))
       (begin
          (set! finger-note (assoc "Llittle" keysByFinger))
          (if finger-note
              (string-append
                  (format #f Llittle-cis-str (state->string (pressed? "cis")))
                  (format #f Llittle-f-str (state->string (pressed? "f")))
                  " 0.11 0.1 translate "
                  (if (pressed? "e") Llittle-e-filled-str Llittle-e-str)
                  " 0.08 0 translate "
                  (if (pressed? "fis") Llittle-fis-filled-str Llittle-fis-str)
                  " -0.19 -0.10 translate ")
               ""))
      (begin
        (set! finger-note (assoc "Rfore" keysByFinger))
        (if finger-note
          (string-append
              " /H -4.3 def "
              (if (or (pressed? "dis")(pressed? "ees")(pressed? "fis"))
                  Rfore-str-filled Rfore-str)
              (if (pressed? "fis") Rfore-str-filled Rfore-str)
              (if (or (pressed? "ais")(pressed? "bes"))
                  Rfore-str-filled Rfore-str)
              (if (pressed? "b") Rfore-str-filled Rfore-str))
           ""))
      (begin
        (set! finger-note (assoc "Rring" keysByFinger))
        (if finger-note
            (format #f Rring-str (state->string (pressed? "b")))
            ""))
      (begin
        (set! finger-note (assoc "Lring" keysByFinger))
        (if finger-note
            (format #f Lring-str
                       (state->string (or (pressed? "dis")(pressed? "ees"))))
            ""))))) ;% end let* ...

  (interpret-markup layout props
    (make-line-markup (list
      (make-hspace-markup 0)
      (make-halign-markup -0.4 ;% try to align notes and holes ...
       (make-override-markup (cons 'baseline-skip (* clarTabScale 11))
              (make-column-markup (list
                     (make-with-dimensions-markup
                            (cons (* clarTabScale -1)(* clarTabScale 3))
                            '(0 . 0)
                        (make-overlay-markup (list
                            twelfth-markup
                            (make-postscript-markup (string-append
                              (format #f postscript-init clarTabScale) s)))))
                     (make-null-markup))))))))))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Test %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% uncomment this line for a better output :
%#(set-default-paper-size "a4" 'landscape)
#(set-global-staff-size 20)
#(ly:set-option 'point-and-click #f)

clarTabScale = #2  %% to change the size

\paper {
  system-system-spacing.basic-distance = 40
  tagline = ##f
}


%% \repeat "unfold" 8 %% uncomment to test the layout in several lines
  \relative c' {

    \override Voice.TextScript.padding = #2 % if you want the holes aligned ...
   %% \fatText % to force an enough space between notes ver 2.10
   \textLengthOn % to force an enough space between notes ver 2.11

    c^"1"_\markup \clarTab ##f #'(0 1 2 3) #'()
    fis^"2"_\markup \clarTab ##f #'(1) #'()
    cis'^"3"_\markup \clarTab ##t   #'(0 1 2 3 4 5 6) #'(("Rlittle" . "fis"))
    a^"4"_\markup \clarTab ##f #'() #'(("Lfore" . "a"))
    cis,^"5"_\markup \clarTab ##f   #'(0 1 2 3) #'(("Llittle" . "cis"))
    e,^"6"_\markup \clarTab ##f #'(0 1 2 3 4 5 6) #'(("Llittle" . "e")("Rlittle" . "f"))
    c''^"7"_\markup \clarTab ##t #'(0 1 2 3 4 5 6) #'(("Llittle" . "f"))
    cis^"8"_\markup \clarTab ##t #'(0 1 2 3 4 5 6) #'(("Llittle" . "fis"))
    dis,^"9"_\markup \clarTab ##f    #'(0 1 2) #'(("Rfore" . "dis"))
    \repeat "tremolo" 2
        { eis16 fis^"10"_\markup \clarTab ##f   #'(0)#'(("Rfore" . "fis"))   }
    \repeat "tremolo" 2
        { ais,16 b^"11"_\markup \clarTab ##f    #'(0 1 2 3 4)#'(("Rring" . "b"))}

    d16 dis^"12"_\markup \clarTab ##f #'(0 1 2) #'(("Lring" . "dis")) e8
    s1^"13"_\markup
        \clarTab ##t #'() #'(
                ("Rlittle" . "")("Llittle" . "")
                ("Rfore" . "")("Lfore" . "")
                ("Rring" . "")("Lring" . ""))
}
</lilypond>

[[Category:Instrument-specific]]
[[Category:Winds]]
[[Category:Symbols and glyphs]]
[[Category:Really cool]]