Created
November 16, 2011 16:50
-
-
Save mwitmer/1370615 to your computer and use it in GitHub Desktop.
A Lilypond hack for drawing waveforms above the staff
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
\version "2.12.3" | |
% vibrato.ly | |
% Author: Mark Witmer | |
% Sets the next trill spanner to draw a waveform with the provided wevelength | |
% and amplitudes. The waveform will go from one amplitude to the next in a | |
% linear fashion. | |
vibrato = #(define-music-function (parser location amplitudes wavelength) (list? number?) #{ | |
\once \override TrillSpanner #'after-line-breaking = #(lambda (grob) | |
(ly:grob-set-property! grob 'stencil (makevib grob $amplitudes $wavelength))) | |
#}) | |
% Esample: | |
% \relative c' {\time 4/4 \key d \major \vibrato #'(4 0 4) #1.5 c\startTrillSpan d e d c d e d c\stopTrillSpan | |
% \vibrato #'(1 6 2 1 3 7 4) #1 c\startTrillSpan d e d c d e d c d e d c d e d c d e d c d e | |
% d c d e d c d e d c d e d c d e d c d e d c d e d c d e d c d e d c d e d c d e\stopTrillSpan} | |
% Creates the postscript for one system of the vibrato marking | |
#(define (make_ps lbound xspan span-so-far amplitude-vector wavelength) | |
(letrec ( | |
(frontmatter | |
(string-append "gsave currentpoint translate " | |
"0.15 setlinewidth newpath\n ")) | |
(backmatter "stroke grestore") | |
(make-curve (lambda (current last) | |
(if (= current (vector-length amplitude-vector)) "" | |
(if (< (vector-ref amplitude-vector current) 0) "" | |
(let ( | |
(current-ps (string-append " x " (number->string (exact->inexact (/ wavelength 3))) " add " (number->string (vector-ref amplitude-vector current)) | |
" x " (number->string (exact->inexact (* 2 (/ wavelength 3)))) " add " (number->string (- (vector-ref amplitude-vector current))) | |
" x " (number->string wavelength) " add 0.0 curveto | |
/x x " (number->string wavelength) " add def\n"))) | |
(if (= current last) current-ps (string-append current-ps (make-curve (+ 1 current) last))))))))) | |
(if (or (= xspan -inf.0) (= xspan +inf.0)) | |
(string-append frontmatter backmatter) | |
(string-append frontmatter " /x " (number->string lbound) " def | |
x 0.0 moveto\n" | |
(make-curve (inexact->exact (ceiling span-so-far)) (+ (inexact->exact (ceiling span-so-far)) (inexact->exact (floor xspan)))) | |
backmatter)))) | |
% Returns the width of a grob | |
#(define (grob-width grob) | |
(- (cdr (ly:grob-property grob 'X-extent)) (car (ly:grob-property grob 'X-extent)))) | |
% Returns the number of ems already traversed by the grob's siblings in previous systems | |
#(define (width-up-to grob siblings count) | |
(if (eq? (car siblings) grob) count (+ (+ count (width-up-to grob (cdr siblings) count)) (grob-width (car siblings))))) | |
% Returns the total width of the individual grobs for each system that make up the original grob | |
#(define (calcfull siblings count) | |
(if (eqv? (length siblings) 0) | |
count | |
(calcfull (cdr siblings) (+ count (grob-width (car siblings)))))) | |
% Fills a vector of length len with linear interpolations between the values found in amplitudes | |
#(define (fill-amplitude-vector! amplitude-vector len current-index amplitudes) | |
(if (> (length amplitudes) 1) | |
(let ((start-amplitude (car amplitudes)) | |
(end-amplitude (cadr amplitudes)) | |
(start-index current-index) | |
(end-index (+ current-index (inexact->exact (floor (/ (vector-length amplitude-vector) (- len 1))))))) | |
(do ((n current-index (+ 1 n))) ((or (> n (+ start-index end-index)) (>= n (vector-length amplitude-vector)))) | |
(vector-set! amplitude-vector n (exact->inexact (+ start-amplitude (* (/ (- n start-index) (- end-index start-index)) (- end-amplitude start-amplitude)))))) | |
(fill-amplitude-vector! amplitude-vector len end-index (cdr amplitudes))))) | |
% Makes the vector of amplitudes for the vibrato marking | |
#(define (make-amplitude-vector amplitudes total-span wavelength) | |
(let* ( | |
(current-start 0) | |
(len (inexact->exact (ceiling (/ total-span wavelength)))) | |
(amplitude-vector (make-vector len))) | |
(if (> (length amplitudes) 1) | |
(fill-amplitude-vector! amplitude-vector (length amplitudes) 0 amplitudes) | |
(vector-fill! amplitude-vector (car amplitudes))) | |
amplitude-vector)) | |
% Creates a stencil that draws a sine wave for vibrato based on the provided amplitudes and wavelength | |
#(define (makevib grob amplitudes wavelength) | |
(let* ((orig (ly:grob-original grob)) | |
(siblings (if (ly:grob? orig) (ly:spanner-broken-into orig) '())) | |
(span (ly:grob-property grob 'X-extent)) | |
(xbeg (car span)) | |
(xend (cdr span)) | |
(xspan (- xend xbeg)) | |
(total-span (if (eqv? (length siblings) 0) xspan (calcfull siblings 0))) | |
(lbound (if (or (null? siblings) (eq? (car siblings) grob)) 0 (cdr (assq 'X (ly:grob-property grob 'left-bound-info))))) | |
(span-so-far (if (null? siblings) 0 (width-up-to grob siblings 0)))) | |
(ly:make-stencil (list 'embedded-ps (make_ps lbound xspan span-so-far (make-amplitude-vector amplitudes total-span wavelength) wavelength)) (cons 0 0) (cons -1 1)))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment