From: Han-Wen Nienhuys Date: Sun, 20 Apr 2003 16:31:13 +0000 (+0000) Subject: * ly/german-chords-init.ly: remove file X-Git-Tag: release/1.7.17~6 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=50308a5fdf9642595e226c8d5c5eef76ddcc9f6c;p=lilypond.git * ly/german-chords-init.ly: remove file * input/test/chord-names-german.ly (scm): new file. * ly/engraver-init.ly (ScoreContext): add chordRootNamer property. * lily/chord-name-engraver.cc: move New_chord_name_engraver to Chord_name_engraver * Documentation/user/refman.itely: lots of updates. --- diff --git a/ChangeLog b/ChangeLog index c097ef313a..744671a493 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,14 @@ 2003-04-20 Han-Wen Nienhuys + * ly/german-chords-init.ly: remove file + + * input/test/chord-names-german.ly (scm): new file. + + * ly/engraver-init.ly (ScoreContext): add chordRootNamer property. + + * lily/chord-name-engraver.cc: move New_chord_name_engraver to + Chord_name_engraver + * Documentation/user/refman.itely: lots of updates. * input/regression/chord-name-exceptions.ly (chExceptionMusic): diff --git a/Documentation/user/refman.itely b/Documentation/user/refman.itely index a14229aa1f..7fe70a71ed 100644 --- a/Documentation/user/refman.itely +++ b/Documentation/user/refman.itely @@ -3283,6 +3283,12 @@ separators, e.g. = \markup { "|" } c:7sus4 } @end lilypond + +@item chordRootNamer +The root of a chord is usually printed as a letter with an optional +alteration. The transformation from pitch to letter is done by this +function. An application of setting this function, is providing chord +names with german notation for the root. @end table diff --git a/input/test/chord-names-german.ly b/input/test/chord-names-german.ly new file mode 100644 index 0000000000..9d883cddfd --- /dev/null +++ b/input/test/chord-names-german.ly @@ -0,0 +1,18 @@ + +\version "1.7.16" +\header { + + texidoc = "By setting @code{ChordNames.chordRootNamer}, the root + of the chord may be named with a different function." + +} + +scm = \chords { c4 b bes } +\score { + +< \context ChordNames \chords < + \property ChordNames. chordRootNamer = #note-name->german-markup + \scm > + \context Voice \scm > +\paper { raggedright = ##t } +} diff --git a/lily/chord-name-engraver.cc b/lily/chord-name-engraver.cc index 8860c235c4..28f9cf803f 100644 --- a/lily/chord-name-engraver.cc +++ b/lily/chord-name-engraver.cc @@ -17,6 +17,8 @@ #include "item.hh" #include "pitch.hh" #include "protected-scm.hh" +#include "translator-group.hh" +#include "warn.hh" class Chord_name_engraver : public Engraver { @@ -30,8 +32,8 @@ private: void add_note (Music *); Item* chord_name_; - - Protected_scm chord_; + Link_array notes_; + Protected_scm last_chord_; }; @@ -40,26 +42,79 @@ private: Chord_name_engraver::Chord_name_engraver () { chord_name_ = 0; - chord_ = gh_cons (SCM_EOL, gh_cons (SCM_EOL, SCM_EOL)); - last_chord_ = chord_; + last_chord_ = SCM_EOL; } void Chord_name_engraver::add_note (Music * n) { - SCM pitches = ly_car (chord_); - SCM modifiers = ly_cdr (chord_); - SCM inversion = modifiers == SCM_EOL ? SCM_EOL : ly_car (modifiers); - SCM bass = modifiers == SCM_EOL ? SCM_EOL : ly_cdr (modifiers); + notes_.push (n); +} + +void +Chord_name_engraver::process_music () +{ + if (!notes_.size() ) + return; + + SCM bass = SCM_EOL; + SCM inversion = SCM_EOL; + SCM pitches = SCM_EOL; + + Music* inversion_event = 0; + for (int i =0 ; i < notes_.size (); i++) + { + Music *n = notes_[i]; + SCM p = n->get_mus_property ("pitch"); + if (!unsmob_pitch (p)) + continue; + + if (n->get_mus_property ("inversion") == SCM_BOOL_T) + { + inversion_event = n; + inversion = p; + } + else if (n->get_mus_property ("bass") == SCM_BOOL_T) + bass = p; + else + pitches = gh_cons (p, pitches); + } + + if (inversion_event) + { + SCM oct = inversion_event->get_mus_property ("octavation"); + if (gh_number_p (oct)) + { + Pitch *p = unsmob_pitch (inversion_event->get_mus_property ("pitch")); + int octavation = gh_scm2int (oct); + Pitch orig = p->transposed (Pitch (-octavation, 0,0)); + + pitches= gh_cons (orig.smobbed_copy (), pitches); + } + else + programming_error ("Inversion does not have original pitch."); + } + + pitches = scm_sort_list (pitches, Pitch::less_p_proc); + + SCM name_proc = get_property ("chordNameFunction"); + SCM markup = scm_call_4 (name_proc, pitches, bass, inversion, + daddy_trans_->self_scm()); + + /* + Ugh. + */ + SCM chord_as_scm = gh_cons (pitches, gh_cons (bass, inversion)); - if (n->get_mus_property ("inversion") == SCM_BOOL_T) - inversion = n->get_mus_property ("pitch"); - else if (n->get_mus_property ("bass") == SCM_BOOL_T) - bass = n->get_mus_property ("pitch"); - else - pitches = scm_sort_list (gh_cons (n->get_mus_property ("pitch"), pitches), - Pitch::less_p_proc); - chord_ = gh_cons (pitches, gh_cons (inversion, bass)); + chord_name_ = new Item (get_property ("ChordName")); + chord_name_->set_grob_property("text", markup); + announce_grob(chord_name_, SCM_EOL); + SCM s = get_property ("chordChanges"); + if (to_boolean (s) && gh_pair_p (last_chord_) + && gh_equal_p (chord_as_scm, last_chord_)) + chord_name_->set_grob_property ("begin-of-line-visible", SCM_BOOL_T); + + last_chord_ = chord_as_scm; } bool @@ -76,21 +131,6 @@ Chord_name_engraver::try_music (Music* m) return false; } -void -Chord_name_engraver::process_music () -{ - if (ly_car (chord_) != SCM_EOL) - { - chord_name_ = new Item (get_property ("ChordName")); - chord_name_->set_grob_property ("chord", chord_); - announce_grob(chord_name_, SCM_EOL); - SCM s = get_property ("chordChanges"); - if (to_boolean (s) && ly_car (last_chord_) != SCM_EOL - && gh_equal_p (chord_, last_chord_)) - chord_name_->set_grob_property ("begin-of-line-visible", SCM_BOOL_T); - } -} - void Chord_name_engraver::stop_translation_timestep () { @@ -99,17 +139,19 @@ Chord_name_engraver::stop_translation_timestep () typeset_grob (chord_name_); } chord_name_ = 0; - - if (ly_car (chord_) != SCM_EOL) - last_chord_ = chord_; - chord_ = gh_cons (SCM_EOL, gh_cons (SCM_EOL, SCM_EOL)); + notes_.clear (); } +/* + The READs description is not strictly accurate: + which properties are read depend on the chord naming function active. +*/ ENTER_DESCRIPTION(Chord_name_engraver, -/* descr */ "Catch note-events, Tonic_reqs, Inversion_reqs, Bass_req " +/* descr */ "Catch note-events " "and generate the appropriate chordname.", /* creats*/ "ChordName", -/* accepts */ "note-event busy-playing-event", +/* accepts */ "note-event", /* acks */ "", -/* reads */ "chordChanges", +/* reads */ "chordChanges chordNameExceptions chordNameFunction " +"chordRootNamer chordNameExceptions majorSevenSymbol", /* write */ ""); diff --git a/lily/new-chord-name-engraver.cc b/lily/new-chord-name-engraver.cc deleted file mode 100644 index 65620defe6..0000000000 --- a/lily/new-chord-name-engraver.cc +++ /dev/null @@ -1,152 +0,0 @@ -/* - chord-name-engraver.cc -- implement New_chord_name_engraver - - source file of the GNU LilyPond music typesetter - - (c) 1998--2003 Jan Nieuwenhuizen -*/ - -#include "engraver.hh" -#include "chord-name.hh" -#include "event.hh" -#include "paper-def.hh" -#include "font-interface.hh" -#include "paper-def.hh" -#include "main.hh" -#include "dimensions.hh" -#include "item.hh" -#include "pitch.hh" -#include "protected-scm.hh" -#include "translator-group.hh" -#include "warn.hh" - -class New_chord_name_engraver : public Engraver -{ - TRANSLATOR_DECLARATIONS( New_chord_name_engraver); -protected: - virtual void stop_translation_timestep (); - virtual void process_music (); - virtual bool try_music (Music *); - -private: - void add_note (Music *); - - Item* chord_name_; - Link_array notes_; - - Protected_scm last_chord_; -}; - - - -New_chord_name_engraver::New_chord_name_engraver () -{ - chord_name_ = 0; - last_chord_ = SCM_EOL; -} - -void -New_chord_name_engraver::add_note (Music * n) -{ - notes_.push (n); -} - -void -New_chord_name_engraver::process_music () -{ - if (!notes_.size() ) - return; - - SCM bass = SCM_EOL; - SCM inversion = SCM_EOL; - SCM pitches = SCM_EOL; - - Music* inversion_event = 0; - for (int i =0 ; i < notes_.size (); i++) - { - Music *n = notes_[i]; - SCM p = n->get_mus_property ("pitch"); - if (!unsmob_pitch (p)) - continue; - - if (n->get_mus_property ("inversion") == SCM_BOOL_T) - { - inversion_event = n; - inversion = p; - } - else if (n->get_mus_property ("bass") == SCM_BOOL_T) - bass = p; - else - pitches = gh_cons (p, pitches); - } - - if (inversion_event) - { - SCM oct = inversion_event->get_mus_property ("octavation"); - if (gh_number_p (oct)) - { - Pitch *p = unsmob_pitch (inversion_event->get_mus_property ("pitch")); - int octavation = gh_scm2int (oct); - Pitch orig = p->transposed (Pitch (-octavation, 0,0)); - - pitches= gh_cons (orig.smobbed_copy (), pitches); - } - else - programming_error ("Inversion does not have original pitch."); - } - - pitches = scm_sort_list (pitches, Pitch::less_p_proc); - - SCM name_proc = get_property ("chordNameFunction"); - SCM markup = scm_call_4 (name_proc, pitches, bass, inversion, - daddy_trans_->self_scm()); - - /* - Ugh. - */ - SCM chord_as_scm = gh_cons (pitches, gh_cons (bass, inversion)); - - chord_name_ = new Item (get_property ("ChordName")); - chord_name_->set_grob_property("text", markup); - announce_grob(chord_name_, SCM_EOL); - SCM s = get_property ("chordChanges"); - if (to_boolean (s) && gh_pair_p (last_chord_) - && gh_equal_p (chord_as_scm, last_chord_)) - chord_name_->set_grob_property ("begin-of-line-visible", SCM_BOOL_T); - - last_chord_ = chord_as_scm; -} - -bool -New_chord_name_engraver::try_music (Music* m) -{ - /* - hmm. Should check? - */ - if (m->is_mus_type ("note-event")) - { - add_note (m); - return true; - } - return false; -} - -void -New_chord_name_engraver::stop_translation_timestep () -{ - if (chord_name_) - { - typeset_grob (chord_name_); - } - chord_name_ = 0; - notes_.clear (); -} - -ENTER_DESCRIPTION(New_chord_name_engraver, -/* descr */ "Catch note-events " -"and generate the appropriate chordname.", -/* creats*/ "ChordName", -/* accepts */ "note-event", -/* acks */ "", -/* reads */ "chordChanges chordNameExceptions chordNameFunction", -/* write */ ""); diff --git a/ly/engraver-init.ly b/ly/engraver-init.ly index 7358d74550..0a2fc103ab 100644 --- a/ly/engraver-init.ly +++ b/ly/engraver-init.ly @@ -304,7 +304,7 @@ ChordNamesContext = \translator { \consists "Rest_swallow_translator" \consists "Output_property_engraver" \consists "Separating_line_group_engraver" - \consists "New_chord_name_engraver" + \consists "Chord_name_engraver" \consists "Skip_req_swallow_translator" \consistsend "Hara_kiri_engraver" minimumVerticalExtent = #'(0 . 2.5) @@ -441,7 +441,8 @@ ScoreContext = \translator { majorSevenSymbol = #whiteTriangleMarkup chordNameSeparator = #(make-simple-markup "/") chordNameExceptions = #ignatzekExceptions - + chordRootNamer = #note-name->markup + %% tablature: stringOneTopmost = ##t highStringOne = ##t diff --git a/ly/german-chords-init.ly b/ly/german-chords-init.ly deleted file mode 100644 index 05a1086324..0000000000 --- a/ly/german-chords-init.ly +++ /dev/null @@ -1,42 +0,0 @@ -\version "1.5.68" - -% german-chords-init.ly: -% german/norwegian/danish? - -% To get Bb instead of B, use -% \include "german-chords-init.ly" -% #(set! german-Bb #t) - -#(define german-Bb #f) - -#(define (pitch->chord-name-text-banter pitch steps) - (let ((dopitch (if (member (cdr pitch) '((6 -1) (6 -2))) - (list 7 (+ (if german-Bb 0 1) (caddr pitch))) - (cdr pitch) - ))) - (list - 'columns - (list-ref '("C" "D" "E" "F" "G" "A" "H" "B") (car dopitch)) - (accidental->text-super (cadr dopitch)) - ) - ) - ) - - - -#(define (pitch->note-name-text-banter pitch) - (let ((dopitch (if (member (cdr pitch) '((6 -1) (6 -2))) - (list 7 (+ 1 (caddr pitch))) - (cdr pitch) - ))) - (list - (string-append - (list-ref '("c" "d" "e" "f" "g" "a" "h" "b") (car dopitch)) - (if (or (equal? (car dopitch) 2) (equal? (car dopitch) 5)) - (list-ref '( "ses" "s" "" "is" "isis") (+ 2 (cadr dopitch))) - (list-ref '("eses" "es" "" "is" "isis") (+ 2 (cadr dopitch))) - ) - ) - ) - ) - ) diff --git a/scm/chords-ignatzek.scm b/scm/chords-ignatzek.scm index 99d3b90ef6..f0b4599c61 100644 --- a/scm/chords-ignatzek.scm +++ b/scm/chords-ignatzek.scm @@ -23,7 +23,8 @@ (= alteration -1) 0.2 ))) -(define (pitch->markup pitch) + +(define-public (note-name->markup pitch) "Return pitch markup for PITCH." (make-line-markup (list @@ -32,6 +33,18 @@ (make-normal-size-super-markup (accidental->markup (ly:pitch-alteration pitch)))))) + +(define-public (note-name->german-markup pitch) + "Return pitch markup for PITCH, using german note names." + (make-line-markup + (list + (make-simple-markup + (vector-ref #("C" "D" "E" "F" "G" "A" "H") (ly:pitch-notename pitch))) + (make-normal-size-super-markup + (accidental->markup (ly:pitch-alteration pitch)))))) + + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -163,7 +176,7 @@ ps) ) ) - + (define name-root (ly:get-context-property context 'chordRootNamer)) (define (is-natural-alteration? p) (= (natural-chord-alteration p) (ly:pitch-alteration p)) @@ -261,7 +274,7 @@ work than classifying the pitches." (let* ( (sep (ly:get-context-property context 'chordNameSeparator)) - (root-markup (pitch->markup root)) + (root-markup (name-root root)) (add-markups (map (lambda (x) (glue-word-to-step "add" x)) addition-pitches)) @@ -277,7 +290,7 @@ work than classifying the pitches." suffixes add-markups) sep)) (base-stuff (if bass-pitch - (list sep (pitch->markup bass-pitch)) + (list sep (name-root bass-pitch)) '())) ) @@ -308,7 +321,7 @@ work than classifying the pitches." (if exception (make-line-markup - (list (pitch->markup root) exception)) + (list (name-root root) exception)) (begin ; no exception. diff --git a/scm/double-plus-new-chord-name.scm b/scm/double-plus-new-chord-name.scm index 9dd77af9ee..c9743e1d5c 100644 --- a/scm/double-plus-new-chord-name.scm +++ b/scm/double-plus-new-chord-name.scm @@ -179,7 +179,7 @@ input/test/dpncnt.ly). ;; + subs:missing (let* ((root->markup (assoc-get-default - 'root->markup options pitch->markup)) + 'root->markup options note-name->markup)) (step->markup (assoc-get-default 'step->markup options step->markup-plusminus)) (sub->markup (assoc-get-default @@ -217,7 +217,7 @@ input/test/dpncnt.ly). ;; + 'add' ;; + steps:rest (let* ((root->markup (assoc-get-default - 'root->markup options pitch->markup)) + 'root->markup options note-name->markup)) (step->markup (assoc-get-default 'step->markup options step->markup-accidental)) (sep (assoc-get-default diff --git a/scm/translator-property-description.scm b/scm/translator-property-description.scm index aabd7d8d50..79f57f5b46 100644 --- a/scm/translator-property-description.scm +++ b/scm/translator-property-description.scm @@ -156,6 +156,9 @@ into one staff.") (translator-property-description 'chordNameFunction procedure? "The function that converts lists of pitches to chord names.") +(translator-property-description + 'chordRootNamer procedure? + "Function that converts from a pitch object to a text markup.") (translator-property-description 'chordNameExceptions list? "Alist of chord exceptions. Contains (CHORD . MARKUP) entries.")