1

Does Lilypond offers keyboard diagramms?

I've seen that there are guitar diagramms (aka FretBoards). But I can not find something similar for keyboard/piano.

enter image description here

1 Answer 1

4

No, but we can draw them ourselves:

#(define (normalize-pitch-to-single-or-no-sharp p)
   (cond ((< (ly:pitch-alteration p) 0) ; raise flats
          (normalize-pitch-to-single-or-no-sharp (ly:pitch-transpose p (ly:make-pitch 0 -1 1/2))))
         ((or (> (ly:pitch-alteration p) 1/2) ; raise double sharps
              (and (> (ly:pitch-alteration p) 0) ; and single sharps for
                   (or (= (ly:pitch-notename p) 2) ; e
                       (= (ly:pitch-notename p) 6)))) ; b
          (normalize-pitch-to-single-or-no-sharp (ly:pitch-transpose p (ly:make-pitch 0 1 -1))))
         (else p)))

#(define (key-stencil length width bside blength bwidth bfac thickness fill)
   (cond ((not bside)
          (make-path-stencil
           `(
              moveto ,(/ thickness 2) ,(/ thickness -2)
              lineto ,(/ thickness 2) ,(- (/ thickness 2) length)
              lineto ,(- width (/ thickness 2)) ,(- (/ thickness 2) length)
              lineto ,(- width (/ thickness 2)) ,(/ thickness -2)
              closepath
            )
           thickness
           1 1 fill))
         ((< bside 0)
          (make-path-stencil
           `(
              moveto ,(/ thickness 2) ,(/ thickness -2)
              lineto ,(/ thickness 2) ,(- 0 (/ thickness 2) blength)
              lineto ,(- (/ thickness 2) (* bfac bwidth)) ,(- 0 (/ thickness 2) blength)
              lineto ,(- (/ thickness 2) (* bfac bwidth)) ,(- (/ thickness 2) length)
              lineto ,(- width (* bfac bwidth) (/ thickness 2)) ,(- (/ thickness 2) length)
              lineto ,(- width (* bfac bwidth) (/ thickness 2)) ,(/ thickness -2)
              closepath
            )
           thickness
           1 1 fill))
         ((> bside 0)
          (make-path-stencil
           `(
              moveto ,(/ thickness 2) ,(/ thickness -2)
              lineto ,(/ thickness 2) ,(- (/ thickness 2) length)
              lineto ,(- width (/ thickness 2)) ,(- (/ thickness 2) length)
              lineto ,(- width (/ thickness 2)) ,(- (/ thickness -2) blength)
              lineto ,(- width (* bfac bwidth) (/ thickness 2)) ,(- (/ thickness -2) blength)
              lineto ,(- width (* bfac bwidth) (/ thickness 2)) ,(/ thickness -2)
              closepath
            )
           thickness
           1 1 fill))
         (else
          (make-path-stencil
           `(
              moveto ,(/ thickness 2) ,(/ thickness -2)
              lineto ,(/ thickness 2) ,(- (/ thickness -2) blength)
              lineto ,(- (/ thickness 2) (* bfac bwidth)) ,(- (/ thickness -2) blength)
              lineto ,(- (/ thickness 2) (* bfac bwidth)) ,(- (/ thickness 2) length)
              lineto ,(- width (* bfac bwidth) (/ thickness 2)) ,(- (/ thickness 2) length)
              lineto ,(- width (* bfac bwidth) (/ thickness 2)) ,(- (/ thickness -2) blength)
              lineto ,(- width (* 2 bfac bwidth) (/ thickness 2)) ,(- (/ thickness -2) blength)
              lineto ,(- width (* 2 bfac bwidth) (/ thickness 2)) ,(/ thickness -2)
              closepath
            )
           thickness
           1 1 fill))))

