-;;; 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))
+;;;; song.scm --- Festival singing mode output
+;;;;
+;;;; This file is part of LilyPond, the GNU music typesetter.
+;;;;
+;;;; Copyright (C) 2006, 2007 Brailcom, o.p.s.
+;;;; Author: Milan Zamazal <pdm@brailcom.org>
+;;;;
+;;;; LilyPond 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 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; LilyPond 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 LilyPond. If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (scm song)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-39)
+ #:use-module (ice-9 optargs)
+ #:use-module (ice-9 receive)
+ #:use-module (lily)
+ #:use-module (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-")
+(define-public *skip-word* (make-parameter "-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)
+(define-public *syllabify* (make-parameter #f))
;; Base Festival octave to which LilyPond notes are mapped.
-(define-public *base-octave* 5)
+(define-public *base-octave* (make-parameter 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)
+(define *base-octave-shift* (make-parameter 0))
;; The coeficient by which the notes just before \breath are shortened.
-(define-public *breathe-shortage* 0.8)
+(define-public *breathe-shortage* (make-parameter 0.8))
;;; LilyPond interface
((note? object)
(let ((pitch (ly:pitch-semitones (note-pitch object))))
(format #f "~a~a~a~a"
- (cdr (assoc (modulo pitch 12) pp-pitch-names))
+ (assoc-get (modulo pitch 12) pp-pitch-names)
(let ((octave (+ (inexact->exact (floor (/ pitch 12))) 1)))
(cond
((= octave 0)
"")
((> octave 0)
- (make-uniform-array #\' octave))
+ (make-string octave #\'))
((< octave 0)
- (make-uniform-array #\, (- 0 octave)))))
+ (make-string (- octave) #\,))))
(pp-duration (note-duration object))
(if (> (note-joined object) 0) "-" ""))))
((rest? object)
(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)))
+ (let* ((tempo-spec (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)))))
+ (tempo-spec
+ (let ((tempo-event (find-child-named tempo-spec
+ 'TempoChangeEvent)))
+ (and tempo-event
+ (let ((count (ly:music-property tempo-event
+ 'metronome-count)))
+ (* (if (pair? count)
+ (round (/ (+ (car count) (cdr count)) 2))
+ count)
+ (duration->number
+ (ly:music-property tempo-event 'tempo-unit)))))))
+ (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)))
+ (and tempo
+ (set! *default-tempo* (property-value
+ (find-child tempo-spec (lambda (elt)
+ (music-property? elt 'tempoWholesPerMinute)))))
+ (round (* tempo (expt 2 (+ 2 (*base-octave-shift*))))))))
(defstruct music-context
music
(lambda (music)
(cond
;; true lyrics
- ((music-name? music 'EventChord)
+ ((music-name? music '(EventChord LyricEvent))
(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))
+ #:unfinished (and (not (*syllabify*)) (find-child-named music 'HyphenEvent))
#:ignore-melismata ignore-melismata
#:context current-voice)
lyrics-list))
joined ; to the next note
origin
)
-
+
(defstruct rest
duration
origin
(append (score-notes-note/rest-list last-result)
(list rest-spec)))
(add! (make-score-notes #:note/rest-list (list rest-spec)) result-list))))))
- #f)
+ (filter
+ (lambda (m)
+ (not (music-name? m '(RestEvent
+ NoteEvent
+ LyricEvent
+ MultiMeasureRestEvent))))
+ (ly:music-property music 'elements)))
+ ((music-name? music '(RestEvent
+ NoteEvent
+ LyricEvent
+ MultiMeasureRestEvent))
+ (make-music 'EventChord
+ 'elements
+ (cons music
+ (ly:music-property music 'articulations))))
;; autobeaming change
((music-property? music 'autoBeaming)
(set! autobeaming (property-value music))
(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)))))
+ (set-note-joined! last-note-spec (+ (note-joined last-note-spec) change))))
+ #t)
;; tempo change
((music-property? music 'tempoWholesPerMinute)
- (set! *tempo-compression* (ly:moment-div *default-tempo* (property-value music))))
+ (set! *tempo-compression* (ly:moment-div *default-tempo* (property-value music)))
+ #t)
;; 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*))
+ (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*))
+ (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")))
+ (warning music "\\\\breathe without previous note known"))
+ #t)
;; anything else
(else
#f))))
count ; number of repetitions
)
-(defstruct verse ;
+(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
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))
+ (add! (make-verse #:text (*skip-word*) #:notelist/rests (list notelist/rest))
verse-list))
(else
(error "Unreachable branch reached")))
(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))
((< 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*
+ (values (if (*skip-word*)
consumed
'())
note-list)))
(insert-lyrics! (get-lyrics (music-context-music music-context) context)
score-list context)
(debug "Final score list" score-list)))
- music-context-list)
+ music-context-list)
(extract-verses score-list)))
(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*))))
+ (format #f "~a~a" (car (assoc-get tone festival-note-mapping))
+ (+ octave (*base-octave*) (*base-octave-shift*)))))
(define (write-header port tempo)
(let ((beats (or (tempo->beats tempo) 100)))
projects / lilypond.git / blobdiff