\version "2.19.15"

% FUNCIÓN "CENTER NOTE COLUMN": Escrita por Thomas Morley, colaboración de David Nalesnik.
% Usar \centerNoteColumnOn para empezar a centrar notas en el compás y \centerNoteColumnOff
% para dejar de hacerlo.
% Tomada de la lista de correo de usuarios de Lilypond address@hidden

% Thanks to David Nalesnik
    
#(define (sort-by-X-coord sys grob-lst)
"Arranges a list of grobs in ascending order by their X-coordinates"
   (let* ((X-coord (lambda (x) (ly:grob-relative-coordinate x sys X)))
          (comparator (lambda (p q) (< (X-coord p) (X-coord q)))))
          
     (sort grob-lst comparator)))
    
#(define (find-bounding-grobs note-column grob-lst)
   (let* ((sys (ly:grob-system note-column))
          (X-coord (lambda (n) (ly:grob-relative-coordinate n sys X)))
          (note-column-X (X-coord note-column)))
    
      (define (helper lst)
        (if (and (< (X-coord (car lst)) note-column-X)
                 (> (X-coord (cadr lst)) note-column-X))
            (cons (car lst) (cadr lst))
            (if (null? (cddr lst))
                (cons note-column note-column)
                (helper (cdr lst)))))
                
      (helper grob-lst)))        

