Hi Werner,
2012/1/25 Werner LEMBERG <w...@gnu.org>:
>
> To all Scheme gurus:
>
> I want to collect the horizontal positions of all bar lines (or
> rather, the position of the first beat in a bar) within an output text
> file.
>
> Has someone written something similarly, possibly sharing his or her
> code?
>
>
> Werner
>
> _______________________________________________
> lilypond-user mailing list
> lilypond-user@gnu.org
> https://lists.gnu.org/mailman/listinfo/lilypond-user
I'm not a scheme guru (so I'm sure the code could be more elegant) but
the attached file seems to work (reading out every NoteColumn on the
first beat of a measure).
If you want to test, comment in the excluded lines, which colors
note-heads on the first beat.
Please notice that the test will work for noteheads only (I didn't
implemented coloring rests on beat one so far, but reading out their
horizontal position by their x-coordinate _is_ supported)
I never tried before to create an textfile from a displayed output.
But I figured out right now that typing
lilypond aatest-01.ly |less &>aatest-01.log
will do so (at least on my Linux-machine). Perhaps there is a better way.
One Problem: I couldn't get rid of the duplications in the log-file.
HTH,
Harm
\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 }
}
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(17.2358207716535 35.6404419582569 54.0450631448603 72.4496843314637 90.8543055180671)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
(5.8 26.5152836027936 47.2305672055873 67.9458508083809 88.6611344111746)
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
