+1.3.47.jcn3
+===========
+
+* Rewrite of chord-name production in scheme. There are two major styles
+ now, banter and american. To get american style, use
+
+ \property ChordNames.chordNameStyle = "american"
+
+ Most anything should be possible now. See input/test/american-chords.ly
+
+* Added isinf check to configure.in, and isinf macro from guile to
+ bezier.cc; solaris has no isinf ().
+
+* Fixed star-spangled-banner with not-so-nice \bar "|." fix. Almost
+ perfect now.
+
+* Added output property to regression test.
+
+* Fixed warning of creating existing outdir.
+
+* Added `Mark' interface to text-items that are marks (thanks, HW).
+
+1.3.46.jcn2
+===========
+
1.3.47.mb2
===========
\mu delafile{time.ly}
@end ignore
+@section Hacks and Features
+
+As a last resort, the placement of items can be adjusted manually.
+
+@mudelafile{generic-output-property.ly}
+
@bye
+
MAJOR_VERSION=1
MINOR_VERSION=3
PATCH_LEVEL=48
-MY_PATCH_LEVEL=
+MY_PATCH_LEVEL=jcn1
# use the above to send patches: MY_PATCH_LEVEL is always empty for a
# released version.
/* define if you have gettext */
#define HAVE_GETTEXT 0
+/* define if you have isinf */
+#define HAVE_ISINF 0
+
/* define if explicit instantiation is needed */
#undef NEED_EXPLICIT_INSTANTIATION
AC_FUNC_MEMCMP
AC_FUNC_VPRINTF
-AC_CHECK_FUNCS(memmem snprintf vsnprintf gettext)
+AC_CHECK_FUNCS(memmem snprintf vsnprintf gettext isinf)
AC_DEFINE_UNQUOTED(TOPLEVEL_VERSION, "${FULL_VERSION}")
AC_DEFINE_UNQUOTED(FLOWER_VERSION, "${FULL_FLOWER_VERSION}")
% TODO:
%
-% * centre non-melismata lyrics under notehead:
+% * centre non-melismata lyrics (where there's only one verse!) under
+% notehead:
%
% l c c c l
% ___
% x|()x| x| x| x| x|( )x|
% Oh_____say can you see
%
+% NOT!
%
-% * repeat colons in Lyrics / running into barline of 'Whose broad'
%
% * slur/lyric clash
%
say, can you | see, by the dawn's ear- ly light
What so proud- ly we hailed,
At the twi- light's last gleam- ing.
- %Whose broad
- %Whose broad_justoseewhatsgoingonhere \bar ":|";
% Ah, it seems that this context stops to exist just before
% the :| barline is set, and doesn't see its width?
- % Adding one here fixes running into the span-bar,
- % but adds yet another repeatcolon -- maybe we can fix that
- % elsewhere.
- Whose broad \bar ":|";
+ % Ugly fix:
+ Whose broad \bar "|.";
}
{
stripes and bright stars, through the per- il- ous fight,
\translator {
\LyricsContext
\consists "Span_bar_engraver";
- % Urg
- % 'Whose broad' still runs into the :| span-bar
- %\consists "Span_bar_engraver";
-
- % Urg
- % Moet iemand kunnen begrijpen hoe die visibilities
- % werken?
- %% #'Span_bar_engraver-visibility = #all-invisible
- "Span_bar_engraver-visibility" = #all-invisible
- "Bar_engraver-visibility" = #all-invisible
- "Span_bar::visibility-lambda" = #all-invisible
}
\translator {
\LyricsVoiceContext
\consists "Bar_engraver";
- "Bar_engraver-visibility" = #all-invisible
- "Bar::visibility-lambda" = #all-invisible
}
}
\midi {
--- /dev/null
+#(set! chord::names-alist-american
+ (append
+ '(
+
+ )
+ chord::names-alist-american))
+
+chord = \notes\transpose c''\chords{
+\property ChordNames.chordNameStyle = "american"
+c
+c:m
+c:m5-
+c:5^3
+c:4^3
+c:5+
+c:2^3
+c:m5-.7-
+c:7+
+c:7.4^3
+c:5+.7
+c:m5-.7
+c:5-.7+
+c:m7+
+c:m7
+c:7
+c:6
+c:m6
+c:9^7
+c:6.9^7
+c:9
+c:7+.9
+}
+
+\score{
+<
+\context ChordNames \chord
+\context Staff \chord
+>
+ \paper
+ {
+ \translator { \ChordNameContext chordNameWordSpace = #1 }
+ \translator { \LyricsContext textScriptWordSpace = #0.3 }
+ }
+}
+
+% (((0 . 0) (2 . -1) (4 . 0)) . ("Bar" . ("script" . "Baz")))
-
-\score
-{
-\notes {
- c''4
- \outputproperty #(make-type-checker 'Note_head) #'staff-position = #20
- c''4
-
+\score{
+ \notes\relative c''{
+ \outputproperty #(make-type-checker 'Note_head)
+ #'extra-offset = #'(2 . 3)
+ c2
+ c
+ \context Score {
+ \outputproperty #(make-type-checker 'Mark)
+ #'extra-offset = #'(-1 . 4)
+ }
+ \mark A;
+ d1
+ \mark;
+ e
+}
+\paper{
+ linewidth=-1.0;
+ \translator {
+ \ScoreContext
+ \consists "Mark_engraver";
+ }
}
}
--- /dev/null
+\score{
+\context Staff \notes\relative c''{
+ c1
+ \context Score {
+ \outputproperty #(make-type-checker 'Mark)
+ #'extra-offset = #'(-1 . 4)
+ }
+ \mark A;
+ d
+ \mark ;
+ e
+}
+\paper{
+ linewidth=-1.0;
+ \translator {
+ \ScoreContext
+ \consists "Mark_engraver";
+ }
+}
+}
*/
#include <math.h>
+#include "config.h"
+
+/*
+ IS_INF tests its floating point number for infiniteness
+ Ripped from guile's number.c. Solaris has no isinf ().
+ */
+#if ! HAVE_ISINF
+ #define isinf(x) ((x) == (x) / 2)
+#endif
+
#include "bezier.hh"
#include "polynomial.hh"
("style" . "text")
*/
Molecule
-Chord_name::ly_word2molecule (SCM scm) const
+Chord_name::ly_word2molecule (SCM word) const
{
- String style;
- if (gh_pair_p (scm))
+ Dictionary<SCM> option_dict;
+ if (gh_pair_p (word))
{
- SCM s = gh_car (scm);
- if (gh_string_p (s))
- style = ly_scm2string (s);
- scm = gh_cdr (scm);
+ SCM options = gh_cdr (word);
+ word = gh_car (word);
+ while (gh_pair_p (options))
+ {
+ SCM option = gh_car (options);
+ if (option != SCM_UNDEFINED && option != SCM_BOOL_F
+ && gh_pair_p (option))
+ {
+ SCM key = gh_car (option);
+ SCM val = gh_cdr (option);
+ String k;
+ if (gh_symbol_p (key))
+ k = ly_symbol2string (key);
+ else if (gh_string_p (key))
+ k = ly_scm2string (key);
+ else
+ continue;
+ option_dict[k] = val;
+ }
+ options = gh_cdr (options);
+ }
+ }
+ Real ex = lookup_l ()->text ("", "x", paper_l ()).extent
+ ()[Y_AXIS].length ();
+ if (gh_string_p (word))
+ {
+ String w = ly_scm2string (word);
+ Molecule mol;
+ Offset offset;
+
+ int size = 0;
+ if (option_dict.elem_b ("size"))
+ size = gh_scm2int (option_dict["size"]);
+
+ String style;
+ if (option_dict.elem_b ("style"))
+ style = ly_scm2string (option_dict["style"]);
+
+ if (option_dict.elem_b ("type")
+ && ly_scm2string (option_dict["type"]) == "super")
+ {
+ Real super_y = ex / 2;
+ //super_y += -acc.extent ()[Y_AXIS][MIN];
+ offset = Offset (0, super_y);
+ if (!size)
+ size = -2;
+ }
+ if (option_dict.elem_b ("offset"))
+ {
+ // hmm
+ SCM s = option_dict["offset"];
+ if (gh_pair_p (s))
+ offset = Offset (gh_scm2double (gh_car (s)),
+ gh_scm2double (gh_cdr (s))) * ex;
+ }
+ if (option_dict.elem_b ("font")
+ && ly_scm2string (option_dict["font"]) == "feta")
+ mol = paper_l ()->lookup_l (size)->afm_find (w);
+ else
+ mol = paper_l ()->lookup_l (size)->text (style, w, paper_l ());
+
+ mol.translate (offset);
+ return mol;
}
- if (gh_string_p (scm))
- return lookup_l ()->text (style, ly_scm2string (scm), paper_l ());
return Molecule ();
}
/*
- scm is word or list of words:
- word
- (word word)
+ ;; text: list of word
+ ;; word: string + optional list of property
+ ;; property: align, kern, font (?), size
*/
Molecule
-Chord_name::ly_text2molecule (SCM scm) const
+Chord_name::ly_text2molecule (SCM text) const
{
Molecule mol;
- if (gh_list_p (scm))
+ if (gh_list_p (text))
{
- while (gh_cdr (scm) != SCM_EOL)
+ while (gh_cdr (text) != SCM_EOL)
{
- Molecule m = ly_word2molecule (gh_car (scm));
+ Molecule m = ly_word2molecule (gh_car (text));
if (!m.empty_b ())
mol.add_at_edge (X_AXIS, RIGHT, m, 0);
- scm = gh_cdr (scm);
+ text = gh_cdr (text);
}
- scm = gh_car (scm);
+ text = gh_car (text);
}
- Molecule m = ly_word2molecule (scm);
+ Molecule m = ly_word2molecule (text);
if (!m.empty_b ())
mol.add_at_edge (X_AXIS, RIGHT, m, 0);
return mol;
}
-Molecule
-Chord_name::pitch2molecule (Musical_pitch p) const
-{
- SCM name = scm_eval (gh_list (ly_symbol2scm ("user-pitch-name"),
- ly_quote_scm (p.to_scm ()),
- SCM_UNDEFINED));
-
- if (name != SCM_UNSPECIFIED)
- {
- return ly_text2molecule (name);
- }
-
- Molecule mol = lookup_l ()->text ("", p.str ().left_str (1).upper_str (), paper_l ());
-
- /*
- We want the smaller size, even if we're big ourselves.
- */
- if (p.accidental_i_)
- {
- Molecule acc = paper_l ()->lookup_l (-3)->afm_find
- (String ("accidentals-") + to_str (p.accidental_i_));
- // urg, howto get a good superscript_y?
- Real super_y = lookup_l ()->text ("", "x", paper_l ()).extent
- ()[Y_AXIS].length () / 2;
- super_y += -acc.extent ()[Y_AXIS][MIN];
- acc.translate_axis (super_y, Y_AXIS);
- mol.add_at_edge (X_AXIS, RIGHT, acc, 0.0);
- }
-
- return mol;
-}
-
-Musical_pitch
-diff_pitch (Musical_pitch tonic, Musical_pitch p)
-{
- Musical_pitch diff (p.notename_i_ - tonic.notename_i_,
- p.accidental_i_ - tonic.accidental_i_,
- p.octave_i_ - tonic.octave_i_);
-
- while (diff.notename_i_ >= 7)
- {
- diff.notename_i_ -= 7;
- diff.octave_i_ ++;
- }
- while (diff.notename_i_ < 0)
- {
- diff.notename_i_ += 7;
- diff.octave_i_ --;
- }
-
- diff.accidental_i_ -= (tonic.semitone_pitch () + diff.semitone_pitch ())
- - p.semitone_pitch ();
-
- return diff;
-}
-
-/*
- JUNKME
- */
-bool
-Chord_name::user_chord_name (Array<Musical_pitch> pitch_arr, Chord_mol* name_p) const
-{
- Array<Musical_pitch> chord_type = pitch_arr;
- Chord::rebuild_transpose (&chord_type, diff_pitch (pitch_arr[0], Musical_pitch (0)), false);
-
- SCM chord = SCM_EOL;
- for (int i= chord_type.size (); i--; )
- chord = gh_cons (chord_type[i].to_scm (), chord);
-
-
- SCM name = scm_eval (gh_list (ly_symbol2scm ("user-chord-name"),
- ly_quote_scm (chord),
- SCM_UNDEFINED));
- if (gh_pair_p (name))
- {
- name_p->modifier_mol = ly_text2molecule (gh_car (name));
- name_p->addition_mol = ly_text2molecule (gh_cdr (name));
- return true;
- }
- return false;
-}
-
-void
-Chord_name::banter (Array<Musical_pitch> pitch_arr, Chord_mol* name_p) const
-{
- Array<Musical_pitch> add_arr;
- Array<Musical_pitch> sub_arr;
- Chord::find_additions_and_subtractions (pitch_arr, &add_arr, &sub_arr);
-
- Array<Musical_pitch> scale;
- for (int i=0; i < 7; i++)
- scale.push (Musical_pitch (i));
-
- Musical_pitch tonic = pitch_arr[0];
- Chord::rebuild_transpose (&scale, tonic, true);
-
- /*
- Does chord include this step? -1 if flat
- */
- int has[16];
- for (int i=0; i<16; i++)
- has[i] = 0;
-
- String mod_str;
- String add_str;
- String sep_str;
- for (int i = 0; i < add_arr.size (); i++)
- {
- Musical_pitch p = add_arr[i];
- int step = Chord::step_i (tonic, p);
- int accidental = p.accidental_i_ - scale[(step - 1) % 7].accidental_i_;
- if ((step < 16) && (has[step] != -1))
- has[step] = accidental == -1 ? -1 : 1;
- // only from guile table ?
- if ((step == 3) && (accidental == -1))
- {
- mod_str = "m";
- }
- else if (accidental
- || (!(step % 2)
- || ((i == add_arr.size () - 1) && (step > 5))))
- {
- add_str += sep_str;
- sep_str = "/";
- if ((step == 7) && (accidental == 1))
- {
- add_str += "maj7";
- }
- else
- {
- add_str += to_str (step);
- if (accidental)
- add_str += accidental < 0 ? "-" : "+";
- }
- }
- }
-
- for (int i = 0; i < sub_arr.size (); i++)
- {
- Musical_pitch p = sub_arr[i];
- int step = Chord::step_i (tonic, p);
- /*
- if additions include 2 or 4, assume sus2/4 and don't display 'no3'
- */
- if (!((step == 3) && (has[2] || has[4])))
- {
- add_str += sep_str + "no" + to_str (step);
- sep_str = "/";
- }
- }
-
- if (mod_str.length_i ())
- name_p->modifier_mol.add_at_edge (X_AXIS, RIGHT,
- lookup_l ()->text ("roman", mod_str, paper_l ()), 0);
- if (add_str.length_i ())
- {
- if (!name_p->addition_mol.empty_b ())
- add_str = "/" + add_str;
- name_p->addition_mol.add_at_edge (X_AXIS, RIGHT,
- lookup_l ()->text ("script", add_str, paper_l ()), 0);
- }
-}
-
-/*
- TODO:
- fix silly to-and-fro scm conversions
- */
Molecule
Chord_name::do_brew_molecule () const
{
- Array<Musical_pitch> pitch_arr;
-
- for (SCM s = get_elt_property ("pitches"); s != SCM_EOL; s = gh_cdr (s))
- pitch_arr.push (Musical_pitch (gh_car (s)));
-
- Musical_pitch tonic = pitch_arr[0];
-
- Chord_mol name;
- name.tonic_mol = pitch2molecule (tonic);
-
- /*
- if user has explicitely listed chord name, use that
-
- TODO
- urg
- maybe we should check all sub-lists of pitches, not
- just full list and base triad?
- */
- if (!user_chord_name (pitch_arr, &name))
- {
- /*
- else, check if user has listed base triad
- use user base name and add banter for remaining part
- */
- if ((pitch_arr.size () > 2)
- && user_chord_name (pitch_arr.slice (0, 3), &name))
- {
- Array<Musical_pitch> base = Chord::base_arr (tonic);
- base.concat (pitch_arr.slice (3, pitch_arr.size ()));
- banter (base, &name);
- }
- /*
- else, use pure banter
- */
- else
- {
- banter (pitch_arr, &name);
- }
- }
+ SCM style = get_elt_property ("style");
+ if (style == SCM_UNDEFINED)
+ style = ly_str02scm ("banter");
- SCM s = get_elt_property ("inversion");
- if (s != SCM_UNDEFINED)
- {
- name.inversion_mol = lookup_l ()->text ("", "/", paper_l ());
- Musical_pitch p (s);
+ SCM inversion = get_elt_property ("inversion");
+ if (inversion == SCM_UNDEFINED)
+ inversion = SCM_BOOL_F;
- Molecule mol = pitch2molecule (p);
- name.inversion_mol.add_at_edge (X_AXIS, RIGHT, mol, 0);
- }
+ SCM bass = get_elt_property ("bass");
+ if (bass == SCM_UNDEFINED)
+ bass = SCM_BOOL_F;
- s = get_elt_property ("bass");
- if (s != SCM_UNDEFINED)
- {
- name.bass_mol = lookup_l ()->text ("", "/", paper_l ());
- Musical_pitch p (s);
- Molecule mol = pitch2molecule (p);
- name.bass_mol.add_at_edge (X_AXIS, RIGHT, mol, 0);
- }
-
- // urg, howto get a good superscript_y?
- Real super_y = lookup_l ()->text ("", "x", paper_l ()).extent
- ()[Y_AXIS].length () / 2;
- if (!name.addition_mol.empty_b ())
- name.addition_mol.translate (Offset (0, super_y));
-
- Molecule mol;
- mol.add_at_edge (X_AXIS, RIGHT, name.tonic_mol, 0);
- // huh?
- if (!name.modifier_mol.empty_b ())
- mol.add_at_edge (X_AXIS, RIGHT, name.modifier_mol, 0);
- if (!name.addition_mol.empty_b ())
- mol.add_at_edge (X_AXIS, RIGHT, name.addition_mol, 0);
- if (!name.inversion_mol.empty_b ())
- mol.add_at_edge (X_AXIS, RIGHT, name.inversion_mol, 0);
- if (!name.bass_mol.empty_b ())
- mol.add_at_edge (X_AXIS, RIGHT, name.bass_mol, 0);
+ SCM pitches = get_elt_property ("pitches");
- s = get_elt_property ("word-space");
- if (gh_number_p (s))
- mol.dim_.interval_a_[X_AXIS][RIGHT] += gh_scm2double (s)
- * staff_symbol_referencer (this).staff_space ();
+ SCM text = scm_eval (gh_list (ly_symbol2scm ("chord::user-name"),
+ style,
+ ly_quote_scm (pitches),
+ ly_quote_scm (gh_cons (inversion, bass)),
+ SCM_UNDEFINED));
- return mol;
+ return ly_text2molecule (text);
}
return i;
}
+/*
+ JUNKME.
+ do something smarter.
+ */
Array<Musical_pitch>
Chord::missing_thirds_pitch_arr (Array<Musical_pitch> const* pitch_arr_p)
{
return pitch_arr;
}
-void
-Chord::find_additions_and_subtractions (Array<Musical_pitch> pitch_arr, Array<Musical_pitch>* add_arr_p, Array<Musical_pitch>* sub_arr_p)
-{
- Musical_pitch tonic = pitch_arr[0];
- /*
- construct an array of thirds for a normal chord
- */
- Array<Musical_pitch> all_arr;
- all_arr.push (tonic);
- if (step_i (tonic, pitch_arr.top ()) >= 5)
- all_arr.push (pitch_arr.top ());
- else
- all_arr.push (base_arr (tonic).top ());
- all_arr.concat (missing_thirds_pitch_arr (&all_arr));
- all_arr.sort (Musical_pitch::compare);
-
- int i = 0;
- int j = 0;
- Musical_pitch last_extra = tonic;
- while ((i < all_arr.size ()) || (j < pitch_arr.size ()))
- {
- Musical_pitch a = all_arr [i <? all_arr.size () - 1];
- Musical_pitch p = pitch_arr[j <? pitch_arr.size () - 1];
- /*
- this pitch is present: do nothing, check next
- */
- if (a == p)
- {
- i++;
- j++;
- last_extra = tonic;
- }
- /*
- found an extra pitch: chord addition
- */
- else if ((p < a) || (p.notename_i_ == a.notename_i_))
- {
- add_arr_p->push (p);
- last_extra = p;
- (j < pitch_arr.size ()) ? j++ : i++;
- }
- /*
- a third is missing: chord subtraction
- */
- else
- {
- if (last_extra.notename_i_ != a.notename_i_)
- sub_arr_p->push (a);
- (i < all_arr.size ()) ? i++ : j++;
- last_extra = tonic;
- }
- }
-
- /* add missing basic steps */
- if (step_i (tonic, pitch_arr.top ()) < 3)
- sub_arr_p->push (base_arr (tonic)[1]);
- if (step_i (tonic, pitch_arr.top ()) < 5)
- sub_arr_p->push (base_arr (tonic).top ());
-
- /*
- add highest addition, because it names chord, if greater than 5
- or non-standard
- (1, 3 and) 5 not additions: part of normal chord
- */
- if ((step_i (tonic, pitch_arr.top ()) > 5)
- || pitch_arr.top ().accidental_i_)
- add_arr_p->push (pitch_arr.top ());
-}
-
-
/*
This routine tries to guess tonic in a possibly inversed chord, ie
<e g c'> should produce: C.
#include "item.hh"
#include "molecule.hh"
-class Chord_mol
-{
-public:
- Molecule tonic_mol;
- Molecule modifier_mol;
- Molecule addition_mol;
- Molecule inversion_mol;
- Molecule bass_mol;
-};
-
/**
elt_properties:
pitches: list of musical-pitch
VIRTUAL_COPY_CONS (Score_element);
Molecule ly_word2molecule (SCM scm) const;
Molecule ly_text2molecule (SCM scm) const;
- Molecule pitch2molecule (Musical_pitch p) const;
- bool user_chord_name (Array<Musical_pitch> pitch_arr, Chord_mol* name_p) const;
- void banter (Array<Musical_pitch> pitch_arr, Chord_mol* name_p) const;
protected:
virtual Molecule do_brew_molecule () const;
{
public:
static Array<Musical_pitch> base_arr (Musical_pitch p);
- static void find_additions_and_subtractions(Array<Musical_pitch> pitch_arr, Array<Musical_pitch>* add_arr_p, Array<Musical_pitch>* sub_arr_p);
static int find_tonic_i (Array<Musical_pitch> const*);
static int find_pitch_i (Array<Musical_pitch> const*, Musical_pitch p);
static int find_notename_i (Array<Musical_pitch> const*, Musical_pitch p);
(c) 1998--2000 Jan Nieuwenhuizen <janneke@gnu.org>
*/
-
+#include <ctype.h>
#include "bar.hh"
#include "clef-item.hh"
#include "command-request.hh"
#include "staff-symbol-referencer.hh"
#include "staff-symbol.hh"
#include "text-item.hh"
-#include <ctype.h>
+#include "group-interface.hh"
+
/**
put stuff over or next to bars. Examples: bar numbers, marginal notes,
rehearsal marks.
text_p_ = new Text_item;
text_p_->set_elt_property ("breakable", SCM_BOOL_T); // ugh
+ Group_interface (text_p_, "interfaces").add_thing (ly_symbol2scm ("Mark"));
Side_position_interface staffside(text_p_);
staffside.set_axis (Y_AXIS);
-;; note-name: (note . accidental)
-;; list: (list-of-pitches . (modifier-string . addition-subtraction-string))
+;;; chord.scm -- to be included in/to replace chord-name.scm
+;;; 2000 janneke@gnu.org
+;;;
-;; if a complete chord is found, use name
-;; if a chord's base triad is found (c e g), use name
+(use-modules
+ (ice-9 debug)
+ ;; urg, these two only to guess if a '/' is needed to separate
+ ;; user-chord-name and additions/subtractions
+ (ice-9 format)
+ (ice-9 regex)
+ )
-(define note-names-alist '())
-(set! note-names-alist
- (append
- '(
- ; use these for German naming
- ;((6 . 0) . ("H" ""))
- ;((6 . -1) . ("B" ("feta-1" . "\12")))
-
- ; C-p/C-r current feta chars for sharp/flat
- ; don't use them: ly2dvi breaks (inputenc package)
- ;((0 . 1) . ("C" ("feta-1" . "\10")))
- ;((0 . -1) . ("C" ("feta-1" . "\12")))
- )
- note-names-alist))
+;;
+;; (octave notename accidental)
+;;
-(define (pitch->note-name pitch)
- (cons (cadr pitch) (caddr pitch)))
-
-(define (user-pitch-name pitch)
- (let ((entry (assoc (pitch->note-name pitch) note-names-alist)))
- (if entry
- (cdr entry))))
+;;
+;; text: list of word
+;; word: string + optional list of property
+;; property: size, style, font, super, offset
+;;
-(define chord-names-alist '())
-(set! chord-names-alist
+;; TODO
+;;
+;; * clean split of base/banter/american stuff
+;; * text definition is rather ad-hoc
+;; * do without format module
+;; * finish and check american names
+;; * make notename (tonic) configurable from mudela
+;; * fix append/cons stuff in inner-name-banter
+;;
+
+
+;;;;;;;;;
+(define chord::names-alist-banter '())
+(set! chord::names-alist-banter
(append
- '(
+ '(
; C iso C.no3.no5
- (((0 . 0)) . (#f . #f))
+ (((0 . 0)) . #f)
; C iso C.no5
- (((0 . 0) (2 . 0)) . (#f . #f))
+ (((0 . 0) (2 . 0)) . #f)
; Cm iso Cm.no5
- (((0 . 0) (2 . -1)) . ("m" . #f))
+ (((0 . 0) (2 . -1)) . ("m"))
+ ; C2 iso C2.no3
+ (((0 . 0) (1 . 0) (4 . 0)) . (("2" (type . "super"))))
+ ; C4 iso C4.no3
+ (((0 . 0) (3 . 0) (4 . 0)) . (("4" (type . "super"))))
; Cdim iso Cm5-
- (((0 . 0) (2 . -1) (4 . -1)) . ("dim" . #f))
+ (((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
; Co iso Cm5-7-
; urg
- ; (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" . ("feta-1" . ".")))
- (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (#f . ("script" . "o")))
+ (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (("o" (type . "super"))))
; Cdim9
- (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ("dim" . ("script" . "9")))
- (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ("dim" . ("script" . "11")))
+ (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ("dim" ("9" (type . "super"))))
+ (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ("dim" ("11" (type . "super"))))
)
- chord-names-alist))
+ chord::names-alist-banter))
+
+
+(define chord::names-alist-american '())
+(set! chord::names-alist-american
+ (append
+ '(
+ (((0 . 0)) . #f)
+ (((0 . 0) (2 . 0)) . #f)
+ (((0 . 0) (2 . -1)) . ("m"))
+ (((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
+ (((0 . 0) (4 . 0)) . (("5" (type . "super"))))
+ (((0 . 0) (3 . 0) (4 . 0)) . ("sus"))
+ (((0 . 0) (2 . -1) (4 . -1)) . (("o" (type . "super"))))
+ (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (("o7" (type . "super"))))
+ (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (("x7" (type . "super"))))
+
+ (((0 . 0) (2 . 0) (4 . 1)) . ("aug"))
+ (((0 . 0) (2 . 0) (4 . 1) (6 . -1)) . (("aug" ("7" (type . "super")))))
+
+ (((0 . 0) (2 . 0) (4 . -1) (6 . 0)) . (("maj7" (type . "super")) ("accidentals--1" (font . "feta") (type . "super")) ("5" (type . "super"))))
+
+ (((0 . 0) (3 . 0) (4 . 0) (6 . -1)) . (("7sus4" (type . "super"))))
+
+ (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . (("maj6" (type . "super"))))
+ ;; dont need this?
+ ;(((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . ("m6" . ""))
+
+ ;; c = 0, d = 1
+ ;;(((0 . 0) (2 . 0) (4 . 0) (8 . 0)) . ("add9" . ""))
+ ;;(((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . ("" . (("script" . "add9"))))
+
+ ;; we don't want the '/no7'
+ ;;(((0 . 0) (2 . 0) (4 . 0) (5 . 0) (8 . 0)) . ("6/9" . ""))
+ ;;(((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . (("script" . "6/9"))))
+
+ ;;already have this?
+ ;;(((0 . 0) (2 . 0) (4 . 0) (6 . 0) (1 . 0)) . ("maj9" . ""))
+
+ )
+ chord::names-alist-american))
+
+;;;;;;;;;;
+
+
+(define (pitch->note-name pitch)
+ (cons (cadr pitch) (caddr pitch)))
+
+(define (pitch->text pitch)
+ (cons
+ (make-string 1 (integer->char (+ (modulo (+ (cadr pitch) 2) 7) 65)))
+ (if (= (caddr pitch) 0)
+ '()
+ (list (list (string-append "accidentals-"
+ (number->string (caddr pitch)))
+ '(font . "feta"))))))
+
+(define (step->text pitch)
+ (string-append
+ (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8)))
+ (case (caddr pitch)
+ ((-2) "--")
+ ((-1) "-")
+ ((0) "")
+ ((1) "+")
+ ((2) "++"))))
+
+(define (pitch->text-banter pitch)
+ (pitch->text pitch))
+
+(define (step->text-banter pitch)
+ (if (= (cadr pitch) 6)
+ (case (caddr pitch)
+ ((-2) "7-")
+ ((-1) "7")
+ ((0) "maj7")
+ ((1) "7+")
+ ((2) "7+"))
+ (step->text pitch)))
+
+(define pitch::semitone-vec (list->vector '(0 2 4 5 7 9 11)))
+
+(define (pitch::semitone pitch)
+ (+ (* (car pitch) 12)
+ (vector-ref pitch::semitone-vec (modulo (cadr pitch) 7))
+ (caddr pitch)))
+
+(define (pitch::transpose pitch delta)
+ (let ((simple-octave (+ (car pitch) (car delta)))
+ (simple-notename (+ (cadr pitch) (cadr delta))))
+ (let ((octave (+ simple-octave (quotient simple-notename 7)))
+ (notename (modulo simple-notename 7)))
+ (let ((accidental (- (+ (pitch::semitone pitch) (pitch::semitone delta))
+ (pitch::semitone `(,octave ,notename 0)))))
+ `(,octave ,notename ,accidental)))))
+
+(define (pitch::diff pitch tonic)
+ (let ((simple-octave (- (car pitch) (car tonic)))
+ (simple-notename (- (cadr pitch) (cadr tonic))))
+ (let ((octave (+ simple-octave (quotient simple-notename 7)
+ (if (< simple-notename 0) -1 0)))
+ (notename (modulo simple-notename 7)))
+ (let ((accidental (- (pitch::semitone pitch)
+ (pitch::semitone tonic)
+ (pitch::semitone `(,octave ,notename 0)))))
+ `(,octave ,notename ,accidental)))))
+
+(define (pitch::note-pitch pitch)
+ (+ (* (car pitch) 7) (cadr pitch)))
+
+(define (chord::step tonic pitch)
+ (- (pitch::note-pitch pitch) (pitch::note-pitch tonic)))
+
+;; text: list of word
+;; word: string + optional list of property
+;; property: align, kern, font (?), size
+
+(define chord::minor-major-vec (list->vector '(0 -1 -1 0 -1 -1 0)))
+
+;; compute the relative-to-tonic pitch that goes with 'step'
+(define (chord::step-pitch tonic step)
+ ;; urg, we only do this for thirds
+ (if (= (modulo step 2) 0)
+ '(0 0 0)
+ (let loop ((i 1) (pitch tonic))
+ (if (= i step) pitch
+ (loop (+ i 2)
+ (pitch::transpose
+ pitch `(0 2 ,(vector-ref chord::minor-major-vec
+ ;; -1 (step=1 -> vector=0) + 7 = 6
+ (modulo (+ i 6) 7)))))))))
+
+;; find the pitches that are not part of `normal' chord
+(define (chord::additions chord-pitches)
+ (let ((tonic (car chord-pitches)))
+ ;; walk the chord steps: 1, 3, 5
+ (let loop ((step 1) (pitches chord-pitches) (additions '()))
+ (if (pair? pitches)
+ (let* ((pitch (car pitches))
+ (p-step (+ (- (pitch::note-pitch pitch)
+ (pitch::note-pitch tonic))
+ 1)))
+ ;; pitch is an addition if
+ (if (or
+ ;; it comes before this step or
+ (< p-step step)
+ ;; its step is even or
+ (= (modulo p-step 2) 0)
+ ;; has same step, but different accidental or
+ (and (= p-step step)
+ (not (equal? pitch (chord::step-pitch tonic step))))
+ ;; is the last of the chord and not one of base thirds
+ (and (> p-step 5)
+ (= (length pitches) 1)))
+ (loop step (cdr pitches) (cons pitch additions))
+ (if (= p-step step)
+ (loop step (cdr pitches) additions)
+ (loop (+ step 2) pitches additions))))
+ (reverse additions)))))
+
+;; find the pitches that are missing from `normal' chord
+(define (chord::subtractions chord-pitches)
+ (let ((tonic (car chord-pitches)))
+ (let loop ((step 1) (pitches chord-pitches) (subtractions '()))
+ (if (pair? pitches)
+ (let* ((pitch (car pitches))
+ (p-step (+ (- (pitch::note-pitch pitch)
+ (pitch::note-pitch tonic))
+ 1)))
+ ;; pitch is an subtraction if
+ ;; a step is missing or
+ (if (> p-step step)
+ (loop (+ step 2) pitches
+ (cons (chord::step-pitch tonic step) subtractions))
+ ;; there are no pitches left, but base thirds are not yet done and
+ (if (and (<= step 5)
+ (= (length pitches) 1))
+ ;; present pitch is not missing step
+ (if (= p-step step)
+ (loop (+ step 2) pitches subtractions)
+ (loop (+ step 2) pitches
+ (cons (chord::step-pitch tonic step) subtractions)))
+ (if (= p-step step)
+ (loop (+ step 2) (cdr pitches) subtractions)
+ (loop step (cdr pitches) subtractions)))))
+ (reverse subtractions)))))
+
+;; combine tonic, user-specified chordname,
+;; additions, subtractions and base or inversion to chord name
+;;
+(define (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)
+ (apply append (pitch->text-banter tonic)
+ (if user-name user-name '())
+ ;; why does list->string not work, format seems only hope...
+ (if (and (string-match "super" (format "~s" user-name))
+ (or (pair? additions)
+ (pair? subtractions)))
+ '(("/" (type . "super")))
+ '())
+ (let loop ((from additions) (to '()))
+ (if (pair? from)
+ (let ((p (car from)))
+ (loop (cdr from)
+ (append to
+ (cons
+ (cons (step->text-banter p) '((type . "super")))
+ (if (or (pair? (cdr from))
+ (pair? subtractions))
+ '(("/" (type . "super")))
+ '())))))
+ to))
+ (let loop ((from subtractions) (to '()))
+ (if (pair? from)
+ (let ((p (car from)))
+ (loop (cdr from)
+ (append to
+ (cons '("no" (type . "super"))
+ (cons
+ (cons (step->text-banter p) '((type . "super")))
+ (if (pair? (cdr from))
+ '(("/" (type . "super")))
+ '()))))))
+ to))
+ (if (and (pair? base-and-inversion)
+ (or (car base-and-inversion)
+ (cdr base-and-inversion)))
+ (cons "/" (append
+ (if (car base-and-inversion)
+ (pitch->text
+ (car base-and-inversion))
+ (pitch->text
+ (cdr base-and-inversion)))
+ '()))
+ '())
+ '()))
+
+(define (chord::name-banter tonic user-name pitches base-and-inversion)
+ (let ((additions (chord::additions pitches))
+ (subtractions (chord::subtractions pitches)))
+ (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)))
+
+;; american chordnames use no "no",
+;; but otherwise very similar to banter for now
+(define (chord::name-american tonic user-name pitches base-and-inversion)
+ (let ((additions (chord::additions pitches))
+ (subtractions #f))
+ (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)))
+
+;; C++ entry point
+;;
+;; Check for each subset of chord, full chord first, if there's a
+;; user-override. Split the chord into user-overridden and to-be-done
+;; parts, complete the missing user-override matched part with normal
+;; chord to be name-calculated.
+;;
+(define (chord::user-name style pitches base-and-inversion)
+ ;(display "pitches:") (display pitches) (newline)
+ ;(display "style:") (display style) (newline)
+ ;(display "b&i:") (display base-and-inversion) (newline)
+ (let ((diff (pitch::diff '(0 0 0) (car pitches)))
+ (name-func
+ (eval (string->symbol (string-append "chord::name-" style))))
+ (names-alist
+ (eval (string->symbol (string-append "chord::names-alist-" style)))))
+ (let loop ((note-names (reverse pitches))
+ (chord '())
+ (user-name #f))
+ (if (pair? note-names)
+ (let ((entry (assoc
+ (reverse
+ (map (lambda (x)
+ (pitch->note-name (pitch::transpose x diff)))
+ note-names))
+ names-alist)))
+ (if entry
+ ;; urg? found: break loop
+ (loop '() chord (cdr entry))
+ (loop (cdr note-names) (cons (car note-names) chord) #f)))
+ (let* ((transposed (if pitches
+ (map (lambda (x) (pitch::transpose x diff)) chord)
+ '()))
+ (matched (if (= (length chord) 0)
+ 3
+ (- (length pitches) (length chord))))
+ (completed
+ (append (do ((i matched (- i 1))
+ (base '() (cons `(0 ,(* (- i 1) 2) 0) base)))
+ ((= i 0) base)
+ ())
+ transposed)))
+ (name-func (car pitches) user-name completed base-and-inversion))))))
-(define (user-chord-name chord)
- (let ((entry (assoc (map (lambda (x) (pitch->note-name x)) chord)
- chord-names-alist)))
- (if entry
- (cdr entry))))
(define generic-chord-name-properties
(cons "Chord_name" (list
(list 'textScriptWordSpace number? 'word-space)
- (list 'chordNameWordSpace number? 'word-space))))
+ (list 'chordNameWordSpace number? 'word-space)
+ (list 'chordNameStyle string? 'style))))
(define generic-crescendo-properties
(cons "Crescendo" (list
esac
case "$(OUT_DIST_FILES)x" in x) ;; *) \
- mkdir $(distdir)/$(localdir)/out; \
+ mkdir -p $(distdir)/$(localdir)/out; \
$(LN) $(OUT_DIST_FILES) $(distdir)/$(localdir)/out;; \
esac
# $(foreach i, $(SUBDIRS), $(MAKE) distdir=../$(distdir) localdir=$(localdir)/$(i) -C $(i) local-dist &&) true
$(outdir)/%.$(XPM_RESOLUTION)gf: %.mf
$(METAFONT) "\\mode=$(XPM_MODE); \\input $<"
- mv $(@F) out
- rm -f $(basename $(@F)).tfm $(basename $(@F)).*log
+# Let's keep this log output, it saves another mf run.
+ mv $(@F) $(basename $(@F)).log $(basename $(@F)).tfm $(outdir)
$(outdir)/%.$(XPM_RESOLUTION)pk: $(outdir)/%.$(XPM_RESOLUTION)gf
gftopk $< $@
pks: $(addprefix $(outdir)/, $(XPM_FONTS:%=%.$(XPM_RESOLUTION)pk))
xpms: $(addprefix $(outdir)/, $(XPM_FONTS:%=%.afm)) pks
- $(SHELL) $(depth)/buildscripts/mf-to-xpms.sh $(XPM_FONTS)
+ $(foreach i, $(XPM_FONTS), $(SHELL) $(depth)/buildscripts/mf-to-xpms.sh $(i) && ) true
projects / lilypond.git / commitdiff