@c to get decent French quotes in ``foo''
@macro qq{TEXT}
@html
-« \TEXT\ »
+« \TEXT\ »
@end html
@end macro
Info for Documentation
----------------------
-Current version of the manual: 2.11.10 ?
+Current version of the manual: 2.11.15
*** Please update this whenever you run convert-ly on the docs.
convert-ly --from=... --to=... --no-version *.itely
@ref{Time administration}.
Line breaks are normally forbidden when beams cross bar lines. This
-behavior can be changed by setting @code{allowBeamBreak}.
+behavior can be changed by setting @code{breakable}.
+
+@funindex breakable
-@funindex allowBeamBreak
@cindex beams and line breaks
@cindex beams, kneed
@cindex kneed beams
@funindex \override
@cindex internal documentation
+For many properties, regardless of the data type of the property, setting the
+property to false ( @code{##f} ) will result in turning it off, causing
+Lilypond to ignore that property entirely. This is particularly useful for
+turning off grob properties which may otherwise be causing problems.
+
We demonstrate how to glean this information from the notation manual
and the program reference.
+
+
@node Navigating the program reference
@subsection Navigating the program reference
\clef "G_8"
b16 d16 g16 b16 e16
\textSpannerDown
-\override TextSpanner #'edge-text = #'("XII " . "")
+\override TextSpanner #'bound-details #'left #'text = "XII "
g16\startTextSpan
b16 e16 g16 e16 b16 g16\stopTextSpan
e16 b16 g16 d16
A basic example of a lilypond input file is
@example
-\version "2.9.13"
+\version "2.11.15"
\score @{
@{ @} % this is a single music expression;
% all the music goes in here.
soprano part).
@example
-\version "2.9.13"
+\version "2.11.15"
melody = \relative c' @{
\clef treble
\key c \major
Now we want to add a cello part. Let's look at the @q{Notes only} example:
@example
-\version "2.9.13"
+\version "2.11.15"
melody = \relative c' @{
\clef treble
\key c \major
notes.
@example
-\version "2.9.13"
+\version "2.11.15"
sopranoMusic = \relative c' @{
\clef treble
\key c \major
easily fixed. Here's the complete soprano and cello template.
@lilypond[quote,verbatim,ragged-right]
-\version "2.9.13"
+\version "2.11.15"
sopranoMusic = \relative c' {
\clef treble
\key c \major
@item first-page-number
The value of the page number of the first page. Default is@tie{}1.
-@funindex printfirst-page-number
+@funindex print-first-page-number
@item print-first-page-number
If set to true, will print the page number in the first page. Default is
false.
add notes, and you're finished!
@lilypond[quote,verbatim,ragged-right]
-\version "2.9.13"
+\version "2.11.15"
melody = \relative c' {
\clef treble
\key c \major
line.
@lilypond[quote,verbatim,ragged-right]
-\version "2.9.13"
+\version "2.11.15"
melody = \relative c' {
\clef treble
\key c \major
Want to prepare a lead sheet with a melody and chords? Look no further!
@lilypond[quote,verbatim,ragged-right]
-\version "2.9.13"
+\version "2.11.15"
melody = \relative c' {
\clef treble
\key c \major
This template allows you to prepare a song with melody, words, and chords.
@lilypond[quote,verbatim,ragged-right]
-\version "2.9.13"
+\version "2.11.15"
melody = \relative c' {
\clef treble
\key c \major
Here is a simple piano staff.
@lilypond[quote,verbatim,ragged-right]
-\version "2.9.13"
+\version "2.11.15"
upper = \relative c'' {
\clef treble
\key c \major
piano accompaniment underneath.
@lilypond[quote,verbatim,ragged-right]
-\version "2.9.13"
+\version "2.11.15"
melody = \relative c'' {
\clef treble
\key c \major
the lyrics between the piano staff (and omit the separate melody staff).
@lilypond[quote,verbatim,ragged-right]
-\version "2.9.13"
+\version "2.11.15"
upper = \relative c'' {
\clef treble
\key c \major
tweaking yourself.
@lilypond[quote,verbatim,ragged-right]
-\version "2.9.13"
+\version "2.11.15"
upper = \relative c'' {
\clef treble
\key c \major
section for time and key signatures.
@lilypond[quote,verbatim,ragged-right]
-\version "2.9.13"
+\version "2.11.15"
global= {
\time 4/4
@verbatim
%%%%% piece.ly
-\version "2.9.13"
+\version "2.11.15"
global= {
\time 4/4
%%%%% score.ly
-\version "2.9.13"
+\version "2.11.15"
\include "piece.ly"
#(set-global-staff-size 14)
\score {
%%%%% vn1.ly
-\version "2.9.13"
+\version "2.11.15"
\include "piece.ly"
\score {
\keepWithTag #'vn1 \music
%%%%% vn2.ly
-\version "2.9.13"
+\version "2.11.15"
\include "piece.ly"
\score {
\keepWithTag #'vn2 \music
%%%%% vla.ly
-\version "2.9.13"
+\version "2.11.15"
\include "piece.ly"
\score {
\keepWithTag #'vla \music
%%%%% vlc.ly
-\version "2.9.13"
+\version "2.11.15"
\include "piece.ly"
\score {
\keepWithTag #'vlc \music
always the same for all parts.
@lilypond[quote,verbatim,ragged-right]
-\version "2.9.13"
+\version "2.11.15"
global = {
\key c \major
\time 4/4
apply to the piano reduction.
@lilypond[quote,verbatim,ragged-right]
-\version "2.9.13"
+\version "2.11.15"
global = {
\key c \major
\time 4/4
and @code{alignBelowContext}.
@lilypond[quote,verbatim,ragged-right]
-\version "2.10.0"
+\version "2.11.15"
global = {
\key c \major
\time 4/4
staves rather than on the staves.
@lilypond[quote,verbatim,line-width=11.0\cm]
-\version "2.9.13"
+\version "2.11.15"
global = {
\set Score.skipBars = ##t
@lilypond[quote,verbatim,ragged-right]
\include "gregorian-init.ly"
-\version "2.9.13"
+\version "2.11.15"
chant = \relative c' {
\set Score.timing = ##f
@c The `line-width' argument is for the \header.
@lilypond[quote,verbatim,ragged-right,line-width]
-\version "2.9.13"
+\version "2.11.15"
\header {
title = "Song"
subtitle = "(tune)"
@ The `line-width' is for \header.
@li lypond[quote,verbatim,ragged-right,line-width]
-\version "2.9.13"
+\version "2.11.15"
\header {
dedication = "dedication"
title = "Title"
was written. To mark a file for version 2.10.1, place
@example
-\version "2.10.1"
+\version "2.11.15"
@end example
@noindent
the @ref{Version number}.
@example
-\version "2.10.1"
+\version "2.11.15"
\header @{
title = "Symphony"
composer = "Me"
@itemize @bullet
@item @strong{Include @code{\version} numbers in every file}. Note that all
-templates contain a @code{\version "2.9.13"} string. We
+templates contain a @code{\version "2.11.15"} string. We
highly recommend that you always include the @code{\version}, no matter
how small your file is. Speaking from personal experience, it's
quite frustrating to try to remember which version of LilyPond you were
@example
%%% global.ly
-\version "2.9.13"
+\version "2.11.15"
#(ly:set-option 'point-and-click #f)
\include "../init/init-defs.ly"
\include "../init/init-layout.ly"
Rune Zedeler
Maximilian Albert
+Milan Zamazal
SPONSORS
James Kilfinger
Jean-Marie Mouchel
Jean-Yves Baudais
+Jonathan Henkelman
Kazuhiro Suzuki
Laura Conrad
Luc Wehli
PACKAGE_NAME=LilyPond
MAJOR_VERSION=2
MINOR_VERSION=11
-PATCH_LEVEL=16
+PATCH_LEVEL=18
MY_PATCH_LEVEL=
# 'expressive' not available yet
dirs = ['ancient','chords','connecting','contemporary','expressive','guitar','parts','repeats','spacing','staff','text','vocal']
+notsafe=[]
try:
in_dir = sys.argv[1]
src = os.path.join (srcdir, file)
dest = os.path.join (destdir, file)
shutil.copyfile (src, dest)
+ s = os.system('lilypond -dsafe --ps -o /tmp/lsrtest ' + dest)
+ if s:
+ notsafe.append(dest)
+ #raise 'Failed'
+
+file=open("lsr-unsafe.txt", 'w')
+for s in notsafe:
+ file.write(s+'\n')
+file.close()
+print
+print
+print "Unsafe files printed in lsr-unsafe.txt: CHECK MANUALLY!"
+print " (probably with xargs git-diff < lsr-unsafe.txt )"
+print
+
--- /dev/null
+;;; lilypond-song.el --- Emacs support for LilyPond singing
+
+;; Copyright (C) 2006 Brailcom, o.p.s.
+
+;; Author: Milan Zamazal <pdm@brailcom.org>
+
+;; COPYRIGHT NOTICE
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+;; for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
+
+;;; Commentary:
+
+;; This file adds Emacs support for singing lyrics of LilyPond files.
+;; It extends lilypond-mode with the following commands (see their
+;; documentation for more information):
+;;
+;; - M-x LilyPond-command-sing (C-c C-a)
+;; - M-x LilyPond-command-sing-and-play (C-c C-q)
+;; - M-x LilyPond-command-sing-last (C-c C-z)
+;;
+;; Note these commands are not available from the standard LilyPond mode
+;; command menus.
+
+;;; Code:
+
+
+(require 'cl)
+(require 'lilypond-mode)
+
+(ignore-errors (require 'ecasound))
+
+
+;;; User options
+
+
+(defcustom LilyPond-synthesize-command "lilysong"
+ "Command used to sing LilyPond files."
+ :group 'LilyPond
+ :type 'string)
+
+(defcustom LilyPond-play-command (or (executable-find "ecaplay") "play")
+ "Command used to play WAV files."
+ :group 'LilyPond
+ :type 'string)
+
+;; In case you would like to use fluidsynth (not recommended as fluidsynth
+;; can perform wave file synthesis only in real time), you can use the
+;; following setting:
+;; (setq LilyPond-midi->wav-command "fluidsynth -nil -a file soundfont.sf2 '%s' && sox -t raw -s -r 44100 -w -c 2 fluidsynth.raw '%t'")
+(defcustom LilyPond-midi->wav-command "timidity -Ow %m -s %r -o '%t' '%s'"
+ "Command used to make a WAV file from a MIDI file.
+%s in the string is replaced with the source MIDI file name,
+%t is replaced with the target WAV file name.
+%r is replaced with rate.
+%m is replaced with lilymidi call."
+ :group 'LilyPond
+ :type 'string)
+
+(defcustom LilyPond-voice-rates
+ '((".*czech.*" . 44100)
+ (".*\\<fi\\(\\>\\|nnish\\).*" . 22050)
+ (".*" . 16000))
+ "Alist of regexps matching voices and the corresponding voice rates.
+It may be necessary to define proper voice rates here in order to
+avoid ecasound resampling problems."
+ :group 'LilyPond
+ :type '(alist :key-type regexp :value-type integer))
+
+(defcustom LilyPond-use-ecasound (and (featurep 'ecasound)
+ (executable-find "ecasound")
+ t)
+ "If non-nil, use ecasound for mixing and playing songs."
+ :group 'LilyPond
+ :type 'boolean)
+
+(defcustom LilyPond-voice-track-regexp "voice"
+ "Perl regexp matching names of MIDI tracks to be ignored on sing&play."
+ :group 'LilyPond
+ :type 'string)
+
+(defcustom LilyPond-lilymidi-command "\"`lilymidi --prefix-tracks -Q --filter-tracks '%s' '%f'`\""
+ "Command to insert into LilyPond-midi->wav-command calls.
+%f is replaced with the corresponding MIDI file name.
+%s is replaced with `LilyPond-voice-track-regexp'."
+ :group 'LilyPond
+ :type 'string)
+
+
+;;; Lyrics language handling
+
+
+(defvar lilysong-language nil)
+(make-variable-buffer-local 'lilysong-language)
+
+(defvar lilysong-last-language nil)
+(make-variable-buffer-local 'lilysong-last-language)
+
+(defvar lilysong-languages '("cs" "en"))
+
+(defvar lilysong-voices nil)
+
+(defun lilysong-voices ()
+ (or lilysong-voices
+ (with-temp-buffer
+ (call-process "lilysong" nil t nil "--list-voices")
+ (call-process "lilysong" nil t nil "--list-languages")
+ (goto-char (point-min))
+ (while (not (eobp))
+ (push (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position))
+ lilysong-voices)
+ (forward-line))
+ lilysong-voices)))
+
+(defun lilysong-change-language ()
+ "Change synthesis language or voice of the current document."
+ (interactive)
+ (setq lilysong-language
+ (completing-read "Lyrics language or voice: "
+ (mapcar 'list (lilysong-voices)))))
+
+(defun lilysong-update-language ()
+ (unless lilysong-language
+ (lilysong-change-language)))
+
+
+;;; Looking for \festival* and \midi commands
+
+
+(defun lilysong-document-files ()
+ (let ((resulting-files ())
+ (stack (list (LilyPond-get-master-file))))
+ (while (not (null stack))
+ (let ((file (expand-file-name (pop stack))))
+ (when (and (file-exists-p file)
+ (not (member file resulting-files)))
+ (push file resulting-files)
+ (save-excursion
+ (save-restriction
+ (set-buffer (find-file-noselect file nil))
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward "^[^%\n]*\\\\include +\"\\([^\"]+\\)\"" nil t)
+ (push (match-string 1) stack)))))))
+ (nreverse resulting-files)))
+
+(defvar lilysong-festival-command-regexp
+ "^[^%\n]*\\\\festival\\(syl\\)? +#\"\\([^\"]+\\)\"")
+
+(defun lilysong-find-song (direction)
+ "Find XML file name of the nearest Festival command in the given DIRECTION.
+DIRECTION is one of the symbols `forward' or `backward'.
+If no Festival command is found in the current buffer, return nil.
+The point is left at the position where the command occurrence was found."
+ (save-match-data
+ (when (funcall (if (eq direction 'backward)
+ 're-search-backward
+ 're-search-forward)
+ lilysong-festival-command-regexp nil t)
+ (match-string-no-properties 2))))
+
+(defun lilysong-current-song ()
+ "Return the XML file name corresponding to the song around current point.
+If there is none, return nil."
+ (save-excursion
+ (or (progn (end-of-line) (lilysong-find-song 'backward))
+ (progn (beginning-of-line) (lilysong-find-song 'forward)))))
+
+(defun lilysong-all-songs (&optional limit-to-region)
+ "Return list of XML file names of the song commands in the current buffer.
+If there are none, return an empty list.
+If LIMIT-TO-REGION is non-nil, look for the commands in the current region
+only."
+ (let ((result '())
+ (current nil))
+ (save-excursion
+ (save-restriction
+ (when limit-to-region
+ (narrow-to-region (or (mark) (point)) (point)))
+ (goto-char (point-min))
+ (while (setq current (lilysong-find-song 'forward))
+ (push current result))))
+ (nreverse result)))
+
+(defun lilysong-walk-files (collector)
+ (save-excursion
+ (mapcar (lambda (f)
+ (set-buffer (find-file-noselect f))
+ (funcall collector))
+ (lilysong-document-files))))
+
+(defun lilysong-all-songs* ()
+ "Return list of XML file names of the song commands in the current document."
+ (remove-duplicates (apply #'append (lilysong-walk-files #'lilysong-all-songs))
+ :test #'equal))
+
+(defvar lilysong-song-history nil)
+(make-variable-buffer-local 'lilysong-song-history)
+
+(defvar lilysong-last-song-list nil)
+(make-variable-buffer-local 'lilysong-last-song-list)
+
+(defvar lilysong-last-command-args nil)
+(make-variable-buffer-local 'lilysong-last-command-args)
+
+(defun lilysong-song-list (multi)
+ (cond
+ ((eq multi 'all)
+ (lilysong-all-songs*))
+ (multi
+ (lilysong-select-songs))
+ (t
+ (lilysong-select-single-song))))
+
+(defun lilysong-select-single-song ()
+ (let ((song (lilysong-current-song)))
+ (if song
+ (list song)
+ (error "No song found"))))
+
+(defun lilysong-select-songs ()
+ (let* ((all-songs (lilysong-all-songs*))
+ (available-songs all-songs)
+ (initial-songs (if (or (not lilysong-last-song-list)
+ (eq LilyPond-command-current
+ 'LilyPond-command-region))
+ (lilysong-all-songs t)
+ lilysong-last-song-list))
+ (last-input (completing-read
+ (format "Sing file%s: "
+ (if initial-songs
+ (format " (default `%s')"
+ (mapconcat 'identity initial-songs
+ ", "))
+ ""))
+ (mapcar 'list all-songs)
+ nil t nil
+ 'lilysong-song-history)))
+ (if (equal last-input "")
+ initial-songs
+ (let ((song-list '())
+ default-input)
+ (while (not (equal last-input ""))
+ (push last-input song-list)
+ (setq default-input (second (member last-input available-songs)))
+ (setq available-songs (remove last-input available-songs))
+ (setq last-input (completing-read "Sing file: "
+ (mapcar #'list available-songs)
+ nil t default-input
+ 'lilysong-song-history)))
+ (setq lilysong-last-song-list (nreverse song-list))))))
+
+(defun lilysong-count-midi-words ()
+ (count-rexp (point-min) (point-max) "^[^%]*\\\\midi"))
+
+(defun lilysong-midi-list (multi)
+ (if multi
+ (let ((basename (file-name-sans-extension (buffer-file-name)))
+ (count (apply #'+ (save-match-data
+ (lilysong-walk-files #'lilysong-count-midi-words))))
+ (midi-files '()))
+ (while (> count 0)
+ (setq count (1- count))
+ (if (= count 0)
+ (push (concat basename ".midi") midi-files)
+ (push (format "%s-%d.midi" basename count) midi-files)))
+ midi-files)
+ (list (LilyPond-string-current-midi))))
+
+
+;;; Compilation
+
+
+(defun lilysong-file->wav (filename &optional extension)
+ (format "%s.%s" (save-match-data
+ (if (string-match "\\.midi$" filename)
+ filename
+ (file-name-sans-extension filename)))
+ (or extension "wav")))
+
+(defun lilysong-file->ewf (filename)
+ (lilysong-file->wav filename "ewf"))
+
+(defstruct lilysong-compilation-data
+ command
+ makefile
+ buffer
+ songs
+ midi
+ in-parallel)
+(defvar lilysong-compilation-data nil)
+(defun lilysong-sing (songs &optional midi-files in-parallel)
+ (setq lilysong-last-command-args (list songs midi-files in-parallel))
+ (lilysong-update-language)
+ (add-to-list 'compilation-finish-functions 'lilysong-after-compilation)
+ (setq songs (mapcar #'expand-file-name songs))
+ (let* ((makefile (lilysong-makefile (current-buffer) songs midi-files))
+ (command (format "make -f %s" makefile)))
+ (setq lilysong-compilation-data
+ (make-lilysong-compilation-data
+ :command command
+ :makefile makefile
+ :buffer (current-buffer)
+ :songs songs
+ :midi midi-files
+ :in-parallel in-parallel))
+ (save-some-buffers (not compilation-ask-about-save))
+ (unless (equal lilysong-language lilysong-last-language)
+ (mapc #'(lambda (f) (when (file-exists-p f) (delete-file f)))
+ (append songs (mapcar 'lilysong-file->wav midi-files))))
+ (if (lilysong-up-to-date-p makefile)
+ (lilysong-process-generated-files lilysong-compilation-data)
+ (compile command))))
+
+(defun lilysong-up-to-date-p (makefile)
+ (equal (call-process "make" nil nil nil "-f" makefile "-q") 0))
+
+(defun lilysong-makefile (buffer songs midi-files)
+ (let ((temp-file (make-temp-file "Makefile.lilysong-el"))
+ (language lilysong-language))
+ (with-temp-file temp-file
+ (let ((source-files (save-excursion
+ (set-buffer buffer)
+ (lilysong-document-files)))
+ (master-file (save-excursion
+ (set-buffer buffer)
+ (LilyPond-get-master-file)))
+ (lilyfiles (append songs midi-files)))
+ (insert "all:")
+ (dolist (f (mapcar 'lilysong-file->wav (append songs midi-files)))
+ (insert " " f))
+ (insert "\n")
+ (when lilyfiles
+ (dolist (f songs)
+ (insert f " "))
+ (when midi-files
+ (dolist (f midi-files)
+ (insert f " ")))
+ (insert ": " master-file "\n")
+ (insert "\t" LilyPond-lilypond-command " " master-file "\n")
+ (dolist (f songs)
+ (insert (lilysong-file->wav f) ": " f "\n")
+ (insert "\t" LilyPond-synthesize-command " $< " (or language "") "\n"))
+ ;; We can't use midi files in ecasound directly, because setpos
+ ;; doesn't work on them.
+ (let ((lilymidi LilyPond-lilymidi-command)
+ (voice-rate (format "%d" (or (cdr (assoc-if (lambda (key) (string-match key language))
+ LilyPond-voice-rates))
+ 16000))))
+ (when (string-match "%s" lilymidi)
+ (setq lilymidi (replace-match LilyPond-voice-track-regexp nil nil lilymidi)))
+ (dolist (f midi-files)
+ (insert (lilysong-file->wav f) ": " f "\n")
+ (let ((command LilyPond-midi->wav-command)
+ (lilymidi* lilymidi))
+ (when (string-match "%s" command)
+ (setq command (replace-match f nil nil command)))
+ (when (string-match "%t" command)
+ (setq command (replace-match (lilysong-file->wav f) nil nil command)))
+ (when (string-match "%r" command)
+ (setq command (replace-match voice-rate nil nil command)))
+ (when (string-match "%f" lilymidi*)
+ (setq lilymidi (replace-match f nil nil lilymidi*)))
+ (when (string-match "%m" command)
+ (setq command (replace-match lilymidi nil nil command)))
+ (insert "\t" command "\n")))
+ ))))
+ temp-file))
+
+(defun lilysong-after-compilation (buffer message)
+ (let ((data lilysong-compilation-data))
+ (when (and data
+ (equal compile-command
+ (lilysong-compilation-data-command data)))
+ (unwind-protect
+ (when (lilysong-up-to-date-p (lilysong-compilation-data-makefile data))
+ (lilysong-process-generated-files data))
+ (delete-file (lilysong-compilation-data-makefile data))))))
+
+(defun lilysong-process-generated-files (data)
+ (with-current-buffer (lilysong-compilation-data-buffer data)
+ (setq lilysong-last-language lilysong-language))
+ (lilysong-play-files (lilysong-compilation-data-in-parallel data)
+ (lilysong-compilation-data-songs data)
+ (lilysong-compilation-data-midi data)))
+
+
+;;; Playing files
+
+
+(defun lilysong-play-files (in-parallel songs midi-files)
+ (funcall (if LilyPond-use-ecasound
+ 'lilysong-play-with-ecasound
+ 'lilysong-play-with-play)
+ in-parallel songs midi-files))
+
+(defun lilysong-call-play (files)
+ (apply 'start-process "lilysong-el" nil LilyPond-play-command files))
+
+(defun lilysong-play-with-play (in-parallel songs midi-files)
+ (let ((files (mapcar 'lilysong-file->wav (append songs midi-files))))
+ (if in-parallel
+ (dolist (f files)
+ (lilysong-call-play (list f)))
+ (lilysong-call-play files))))
+
+(defun lilysong-make-ewf-files (files)
+ (let ((offset 0.0))
+ (dolist (f files)
+ (let* ((wav-file (lilysong-file->wav f))
+ (length (with-temp-buffer
+ (call-process "ecalength" nil t nil "-s" wav-file)
+ (goto-char (point-max))
+ (forward-line -1)
+ (read (current-buffer)))))
+ (with-temp-file (lilysong-file->ewf f)
+ (insert "source = " wav-file "\n")
+ (insert (format "offset = %s\n" offset))
+ (insert "start-position = 0.0\n")
+ (insert (format "length = %s\n" length))
+ (insert "looping = false\n"))
+ (setq offset (+ offset length))))))
+
+(when (and (featurep 'ecasound)
+ (not (fboundp 'eci-cs-set-param)))
+ (defeci cs-set-param ((parameter "sChainsetup option: " "%s"))))
+
+(defun lilysong-play-with-ecasound (in-parallel songs midi-files)
+ (ecasound)
+ (eci-cs-add "lilysong-el")
+ (eci-cs-select "lilysong-el")
+ (eci-cs-remove)
+ (eci-cs-add "lilysong-el")
+ (eci-cs-select "lilysong-el")
+ (eci-cs-set-param "-z:mixmode,sum")
+ (unless in-parallel
+ (lilysong-make-ewf-files songs)
+ ;; MIDI files should actually start with each of the songs
+ (mapc 'lilysong-make-ewf-files (mapcar 'list midi-files)))
+ (let* ((file->wav (if in-parallel 'lilysong-file->wav 'lilysong-file->ewf))
+ (files (mapcar file->wav (append songs midi-files))))
+ (dolist (f files)
+ (eci-c-add f)
+ (eci-c-select f)
+ (eci-ai-add f))
+ (eci-c-select-all)
+ (eci-ao-add-default)
+ (let* ((n (length songs))
+ (right (if (<= n 1) 50 0))
+ (step (if (<= n 1) 0 (/ 100.0 (1- n)))))
+ (dolist (f songs)
+ (let ((chain (funcall file->wav f)))
+ (eci-c-select chain)
+ (eci-cop-add "-erc:1,2")
+ (eci-cop-add (format "-epp:%f" (min right 100)))
+ (incf right step))))
+ (eci-start)))
+
+
+;;; User commands
+
+
+(defun lilysong-arg->multi (arg)
+ (cond
+ ((not arg)
+ nil)
+ ((or
+ (numberp arg)
+ (equal arg '(4)))
+ t)
+ (t
+ 'all)))
+
+(defun lilysong-command (arg play-midi?)
+ (let* ((multi (lilysong-arg->multi arg))
+ (song-list (lilysong-song-list multi))
+ (midi-list (if play-midi? (lilysong-midi-list multi))))
+ (message "Singing %s" (mapconcat 'identity song-list ", "))
+ (lilysong-sing song-list midi-list (if play-midi? t (listp arg)))))
+
+(defun LilyPond-command-sing (&optional arg)
+ "Sing lyrics of the current LilyPond buffer.
+Without any prefix argument, sing current \\festival* command.
+With the universal prefix argument, ask which parts to sing.
+With a double universal prefix argument, sing all the parts.
+With a numeric prefix argument, ask which parts to sing and sing them
+sequentially rather than in parallel."
+ (interactive "P")
+ (lilysong-command arg nil))
+
+(defun LilyPond-command-sing-and-play (&optional arg)
+ "Sing lyrics and play midi of the current LilyPond buffer.
+Without any prefix argument, sing and play current \\festival* and \\midi
+commands.
+With the universal prefix argument, ask which parts to sing and play.
+With a double universal prefix argument, sing and play all the parts."
+ (interactive "P")
+ (lilysong-command arg t))
+
+(defun LilyPond-command-sing-last ()
+ "Repeat last LilyPond singing command."
+ (interactive)
+ (if lilysong-last-command-args
+ (apply 'lilysong-sing lilysong-last-command-args)
+ (error "No previous singing command")))
+
+(defun LilyPond-command-clean ()
+ "Remove generated *.xml and *.wav files used for singing."
+ (interactive)
+ (flet ((delete-file* (file)
+ (when (file-exists-p file)
+ (delete-file file))))
+ (dolist (xml-file (lilysong-song-list 'all))
+ (delete-file* xml-file)
+ (delete-file* (lilysong-file->wav xml-file)))
+ (mapc 'delete-file* (mapcar 'lilysong-file->wav (lilysong-midi-list 'all)))))
+
+(define-key LilyPond-mode-map "\C-c\C-a" 'LilyPond-command-sing)
+(define-key LilyPond-mode-map "\C-c\C-q" 'LilyPond-command-sing-and-play)
+(define-key LilyPond-mode-map "\C-c\C-x" 'LilyPond-command-clean)
+(define-key LilyPond-mode-map "\C-c\C-z" 'LilyPond-command-sing-last)
+
+(easy-menu-add-item LilyPond-command-menu nil
+ ["Sing Current" LilyPond-command-sing t])
+(easy-menu-add-item LilyPond-command-menu nil
+ ["Sing Selected" (LilyPond-command-sing '(4)) t])
+(easy-menu-add-item LilyPond-command-menu nil
+ ["Sing All" (LilyPond-command-sing '(16)) t])
+(easy-menu-add-item LilyPond-command-menu nil
+ ["Sing Selected Sequentially" (LilyPond-command-sing 1) t])
+(easy-menu-add-item LilyPond-command-menu nil
+ ["Sing and Play Current" LilyPond-command-sing-and-play t])
+(easy-menu-add-item LilyPond-command-menu nil
+ ["Sing and Play Selected" (LilyPond-command-sing-and-play '(4)) t])
+(easy-menu-add-item LilyPond-command-menu nil
+ ["Sing and Play All" (LilyPond-command-sing-and-play '(16)) t])
+(easy-menu-add-item LilyPond-command-menu nil
+ ["Sing Last" LilyPond-command-sing-last t])
+
+
+;;; Announce
+
+(provide 'lilypond-song)
+
+
+;;; lilypond-song.el ends here
depth = ../../
-SUBDIRS = ancient chords connecting contemporary guitar parts repeats spacing staff text vocal
+SUBDIRS = ancient chords connecting contemporary guitar parts repeats spacing staff text vocal expressive
STEPMAKE_TEMPLATES=documentation texinfo tex
LOCALSTEPMAKE_TEMPLATES=lilypond ly lysdoc
-
+EXTRA_DIST_FILES=README
include $(depth)/make/stepmake.make
" }
% 7sus4 denoted with ^7 wahh
-chExceptionMusic = {
- <c f g bes>1-\markup { \super "7" "wahh" }}
+chExceptionMusic = {
+ <c f g bes>1-\markup { \super "7" "wahh" }
+}
- % add to existing exceptions.
+% add to existing exceptions.
chExceptions = #(append
- (sequential-music-to-chord-exceptions chExceptionMusic #t)
- ignatzekExceptions)
+ (sequential-music-to-chord-exceptions chExceptionMusic #t)
+ ignatzekExceptions)
theMusic = \chordmode {
- c:7sus4 c:dim7/+f
- \set chordNameExceptions = #chExceptions
- c:7sus4 c:dim7/+f
+ c:7sus4 c:dim7/+f
+ \set chordNameExceptions = #chExceptions
+ c:7sus4 c:dim7/+f
}
-\layout { ragged-right = ##t }
+\layout {
+ ragged-right = ##t
+}
<< \context ChordNames \theMusic
\context Voice \theMusic
" }
\chords {
- c:7+
- \set majorSevenSymbol = \markup { "j7" }
- c:7+
+ c:7+
+ \set majorSevenSymbol = \markup { "j7" }
+ c:7+
}
<c d e f>4\laissezVibrer r
\override LaissezVibrerTieColumn #'tie-configuration
- = #'((-7 . -1)
- (-5 . -1)
- (-3 . 1)
- (-1 . 1))
+ = #'((-7 . -1)
+ (-5 . -1)
+ (-3 . 1)
+ (-1 . 1))
<c d e f>4\laissezVibrer r
}
Clusters are a device to denote that a complete range of notes is to be played.
" }
-\layout { ragged-right = ##t }
+\layout {
+ ragged-right = ##t
+}
fragment = \relative c' {
c4 f4 <e d'>4
By setting @{markFormatter@} we may choose a different style of mark printing. Also, marks can be specified manually, with a markup argument.
" }
-\paper { ragged-right = ##t }
+\paper {
+ ragged-right = ##t
+}
\relative c''{
\set Score.markFormatter = #format-mark-numbers
c1 | \mark \default
c1 | \mark \default
\set Score.markFormatter
- = #(lambda (mark context)
- (make-box-markup (format-mark-numbers mark context)))
+ = #(lambda (mark context)
+ (make-box-markup (format-mark-numbers mark context)))
c1 | \mark \default
\set Score.markFormatter
- = #(lambda (mark context)
- (make-circle-markup (format-mark-numbers mark context)))
+ = #(lambda (mark context)
+ (make-circle-markup (format-mark-numbers mark context)))
c1 | \mark \default
}
The @{\tag@} command marks music expressions with a name. These tagged expressions can be filtered out later. This mechanism can be used to make different versions of the same music. In this example, the top stave displays the music expression with all tags included. The bottom two staves are filtered: the part has cue notes and fingerings, but the score has not.
" }
-\layout { ragged-right= ##t }
+\layout {
+ ragged-right= ##t
+}
common =
\relative c'' {
-
c1
\relative c' <<
\tag #'part <<
}
-
\simultaneous {
\new Staff {
\set Staff.instrumentName = #"both"
By setting @{voltaOnThisStaff@}, repeats can be put also over other staves than the topmost one in a score.
" }
-\layout { ragged-right = ##t }
-vmus = { \repeat volta 2 c1 \alternative { d e } }
+\layout {
+ ragged-right = ##t
+}
+
+vmus = {
+ \repeat volta 2 c1 \alternative { d e }
+}
\relative c'' <<
\new StaffGroup <<
\paper {
#(define write-page-layout #t)
}
+
bla = \new Staff {
c1 c1
\break
#(newline)
#(ly:progress "Contents of: '~a'" (ly:gulp-file tweakFileName))
-
Proportional notation can be created by setting @{proportionalNotationDuration@}. Notes will be spaced proportional to the distance for the given duration.
" }
-\paper { ragged-right = ##t }
+\paper {
+ ragged-right = ##t
+}
\relative c''
<<
\set Score.proportionalNotationDuration = #(ly:make-moment 1 16)
- \new Staff { c8[ c c c c c] c4 c2 r2 }
- \new Staff { c2 \times 2/3 { c8 c c } c4 c1 }
+ \new Staff { c8[ c c c c c] c4 c2 r2 }
+ \new Staff { c2 \times 2/3 { c8 c c } c4 c1 }
>>
\new StaffGroup <<
\new Staff {
c1\break
- c\break c\break
+ c\break
+ c\break
+ }
+ \new Staff {
+ c1 c c
}
- \new Staff { c1 c c }
\new PianoStaff <<
\new Voice {
\set PianoStaff.instrumentName = #"piano"
c1_"normal"
\overrideProperty
- #"Score.NonMusicalPaperColumn"
- #'line-break-system-details
- #'((fixed-alignment-extra-space . 15))
+ #"Score.NonMusicalPaperColumn"
+ #'line-break-system-details
+ #'((fixed-alignment-extra-space . 15))
c_"fixed-aligment-extra-space"
\overrideProperty
- #"Score.NonMusicalPaperColumn"
- #'line-break-system-details
- #'((alignment-extra-space . 15))
+ #"Score.NonMusicalPaperColumn"
+ #'line-break-system-details
+ #'((alignment-extra-space . 15))
c_"aligment-extra-space"
}
{ c1 c c }
\paper {
#(define write-page-layout #t)
}
+
bla = \new Staff {
c1 c1
\break
#(newline)
#(ly:progress "Contents of: '~a'" (ly:gulp-file tweakFileName))
-
#(set-global-staff-size 11)
-\book {
- \score {
- \relative c'' \new PianoStaff <<
- \new Voice {
- c1_"followed by default spacing"\break
- c\break
+ \book {
+ \score {
+ \relative c'' \new PianoStaff <<
+ \new Voice {
+ c1_"followed by default spacing"
+ \break
+ c
+ \break
- \overrideProperty
- #"Score.NonMusicalPaperColumn"
- #'line-break-system-details
- #'((Y-extent . (-30 . 10)))
- c_"Big bounding box (property Y-extent)"\break
+ \overrideProperty
+ #"Score.NonMusicalPaperColumn"
+ #'line-break-system-details
+ #'((Y-extent . (-30 . 10)))
+ c_"Big bounding box (property Y-extent)"
+ \break
- \overrideProperty
- #"Score.NonMusicalPaperColumn"
- #'line-break-system-details
- #'((refpoint-Y-extent . (-37 . -10)))
- c_\markup {
- \column {
- "Refpoints further apart (property refpoint-Y-extent)."
- "Stretchable space runs between refpoints"
- }
- }
-
- \break
-
- \overrideProperty
- #"Score.NonMusicalPaperColumn"
- #'line-break-system-details
- #'((next-padding . 10))
+ \overrideProperty
+ #"Score.NonMusicalPaperColumn"
+ #'line-break-system-details
+ #'((refpoint-Y-extent . (-37 . -10)))
+ c_\markup {
+ \column {
+ "Refpoints further apart (property refpoint-Y-extent)."
+ "Stretchable space runs between refpoints" } }
+ \break
- c_"Followed by padding, ie unstretchable space. (property next-padding)" \break
- \overrideProperty
- #"Score.NonMusicalPaperColumn"
- #'line-break-system-details
- #'((next-space . 20))
- c_"Followed by stretchable space (property next-space)"\break
- c\break
- \overrideProperty
- #"Score.NonMusicalPaperColumn" #'line-break-system-details
- #'((bottom-space . 25.0))
- c_"25 staff space to the bottom of the page. (property bottom-space)"\break
+ \overrideProperty
+ #"Score.NonMusicalPaperColumn"
+ #'line-break-system-details
+ #'((next-padding . 10))
+ c_"Followed by padding, ie unstretchable space (property next-padding)."
+ \break
+ \overrideProperty
+ #"Score.NonMusicalPaperColumn"
+ #'line-break-system-details
+ #'((next-space . 20))
+ c_"Followed by stretchable space (property next-space)"
+ \break
+ c
+ \break
+ \overrideProperty
+ #"Score.NonMusicalPaperColumn"
+ #'line-break-system-details
+ #'((bottom-space . 25.0))
+ c_"25 staff space to the bottom of the page (property bottom-space)."
+ \break
}
- { c1 c c c c c c c }
- >>
- }
- \paper {
- ragged-last-bottom = ##f
- annotate-spacing = ##t
- between-system-space = 1.0
- #(set! text-font-defaults
- (acons
- 'font-size 6
- text-font-defaults)
-
- )
+ { c1 c c c c c c c }
+ >>
+ }
+
+ \paper {
+ ragged-last-bottom = ##f
+ annotate-spacing = ##t
+ between-system-space = 1.0
+ #(set! text-font-defaults
+ (acons
+ 'font-size 6
+ text-font-defaults))
}
}
Proportional notation can be created by setting @{proportionalNotationDuration@}. Notes will be spaced proportional to the distance for the given duration.
" }
-\paper { ragged-right = ##t }
+\paper {
+ ragged-right = ##t
+}
\relative c''
<<
\set Score.proportionalNotationDuration = #(ly:make-moment 1 16)
- \new Staff { c8[ c c c c c] c4 c2 r2 }
- \new Staff { c2 \times 2/3 { c8 c c } c4 c1 }
+ \new Staff { c8[ c c c c c] c4 c2 r2 }
+ \new Staff { c2 \times 2/3 { c8 c c } c4 c1 }
>>
The vertical positions of staff lines may be specified individually, by setting the @{line-positions@} property of the StaffSymbol.
" }
-\new Staff \relative c' {
+\new Staff \relative c' {
\override Staff.StaffSymbol #'line-positions = #'(-7 -2 0 3 9)
g c f b e a
}
The default font families for text can be overridden with @{make-pango-font-tree@}
" }
-\paper {
+\paper {
% change for other default global staff size.
myStaffSize = #20
%{
- run
- lilypond -dshow-available-fonts blabla
- to show all fonts available in the process log.
- %}
+ run
+ lilypond -dshow-available-fonts blabla
+ to show all fonts available in the process log.
+ %}
- #(define fonts
+ #(define fonts
(make-pango-font-tree "Times New Roman"
"Nimbus Sans"
"Luxi Mono"
-;; "Helvetica"
-;; "Courier"
+;; "Helvetica"
+;; "Courier"
(/ myStaffSize 20)))
}
\relative {
- c'^\markup { roman: foo \bold bla \italic bar \italic \bold baz }
+ c'^\markup {
+ roman: foo \bold bla \italic bar \italic \bold baz
+ }
c'_\markup {
\override #'(font-family . sans)
{
" }
\layout {
- ragged-right = ##t
- \context {
- \Voice
- \consists Ambitus_engraver
- }
+ ragged-right = ##t
+ \context {
+ \Voice
+ \consists Ambitus_engraver
+ }
}
\relative
<<
- \new Staff { \time 2/4 c4 f' }
- \new Staff \relative {
- \time 2/4
- \key d \major
- cis as'
- }
+ \new Staff {
+ \time 2/4 c4 f'
+ }
+ \new Staff \relative {
+ \time 2/4
+ \key d \major
+ cis as'
+ }
>>
\autoBeamOff
c2( d4) e8[ c b c] f4
}
- \lyricsto "bla" \new Lyrics { bla ab blob blob }
- \lyricsto "bla" \new Lyrics {
+ \lyricsto "bla" \new Lyrics {
+ bla ab blob blob
+ }
+ \lyricsto "bla" \new Lyrics {
bla
\set ignoreMelismata = ##t
blob
}
- \lyricsto "bla" \new Lyrics {
+ \lyricsto "bla" \new Lyrics {
nes ted lyrics voice with more words than no tes
}
>>
--- /dev/null
+\header {
+ texidoc = "Unknown clef name warning displays available clefs"
+ }
+
+
+\version "2.11.17"
+{
+ \clef "foo"
+ c4
+ }
STEPMAKE_TEMPLATES=documentation texinfo tex
LOCALSTEPMAKE_TEMPLATES=lilypond ly lysdoc
+EXTRA_DIST_FILES=README
include $(depth)/make/stepmake.make
}
while (flip (&d) != LEFT);
+ Offset adjust = dz.direction() * Staff_symbol_referencer::staff_space (me);
line.add_stencil (Line_interface::line (me,
- span_points[LEFT],
- span_points[RIGHT]));
+ span_points[LEFT] + (arrows[LEFT] ? adjust*1.4 : Offset(0,0)),
+ span_points[RIGHT] - (arrows[RIGHT] ? adjust*0.55 : Offset(0,0))));
line.add_stencil (Line_interface::arrows (me,
span_points[LEFT],
--- /dev/null
+% festival.ly --- Festival singing mode output
+%
+% Copyright (C) 2006, 2007 Brailcom, o.p.s.
+%
+% Author: Milan Zamazal <pdm@brailcom.org>
+%
+% COPYRIGHT NOTICE
+%
+% This program is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% This program is distributed in the hope that it will be useful, but
+% WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+% or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+% for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with this program; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
+
+\version "2.11.11"
+
+#(use-modules (scm song))
+
+% \festival #"filename" { \tempo N = X } { music }
+festival =
+#(define-music-function (parser location filename tempo music) (string? ly:music? ly:music?)
+ (output-file music tempo filename)
+ music)
+
+% \festivalsyl #"filename" { \tempo N = X } { music }
+festivalsyl =
+#(define-music-function (parser location filename tempo music) (string? ly:music? ly:music?)
+ (set! *syllabify* #t)
+ (output-file music tempo filename)
+ music)
(define-public (lilypond-main files)
"Entry point for LilyPond."
- (define (no-files-handler)
- (ly:usage)
- (exit 2))
(eval-string (ly:command-line-code))
+
+ (if (ly:get-option 'help)
+ (begin
+ (ly:option-usage)
+ (exit 0)))
+
+ (if (ly:get-option 'show-available-fonts)
+ (begin
+ (ly:font-config-display-fonts)
+ (exit 0)
+ ))
+
(if (ly:get-option 'gui)
(gui-main files))
(if (null? files)
- (no-files-handler))
+ (begin
+ (ly:usage)
+ (exit 2)))
(if (ly:get-option 'read-file-list)
(set! files
(exit 0)))))
(define-public (lilypond-all files)
- (if (ly:get-option 'help)
- (begin
- (ly:option-usage)
- (exit 0)))
- (if (ly:get-option 'show-available-fonts)
- (begin
- (ly:font-config-display-fonts)
- (exit 0)
- ))
-
(let* ((failed '())
(separate-logs (ly:get-option 'separate-log-files))
(do-measurements (ly:get-option 'dump-profile))
("vaticana-do2" . ("clefs.vaticana.do" 1 0))
("vaticana-do3" . ("clefs.vaticana.do" 3 0))
("vaticana-fa1" . ("clefs.vaticana.fa" -1 0))
+
("vaticana-fa2" . ("clefs.vaticana.fa" 1 0))
("medicaea-do1" . ("clefs.medicaea.do" -1 0))
("medicaea-do2" . ("clefs.medicaea.do" 1 0))
(context-spec-music seq 'Staff))
(begin
(ly:warning (_ "unknown clef type `~a'") clef-name)
- (ly:warning (_ "see scm/clef.scm for supported clefs"))
+ (ly:warning (_ "supported clefs: ~a")
+ (string-join
+ (sort (map car supported-clefs) string<?)))
(make-music 'Music)))))
--- /dev/null
+;;; festival.scm --- Festival singing mode output
+
+;; Copyright (C) 2006, 2007 Brailcom, o.p.s.
+
+;; Author: Milan Zamazal <pdm@brailcom.org>
+
+;; COPYRIGHT NOTICE
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+;; for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
+
+
+(define-module (scm song-util))
+
+(use-modules (srfi srfi-1))
+(use-modules (ice-9 optargs))
+(use-modules (ice-9 pretty-print))
+
+(use-modules (lily))
+
+
+;;; Debugging utilities
+
+
+;; Iff true, enable a lot of debugging output
+(define-public *debug* #f)
+
+(define-macro (assert condition . data)
+ (if *debug*
+ `(if (not ,condition)
+ (error "Assertion failed" (quote ,condition) ,@data))
+ #f))
+(export assert)
+
+(define-macro (debug message object)
+ (if *debug*
+ `(debug* ,message ,object)
+ object))
+(export debug)
+
+(define (debug* message object)
+ (display "[[") (display message) (display "]] ") (pretty-print object)
+ object)
+
+
+;;; General utilities
+
+
+(define-macro (defstruct name . slots)
+ ;; Similar as in Common Lisp, but much simplier -- no structure and slot options, no docstring
+ (let* ((slots* (map (lambda (s) (if (pair? s) s (list s))) slots))
+ (make-symbol (lambda (format% . extra-args)
+ (string->symbol (apply format #f format% name extra-args))))
+ ($record? (make-symbol "~a?"))
+ ($make-record (make-symbol "make-~a"))
+ ($copy-record (make-symbol "copy-~a"))
+ (reader-format "~a-~a")
+ (writer-format "set-~a-~a!")
+ (record (gensym)))
+ `(begin
+ (define ,$record? #f)
+ (define ,$make-record #f)
+ (define ,$copy-record #f)
+ ,@(map (lambda (s) `(define ,(make-symbol reader-format (car s)) #f)) slots*)
+ ,@(map (lambda (s) `(define ,(make-symbol writer-format (car s)) #f)) slots*)
+ (let ((,record ,(make-record-type name (map car slots*))))
+ (set! ,$record?
+ (lambda (record) ((record-predicate ,record) record)))
+ (set! ,$make-record
+ (lambda* (#:key ,@slots)
+ ((record-constructor ,record) ,@(map car slots*))))
+ (set! ,$copy-record
+ (lambda (record)
+ (,$make-record ,@(apply
+ append
+ (map (lambda (slot)
+ (list (symbol->keyword slot)
+ (list (make-symbol reader-format slot) 'record)))
+ (map car slots*))))))
+ ,@(map (lambda (s)
+ `(set! ,(make-symbol reader-format (car s))
+ (record-accessor ,record (quote ,(car s)))))
+ slots*)
+ ,@(map (lambda (s)
+ `(set! ,(make-symbol writer-format (car s))
+ (record-modifier ,record (quote ,(car s)))))
+ slots*)))))
+(export defstruct)
+
+(define-public (compose . functions)
+ (let ((functions* (drop-right functions 1))
+ (last-function (last functions)))
+ (letrec ((reduce (lambda (x functions)
+ (if (null? functions)
+ x
+ (reduce ((car functions) x) (cdr functions))))))
+ (lambda args (reduce (apply (last functions) args) (reverse functions*))))))
+
+(define-macro (push! object list-var)
+ ;; The same as in Common Lisp
+ `(set! ,list-var (cons ,object ,list-var)))
+(export push!)
+
+(define-macro (add! object list-var)
+ `(set! ,list-var (append ,list-var (list ,object))))
+(export add!)
+
+(define-public (flatten lst)
+ (cond
+ ((null? lst)
+ lst)
+ ((pair? (car lst))
+ (append (flatten (car lst)) (flatten (cdr lst))))
+ (else
+ (cons (car lst) (flatten (cdr lst))))))
+
+(define-public (safe-car list)
+ (if (null? list)
+ #f
+ (car list)))
+
+(define-public (safe-last list)
+ (if (null? list)
+ #f
+ (last list)))
+
+
+;;; LilyPond utility functions
+
+
+(define-public (music-property-value? music property value)
+ "Return true iff MUSIC's PROPERTY is equal to VALUE."
+ (equal? (ly:music-property music property) value))
+
+(define-public (music-name? music name)
+ "Return true iff MUSIC's name is NAME."
+ (if (list? name)
+ (member (ly:music-property music 'name) name)
+ (music-property-value? music 'name name)))
+
+(define-public (music-property? music property)
+ "Return true iff MUSIC is a property setter and sets or unsets PROPERTY."
+ (and (music-name? music '(PropertySet PropertyUnset))
+ (music-property-value? music 'symbol property)))
+
+(define-public (music-has-property? music property)
+ "Return true iff MUSIC contains PROPERTY."
+ (not (eq? (ly:music-property music property) '())))
+
+(define-public (property-value music)
+ "Return value of a property setter MUSIC.
+If it unsets the property, return #f."
+ (if (music-name? music 'PropertyUnset)
+ #f
+ (ly:music-property music 'value)))
+
+(define-public (music-elements music)
+ "Return list of all MUSIC's top-level children."
+ (let ((elt (ly:music-property music 'element))
+ (elts (ly:music-property music 'elements)))
+ (if (not (null? elt))
+ (cons elt elts)
+ elts)))
+
+(define-public (find-child music predicate)
+ "Find the first node in MUSIC that satisfies PREDICATE."
+ (define (find-child queue)
+ (if (null? queue)
+ #f
+ (let ((elt (car queue)))
+ (if (predicate elt)
+ elt
+ (find-child (append (music-elements elt) (cdr queue)))))))
+ (find-child (list music)))
+
+(define-public (find-child-named music name)
+ "Return the first child in MUSIC that is named NAME."
+ (find-child music (lambda (elt) (music-name? elt name))))
+
+(define-public (process-music music function)
+ "Process all nodes of MUSIC (including MUSIC) in the DFS order.
+Apply FUNCTION on each of the nodes.
+If FUNCTION applied on a node returns true, don't process the node's subtree."
+ (define (process-music queue)
+ (if (not (null? queue))
+ (let* ((elt (car queue))
+ (stop (function elt)))
+ (process-music (if stop
+ (cdr queue)
+ (append (music-elements elt) (cdr queue)))))))
+ (process-music (list music)))
--- /dev/null
+;;; festival.scm --- Festival singing mode output
+
+;; Copyright (C) 2006, 2007 Brailcom, o.p.s.
+
+;; Author: Milan Zamazal <pdm@brailcom.org>
+
+;; COPYRIGHT NOTICE
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+;; for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
+
+
+(define-module (scm song))
+
+(use-modules (srfi srfi-1))
+(use-modules (ice-9 optargs))
+(use-modules (ice-9 receive))
+
+(use-modules (lily))
+(use-modules (scm song-util))
+
+
+;;; Configuration
+
+
+;; The word to be sung in places where notes are played without lyrics.
+;; If it is #f, the places without lyrics are omitted on the output.
+(define-public *skip-word* "-skip-")
+
+;; If true, use syllables in the Festival XML file.
+;; If false, use whole words instead; this is necessary in languages like
+;; English, were the phonetic form cannot be deduced from syllables well enough.
+(define-public *syllabify* #f)
+
+;; Base Festival octave to which LilyPond notes are mapped.
+(define-public *base-octave* 5)
+;; The resulting base octave is sum of *base-octave* and
+;; *base-octave-shift*. This is done to work around a Festival bug
+;; causing Festival to segfault or produce invalid pitch on higher pitches.
+;(define *base-octave-shift* -2)
+(define *base-octave-shift* 0)
+
+;; The coeficient by which the notes just before \breath are shortened.
+(define-public *breathe-shortage* 0.8)
+
+
+;;; LilyPond interface
+
+
+(define-public (output-file music tempo filename)
+ (if *debug*
+ (debug-enable 'backtrace))
+ (ly:message "Writing Festival XML file ~a..." filename)
+ (let ((port (open-output-file filename)))
+ (write-header port tempo)
+ (write-lyrics port music)
+ (write-footer port))
+ #f)
+
+
+;;; Utility functions
+
+
+(define pp-pitch-names '((0 . "c") (1 . "des") (2 . "d") (3 . "es") (4 . "e") (5 . "f")
+ (6 . "ges") (7 . "g") (8 . "as") (9 . "a") (10 . "bes") (11 . "b")))
+(define (pp object)
+ (cond
+ ((list? object)
+ (format #f "[~{~a ~}]" (map pp object)))
+ ((skip? object)
+ (format #f "skip(~a)" (skip-duration object)))
+ ((lyrics? object)
+ (format #f "~a(~a)~a" (lyrics-text object) (lyrics-duration object)
+ (if (lyrics-unfinished object) "-" "")))
+ ((note? object)
+ (let ((pitch (ly:pitch-semitones (note-pitch object))))
+ (format #f "~a~a~a~a"
+ (cdr (assoc (modulo pitch 12) pp-pitch-names))
+ (let ((octave (+ (inexact->exact (floor (/ pitch 12))) 1)))
+ (cond
+ ((= octave 0)
+ "")
+ ((> octave 0)
+ (make-uniform-array #\' octave))
+ ((< octave 0)
+ (make-uniform-array #\, (- 0 octave)))))
+ (pp-duration (note-duration object))
+ (if (> (note-joined object) 0) "-" ""))))
+ ((rest? object)
+ (format #f "r~a" (pp-duration (rest-duration object))))
+ (else
+ object)))
+
+(define (pp-duration duration)
+ (set! duration (/ 4 duration))
+ (if (< (abs (- duration (inexact->exact duration))) 0.0001)
+ (inexact->exact duration)
+ (/ (round (* duration 100)) 100)))
+
+(define-public (warning object-with-origin message . args)
+ (let ((origin (cond
+ ((not object-with-origin)
+ #f)
+ ((note? object-with-origin)
+ (note-origin object-with-origin))
+ ((rest? object-with-origin)
+ (rest-origin object-with-origin))
+ ((ly:input-location? object-with-origin)
+ object-with-origin)
+ ((ly:music? object-with-origin)
+ (ly:music-property object-with-origin 'origin))
+ (else
+ (format #t "Minor programming error: ~a~%" object-with-origin)
+ #f))))
+ (if origin
+ (ly:input-message origin "***Song Warning***")
+ (format #t "~%***Song Warning***"))
+ (apply ly:message message (map pp args))))
+
+
+;;; Analysis functions
+
+
+(define *default-tempo* #f)
+(define *tempo-compression* #f)
+
+(define (duration->number duration)
+ (let* ((log (ly:duration-log duration))
+ (dots (ly:duration-dot-count duration))
+ (factor (ly:duration-factor duration)))
+ (exact->inexact (* (expt 2 (- log)) (+ 1 (/ dots 2)) (/ (car factor) (cdr factor))))))
+
+(define (tempo->beats music)
+ (let* ((tempo-spec (or (find-child-named music 'MetronomeChangeEvent)
+ (find-child-named music 'SequentialMusic)))
+ (tempo (cond
+ ((not tempo-spec)
+ #f)
+ ((music-name? tempo-spec 'MetronomeChangeEvent)
+ (* (ly:music-property tempo-spec 'metronome-count)
+ (duration->number (ly:music-property tempo-spec 'tempo-unit))))
+ ((music-name? tempo-spec 'SequentialMusic)
+ (* (property-value
+ (find-child tempo-spec (lambda (elt) (music-property? elt 'tempoUnitCount))))
+ (duration->number
+ (property-value
+ (find-child tempo-spec (lambda (elt) (music-property? elt 'tempoUnitDuration)))))))
+ (else
+ (format #t "Programming error (tempo->beats): ~a~%" tempo-spec)))))
+ (debug-enable 'backtrace)
+ (if (and tempo (music-name? tempo-spec 'SequentialMusic))
+ (set! *default-tempo* (property-value
+ (find-child tempo-spec (lambda (elt) (music-property? elt 'tempoWholesPerMinute))))))
+ (if tempo
+ (round (* tempo (expt 2 (+ 2 *base-octave-shift*))))
+ #f)))
+
+(defstruct music-context
+ music
+ context)
+
+(define (collect-lyrics-music music)
+ ;; Returns list of music-context instances.
+ (let ((music-context-list '()))
+ (process-music
+ music
+ (lambda (music*)
+ (cond
+ ((music-name? music* 'LyricCombineMusic)
+ (push! (make-music-context #:music music*
+ #:context (ly:music-property music* 'associated-context))
+ music-context-list)
+ #t)
+ ((and (music-name? music* 'ContextSpeccedMusic)
+ (music-property-value? music* 'context-type 'Lyrics)
+ (not (find-child-named music* 'LyricCombineMusic)))
+ (let ((name-node (find-child music* (lambda (node) (music-property? node 'associatedVoice)))))
+ (if name-node
+ (push! (make-music-context #:music music* #:context (property-value name-node))
+ music-context-list)))
+ #t)
+ (else
+ #f))))
+ (debug "Lyrics contexts" (reverse music-context-list))))
+
+(defstruct lyrics
+ text
+ duration
+ unfinished
+ ignore-melismata
+ context)
+
+(defstruct skip
+ duration
+ context)
+
+(define (get-lyrics music context)
+ ;; Returns list of lyrics and skip instances.
+ (let ((lyrics-list '())
+ (next-ignore-melismata #f)
+ (ignore-melismata #f)
+ (next-current-voice context)
+ (current-voice context))
+ (process-music
+ music
+ (lambda (music)
+ (cond
+ ;; true lyrics
+ ((music-name? music 'EventChord)
+ (let ((lyric-event (find-child-named music 'LyricEvent)))
+ (push! (make-lyrics
+ #:text (ly:music-property lyric-event 'text)
+ #:duration (* (duration->number (ly:music-property lyric-event 'duration)) 4)
+ #:unfinished (and (not *syllabify*) (find-child-named music 'HyphenEvent))
+ #:ignore-melismata ignore-melismata
+ #:context current-voice)
+ lyrics-list))
+ ;; LilyPond delays applying settings
+ (set! ignore-melismata next-ignore-melismata)
+ (set! current-voice next-current-voice)
+ #t)
+ ;; skipping
+ ((music-name? music 'SkipMusic)
+ (push! (make-skip
+ #:duration (* (duration->number (ly:music-property music 'duration)) 4)
+ #:context current-voice)
+ lyrics-list)
+ #t)
+ ;; parameter change
+ ((music-property? music 'ignoreMelismata)
+ (set! next-ignore-melismata (property-value music))
+ #t)
+ ((music-property? music 'associatedVoice)
+ (set! next-current-voice (property-value music))
+ #t)
+ ;; anything else
+ (else
+ #f))))
+ (debug "Raw lyrics" (reverse lyrics-list))))
+
+(defstruct score-voice
+ context
+ elements ; list of score-* instances
+ )
+
+(defstruct score-choice
+ lists ; of lists of score-* instances
+ (n-assigned 0) ; number of lists having a verse-block
+ )
+
+(defstruct score-repetice
+ count ; number of repetitions
+ elements ; list of score-* instances
+ )
+
+(defstruct score-notes
+ note/rest-list ; list of note and rest instances
+ (verse-block-list '()) ; lyrics attached to notes -- multiple elements are
+ ; possible for multiple stanzas
+ )
+
+(defstruct note
+ pitch
+ duration
+ joined ; to the next note
+ origin
+ )
+
+(defstruct rest
+ duration
+ origin
+ )
+
+(define (get-notes music)
+ ;; Returns list of score-* instances.
+ (get-notes* music #t))
+
+(define (get-notes* music autobeaming*)
+ ;; Returns list of score-* instances.
+ (let* ((result-list '())
+ (in-slur 0)
+ (autobeaming autobeaming*)
+ (last-note-spec #f))
+ (process-music
+ music
+ (lambda (music)
+ (cond
+ ;; context change
+ ((music-has-property? music 'context-id)
+ (let ((context (ly:music-property music 'context-id))
+ (children (music-elements music)))
+ (add! (make-score-voice #:context (debug "Changing context" context)
+ #:elements (append-map (lambda (elt)
+ (get-notes* elt autobeaming))
+ children))
+ result-list))
+ #t)
+ ;; timing change
+ ((music-property? music 'timeSignatureFraction)
+ (let ((value (property-value music)))
+ (debug "Timing change" value)))
+ ;; simultaneous notes
+ ((music-name? music 'SimultaneousMusic)
+ (let ((simultaneous-lists (map (lambda (child)
+ (get-notes* child autobeaming))
+ (ly:music-property music 'elements))))
+ (debug "Simultaneous lists" simultaneous-lists)
+ (add! (make-score-choice #:lists simultaneous-lists) result-list))
+ #t)
+ ;; repetice
+ ((music-name? music 'VoltaRepeatedMusic)
+ (let ((repeat-count (ly:music-property music 'repeat-count))
+ (children (music-elements music)))
+ (add! (make-score-repetice #:count repeat-count
+ #:elements (append-map
+ (lambda (elt) (get-notes* elt autobeaming))
+ children))
+ result-list))
+ #t)
+ ;; a note or rest
+ ((or (music-name? music 'EventChord)
+ (music-name? music 'MultiMeasureRestMusic)) ; 2.10
+ (debug "Simple music event" music)
+ (if *tempo-compression*
+ (set! music (ly:music-compress (ly:music-deep-copy music) *tempo-compression*)))
+ (let ((note (find-child-named music 'NoteEvent))
+ (rest (if (music-name? music 'MultiMeasureRestMusic) ; 2.10
+ music
+ (or (find-child-named music 'RestEvent)
+ (find-child-named music 'MultiMeasureRestEvent) ; 2.8
+ ))))
+ (cond
+ (note
+ (debug "Note" note)
+ (let* ((pitch (ly:music-property note 'pitch))
+ (duration (* (duration->number (ly:music-property note 'duration)) 4))
+ (events (filter identity (list
+ (find-child-named music 'SlurEvent)
+ (find-child-named music 'ManualMelismaEvent)
+ (and (not autobeaming)
+ (find-child-named music 'BeamEvent)))))
+ (slur-start (length (filter (lambda (e) (music-property-value? e 'span-direction -1))
+ events)))
+ (slur-end (length (filter (lambda (e) (music-property-value? e 'span-direction 1))
+ events))))
+ (set! in-slur (+ in-slur slur-start (- slur-end)))
+ (let ((note-spec (make-note #:pitch pitch #:duration duration #:joined in-slur
+ #:origin (ly:music-property note 'origin)))
+ (last-result (and (not (null? result-list)) (last result-list))))
+ (set! last-note-spec note-spec)
+ (if (and last-result
+ (score-notes? last-result))
+ (set-score-notes-note/rest-list!
+ last-result
+ (append (score-notes-note/rest-list last-result) (list note-spec)))
+ (add! (make-score-notes #:note/rest-list (list note-spec)) result-list)))))
+ (rest
+ (debug "Rest" rest)
+ (let* ((duration (* (duration->number (ly:music-property rest 'duration)) 4))
+ (rest-spec (make-rest #:duration duration
+ #:origin (ly:music-property rest 'origin)))
+ (last-result (and (not (null? result-list)) (last result-list))))
+ (if (and last-result
+ (score-notes? last-result))
+ (set-score-notes-note/rest-list! last-result
+ (append (score-notes-note/rest-list last-result)
+ (list rest-spec)))
+ (add! (make-score-notes #:note/rest-list (list rest-spec)) result-list))))))
+ #f)
+ ;; autobeaming change
+ ((music-property? music 'autoBeaming)
+ (set! autobeaming (property-value music))
+ #t)
+ ;; melisma change
+ ((music-property? music 'melismaBusy) ; 2.10
+ (let ((change (if (property-value music) 1 -1)))
+ (set! in-slur (+ in-slur change))
+ (if last-note-spec
+ (set-note-joined! last-note-spec (+ (note-joined last-note-spec) change)))))
+ ;; tempo change
+ ((music-property? music 'tempoWholesPerMinute)
+ (set! *tempo-compression* (ly:moment-div *default-tempo* (property-value music))))
+ ;; breathe
+ ((music-name? music 'BreathingEvent)
+ (if last-note-spec
+ (let* ((note-duration (note-duration last-note-spec))
+ (rest-spec (make-rest #:duration (* note-duration (- 1 *breathe-shortage*))
+ #:origin (ly:music-property music 'origin))))
+ (set-note-duration! last-note-spec (* note-duration *breathe-shortage*))
+ (add! (make-score-notes #:note/rest-list (list rest-spec)) result-list))
+ (warning music "\\\\breathe without previous note known")))
+ ;; anything else
+ (else
+ #f))))
+ (debug "Raw notes" result-list)))
+
+(defstruct verse-block ; lyrics for a given piece of music
+ verse-list
+ (fresh #t) ; if #t, this block hasn't been yet included in the final output
+ )
+
+(defstruct parallel-blocks ; several parallel blocks (e.g. stanzas)
+ block-list ; list of verse-blocks
+ )
+
+(defstruct sequential-blocks
+ block-list ; list of verse-blocks
+ )
+
+(defstruct repeated-blocks
+ block-list ; list of verse-blocks
+ count ; number of repetitions
+ )
+
+(defstruct verse ;
+ text ; separate text element (syllable or word)
+ notelist/rests ; list of note lists (slurs) and rests
+ (unfinished #f) ; whether to be merged with the following verse
+ )
+
+(define (find-lyrics-score score-list context accept-default)
+ ;; Returns score-* element of context or #f (if there's no such any).
+ (and (not (null? score-list))
+ (or (find-lyrics-score* (car score-list) context accept-default)
+ (find-lyrics-score (cdr score-list) context accept-default))))
+
+(define (find-lyrics-score* score context accept-default)
+ (cond
+ ((and (score-voice? score)
+ (equal? (score-voice-context score) context))
+ score)
+ ((score-voice? score)
+ (find-lyrics-score (score-voice-elements score) context #f))
+ ((score-choice? score)
+ (letrec ((lookup (lambda (lists)
+ (if (null? lists)
+ #f
+ (or (find-lyrics-score (car lists) context accept-default)
+ (lookup (cdr lists)))))))
+ (lookup (score-choice-lists score))))
+ ((score-repetice? score)
+ (if accept-default
+ score
+ (find-lyrics-score (score-repetice-elements score) context accept-default)))
+ ((score-notes? score)
+ (if accept-default
+ score
+ #f))
+ (else
+ (error "Unknown score element" score))))
+
+(define (insert-lyrics! lyrics/skip-list score-list context)
+ ;; Add verse-block-lists to score-list.
+ ;; Each processed score-notes instance must receive at most one block in each
+ ;; insert-lyrics! call. (It can get other blocks if more pieces of
+ ;; lyrics are attached to the same score part.)
+ (let ((lyrics-score-list (find-lyrics-score score-list context #f)))
+ (debug "Lyrics+skip list" lyrics/skip-list)
+ (debug "Corresponding score-* list" score-list)
+ (if lyrics-score-list
+ (insert-lyrics*! lyrics/skip-list (list lyrics-score-list) context)
+ (warning #f "Lyrics context not found: ~a" context))))
+
+(define (insert-lyrics*! lyrics/skip-list score-list context)
+ (debug "Processing lyrics" lyrics/skip-list)
+ (debug "Processing score" score-list)
+ (cond
+ ((and (null? lyrics/skip-list)
+ (null? score-list))
+ #f)
+ ((null? lyrics/skip-list)
+ (warning #f "Extra notes: ~a ~a" context score-list))
+ ((null? score-list)
+ (warning #f "Extra lyrics: ~a ~a" context lyrics/skip-list))
+ (else
+ (let* ((lyrics/skip (car lyrics/skip-list))
+ (lyrics-context ((if (lyrics? lyrics/skip) lyrics-context skip-context) lyrics/skip))
+ (score (car score-list)))
+ (cond
+ ((score-voice? score)
+ (let ((new-context (score-voice-context score)))
+ (if (equal? new-context lyrics-context)
+ (insert-lyrics*! lyrics/skip-list
+ (append (score-voice-elements score)
+ (if (null? (cdr score-list))
+ '()
+ (list (make-score-voice #:context context
+ #:elements (cdr score-list)))))
+ new-context)
+ (insert-lyrics*! lyrics/skip-list (cdr score-list) context))))
+ ((score-choice? score)
+ (let* ((lists* (score-choice-lists score))
+ (lists lists*)
+ (n-assigned (score-choice-n-assigned score))
+ (n 0)
+ (allow-default #f)
+ (score* #f))
+ (while (and (not score*)
+ (not (null? lists)))
+ (set! score* (find-lyrics-score (car lists) lyrics-context allow-default))
+ (set! lists (cdr lists))
+ (if (not score*)
+ (set! n (+ n 1)))
+ (if (and (null? lists)
+ (not allow-default)
+ (equal? lyrics-context context))
+ (begin
+ (set! allow-default #t)
+ (set! n 0)
+ (set! lists (score-choice-lists score)))))
+ (debug "Selected score" score*)
+ (if (and score*
+ (>= n n-assigned))
+ (begin
+ (if (> n n-assigned)
+ (receive (assigned-elts unassigned-elts) (split-at lists* n-assigned)
+ (set-score-choice-lists! score (append assigned-elts
+ (list (list-ref lists* n))
+ (take unassigned-elts (- n n-assigned))
+ lists))))
+ (set-score-choice-n-assigned! score (+ n-assigned 1))))
+ (insert-lyrics*! lyrics/skip-list (append (if score* (list score*) '()) (cdr score-list)) context)))
+ ((score-repetice? score)
+ (insert-lyrics*! lyrics/skip-list
+ (append (score-repetice-elements score) (cdr score-list)) context))
+ ((score-notes? score)
+ ;; This is the only part which actually attaches the processed lyrics.
+ ;; The subsequent calls return verses which we collect into a verse block.
+ ;; We add the block to the score element.
+ (if (equal? lyrics-context context)
+ (set! lyrics/skip-list (really-insert-lyrics! lyrics/skip-list score context)))
+ (insert-lyrics*! lyrics/skip-list (cdr score-list) context))
+ (else
+ (error "Unknown score element in lyrics processing" score)))))))
+
+(define (really-insert-lyrics! lyrics/skip-list score context)
+ ;; Return new lyrics/skip-list.
+ ;; Score is modified by side effect.
+ (debug "Assigning notes" score)
+ (let ((note-list (score-notes-note/rest-list score))
+ (unfinished-verse #f)
+ (verse-list '()))
+ (while (not (null? note-list))
+ (if (null? lyrics/skip-list)
+ (let ((final-rests '()))
+ (while (and (not (null? note-list))
+ (rest? (car note-list)))
+ (push! (car note-list) final-rests)
+ (set! note-list (cdr note-list)))
+ (if (not (null? final-rests))
+ (set! verse-list (append verse-list
+ (list (make-verse #:text ""
+ #:notelist/rests (reverse! final-rests))))))
+ (if (not (null? note-list))
+ (begin
+ (warning (car note-list) "Missing lyrics: ~a ~a" context note-list)
+ (set! note-list '()))))
+ (let ((lyrics/skip (car lyrics/skip-list)))
+ (receive (notelist/rest note-list*) (if (lyrics? lyrics/skip)
+ (consume-lyrics-notes lyrics/skip note-list context)
+ (consume-skip-notes lyrics/skip note-list context))
+ (debug "Consumed notes" (list lyrics/skip notelist/rest))
+ (set! note-list note-list*)
+ (cond
+ ((null? notelist/rest)
+ #f)
+ ;; Lyrics
+ ((and (lyrics? lyrics/skip)
+ unfinished-verse)
+ (set-verse-text!
+ unfinished-verse
+ (string-append (verse-text unfinished-verse) (lyrics-text lyrics/skip)))
+ (set-verse-notelist/rests!
+ unfinished-verse
+ (append (verse-notelist/rests unfinished-verse) (list notelist/rest)))
+ (if (not (lyrics-unfinished lyrics/skip))
+ (set! unfinished-verse #f)))
+ ((lyrics? lyrics/skip)
+ (let ((verse (make-verse #:text (if (rest? notelist/rest)
+ ""
+ (lyrics-text lyrics/skip))
+ #:notelist/rests (list notelist/rest))))
+ (add! verse verse-list)
+ (set! unfinished-verse (if (lyrics-unfinished lyrics/skip) verse #f))))
+ ;; Skip
+ ((skip? lyrics/skip)
+ (cond
+ ((rest? notelist/rest)
+ (if (null? verse-list)
+ (set! verse-list (list (make-verse #:text ""
+ #:notelist/rests (list notelist/rest))))
+ (let ((last-verse (last verse-list)))
+ (set-verse-notelist/rests!
+ last-verse
+ (append (verse-notelist/rests last-verse) (list notelist/rest))))))
+ ((pair? notelist/rest)
+ (add! (make-verse #:text *skip-word* #:notelist/rests (list notelist/rest))
+ verse-list))
+ (else
+ (error "Unreachable branch reached")))
+ (set! unfinished-verse #f)))
+ (if (not (rest? notelist/rest))
+ (set! lyrics/skip-list (cdr lyrics/skip-list)))))))
+ (if unfinished-verse
+ (set-verse-unfinished! unfinished-verse #t))
+ (set-score-notes-verse-block-list!
+ score
+ (append (score-notes-verse-block-list score)
+ (list (make-verse-block #:verse-list verse-list)))))
+ lyrics/skip-list)
+
+(define (consume-lyrics-notes lyrics note-list context)
+ ;; Returns list of note instances + new note-list.
+ (assert (lyrics? lyrics))
+ (if (and (not (null? note-list))
+ (rest? (car note-list)))
+ (values (car note-list) (cdr note-list))
+ (let ((ignore-melismata (lyrics-ignore-melismata lyrics))
+ (join #t)
+ (consumed '()))
+ (while (and join
+ (not (null? note-list)))
+ (let ((note (car note-list)))
+ (push! note consumed)
+ (let ((note-slur (note-joined note)))
+ (if (< note-slur 0)
+ (warning note "Slur underrun"))
+ (set! join (and (not ignore-melismata) (> note-slur 0)))))
+ (set! note-list (cdr note-list)))
+ (if join
+ (warning (safe-car (if (null? note-list) consumed note-list))
+ "Unfinished slur: ~a ~a" context consumed))
+ (values (reverse consumed) note-list))))
+
+(define (consume-skip-notes skip note-list context)
+ ;; Returns either note list (skip word defined) or rest instance (no skip word) + new note-list.
+ (assert (skip? skip))
+ (let ((duration (skip-duration skip))
+ (epsilon 0.001)
+ (consumed '()))
+ (while (and (> duration epsilon)
+ (not (null? note-list)))
+ (let ((note (car note-list)))
+ (assert (note? note))
+ (push! note consumed)
+ (set! duration (- duration (note-duration note))))
+ (set! note-list (cdr note-list)))
+ (set! consumed (reverse! consumed))
+ (cond
+ ((> duration epsilon)
+ (warning (if (null? note-list) (safe-last consumed) (safe-car note-list))
+ "Excessive skip: ~a ~a ~a ~a" context skip duration consumed))
+ ((< duration (- epsilon))
+ (warning (if (null? note-list) (safe-last consumed) (safe-car note-list))
+ "Skip misalignment: ~a ~a ~a ~a" context skip duration consumed)))
+ (values (if *skip-word*
+ consumed
+ '())
+ note-list)))
+
+(define (extract-verse-blocks score)
+ ;; Returns list of blocks and parallel blocks.
+ (debug "Extracting verse blocks" score)
+ (cond
+ ((score-voice? score)
+ (append-map extract-verse-blocks (score-voice-elements score)))
+ ((score-choice? score)
+ (list (make-parallel-blocks
+ #:block-list (map (lambda (block-list)
+ (make-sequential-blocks
+ #:block-list (append-map extract-verse-blocks block-list)))
+ (score-choice-lists score)))))
+ ((score-repetice? score)
+ (list (make-repeated-blocks #:count (score-repetice-count score)
+ #:block-list (append-map extract-verse-blocks
+ (score-repetice-elements score)))))
+ ((score-notes? score)
+ (list (make-parallel-blocks #:block-list (score-notes-verse-block-list score))))
+ (else
+ (error "Invalid score element" score))))
+
+(define (extract-verses score-list)
+ ;; Returns (final) list of verses.
+ ;; The primary purpose of this routine is to build complete stanzas from
+ ;; lists of verse blocks.
+ ;; Extract verse-blocks and process them until no unprocessed stanzas remain.
+ (debug "Final score list" score-list)
+ (let ((verse-block-list (debug "Verse blocks" (append-map extract-verse-blocks score-list))))
+ (letrec ((combine (lambda (lst-1 lst-2)
+ (debug "Combining lists" (list lst-1 lst-2))
+ (if (null? lst-2)
+ lst-1
+ (let ((diff (- (length lst-1) (length lst-2))))
+ (if (< diff 0)
+ (let ((last-elt (last lst-1)))
+ (while (< diff 0)
+ (add! last-elt lst-1)
+ (set! diff (+ diff 1))))
+ (let ((last-elt (last lst-2)))
+ (while (> diff 0)
+ (add! last-elt lst-2)
+ (set! diff (- diff 1)))))
+ (debug "Combined" (map append lst-1 lst-2))))))
+ (expand* (lambda (block)
+ (cond
+ ((parallel-blocks? block)
+ (append-map (lambda (block) (expand (list block)))
+ (parallel-blocks-block-list block)))
+ ((sequential-blocks? block)
+ (expand (sequential-blocks-block-list block)))
+ ((repeated-blocks? block)
+ ;; Only simple repetice without nested parallel sections is supported.
+ (let ((count (repeated-blocks-count block))
+ (expanded (expand (repeated-blocks-block-list block)))
+ (expanded* '()))
+ (while (not (null? expanded))
+ (let ((count* count)
+ (item '()))
+ (while (and (> count* 0) (not (null? expanded)))
+ (set! item (append item (car expanded)))
+ (set! expanded (cdr expanded))
+ (set! count* (- count* 1)))
+ (push! item expanded*)))
+ (reverse expanded*)))
+ (else
+ (list (list block))))))
+ (expand (lambda (block-list)
+ (debug "Expanding list" block-list)
+ (if (null? block-list)
+ '()
+ (debug "Expanded" (combine (expand* (car block-list))
+ (expand (cdr block-list)))))))
+ (merge (lambda (verse-list)
+ (cond
+ ((null? verse-list)
+ '())
+ ((verse-unfinished (car verse-list))
+ (let ((verse-1 (first verse-list))
+ (verse-2 (second verse-list)))
+ (merge (cons (make-verse #:text (string-append (verse-text verse-1)
+ (verse-text verse-2))
+ #:notelist/rests (append (verse-notelist/rests verse-1)
+ (verse-notelist/rests verse-2))
+ #:unfinished (verse-unfinished verse-2))
+ (cddr verse-list)))))
+ (else
+ (cons (car verse-list) (merge (cdr verse-list))))))))
+ (debug "Final verses" (merge (append-map (lambda (lst) (append-map verse-block-verse-list lst))
+ (expand verse-block-list)))))))
+
+(define (handle-music music)
+ ;; Returns list of verses.
+ ;; The main analysis function.
+ (if *debug*
+ (display-scheme-music music))
+ (let ((score-list (debug "Final raw notes" (get-notes music)))
+ (music-context-list (collect-lyrics-music music)))
+ (for-each (lambda (music-context)
+ (let ((context (music-context-context music-context)))
+ (set! *tempo-compression* #f)
+ (insert-lyrics! (get-lyrics (music-context-music music-context) context)
+ score-list context)
+ (debug "Final score list" score-list)))
+ music-context-list)
+ (extract-verses score-list)))
+
+
+;;; Output
+
+
+(define festival-note-mapping '((0 "C") (1 "C#") (2 "D") (3 "D#") (4 "E") (5 "F") (6 "F#")
+ (7 "G") (8 "G#") (9 "A") (10 "A#") (11 "B")))
+(define (festival-pitch pitch)
+ (let* ((semitones (ly:pitch-semitones pitch))
+ (octave (inexact->exact (floor (/ semitones 12))))
+ (tone (modulo semitones 12)))
+ (format #f "~a~a" (cadr (assoc tone festival-note-mapping))
+ (+ octave *base-octave* *base-octave-shift*))))
+
+(define (write-header port tempo)
+ (let ((beats (or (tempo->beats tempo) 100)))
+ (format port "<?xml version=\"1.0\"?>
+<!DOCTYPE SINGING PUBLIC \"-//SINGING//DTD SINGING mark up//EN\" \"Singing.v0_1.dtd\" []>
+<SINGING BPM=\"~d\">
+" beats)))
+
+(define (write-footer port)
+ (format port "</SINGING>~%"))
+
+(define (write-lyrics port music)
+ (let ((rest-dur 0))
+ (for-each (lambda (verse)
+ (let ((text (verse-text verse))
+ (note/rest-list (verse-notelist/rests verse)))
+ (receive (rest-list note-listlist) (partition rest? note/rest-list)
+ (debug "Rest list" rest-list)
+ (debug "Note list" note-listlist)
+ (if (not (null? rest-list))
+ (set! rest-dur (+ rest-dur (apply + (map rest-duration rest-list)))))
+ (if (not (null? note-listlist))
+ (begin
+ (if (> rest-dur 0)
+ (begin
+ (write-rest-element port rest-dur)
+ (set! rest-dur 0)))
+ (write-lyrics-element port text note-listlist))))))
+ (handle-music music))
+ (if (> rest-dur 0)
+ (write-rest-element port rest-dur))))
+
+(define (write-lyrics-element port text slur-list)
+ (let ((fmt "~{~{~a~^+~}~^,~}")
+ (transform (lambda (function)
+ (map (lambda (slur)
+ (let ((rests (filter rest? slur)))
+ (if (not (null? rests))
+ (begin
+ (warning (car rests) "Rests in a slur: ~a" slur)
+ (set! slur (remove rest? slur)))))
+ (map function slur))
+ slur-list))))
+ (format port "<DURATION BEATS=\"~@?\"><PITCH NOTE=\"~@?\">~a</PITCH></DURATION>~%"
+ fmt (transform note-duration)
+ fmt (transform (compose festival-pitch note-pitch))
+ text)))
+
+(define (write-rest-element port duration)
+ (format port "<REST BEATS=\"~a\"></REST>~%" duration))
depth = ..
-SEXECUTABLES=convert-ly lilypond-book abc2ly etf2ly midi2ly lilypond-invoke-editor musicxml2ly
+SEXECUTABLES=convert-ly lilypond-book abc2ly etf2ly midi2ly lilypond-invoke-editor musicxml2ly lilysong lilymidi
STEPMAKE_TEMPLATES=script help2man po
LOCALSTEPMAKE_TEMPLATES = lilypond
--- /dev/null
+#!@TARGET_PYTHON@
+
+# Copyright (C) 2006, 2007 Brailcom, o.p.s.
+#
+# Author: Milan Zamazal <pdm@brailcom.org>
+#
+# COPYRIGHT NOTICE
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+# for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
+
+
+import optparse
+import os
+import sys
+
+"""
+@relocate-preamble@
+"""
+
+def process_options (args):
+ parser = optparse.OptionParser (version="@TOPLEVEL_VERSION@")
+ parser.add_option ('', '--filter-tracks', metavar='REGEXP', action='store', type='string', dest='regexp',
+ help="display only tracks numbers, of those track names matching REGEXP")
+ parser.add_option ('', '--prefix-tracks', metavar='PREFIX', action='store', type='string', dest='prefix',
+ help="prefix filtered track numbers with PREFIX")
+ parser.add_option ('', '--dump', action='store_true', dest='dump',
+ help="just dump parsed contents of the MIDI file")
+ parser.usage = parser.usage + " FILE"
+ options, args = parser.parse_args (args)
+ if len (args) != 1:
+ parser.print_help ()
+ sys.exit (2)
+ return options, args
+
+def read_midi (file):
+ import midi
+ return midi.parse (open (file).read ())
+
+def track_info (data):
+ tracks = data[1]
+ def track_name (track):
+ name = ''
+ for time, event in track:
+ if time > 0:
+ break
+ if event[0] == 255 and event[1] == 3:
+ name = event[2]
+ break
+ return name
+ track_info = []
+ for i in range (len (tracks)):
+ track_info.append ((i, track_name (tracks[i])))
+ return track_info
+
+def go ():
+ options, args = process_options (sys.argv[1:])
+ midi_file = args[0]
+ midi_data = read_midi (midi_file)
+ info = track_info (midi_data)
+ if options.dump:
+ print midi_data
+ elif options.regexp:
+ import re
+ regexp = re.compile (options.regexp)
+ numbers = [str(n+1) for n, name in info if regexp.search (name)]
+ if numbers:
+ if options.prefix:
+ sys.stdout.write ('%s ' % (options.prefix,))
+ import string
+ sys.stdout.write (string.join (numbers, ','))
+ sys.stdout.write ('\n')
+ else:
+ for n, name in info:
+ sys.stdout.write ('%d %s\n' % (n+1, name,))
+
+if __name__ == '__main__':
+ go ()
--- /dev/null
+#!@TARGET_PYTHON@
+
+# Copyright (C) 2006, 2007 Brailcom, o.p.s.
+#
+# Author: Milan Zamazal <pdm@brailcom.org>
+#
+# COPYRIGHT NOTICE
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+# for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
+
+
+import codecs
+import optparse
+import os
+import popen2
+import sys
+import tempfile
+
+"""
+@relocate-preamble@
+"""
+
+
+FESTIVAL_COMMAND = 'festival --pipe'
+VOICE_CODINGS = {'voice_czech_ph': 'iso-8859-2'}
+
+_USAGE = """lilysong [ -p PLAY-PROGRAM ] FILE.xml [ LANGUAGE-CODE-OR-VOICE [ SPEEDUP ] ]
+./lilysong FILE.ly [ LANGUAGE-CODE-OR-VOICE ]
+./lilysong --list-voices
+./lilysong --list-languages
+"""
+
+def usage ():
+ print 'usage:', _USAGE
+ sys.exit (2)
+
+def process_options (args):
+ parser = optparse.OptionParser (usage=_USAGE, version="@TOPLEVEL_VERSION@")
+ parser.add_option ('', '--list-voices', action='store_true', dest='list_voices',
+ help="list available Festival voices")
+ parser.add_option ('', '--list-languages', action='store_true', dest='list_languages',
+ help="list available Festival languages")
+ parser.add_option ('-p', '--play-program', metavar='PROGRAM',
+ action='store', type='string', dest='play_program',
+ help="use PROGRAM to play song immediately")
+ options, args = parser.parse_args (args)
+ return options, args
+
+def call_festival (scheme_code):
+ in_, out = popen2.popen2 (FESTIVAL_COMMAND)
+ out.write (scheme_code)
+ out.close ()
+ answer = ''
+ while True:
+ process_output = in_.read ()
+ if not process_output:
+ break
+ answer = answer + process_output
+ return answer
+
+def select_voice (language_or_voice):
+ if language_or_voice[:6] == 'voice_':
+ voice = language_or_voice
+ else:
+ voice = call_festival ('''
+(let ((candidates '()))
+ (mapcar (lambda (v)
+ (if (eq (cadr (assoc 'language (cadr (voice.description v)))) '%s)
+ (set! candidates (cons v candidates))))
+ (append (voice.list) (mapcar car Voice_descriptions)))
+ (if candidates
+ (format t "voice_%%s" (car candidates))
+ (format t "nil")))
+''' % (language_or_voice,))
+ if voice == 'nil':
+ voice = None
+ return voice
+
+def list_voices ():
+ print call_festival ('''
+(let ((voices (voice.list))
+ (print-voice (lambda (v) (format t "voice_%s\n" v))))
+ (mapcar print-voice voices)
+ (mapcar (lambda (v) (if (not (member v voices)) (print-voice v)))
+ (mapcar car Voice_descriptions)))
+''')
+
+def list_languages ():
+ print call_festival ('''
+(let ((languages '()))
+ (let ((voices (voice.list))
+ (print-language (lambda (v)
+ (let ((language (cadr (assoc 'language (cadr (voice.description v))))))
+ (if (and language (not (member language languages)))
+ (begin
+ (set! languages (cons language languages))
+ (print language)))))))
+ (mapcar print-language voices)
+ (mapcar (lambda (v) (if (not (member v voices)) (print-language v)))
+ (mapcar car Voice_descriptions))))
+''')
+
+def process_xml_file (file_name, voice, speedup, play_program):
+ if speedup == 1:
+ speedup = None
+ coding = (VOICE_CODINGS.get (voice) or 'iso-8859-1')
+ _, xml_temp_file = tempfile.mkstemp ('.xml')
+ try:
+ # recode the XML file
+ recodep = (coding != 'utf-8')
+ if recodep:
+ decode = codecs.getdecoder ('utf-8')
+ encode = codecs.getencoder (coding)
+ input = open (file_name)
+ output = open (xml_temp_file, 'w')
+ while True:
+ data = input.read ()
+ if not data:
+ break
+ if recodep:
+ data = encode (decode (data)[0])[0]
+ output.write (data)
+ output.close ()
+ # synthesize
+ wav_file = file_name[:-3] + 'wav'
+ if speedup:
+ _, wav_temp_file = tempfile.mkstemp ('.wav')
+ else:
+ wav_temp_file = wav_file
+ try:
+ print "text2wave -eval '(%s)' -mode singing '%s' -o '%s'" % (voice, xml_temp_file, wav_temp_file,)
+ result = os.system ("text2wave -eval '(%s)' -mode singing '%s' -o '%s'" %
+ (voice, xml_temp_file, wav_temp_file,))
+ if result:
+ sys.stdout.write ("Festival processing failed.\n")
+ return
+ if speedup:
+ result = os.system ("sox '%s' '%s' speed '%f'" % (wav_temp_file, wav_file, speedup,))
+ if result:
+ sys.stdout.write ("Festival processing failed.\n")
+ return
+ finally:
+ if speedup:
+ try:
+ os.delete (wav_temp_file)
+ except:
+ pass
+ sys.stdout.write ("%s created.\n" % (wav_file,))
+ # play
+ if play_program:
+ os.system ("%s '%s' >/dev/null" % (play_program, wav_file,))
+ finally:
+ try:
+ os.delete (xml_temp_file)
+ except:
+ pass
+
+def process_ly_file (file_name, voice):
+ result = os.system ("lilypond '%s'" % (file_name,))
+ if result:
+ return
+ xml_file = None
+ for f in os.listdir (os.path.dirname (file_name) or '.'):
+ if (f[-4:] == '.xml' and
+ (not xml_file or os.stat.st_mtime (f) > os.stat.st_mtime (xml_file))):
+ xml_file = f
+ if xml_file:
+ process_xml_file (xml_file, voice, None, None)
+ else:
+ sys.stderr.write ("No XML file found\n")
+
+def go ():
+ options, args = process_options (sys.argv[1:])
+ if options.list_voices:
+ list_voices ()
+ elif options.list_languages:
+ list_languages ()
+ else:
+ arglen = len (args)
+ if arglen < 1:
+ usage ()
+ file_name = args[0]
+ if arglen > 1:
+ language_or_voice = args[1]
+ voice = select_voice (language_or_voice)
+ else:
+ voice = None
+ if file_name[-3:] == '.ly':
+ if arglen > 2:
+ usage ()
+ process_ly_file (file_name, voice)
+ else:
+ if arglen > 3:
+ usage ()
+ elif arglen == 3:
+ try:
+ speedup = float (args[2])
+ except ValueError:
+ usage ()
+ else:
+ speedup = None
+ process_xml_file (file_name, voice, speedup, options.play_program)
+
+if __name__ == '__main__':
+ go ()
projects / lilypond.git / commitdiff