]> git.donarmstrong.com Git - lilypond.git/blob - ly/event-listener.ly
Merge branch 'fixedmerge' into HEAD
[lilypond.git] / ly / event-listener.ly
1 %%%% This file is part of LilyPond, the GNU music typesetter.
2 %%%%
3 %%%% Copyright (C) 2011--2012 Graham Percival <graham@percival-music.ca>
4 %%%%
5 %%%% LilyPond is free software: you can redistribute it and/or modify
6 %%%% it under the terms of the GNU General Public License as published by
7 %%%% the Free Software Foundation, either version 3 of the License, or
8 %%%% (at your option) any later version.
9 %%%%
10 %%%% LilyPond is distributed in the hope that it will be useful,
11 %%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
12 %%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 %%%% GNU General Public License for more details.
14 %%%%
15 %%%% You should have received a copy of the GNU General Public License
16 %%%% along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
17 %
18 %
19 %
20 % This file is used for Vivi, the Virtual Violinist:
21 %   http://percival-music.ca/vivi.html
22 % but it may be helpful to other researchers, either with the same
23 % output, or as a basis for other work in extracting music events
24 % from lilypond.
25 %
26 % Output format is tab-separated lines, like this:
27 %0.00000000     note    57      0.25000000      point-and-click 2 38
28 %0.00000000     dynamic f
29 %0.25000000     note    62      0.25000000      point-and-click 7 38
30 %0.50000000     note    66      0.12500000      point-and-click 9 38
31 %0.50000000     script  staccato
32
33
34
35 \version "2.15.31"
36
37 %%%% Helper functions
38
39 #(define (filename-from-staffname context)
40    "Constructs a filename in the form
41 @file{@var{original_filename}-@var{staff_instrument_name}.notes} if the
42 staff has an instrument name.  If the staff has no instrument
43 name, it uses "unnamed-staff" for that part of the filename."
44    (let* ((inst-name (ly:context-property context 'instrumentName)))
45      (string-concatenate (list
46                           (substring (object->string (command-line))
47                            ;; filename without .ly part
48                            (+ (string-rindex (object->string (command-line)) #\sp) 2)
49                            (- (string-length (object->string (command-line))) 5))
50                           "-"
51                           (if (string? inst-name)
52                               inst-name
53                             "unnamed-staff")
54                           ".notes"))))
55
56 #(define (format-moment moment)
57    (exact->inexact
58     (/ (ly:moment-main-numerator moment)
59        (ly:moment-main-denominator moment))))
60
61 #(define (moment-grace->string moment)
62    "Prints a moment without grace note(s) as a float such as
63 0.25000.  Grace notes are written with the grace duration as a
64 separate \"dashed\" number, i.e. 0.25000-0.12500.  This allows any
65 program using the output of this function to interpret grace notes
66 however they want (half duration, quarter duration?  before beat,
67 after beat?  etc.)."
68    (if
69        (eq? 0 (ly:moment-grace-numerator moment))
70        (ly:format "~a" (format-moment moment))
71        ;; grace notes have a negative numerator, so no "-" necessary
72        (ly:format
73          "~a~a"
74          (format-moment moment)
75          (format-moment
76                        (ly:make-moment
77                         (ly:moment-grace-numerator moment)
78                         (ly:moment-grace-denominator moment))))))
79
80 #(define (make-output-string-line context values)
81    "Constructs a tab-separated string beginning with the
82 score time (derived from the context) and then adding all the
83 values.  The string ends with a newline."
84    (let* ((moment (ly:context-current-moment context)))
85     (string-append
86      (string-join
87        (append
88          (list (moment-grace->string moment))
89          (map
90              (lambda (x) (ly:format "~a" x))
91              values))
92        "\t")
93      "\n")))
94
95
96 #(define (print-line context . values)
97    "Prints the list of values (plus the score time) to a file, and
98 optionally outputs to the console as well.  context may be specified
99 as an engraver for convenience."
100    (if (ly:translator? context)
101        (set! context (ly:translator-context context)))
102    (let* ((p (open-file (filename-from-staffname context) "a")))
103      ;; for regtest comparison
104     (if (defined? 'EVENT_LISTENER_CONSOLE_OUTPUT)
105      (ly:progress
106       (make-output-string-line context values)))
107     (display
108      (make-output-string-line context values)
109      p)
110     (close p)))
111
112
113 %%% main functions
114
115 #(define (format-rest engraver event)
116    (print-line engraver
117                "rest"
118                (ly:duration->string
119                 (ly:event-property event 'duration))
120                (format-moment (ly:duration-length
121                                (ly:event-property event 'duration)))))
122
123 #(define (format-note engraver event)
124    (let* ((origin (ly:input-file-line-char-column
125                    (ly:event-property event 'origin))))
126      (print-line engraver
127                  "note"
128                  ;; get a MIDI pitch value.
129                  (+ 60 (ly:pitch-semitones
130                         (ly:event-property event 'pitch)))
131                  (ly:duration->string
132                   (ly:event-property event 'duration))
133                  (format-moment (ly:duration-length
134                                  (ly:event-property event 'duration)))
135                  ;; point and click info
136                  (ly:format "point-and-click ~a ~a"
137                             (caddr origin)
138                             (cadr origin)))))
139
140 #(define (format-tempo engraver event)
141    (print-line engraver
142                "tempo"
143                ; get length of quarter notes, in seconds
144                (/ (ly:event-property event 'metronome-count)
145                    (format-moment (ly:duration-length (ly:event-property
146                                                        event
147                                                        'tempo-unit))))))
148
149
150 #(define (format-breathe engraver event)
151    (print-line engraver
152                "breathe"))
153
154 #(define (format-tie engraver event)
155    (print-line engraver
156                "tie"))
157
158 #(define (format-articulation engraver event)
159    (print-line engraver
160                "script"
161                (ly:event-property event 'articulation-type)))
162
163 #(define (format-text engraver event)
164    (print-line engraver
165                "text"
166                (ly:event-property event 'text)))
167
168 #(define (format-slur engraver event)
169    (print-line engraver
170                "slur"
171                (ly:event-property event 'span-direction)))
172
173 #(define (format-dynamic engraver event)
174    (print-line engraver
175                "dynamic"
176                (ly:event-property event 'text)))
177
178 #(define (format-cresc engraver event)
179    (print-line engraver
180                "cresc"
181                (ly:event-property event 'span-direction)))
182
183 #(define (format-decresc engraver event)
184    (print-line engraver
185                "decresc"
186                (ly:event-property event 'span-direction)))
187
188 #(define (format-textspan engraver event)
189    (let* ((context (ly:translator-context engraver))
190           (moment (ly:context-current-moment context))
191           (spanner-props (ly:context-property context 'TextSpanner))
192           (details (chain-assoc-get 'bound-details spanner-props))
193           (left-props (assoc-get 'left details '()))
194           (left-text (assoc-get 'text left-props '())))
195      (print-line engraver
196                  "set_string"
197                  (ly:event-property event 'span-direction)
198                  left-text)))
199
200
201 %%%% The actual engraver definition: We just install some listeners so we
202 %%%% are notified about all notes and rests. We don't create any grobs or
203 %%%% change any settings.
204
205 \layout {
206   \context {
207   \Voice
208   \consists #(make-engraver
209               (listeners
210                (tempo-change-event . format-tempo)
211                (rest-event . format-rest)
212                (note-event . format-note)
213                (articulation-event . format-articulation)
214                (text-script-event . format-text)
215                (slur-event . format-slur)
216                (breathing-event . format-breathe)
217                (dynamic-event . format-dynamic)
218                (crescendo-event . format-cresc)
219                (decrescendo-event . format-decresc)
220                (text-span-event . format-textspan)
221                (tie-event . format-tie)))
222   }
223 }