#(define (bkey-stencil blength bwidth bfac thickness fill extrashift)
   (ly:stencil-translate-axis
    (make-path-stencil
      `(
        moveto ,(- (/ thickness 2) (* bfac bwidth)) ,(/ thickness -2)
        lineto ,(- (/ thickness 2) (* bfac bwidth)) ,(- (/ thickness 2) blength)
        lineto ,(- bwidth (* bfac bwidth) (/ thickness 2)) ,(- (/ thickness 2) blength)
        lineto ,(- bwidth (* bfac bwidth) (/ thickness 2)) ,(/ thickness -2)
        closepath
       )
      thickness
      1 1 fill)
    extrashift X))
    

#(define kbd-bside-map
   (list 1 0 -1 1 0 0 -1))

#(define (magstep->ss val layout)
   (let* ((base-font-size (ly:output-def-lookup layout 'text-font-size 11))
          (pt (* base-font-size (magstep val)))
          (rel-staff-space (ly:output-def-lookup layout 'staff-space 1))
          (base-staff-space (* 5 (/ base-font-size 11)))
          (fact (* rel-staff-space base-staff-space)))
     (/ pt fact)))

#(define (scaled-font-size val layout props)
   (let ((font-size (chain-assoc-get 'font-size props 0)))
     (magstep->ss (+ font-size (magnification->font-size val)) layout)))

#(define-markup-command (kbd-key layout props p) (ly:pitch?)
   #:properties ((thickness 0.1)
                 (keylength 3)
                 (bkeylength 2)
                 (keywidth 0.9)
                 (bkeywidth (* 0.9 2/3))
                 (bkeyfac 1/2)
                 (bkeyfill #t)
                 (shorten-bkey 0)
                 (thin-bkey 0)
                 (key-color #f)
                 (bkey-color #f)
                 (indicator-height 0.3)
                 (indicator-width 0.3)
                 (indicator-color #f)
                 (show-indicator #f)
                 (force-no-left-bside #f)
                 (force-no-right-bside #f))

   (let* ((p (normalize-pitch-to-single-or-no-sharp p))
          (nn (ly:pitch-notename p))
          (a (ly:pitch-alteration p)))
     (let* ((bside (list-ref kbd-bside-map nn))
            (bside (if force-no-left-bside
                       (cond ((< bside 0) #f)
                             ((= bside 0) RIGHT)
                             (else bside))
                       bside))
            (bside (if force-no-right-bside
                       (cond ((> bside 0) #f)
                             ((= bside 0) LEFT)
                             (else bside))
                       bside))
            (stc
             (if (> a 0)
                 (bkey-stencil
                  (- (scaled-font-size bkeylength layout props) shorten-bkey)
                  (- (scaled-font-size bkeywidth layout props) thin-bkey)
                  bkeyfac
                  thickness
                  (or bkeyfill bkey-color)
                  (- (/ thin-bkey 2)))
                 (key-stencil
                  (scaled-font-size keylength layout props)
                  (scaled-font-size keywidth layout props)
                  bside
                  (scaled-font-size bkeylength layout props)
                  (scaled-font-size bkeywidth layout props)
                  bkeyfac
                  thickness
                  key-color)))
            (stc (cond ((and (> a 0) bkey-color) (stencil-with-color stc bkey-color))
                       ((and (= a 0) key-color) (stencil-with-color stc key-color))
                       (else stc))))
       (if show-indicator
           (let* ((bside (or bside 0))
                  (w (scaled-font-size indicator-width layout props))
                  (h (scaled-font-size indicator-height layout props))
                  (ind (make-path-stencil
                        `(
                           moveto 0 ,(/ thickness 2)
                           lineto ,(- (/ w 2) (/ thickness 2)) ,(- h (/ thickness 2))
                           lineto ,(- (/ w -2) (/ thickness -2)) ,(- h (/ thickness 2))
                           closepath
                         )
                        thickness
                        1 1
                        indicator-color))
                  (iexty (ly:stencil-extent ind Y))
                  (ind (ly:make-stencil (ly:stencil-expr ind) '(0 . 0) iexty))
                  (ind (if indicator-color
                           (stencil-with-color ind indicator-color)
                           ind))
                  (x (interval-center (ly:stencil-extent stc X)))
                  (ind (ly:stencil-translate-axis ind x X))
                  (ind (ly:stencil-translate-axis
                        ind
                        (cond ((and (= a 0)
                                    (< bside 0))
                               (* bkeyfac (scaled-font-size bkeywidth layout props) 1/2))
                              ((and (= a 0)
                                    (> bside 0))
                               (* bkeyfac (scaled-font-size bkeywidth layout props) -1/2))
                              (else 0))
                        X)))
             (ly:stencil-add stc ind))
           stc))))

