* 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.
2003-04-20 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+ * 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):
= \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
--- /dev/null
+
+\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 }
+}
#include "item.hh"
#include "pitch.hh"
#include "protected-scm.hh"
+#include "translator-group.hh"
+#include "warn.hh"
class Chord_name_engraver : public Engraver
{
void add_note (Music *);
Item* chord_name_;
-
- Protected_scm chord_;
+ Link_array<Music> notes_;
+
Protected_scm last_chord_;
};
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
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 ()
{
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 */ "");
+++ /dev/null
-/*
- chord-name-engraver.cc -- implement New_chord_name_engraver
-
- source file of the GNU LilyPond music typesetter
-
- (c) 1998--2003 Jan Nieuwenhuizen <janneke@gnu.org>
-*/
-
-#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<Music> 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 */ "");
\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)
majorSevenSymbol = #whiteTriangleMarkup
chordNameSeparator = #(make-simple-markup "/")
chordNameExceptions = #ignatzekExceptions
-
+ chordRootNamer = #note-name->markup
+
%% tablature:
stringOneTopmost = ##t
highStringOne = ##t
+++ /dev/null
-\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)))
- )
- )
- )
- )
- )
(= alteration -1) 0.2
)))
-(define (pitch->markup pitch)
+
+(define-public (note-name->markup pitch)
"Return pitch markup for PITCH."
(make-line-markup
(list
(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))))))
+
+
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
ps)
)
)
-
+ (define name-root (ly:get-context-property context 'chordRootNamer))
(define (is-natural-alteration? p)
(= (natural-chord-alteration p) (ly:pitch-alteration p))
(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))
suffixes
add-markups) sep))
(base-stuff (if bass-pitch
- (list sep (pitch->markup bass-pitch))
+ (list sep (name-root bass-pitch))
'()))
)
(if
exception
(make-line-markup
- (list (pitch->markup root) exception))
+ (list (name-root root) exception))
(begin ; no exception.
;; + 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
;; + '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
(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.")
projects / lilypond.git / commitdiff