\version "2.14.2"

% lilypond aatest-01.ly &>all.log
% schreibt alle log-Meldungen in das file: "all.log"

% lilypond aatest-01.ly |less &>all.log
% schreibt den less-output in das file: "all.log"

\version "2.14.2"

#(define (read-out ls1 ls2 ls3 symbol)
"Filters all elements of ls1 from ls2 and appends it to ls3 by their grob-name"
(set! ls3 (append ls3 (filter (lambda (x) (eq? (car ls1) (symbol x))) ls2)))
  (if (null? (cdr ls1))
      ls3
      (read-out (cdr ls1) ls2 ls3 symbol)))
      
#(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 (shorten-list l1 l2 sys)
  "Deletes every element of the (sorted) list l1 which is greater than
   the last element of the (sorted) list l2 by their X-coord"
  (let* ((X-coord (lambda (n) (ly:grob-relative-coordinate n sys X))))
     (if (not (> (X-coord (car (last-pair l1))) (X-coord (car (last-pair l2)))))
         l1
         (begin
         (set! l1 (reverse (cdr (reverse l1))))
         (shorten-list l1 l2 sys)))))
     
#(define (list-helper-2 ls obj)
  "Search the first element of the lst, which is greater than obj by their X-coord.
  ls is supposed to be a sorted list '(small ... great)"
  (let* ((sys (ly:grob-system obj))
        (X-coord (lambda (n) (ly:grob-relative-coordinate n sys X))))
          (if (> (X-coord (car ls)) (X-coord obj))
              (car ls)
              (if (null? (cdr ls))
                  (begin 
                    (display "no member of the list is greater than the object")
                    (newline))
                  (list-helper-2 (cdr ls) obj)))))
     
#(define (delete-adjacent-duplicates lst)
  "Deletes adjacent duplicates in lst
  eg. '(1 1 2 2) -> '(1 2)"
            (fold-right (lambda (elem ret)
                          (if (equal? elem (first ret))
                              ret
                              (cons elem ret)))
                        (list (last lst))
                        lst))

#(define (read-out-note-columns 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)))
            (X-coord (lambda (n) (ly:grob-relative-coordinate n sys X)))
            (args (list 'BarLine 
             	        'TimeSignature
             	        'KeySignature
             	        'KeyCancellation
             	        'Clef))
            (grob-lst (read-out args elements-lst '() grob-name))
            (new-grob-lst (remove (lambda (x) (interval-empty? (X-extent x))) grob-lst))
            (sorted-grob-lst (sort-by-X-coord sys new-grob-lst))
            (note-column-lst (read-out (list 'NoteColumn) elements-lst '() grob-name))
            (new-note-column-lst (remove (lambda (x) (interval-empty? (X-extent x))) note-column-lst))
            (sorted-note-column-lst (sort-by-X-coord sys new-note-column-lst))
            (new-sorted-grob-lst (shorten-list sorted-grob-lst sorted-note-column-lst sys))
            
            (beat-one-nc-grobs (delete-adjacent-duplicates 
            		(map 
            		  (lambda (x) (list-helper-2 sorted-note-column-lst x)) 
            		    new-sorted-grob-lst)))
            (x-coords-beat-one-nc-grobs (map X-coord beat-one-nc-grobs))) ;end of let*
            
        (begin
            (display x-coords-beat-one-nc-grobs)
            (newline)
        ;;;; for test: comment in!
        ;;;; notice: the test is implemented for note-heads only!
        ;;;;         (rests on beat one will produce an ERROR with the test, 
        ;;;;         but the test-functionality may be extended ... ) 
        
;;           (let* ((note-heads (map (lambda (x) (ly:grob-object x 'note-heads)) beat-one-nc-grobs))
;;                  (note-heads-grobs (map (lambda (x)
;;                  	(if (not (null? x))
;;           		  (ly:grob-array->list x)
;;           		  '())) note-heads))
;;                  (color (lambda (x) (ly:grob-set-property! (car x) 'color red)))
;;           		 )
;;           (map color note-heads-grobs))
            )))
     
barLineTest = \override NoteColumn #'after-line-breaking = #read-out-note-columns
      
\relative c' {
        \barLineTest 
        \repeat unfold 10 { c2 c4 c8 r }
}