#(define-markup-command (draw-circle-scaled layout props radius thickness fill)
   (number? number? boolean?)
   (interpret-markup layout props
                     (markup #:draw-circle (scaled-font-size radius layout props) thickness fill)))

#(define-markup-command (vcenter-at-middle layout props mup) (markup?)
   (let ((stc (interpret-markup layout props mup))
         (em (cdr (ly:stencil-extent (interpret-markup layout props "M") Y))))
     (ly:stencil-translate-axis
      (ly:stencil-aligned-to stc Y CENTER)
      (/ em 2)
      Y)))

#(define-public (custom-note-name->markup pitch)
  (let ((str (note-name->string pitch)))
    (markup #:concat (
      (make-simple-markup (string-capitalize str))
      (make-vcenter-at-middle-markup
       ((@@ (lily) accidental->markup) (ly:pitch-alteration pitch)))))))

#(define-markup-command (kbd-key-with-marker layout props pitch) (ly:pitch?)
   #:properties ((marker-radius 0.3)
                 (marker-color "black")
                 (bmarker-color "white")
                 (bkeyfill #t)
                 (marker-as-text #f)
                 (marker-text #f)
                 (marker-key-color #f)
                 (marker-bkey-color #f)
                 (marker-hide-marker #f)
                 (thickness 0.1))
   (let* ((p (normalize-pitch-to-single-or-no-sharp pitch))
          (a (ly:pitch-alteration p))
          (key-stc
           (interpret-markup layout props
                             (if (and (> a 0) marker-bkey-color)
                                 (markup #:override (cons 'bkey-color marker-bkey-color)
                                         #:kbd-key p)
                                 (if (and (= a 0) marker-key-color)
                                     (markup #:override (cons 'key-color marker-key-color)
                                             #:kbd-key p)
                                     (markup #:kbd-key p))))))
     (if marker-hide-marker
         key-stc
         (let* ((marker-mup (if marker-as-text
                                (if marker-text
                                    marker-text
                                    (custom-note-name->markup pitch))
                                (markup #:draw-circle-scaled marker-radius 0 #t)))
                (marker-stc-r (interpret-markup layout props marker-mup))
                (f (/ (* (- (interval-length (ly:stencil-extent key-stc X)) (* 2 thickness)) 0.95)
                      (interval-length (ly:stencil-extent marker-stc-r X))))
                (marker-stc (interpret-markup layout props
                                              (markup #:fontsize (min (magnification->font-size f) 0)
                                                      marker-mup)))
                (marker-stc (if (and (> a 0) bkeyfill)
                                (ly:stencil-in-color marker-stc bmarker-color)
                                (ly:stencil-in-color marker-stc marker-color)))
                (x (interval-center (ly:stencil-extent key-stc X)))
                (y (+ (car (ly:stencil-extent key-stc Y))
                      (/ (max
                          (interval-length (ly:stencil-extent key-stc X))
                          (+ (* 2 thickness) (interval-length (ly:stencil-extent marker-stc Y))))
                         2)))
                (marker-stc
                 (ly:stencil-translate
                  (ly:stencil-aligned-to
                   (ly:stencil-aligned-to marker-stc X CENTER)
                   Y CENTER)
                  (cons x y))))
           (ly:stencil-add key-stc marker-stc))))) 


%\markup \override #'(marker-as-text . #t) \kbd-key-with-marker { c }
%\markup \kbd-key-with-marker { c }

%\markup \override #'(marker-as-text . #t) \kbd-key-with-marker { cis }
%\markup \kbd-key-with-marker { cis }

%\markup \override #'(marker-as-text . #t) \kbd-key-with-marker { cisis }
%\markup \kbd-key-with-marker { cisis }

#(define-markup-command (keyboard-stencil layout props pitches)
   ((lambda (x) (or (ly:music? x) (ly:pitch? x)
                    (and (list? x)
                         (fold (lambda (p prev) (and prev (ly:pitch? p))) #t x)))))
   #:properties ((keygap 0.05) (minsemitone #f) (maxsemitone #f)
                 (indicator-at #f)
                 (round-to-octaves #t)
                 (add-binding-line #f)
                 (thickness 0.1))
   (define (collapse idx p)
     (define (icollapse idx2 p2)
       (if (null? idx2)
           (cons (cons idx2 p2) '())
           (if (= (car idx) (car idx2))
               (let ((p (icollapse (cdr idx2) (cdr p2))))
                 (cons (car p) (cons (car p2) (cdr p))))
               (cons (cons idx2 p2) '()))))
     (if (null? idx)
         '()
         (let ((pair (icollapse idx p)))
           (cons (cons (car idx) (cdr pair))
                 (collapse (caar pair) (cdar pair))))))
   (define (create-marker-text ps)
     (markup #:override '(baseline-skip . 0)
             (make-column-markup (map (lambda (x) (custom-note-name->markup x)) ps))))
   (define (create-keyboard-stencils i min max map)
     (if (> i max)
         '()
         (let* ((p (normalize-pitch-to-single-or-no-sharp (ly:make-pitch 0 0 (/ i 2))))
                (m (if (and (not (null? map)) (= (caar map) i))
                       (markup #:override (cons 'marker-text (create-marker-text (cdar map)))
                               #:override (cons 'shorten-bkey keygap)
                               #:override (cons 'thin-bkey keygap)
                               #:kbd-key-with-marker p)
                       (markup #:override (cons 'shorten-bkey keygap)
                               #:override (cons 'thin-bkey keygap)
                               #:kbd-key p)))
                (m (if (and indicator-at (= indicator-at i))
                       (markup #:override '(show-indicator . #t) m)
                       m))
                (m (if (= i min)
                       (markup #:override '(force-no-left-bside . #t) m)
                       m))
                (m (if (= i max)
                       (markup #:override '(force-no-right-bside . #t) m)
                       m)))
           (cons (interpret-markup layout props m)
                 (create-keyboard-stencils (1+ i) min max
                                           (if (and (not (null? map)) (= (caar map) i))
                                               (cdr map)
                                               map))))))
   (define (stack-keys gap stcs carry i)
     (if (null? stcs)
         '()
         (cons (ly:stencil-translate-axis (car stcs) carry X)
               (stack-keys gap (cdr stcs)
                           (+ carry
                              (cdr (ly:stencil-extent (car stcs) X))
                              gap)
                           (1+ i)))))
   (let* ((pitches (cond ((ly:music? pitches)
                          (map (lambda (m) (ly:music-property m 'pitch))
                               (extract-named-music pitches 'NoteEvent)))
                         ((ly:pitch? pitches) (list pitches))
                         (else pitches)))
          (pitches (sort! pitches ly:pitch<?))
          (npitches (map ly:pitch-semitones pitches))
          (pitchmap (collapse npitches pitches))
          (mins (if (null? npitches) +inf.0 (first npitches)))
          (maxs (if (null? npitches) -inf.0 (last npitches)))
          (mins (if round-to-octaves (* (floor-quotient mins 12) 12) mins))
          (maxs (if round-to-octaves (1- (* (1+ (floor-quotient maxs 12)) 12)) maxs))
          (mins (if minsemitone (if (< minsemitone mins) minsemitone mins) mins))
          (maxs (if maxsemitone (if (> maxsemitone maxs) maxsemitone maxs) maxs))
          (stcs (create-keyboard-stencils mins mins maxs pitchmap))
          (stc (apply ly:stencil-add (stack-keys keygap stcs 0 mins)))
          (ext (ly:stencil-extent stc X))
          (stc (if add-binding-line
                   (ly:stencil-add
                    stc
                    (make-line-stencil thickness 
                                       (+ (car ext) (/ thickness 2))
                                       (/ thickness -2)
                                       (- (cdr ext) (/ thickness 2))
                                       (/ thickness -2)))
                   stc)))
     (ly:stencil-aligned-to stc Y DOWN)))

\markup\override #'(baseline-skip . 9) \column {
  \keyboard-stencil { c deses e g bes }
  
  \override #'((marker-as-text #t) (add-binding-line . #t))
  \keyboard-stencil { c deses e g bes }
  
  \override #'(bkeyfill . #f)
  \keyboard-stencil { c e g d'' fis'' }
  
  \override #'((marker-color . "blue") (bmarker-color . "red"))
  \fontsize #-3
  \keyboard-stencil { c e g d' fis' }
  
  \override #'((marker-color . "blue") (bmarker-color . "red"))
  \fontsize #-5
  \override #'(marker-as-text . #t)
  \keyboard-stencil { c e g d' fis' }
  
  \override #'((key-color . "lightgrey"))
  \keyboard-stencil { c e g d' fis' }
 
  \override #'((key-color . "lightgrey") (marker-key-color . "orange") (marker-bkey-color . "red")
               (add-binding-line #t))
  \keyboard-stencil { c e g d' fis' }
  
  \override #'((key-color . "lightgrey") (marker-key-color . "orange") (marker-bkey-color . "red")
               (marker-hide-marker . #t))
  \keyboard-stencil { c e g d' fis' }

  \override #'((key-color . "lightgrey") (marker-key-color . "orange") (marker-bkey-color . "red")
               (marker-hide-marker . #t) (minsemitone . 12) (maxsemitone . 23))
  \keyboard-stencil { c e g }

  \override #'((key-color . "lightgrey") (marker-key-color . "orange") (marker-bkey-color . "red")
               (marker-hide-marker . #t) (minsemitone . 12) (maxsemitone . 23)
               (indicator-at . 0))
  \keyboard-stencil { c e g }
  
  \override #'((key-color . "lightgrey") (marker-key-color . "orange") (marker-bkey-color . "red")
               (marker-hide-marker . #t) (minsemitone . 12) (maxsemitone . 23)
               (indicator-at . 0) (indicator-color . "green") (keygap . 0.1))
  \keyboard-stencil { c e g }
  
  \override #'((key-color . "lightgrey") (marker-key-color . "orange") (marker-bkey-color . "red")
               (marker-hide-marker . #t) (minsemitone . 12) (maxsemitone . 23)
               (indicator-at . 0) (indicator-color . "green") (keygap . 0.1)
               (keylength . 4) (bkeylength . 2.5)
               (indicator-height . 0.4) (indicator-width . 0.8))
  \keyboard-stencil { c e g }

  \keyboard-stencil { c }

  \keyboard-stencil #(list (ly:make-pitch 0 0) (ly:make-pitch 0 2) (ly:make-pitch 0 4))
  
  \override #`((minsemitone . ,(ly:pitch-semitones #{ a,,, #}))
               (maxsemitone . ,(+ 87 (ly:pitch-semitones #{ a,,, #}))))
  \keyboard-stencil { c g c' e' g' }
  
  \line { \keyboard-stencil { } "← empty" }
  
  \override #`((minsemitone . ,(ly:pitch-semitones #{ a,,, #}))
               (maxsemitone . ,(+ 87 (ly:pitch-semitones #{ a,,, #})))
               (add-binding-line #t))
  \keyboard-stencil { }
  
  \override #'((round-to-octaves . #f) (indicator-at . 0))
  \keyboard-stencil { a c' e' g' }
}

enter image description here

13
  • Interestingly, entering just one argument produces and error, e.g. \keyboard-stencil { c }. But you can get around this by using a rest for the second argument, e.g. \keyboard-stencil { c r }. Sep 17 at 11:42
  • 1
    @ElementsinSpace This is because { c } will be parsed as pitch, unlike e.g. { c4 }. I’ve updated the code to allow for single pitches and lists of pitches. Also I’ve fixed a few things.
    – Lazy
    Sep 17 at 12:23
  • Also improved rendering of accidentals.
    – Lazy
    Sep 17 at 12:54
  • If you want another aspect of your code to work on, I'd suggest improving the displayed range. It'd be nice if you could optionally specify the highest and lowest keys shown, and if there was a parameter to show a full keyboard (88, 76, 61, 49, or 32 keys). Sep 17 at 12:58
  • 1
    @ElementsinSpace The only problem here is that this will handle the bottom a and the top c as if they had a right / left black neighbor. I will fix this immediately!
    – Lazy
    Sep 17 at 19:34

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.