X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fsong.scm;h=9dbca9fd6286d7c1c8204075840737c8e4d287fc;hb=93b7a6ff072d73dcdd41da59cd18da8aa8d8e8cb;hp=313480a85a04e42715eb417c08af51f8ead1ce77;hpb=d0c106f0391e64451d41db3ed11d1aa27afebbbb;p=lilypond.git diff --git a/scm/song.scm b/scm/song.scm index 313480a85a..9dbca9fd62 100644 --- a/scm/song.scm +++ b/scm/song.scm @@ -1,24 +1,22 @@ -;;; 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. +;;;; 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)) @@ -65,7 +63,8 @@ (let ((port (open-output-file filename))) (write-header port tempo) (write-lyrics port music) - (write-footer port)) + (write-footer port) + (close-port port)) #f) @@ -86,7 +85,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) @@ -142,29 +141,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 @@ -276,7 +274,7 @@ joined ; to the next note origin ) - + (defstruct rest duration origin @@ -423,7 +421,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 @@ -642,7 +640,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)) @@ -772,7 +770,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))) @@ -785,7 +783,7 @@ (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)) + (format #f "~a~a" (car (assoc-get tone festival-note-mapping)) (+ octave *base-octave* *base-octave-shift*)))) (define (write-header port tempo)