X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fsong.scm;h=9655e321e49afe05c00a48361d2d8f8fc3bbc608;hb=a6a3f2bfa82f7c9e8f7b153a4cb649beaef80c16;hp=8edacdf13c24d8b03d4888d5058ff0c9a3dfcc38;hpb=175da222fd01361eb901ba2c55d9b2574126bf41;p=lilypond.git diff --git a/scm/song.scm b/scm/song.scm index 8edacdf13c..9655e321e4 100644 --- a/scm/song.scm +++ b/scm/song.scm @@ -1,34 +1,31 @@ -;;; festival.scm --- Festival singing mode output - -;; Copyright (C) 2006, 2007 Brailcom, o.p.s. - -;; Author: Milan Zamazal - -;; 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 +;;;; +;;;; 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 . + + +(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 @@ -36,23 +33,23 @@ ;; 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 @@ -87,7 +84,7 @@ ((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) @@ -143,29 +140,28 @@ (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 @@ -223,7 +219,7 @@ (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)) @@ -277,7 +273,7 @@ joined ; to the next note origin ) - + (defstruct rest duration origin @@ -396,9 +392,9 @@ ((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"))) ;; anything else @@ -424,7 +420,7 @@ 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 @@ -606,7 +602,7 @@ 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"))) @@ -643,7 +639,7 @@ (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)) @@ -665,7 +661,7 @@ ((< 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))) @@ -773,7 +769,7 @@ (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))) @@ -786,8 +782,8 @@ (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)))