lilypond-user
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: printing bar line positions into a file


From: Werner LEMBERG
Subject: Re: printing bar line positions into a file
Date: Sun, 29 Jan 2012 08:26:45 +0100 (CET)

>> 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.
>
> 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).

Thanks a lot!  I've refined your solution, renamed stuff, adding
comments, etc.  Please see the attached file.


    Werner
% beat-one-note-columns.ly
%
% Print horizontal coordinates of first beats.  See below for function
% `beat-one-note-columns' and an example.
%
%   Written originally by Thomas Morley <address@hidden>.
%   Refined by Werner Lemberg <address@hidden>.
%
% tested with LilyPond versions 2.14.2 and 2.15.27

#(define (read-out in pool out symbol)
  "Filter out all elements of list IN which are in list POOL, then
append them to list OUT.  The predicate SYMBOL gets applied to the
elements of POOL to test for equality with the elements of IN."
  (set! out (append out
                    (filter (lambda (x)
                              (eq? (car in) (symbol x)))
                            pool)))
  (if (null? (cdr in)) out
      (read-out (cdr in) pool out symbol)))

#(define (sort-grobs-horizontally refpoint grobs)
  "Sort GROBS, a list of grobs (relative to grob REFPOINT), in
horizontal order."
  (let* ((get-x-coord (lambda (grob)
                        (ly:grob-relative-coordinate grob refpoint X)))
         (comparator (lambda (grob1 grob2)
                       (< (get-x-coord grob1) (get-x-coord grob2)))))
    (sort grobs comparator)))

#(define (cut-grobs-horizontally grobs reference refpoint)
  "Delete all elements of the horizontally sorted grob list GROBS
which have a larger X-coordinate (relative to REFPOINT) than the last
element of the horizontally sorted grob list REFERENCE."
  (let* ((get-x-coord (lambda (grob)
                        (ly:grob-relative-coordinate grob refpoint X))))
    (if (not (> (get-x-coord (car (last-pair grobs)))
                (get-x-coord (car (last-pair reference)))))
        grobs
        (begin
          (set! grobs (reverse (cdr (reverse grobs))))
          (cut-grobs-horizontally grobs reference refpoint)))))

#(define (search-grob-horizontally grobs reference)
  "Search the first element of the horizontally sorted grob list GROBS
which has a larger X-coordinate than the grob REFERENCE."
  (let* ((system (ly:grob-system reference))
         (x-coord (lambda (grob)
                    (ly:grob-relative-coordinate grob system X))))
    (if (> (x-coord (car grobs)) (x-coord reference))
        (car grobs)
        (if (null? (cdr grobs))
            (begin
              (display "no member of the list is greater than the reference")
              (newline))
            (search-grob-horizontally (cdr grobs) reference)))))

#(define (delete-adjacent-duplicates lst)
  "Delete adjacent duplicates in LST.  Example: '(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 (beat-one-note-columns anchor)
  "Append list of horizontal positions of the first beats of the
current system's bars to a file.

The file name is given by the global option @code{beat-one-file}, to
be set on the command line with @address@hidden or
within a LilyPond input file using @code{#(ly:set-option
'beat-one-file @var{FILE})}.  Expect a harmless warning @code{no such
internal option: beat-one-file} which can be safely ignored.

If no file name is specified, write to standard output.

Use this function as an argument to the @code{after-line-breaking}
property of e.g. @code{StaffSymbol}."
  (let* ((output-name (ly:get-option 'beat-one-file))
         (output (current-output-port))

         (system (ly:grob-system anchor))
         (all-grobs (ly:grob-array->list
                    (ly:grob-object system 'all-elements)))

         ;; auxiliary predicates
         (grob-name (lambda (grob)
                      (assq-ref (ly:grob-property grob 'meta) 'name)))
         (x-extent (lambda (grob)
                     (ly:grob-extent grob system X)))
         (x-coord (lambda (grob)
                    (ly:grob-relative-coordinate grob system X)))

         ;; a list of grobs which can occur right before a `beat one'
         (before-beat-one-grobs (list 'BarLine
                                      'TimeSignature
                                      'KeySignature
                                      'KeyCancellation
                                      'Clef))

         ;; filter out everything else and sort the list
         (grobs-raw
          (read-out before-beat-one-grobs all-grobs '() grob-name))
         (grobs (remove (lambda (grob)
                          (interval-empty? (x-extent grob)))
                        grobs-raw))
         (sorted-grobs (sort-grobs-horizontally system
                                                grobs))

         ;; get a sorted list of all (non-zero) NoteColumn grobs
         (note-columns-raw
          (read-out (list 'NoteColumn) all-grobs '() grob-name))
         (note-columns (remove (lambda (grob)
                                 (interval-empty? (x-extent grob)))
                               note-columns-raw))
         (sorted-note-columns (sort-grobs-horizontally system
                                                       note-columns))

         ;; remove grobs which are too far to the right
         (cut-grobs (cut-grobs-horizontally sorted-grobs
                                            sorted-note-columns
                                            system))
        
         ;; get a list of all NoteColumn grobs (without duplicates)
         ;; which come immediately after `before beat one' grobs
         (beat-one-grobs
          (delete-adjacent-duplicates
           (map (lambda (grob)
                  (search-grob-horizontally sorted-note-columns grob))
                cut-grobs)))

         ;; extract horizontal coordinates
         (x-coords-beat-one-grobs (map x-coord beat-one-grobs)))

    ;; body
    (if output-name
        (set! output (open-file output-name "a")))
    (display x-coords-beat-one-grobs output)
    (newline output)
    (if output-name
        (close-port output))))


%%%%%%%%%


%{

  % sample call

  #(ly:set-option 'beat-one-file "foo")

  printXPos = \override Staff.StaffSymbol
                 #'after-line-breaking = #beat-one-note-columns

  \relative c' {
    \printXPos
    \repeat unfold 10 { c2 c4 c8 r }
  }

%}

% EOF

reply via email to

[Prev in Thread] Current Thread [Next in Thread]