#(define (read-out l1 l2)
   (define (helper ls1 ls2 ls3)
   "Filters all elements of ls1 from ls2 by their grob-name and appends it to ls3"
    (let ((grob-name-proc (lambda (x) (assq-ref (ly:grob-property x 'meta) 'name))))
     (if (null? ls1)
         ls3
         (helper
           (cdr ls1) 
           ls2 
           (append ls3 (filter (lambda (x) (eq? (car ls1) (grob-name-proc x))) ls2))))))
  (helper l1 l2 '()))
      
#(define ((center-note-column x-offs) grob)
     (let* ((sys (ly:grob-system grob))
            (elements-lst (ly:grob-array->list (ly:grob-object sys 'all-elements)))
            (grob-name (lambda (x) (assq-ref (ly:grob-property x 'meta) 'name)))
            (X-extent (lambda (q) (ly:grob-extent q sys X)))
      ;; NoteColumn
            (note-column-coord (ly:grob-relative-coordinate grob sys X))
            (grob-ext (X-extent grob))
            (grob-length (interval-length grob-ext))
      ;; NoteHeads
            (note-heads (ly:grob-object grob 'note-heads))
            (note-heads-grobs (if (not (null? note-heads))
                         (ly:grob-array->list note-heads)
                         '()))
            (one-note-head (if (not (null? note-heads-grobs))
                        (car note-heads-grobs)
                        '()))
            (one-note-head-length (if (not (null? one-note-head))
                             (interval-length (X-extent one-note-head)) ;; NB
                             0))
      ;; Stem
            (stem (ly:grob-object grob 'stem))
            (stem-dir (ly:grob-property stem 'direction))
            (stem-length-x (interval-length (X-extent stem))) ;; NB
      ;; DotColumn
            (dot-column (ly:note-column-dot-column grob))
      ;; AccidentalPlacement
            (accidental-placement (ly:note-column-accidentals grob))
      ;; Arpeggio
            (arpeggio (ly:grob-object grob 'arpeggio))
      ;; Rest
            (rest (ly:grob-object grob 'rest))
      ;; BassFigure + ChordName
            (other-grobs-to-center
               ;; TODO 
               ;; Not sure: What belongs to the list, what not?
               (list 'BassFigure
                     ;'BassFigureAlignment
                     ;'BassFigureAlignmentPositioning
                     'BassFigureBracket
                     'BassFigureContinuation
                     ;'BassFigureLine
                     'ChordName
                     'FretBoard
                     ))
            (all-other-grobs (read-out other-grobs-to-center elements-lst))
            (condensed-other-grobs
               (remove 
                 (lambda (x) 
                      (not (= (ly:grob-relative-coordinate x sys X)
                              note-column-coord))) 
                 all-other-grobs))
      ;; Grobs to center between
            (args (list 'BarLine 
             	        'Clef 
             	        'KeySignature
             	        'KeyCancellation
             	        'TimeSignature))
            (grob-lst (read-out args elements-lst)) 
            (new-grob-lst (remove (lambda (x) (interval-empty? (X-extent x))) grob-lst))
            (sorted-grob-lst (sort-by-X-coord sys new-grob-lst))
      ;; Bounds
            (bounds (find-bounding-grobs grob sorted-grob-lst))
            (left (cdr (X-extent (car bounds))))
            (right (car (X-extent (cdr bounds))))
            
            ;;(bounds-coord (cons left right)) ;; delete
            
            (basic-offset
              (- (average left right)
                 (interval-center (X-extent grob))
                 (* -1 x-offs)))
            (dir-correction
              (if (> grob-length one-note-head-length)
                  (* stem-dir (* -2 stem-length-x) grob-length)
                  0))
            ) ;; End of Defs in let*
         
   ;; Calculation
   (begin
     ;; (display "\n\taccidental-placement: \t")(write accidental-placement)
     (for-each
       (lambda (x)
         (cond ((ly:grob? x)
                (ly:grob-translate-axis!
                  x
                  (- basic-offset dir-correction)
                  X))))
         (append
            (list
              (cond ((not (null? note-heads)) grob))
              dot-column 
              accidental-placement 
              arpeggio) 
            condensed-other-grobs)))))

centerNoteColumnOn = \override Staff.NoteColumn #'after-line-breaking = #(center-note-column 0)

centerNoteColumnOff = \revert Staff.NoteColumn #'after-line-breaking

onceCenterNoteColumn =
#(define-music-function (parser location x-offs)(number?)
#{
        \once \override Staff.NoteColumn #'after-line-breaking = #(center-note-column x-offs)
#})


global = {
  \key a \major
  \time 4/4
  \partial 4
}

pianoDerI = \relative c'' {
  \global
  \voiceOne
  a4						|
  a e' e( d8[ cis]				|
  b4) cis d8[ cis] b4				|
  a2\fermata r4 a				|
  b cis d b					|
  
  e fis e\fermata cis				|
  cis8[ d] e4 d cis8[( b])			|
  a[( b] cis4) b\fermata cis			|
  a b8[ cis] d4\fermata cis			|
  
  b cis d\fermata cis				|
  b a e'4.( d8					|
  cis4) d8[ cis] b2				|
  \centerNoteColumnOn a2.\fermata \bar "|."
}

pianoDerII = \relative c' {
  \global
  \voiceTwo
  fis4						|
  e8( fis gis a b4) e,				|
  dis e d8 a' gis4				|
  e2 r4 fis					|
  fis e8( cis) gis'( fis) e( dis)		|
  
  e[ fis16 gis a8] fis gis4 a			|
  a ais b8 a gis fis				|
  e[( fis16 gis a8 fis]) gis4 a8[ gis]		|
  fis4. gis16 ais b4 ais!			|
  
  b8 a g4 fis e8 a~(				|
  a gis4) fis8 gis a b4~			|
  b8 e, a4 a( gis)				|
  e2.
}

pianoIzqI = \relative c' {
  \global
  \voiceOne
  cis8 d					|
  e4 d8 cis b4( a				|
  b) a8 g a4 e'8 d				|
  cis2 r4 a					|
  a gis b8( a) b4				|
  
  b8( e4) dis8 e4 e				|
  fis fis fis e					|
  e8( d cis dis) e4 e				|
  d8( cis) d( e) fis4 fis8 e			|
  
  d4 e a, a					|
  b cis8 dis e2~				|
  e8 cis a cis fis d b e			|
  \centerNoteColumnOn cis2.
}

pianoIzqII = \relative c {
  \global
  \voiceTwo
  fis4						|
  cis' b8 a gis4 a~				|
  a8 g fis e fis d e4				|
  a,2\fermata r4 d				|
  dis8 e4 eis fis8 gis a			|
  
  gis e b'4 e,\fermata a8 gis			|
  fis e d cis b4 e8 d				|
  cis( b a4) e'\fermata a,			|
  d8 e d cis b4\fermata fis'			|
  
  g8 fis e4 d\fermata a				|
  e'2~ e8 fis gis e				|
  a gis fis e d( b e4)				|
  a,2.\fermata
}

\score {
  <<
    \new PianoStaff \with { instrumentName = "Piano" } <<
      \new Staff = "right" <<
        \new Voice \pianoDerI
        \new Voice \pianoDerII
      >>
      \new Staff = "left" <<
        \clef bass 
        \new Voice \pianoIzqI
        \new Voice \pianoIzqII
      >>
    >>
  >>
}