From: fred Date: Wed, 27 Mar 2002 00:39:17 +0000 (+0000) Subject: lilypond-1.3.109 X-Git-Tag: release/1.5.59~983 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=3084793e26e9a2d65ac82cc1a16d3b7e3605f6e8;p=lilypond.git lilypond-1.3.109 --- diff --git a/lily/include/key-performer.hh b/lily/include/key-performer.hh deleted file mode 100644 index 512bd48a53..0000000000 --- a/lily/include/key-performer.hh +++ /dev/null @@ -1,33 +0,0 @@ -/* - key-performer.hh -- declare Key_performer - - source file of the GNU LilyPond music typesetter - - (c) 1997--2000 Jan Nieuwenhuizen -*/ - -#ifndef KEY_PERFOMER_HH -#define KEY_PERFOMER_HH - -#include "lily-proto.hh" -#include "performer.hh" - -class Key_performer : public Performer -{ -public: - VIRTUAL_COPY_CONS(Translator); - - Key_performer(); - ~Key_performer(); - -protected: - virtual bool do_try_music (Music* req_l); - virtual void do_process_music (); - virtual void do_pre_move_processing (); - -private: - Key_change_req* key_req_l_; - Audio_key* audio_p_; -}; - -#endif // KEY_PERFOMER_HH diff --git a/lily/include/lyric-performer.hh b/lily/include/lyric-performer.hh deleted file mode 100644 index 9bb48d0b74..0000000000 --- a/lily/include/lyric-performer.hh +++ /dev/null @@ -1,33 +0,0 @@ -/* - lyric-performer.hh -- declare Lyric_performer - - source file of the GNU LilyPond music typesetter - - (c) 1997--2000 Jan Nieuwenhuizen -*/ - - -#ifndef LYRIC_PERFOMER_HH -#define LYRIC_PERFOMER_HH - -#include "lily-proto.hh" -#include "performer.hh" -#include "array.hh" - -class Lyric_performer : public Performer { -public: - VIRTUAL_COPY_CONS(Translator); - Lyric_performer (); - -protected: - - virtual bool do_try_music (Music* req_l); - virtual void do_process_music(); - virtual void do_pre_move_processing (); - -private: - Link_array lreq_arr_; - Audio_text* audio_p_; -}; - -#endif // LYRIC_PERFOMER_HH diff --git a/lily/include/note-performer.hh b/lily/include/note-performer.hh deleted file mode 100644 index 574e695224..0000000000 --- a/lily/include/note-performer.hh +++ /dev/null @@ -1,37 +0,0 @@ -/* - note-performer.hh -- declare Note_performer - - (c) 1996--2000 Han-Wen Nienhuys - Jan Nieuwenhuizen - */ - -#ifndef NOTE_PERFORMER_HH -#define NOTE_PERFORMER_HH - -#include "performer.hh" - -/** -Convert reqs to audio notes. -*/ -class Note_performer : public Performer { -public: - VIRTUAL_COPY_CONS(Translator); - - - Note_performer(); - -protected: - virtual void do_process_music (); - virtual bool do_try_music (Music *req_l) ; - - virtual void do_pre_move_processing (); - virtual void process_acknowledged (); - Global_translator* global_translator_l (); - -private: - Array note_req_l_arr_; - Array note_p_arr_; - Array delayed_p_arr_; -}; - -#endif // NOTE_PERFORMER_HH diff --git a/lily/include/score-element-info.hh b/lily/include/score-element-info.hh deleted file mode 100644 index ac5ca85575..0000000000 --- a/lily/include/score-element-info.hh +++ /dev/null @@ -1,35 +0,0 @@ -/* - score-element-info.hh -- declare Score_element_info - - source file of the GNU LilyPond music typesetter - - (c) 1997--2000 Han-Wen Nienhuys -*/ - - -#ifndef STAFFELEMINFO_HH -#define STAFFELEMINFO_HH - -#include "lily-proto.hh" -#include "parray.hh" - -/** - Data container for broadcasts. - - TODO: Store this in element info! - */ -struct Score_element_info { - Translator * origin_trans_l_; - friend Engraver; -public: - Link_array origin_trans_l_arr (Translator*) const; - Score_element * elem_l_; - Music *req_l_; - - - Score_element_info (Score_element*, Music*); - Score_element_info(); -}; - - -#endif // STAFFELEMINFO_HH diff --git a/lily/include/score-element.hh b/lily/include/score-element.hh deleted file mode 100644 index 424a182932..0000000000 --- a/lily/include/score-element.hh +++ /dev/null @@ -1,175 +0,0 @@ -/* - score-element.hh -- declare Score_element - - (c) 1996-1999--2000 Han-Wen Nienhuys -*/ - -#ifndef STAFFELEM_HH -#define STAFFELEM_HH - -#include "parray.hh" -#include "virtual-methods.hh" -#include "lily-guile.hh" -#include "lily-proto.hh" -#include "smobs.hh" -#include "dimension-cache.hh" - -/** - for administration of what was done already - */ -enum Score_element_status { - ORPHAN=0, // not yet added to Paper_score - VIRGIN, - PRECALCING, - PRECALCED, // calcs before spacing done - POSTCALCING, // busy calculating. This is used to trap cyclic deps. - POSTCALCED, // after spacing calcs done -}; - -typedef void (Score_element::*Score_element_method_pointer) (void); - -/* - Basic output object. -*/ -class Score_element { -public: - SCM immutable_property_alist_; - SCM mutable_property_alist_; - Score_element *original_l_; - - /** - Administration: Where are we?. This is mainly used by Super_element and - Score_element::calcalute_dependencies () - - 0 means ORPHAN, - */ - char status_i_; - String name () const; - - /* - IDEA: make this a global variable. This is the same for all - elements, I think it is safe to assume that we will not have - scores being formatted multithreadedly. - */ - Paper_score *pscore_l_; - - Score_element (SCM basic_props); - Score_element (Score_element const&); - - /* - properties - */ - SCM get_elt_property (const char*) const; - SCM get_elt_property (SCM) const; - void set_elt_property (const char * , SCM val); - void set_immutable_elt_property (const char * , SCM val); - void set_immutable_elt_property (SCM key, SCM val); - void set_elt_property (SCM , SCM val); - void set_elt_pointer (const char*, SCM val); - friend class Property_engraver; // UGHUGHUGH. - SCM remove_elt_property (const char* nm); - - /* - related classes. - */ - Paper_def *paper_l () const; - - /** - add a dependency. It may be the 0 pointer, in which case, it is ignored. - */ - void add_dependency (Score_element*); - virtual Line_of_score * line_l () const; - bool linked_b () const; - - - VIRTUAL_COPY_CONS(Score_element); - - /** - Recursively track all dependencies of this Score_element. The - status_i_ field is used as a mark-field. It is marked with - #busy# during execution of this function, and marked with #final# - when finished. - - #funcptr# is the function to call to update this element. - */ - void calculate_dependencies (int final, int busy, SCM funcname); - static SCM handle_broken_smobs (SCM, SCM criterion); - - virtual void do_break_processing (); - virtual Score_element *find_broken_piece (Line_of_score*) const; - virtual void discretionary_processing (); - virtual SCM do_derived_mark (); - - Molecule * get_molecule () const; - void suicide (); - - DECLARE_SCHEME_CALLBACK(preset_extent, (SCM smob, SCM axis)); - DECLARE_SCHEME_CALLBACK(point_dimension_callback, (SCM smob, SCM axis)); - DECLARE_SCHEME_CALLBACK(molecule_extent, (SCM smob, SCM axis)); - - - static SCM ly_set_elt_property (SCM, SCM,SCM); - static SCM ly_get_elt_property (SCM, SCM); - - bool has_interface (SCM intf); - void set_interface (SCM intf); - - virtual void handle_broken_dependencies (); - virtual void handle_prebroken_dependencies (); - - - DECLARE_SMOBS(Score_element,foo); - - void init (); - - Dimension_cache dim_cache_[NO_AXES]; - -public: - bool empty_b (Axis a) const; - - Interval extent (Score_element * refpoint, Axis) const; - - /** - translate in one direction - */ - - void translate_axis (Real, Axis); - - /** - Find the offset relative to D. If D equals THIS, then it is 0. - Otherwise, it recursively defd as - - OFFSET_ + PARENT_L_->relative_coordinate (D) - */ - Real relative_coordinate (Score_element const* refp, Axis) const; - /** - Find the group-element which has both #this# and #s# - */ - Score_element*common_refpoint (Score_element const* s, Axis a) const; - Score_element*common_refpoint (SCM elt_list, Axis a) const; - - // duh. slim down interface here. (todo) - bool has_offset_callback_b (SCM callback, Axis)const; - void add_offset_callback (SCM callback, Axis); - bool has_extent_callback_b (SCM, Axis)const; - void set_extent_callback (SCM , Axis); - bool has_extent_callback_b (Axis) const; - - - /** - Invoke callbacks to get offset relative to parent. - */ - Real get_offset (Axis a) const; - /** - Set the parent refpoint of THIS to E - */ - void set_parent (Score_element* e, Axis); - - Score_element *parent_l (Axis a) const; - DECLARE_SCHEME_CALLBACK(fixup_refpoint, (SCM)); -}; - -Score_element * unsmob_element (SCM); - -#endif // STAFFELEM_HH - diff --git a/lily/include/staff-performer.hh b/lily/include/staff-performer.hh deleted file mode 100644 index 2ff3cd276d..0000000000 --- a/lily/include/staff-performer.hh +++ /dev/null @@ -1,44 +0,0 @@ -/* - staff-performer.hh -- declare Staff_performer - - (c) 1996--2000 Han-Wen Nienhuys - Jan Nieuwenhuizen - */ - -#ifndef STAFF_PERFORMER_HH -#define STAFF_PERFORMER_HH - -#include "performer-group-performer.hh" - -/** Perform a staff. Individual notes should have their instrument - (staff-wide) set, so we override play_element() - - */ -class Staff_performer : public Performer_group_performer -{ -public: - VIRTUAL_COPY_CONS(Translator); - - - Staff_performer (); - ~Staff_performer (); - - String new_instrument_str (); - String instrument_str_; - -protected: - virtual void play_element (Audio_element* p); - virtual void do_removal_processing (); - virtual void do_creation_processing (); - virtual void do_process_music (); - virtual void do_pre_move_processing (); - -private: - Audio_staff* audio_staff_p_; - Audio_instrument* instrument_p_; - Audio_text* instrument_name_p_; - Audio_text* name_p_; - Audio_tempo* tempo_p_; -}; - -#endif // STAFF_PERFORMER_HH diff --git a/lily/include/tempo-performer.hh b/lily/include/tempo-performer.hh deleted file mode 100644 index c4a6d0f7c8..0000000000 --- a/lily/include/tempo-performer.hh +++ /dev/null @@ -1,34 +0,0 @@ -/* - tempo-performer.hh -- declare Tempo_performer - - source file of the GNU LilyPond music typesetter - - (c) 1997--2000 Jan Nieuwenhuizen -*/ - -#ifndef TEMPO_PERFORMER_HH -#define TEMPO_PERFORMER_HH - -#include "lily-proto.hh" -#include "performer.hh" - -class Tempo_performer : public Performer -{ -public: - VIRTUAL_COPY_CONS(Translator); - - Tempo_performer(); - ~Tempo_performer(); - -protected: - - virtual bool do_try_music (Music* req_l); - virtual void do_process_music(); - virtual void do_pre_move_processing (); - -private: - Tempo_req* tempo_req_l_; - Audio_tempo* audio_p_; -}; - -#endif // TEMPO_PERFORMER_HH diff --git a/lily/include/tie-performer.hh b/lily/include/tie-performer.hh deleted file mode 100644 index 54425eb2fa..0000000000 --- a/lily/include/tie-performer.hh +++ /dev/null @@ -1,64 +0,0 @@ -/* - tie-performer.hh -- declare Tie_performer - - source file of the GNU LilyPond music typesetter - - (c) 1999--2000 Jan Nieuwenhuizen - - */ - -#ifndef TIE_PERFORMER_HH -#define TIE_PERFORMER_HH - -#include "pqueue.hh" -#include "performer.hh" - -struct CNote_melodic_tuple { - Melodic_req *req_l_ ; - Audio_note *note_l_; - Moment end_; - CNote_melodic_tuple (); - CNote_melodic_tuple (Audio_note*, Melodic_req*, Moment); - static int pitch_compare (CNote_melodic_tuple const &, CNote_melodic_tuple const &); - static int time_compare (CNote_melodic_tuple const &, CNote_melodic_tuple const &); -}; - -inline int compare (CNote_melodic_tuple const &a, CNote_melodic_tuple const &b) -{ - return CNote_melodic_tuple::time_compare (a,b); -} - - -/** - Manufacture ties. Acknowledge notes, and put them into a - priority queue. If we have a Tie_req, connect the notes that finish - just at this time, and note that start at this time. - - TODO: should share code with Tie_engraver ? - */ -class Tie_performer : public Performer -{ -public: - VIRTUAL_COPY_CONS(Translator); - Tie_performer (); - -private: - PQueue past_notes_pq_; - Tie_req *req_l_; - Array now_notes_; - Array stopped_notes_; - Link_array tie_p_arr_; - -protected: - virtual void do_post_move_processing (); - virtual void do_pre_move_processing (); - virtual void acknowledge_element (Audio_element_info); - virtual bool do_try_music (Music*); - virtual void do_process_music (); - virtual void process_acknowledged (); - -}; - - -#endif /* TIE_PERFORMER_HH */ - diff --git a/lily/include/time-signature-performer.hh b/lily/include/time-signature-performer.hh deleted file mode 100644 index 5a827b54bc..0000000000 --- a/lily/include/time-signature-performer.hh +++ /dev/null @@ -1,13 +0,0 @@ -/* - time_signature-performer.hh -- declare Time_signature_performer - - source file of the GNU LilyPond music typesetter - - (c) 1997--2000 Jan Nieuwenhuizen -*/ - -#ifndef TIME_SIGNATURE_PERFORMER_HH -#define TIME_SIGNATURE_PERFORMER_HH - - -#endif // TIME_SIGNATURE_PERFORMER_HH diff --git a/lily/score-element-callback.cc b/lily/score-element-callback.cc deleted file mode 100644 index 00cd9f7a38..0000000000 --- a/lily/score-element-callback.cc +++ /dev/null @@ -1,56 +0,0 @@ -#if 0 -/* - score-element-callback.cc -- implement Callback smob. - - source file of the GNU LilyPond music typesetter - - (c) 2000 Han-Wen Nienhuys - - */ - -#include "score-element-callback.hh" - -static SCM callback_tag; - -static -SCM mark_smob (SCM) -{ - return SCM_EOL; -} - -static int -print_smob (SCM, SCM port, scm_print_state *) -{ - scm_puts ("#", port); - return 1; -} - -static -scm_sizet free_smob (SCM) -{ - return 0; -} - -static -void start_callback_smobs() -{ - callback_tag = scm_make_smob_type_mfpe ("callback", 0, - mark_smob, free_smob, - print_smob, 0); -} - - -SCM -smobify_callback (Score_element_callback cb ) -{ - SCM z; - - SCM_NEWCELL(z); - SCM_SETCDR (z, (SCM)cb); - SCM_SETCAR (z, (SCM)callback_tag); - - return z; -} - -ADD_SCM_INIT_FUNC(callback, start_callback_smobs); -#endif diff --git a/lily/score-element-info.cc b/lily/score-element-info.cc deleted file mode 100644 index c437a655d5..0000000000 --- a/lily/score-element-info.cc +++ /dev/null @@ -1,42 +0,0 @@ -/* - score-element-info.cc -- implement Score_element_info - - source file of the GNU LilyPond music typesetter - - (c) 1997--2000 Han-Wen Nienhuys -*/ - -#include "score-element-info.hh" -#include "request.hh" -#include "translator.hh" -#include "translator-group.hh" - -Score_element_info::Score_element_info (Score_element*s_l, Music *r_l) -{ - elem_l_ = s_l; - req_l_ = r_l; - origin_trans_l_ = 0; -} - - -Score_element_info::Score_element_info() -{ - elem_l_ = 0; - req_l_ = 0; - origin_trans_l_ = 0; -} - - -Link_array -Score_element_info::origin_trans_l_arr (Translator* end) const -{ - Translator * t = origin_trans_l_; - Link_array r; - do { - r.push (t); - t = t->daddy_trans_l_; - } while (t && t != end->daddy_trans_l_); - - return r; -} - diff --git a/lily/score-element.cc b/lily/score-element.cc deleted file mode 100644 index 5928d8b874..0000000000 --- a/lily/score-element.cc +++ /dev/null @@ -1,886 +0,0 @@ -/* - score-elem.cc -- implement Score_element - - source file of the GNU LilyPond music typesetter - - (c) 1997--2000 Han-Wen Nienhuys -*/ - - -#include -#include - -#include "input-smob.hh" -#include "libc-extension.hh" -#include "group-interface.hh" -#include "misc.hh" -#include "paper-score.hh" -#include "paper-def.hh" -#include "molecule.hh" -#include "score-element.hh" -#include "debug.hh" -#include "spanner.hh" -#include "line-of-score.hh" -#include "item.hh" -#include "paper-column.hh" -#include "molecule.hh" -#include "misc.hh" -#include "paper-outputter.hh" -#include "dimension-cache.hh" -#include "side-position-interface.hh" -#include "item.hh" - -#include "ly-smobs.icc" - -/* -TODO: - -remove dynamic_cast and put this code into respective - subclass. -*/ - - -#define INFINITY_MSG "Infinity or NaN encountered" - -Score_element::Score_element(SCM basicprops) -{ - /* - fixme: default should be no callback. - */ - - pscore_l_=0; - status_i_ = 0; - original_l_ = 0; - immutable_property_alist_ = basicprops; - mutable_property_alist_ = SCM_EOL; - - smobify_self (); - - char const*onames[] = {"X-offset-callbacks", "Y-offset-callbacks"}; - char const*enames[] = {"X-extent-callback", "Y-extent-callback"}; - - for (int a = X_AXIS; a <= Y_AXIS; a++){ - SCM l = get_elt_property (onames[a]); - - if (scm_ilength (l) >=0) - { - dim_cache_[a].offset_callbacks_ = l; - dim_cache_[a].offsets_left_ = scm_ilength (l); - } - else - { - programming_error ("[XY]-offset-callbacks must be a list"); - } - - SCM cb = get_elt_property (enames[a]); - - /* - Should change default to be empty? - */ - if (!gh_procedure_p (cb) && !gh_pair_p (cb)) - cb = molecule_extent_proc; - - dim_cache_[a].dimension_ = cb; - } - - SCM meta = get_elt_property ("meta"); - SCM ifs = scm_assoc (ly_symbol2scm ("interfaces"), meta); - - set_elt_property ("interfaces",gh_cdr (ifs)); -} - - -Score_element::Score_element (Score_element const&s) - : dim_cache_ (s.dim_cache_) -{ - original_l_ =(Score_element*) &s; - immutable_property_alist_ = s.immutable_property_alist_; - mutable_property_alist_ = SCM_EOL; - - status_i_ = s.status_i_; - pscore_l_ = s.pscore_l_; - - smobify_self (); -} - -Score_element::~Score_element() -{ - /* - do nothing scm-ish and no unprotecting here. - */ -} - - -SCM -Score_element::get_elt_property (const char *nm) const -{ - SCM sym = ly_symbol2scm (nm); - return get_elt_property (sym); -} - -SCM -Score_element::get_elt_property (SCM sym) const -{ - SCM s = scm_sloppy_assq(sym, mutable_property_alist_); - if (s != SCM_BOOL_F) - return gh_cdr (s); - - s = scm_sloppy_assq (sym, immutable_property_alist_); - return (s == SCM_BOOL_F) ? SCM_EOL : gh_cdr (s); -} - -/* - Remove the value associated with KEY, and return it. The result is - that a next call will yield SCM_UNDEFINED (and not the underlying - `basic' property. -*/ -SCM -Score_element::remove_elt_property (const char* key) -{ - SCM val = get_elt_property (key); - if (val != SCM_EOL) - set_elt_property (key, SCM_EOL); - return val; -} - -void -Score_element::set_elt_property (const char* k, SCM v) -{ - SCM s = ly_symbol2scm (k); - set_elt_property (s, v); -} - -/* - Puts the k, v in the immutable_property_alist_, which is convenient for - storing variables that are needed during the breaking process. (eg. - Line_of_score::rank : int ) - */ -void -Score_element::set_immutable_elt_property (const char*k, SCM v) -{ - SCM s = ly_symbol2scm (k); - set_immutable_elt_property (s, v); -} - -void -Score_element::set_immutable_elt_property (SCM s, SCM v) -{ - immutable_property_alist_ = gh_cons (gh_cons (s,v), mutable_property_alist_); - mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, s); -} -void -Score_element::set_elt_property (SCM s, SCM v) -{ - mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v); -} - - -MAKE_SCHEME_CALLBACK(Score_element,molecule_extent,2); -SCM -Score_element::molecule_extent (SCM element_smob, SCM scm_axis) -{ - Score_element *s = unsmob_element (element_smob); - Axis a = (Axis) gh_scm2int (scm_axis); - - Molecule *m = s->get_molecule (); - Interval e ; - if (m) - e = m->extent(a); - return ly_interval2scm ( e); -} - -MAKE_SCHEME_CALLBACK(Score_element,preset_extent,2); - -SCM -Score_element::preset_extent (SCM element_smob, SCM scm_axis) -{ - Score_element *s = unsmob_element (element_smob); - Axis a = (Axis) gh_scm2int (scm_axis); - - SCM ext = s->get_elt_property ((a == X_AXIS) - ? "extent-X" - : "extent-Y"); - - if (gh_pair_p (ext)) - { - Real l = gh_scm2double (gh_car (ext)); - Real r = gh_scm2double (gh_cdr (ext)); - return ly_interval2scm (Interval (l, r)); - } - - return ly_interval2scm ( Interval ()); -} - - - -Paper_def* -Score_element::paper_l () const -{ - return pscore_l_ ? pscore_l_->paper_l_ : 0; -} - -void -Score_element::calculate_dependencies (int final, int busy, SCM funcname) -{ - assert (status_i_ >=0); - - if (status_i_ >= final) - return; - - if (status_i_== busy) - { - programming_error ("Element is busy, come back later"); - return; - } - - status_i_= busy; - - for (SCM d= get_elt_property ("dependencies"); gh_pair_p (d); d = gh_cdr (d)) - { - unsmob_element (gh_car (d)) - ->calculate_dependencies (final, busy, funcname); - } - - // ughugh. - String s = ly_symbol2string (funcname); - SCM proc = get_elt_property (s.ch_C()); - if (gh_procedure_p (proc)) - gh_call1 (proc, this->self_scm ()); - - status_i_= final; - -} - -Molecule * -Score_element::get_molecule () const -{ - SCM mol = get_elt_property ("molecule"); - if (unsmob_molecule (mol)) - return unsmob_molecule (mol); - - SCM proc = get_elt_property ("molecule-callback"); - - mol = SCM_EOL; - if (gh_procedure_p (proc)) - mol = gh_apply (proc, gh_list (this->self_scm (), SCM_UNDEFINED)); - - - /* - TODO: add option for not copying origin info. - */ - SCM origin =get_elt_property ("origin"); - if (!unsmob_input (origin)) - origin =ly_symbol2scm ("no-origin"); - - if (gh_pair_p (mol)) - { - // ugr. - mol = gh_cons (gh_list (origin, gh_car (mol), SCM_UNDEFINED), gh_cdr (mol)); - } - - Molecule *m = unsmob_molecule (mol); - - - /* - transparent retains dimensions of element. - */ - if (m && to_boolean (get_elt_property ("transparent"))) - mol = Molecule (m->extent_box (), SCM_EOL).smobbed_copy (); - - Score_element *me = (Score_element*)this; - me->set_elt_property ("molecule", mol); - - m = unsmob_molecule (mol); - return m; -} - - -/* - - VIRTUAL STUBS - - */ -void -Score_element::do_break_processing() -{ -} - - - - - - -Line_of_score * -Score_element::line_l() const -{ - return 0; -} - -void -Score_element::add_dependency (Score_element*e) -{ - if (e) - { - Pointer_group_interface ::add_element (this, "dependencies",e); - - } - else - programming_error ("Null dependency added"); -} - - - - -/** - Do break substitution in S, using CRITERION. Return new value. - CRITERION is either a SMOB pointer to the desired line, or a number - representing the break direction. Do not modify SRC. -*/ -SCM -Score_element::handle_broken_smobs (SCM src, SCM criterion) -{ - again: - Score_element *sc = unsmob_element (src); - if (sc) - { - if (gh_number_p (criterion)) - { - Item * i = dynamic_cast (sc); - Direction d = to_dir (criterion); - if (i && i->break_status_dir () != d) - { - Item *br = i->find_prebroken_piece (d); - return (br) ? br->self_scm () : SCM_UNDEFINED; - } - } - else - { - Line_of_score * line - = dynamic_cast (unsmob_element (criterion)); - if (sc->line_l () != line) - { - sc = sc->find_broken_piece (line); - - } - - /* now: !sc || (sc && sc->line_l () == line) */ - if (!sc) - return SCM_UNDEFINED; - - /* now: sc && sc->line_l () == line */ - if (!line - || (sc->common_refpoint (line, X_AXIS) - && sc->common_refpoint (line, Y_AXIS))) - { - return sc->self_scm (); - } - return SCM_UNDEFINED; - } - } - else if (gh_pair_p (src)) - { - SCM oldcar =gh_car (src); - /* - UGH! breaks on circular lists. - */ - SCM newcar = handle_broken_smobs (oldcar, criterion); - SCM oldcdr = gh_cdr (src); - - if (newcar == SCM_UNDEFINED - && (gh_pair_p (oldcdr) || oldcdr == SCM_EOL)) - { - /* - This is tail-recursion, ie. - - return handle_broken_smobs (cdr, criterion); - - We don't want to rely on the compiler to do this. Without - tail-recursion, this easily crashes with a stack overflow. */ - src = oldcdr; - goto again; - } - - SCM newcdr = handle_broken_smobs (oldcdr, criterion); - return gh_cons (newcar, newcdr); - } - else - return src; - - return src; -} - -void -Score_element::handle_broken_dependencies() -{ - Spanner * s= dynamic_cast (this); - if (original_l_ && s) - return; - - if (s) - { - for (int i = 0; i< s->broken_into_l_arr_ .size (); i++) - { - Score_element * sc = s->broken_into_l_arr_[i]; - Line_of_score * l = sc->line_l (); - sc->mutable_property_alist_ = - handle_broken_smobs (mutable_property_alist_, - l ? l->self_scm () : SCM_UNDEFINED); - } - } - - - Line_of_score *line = line_l(); - - if (line && common_refpoint (line, X_AXIS) && common_refpoint (line, Y_AXIS)) - { - mutable_property_alist_ - = handle_broken_smobs (mutable_property_alist_, - line ? line->self_scm () : SCM_UNDEFINED); - } - else if (dynamic_cast (this)) - { - mutable_property_alist_ = handle_broken_smobs (mutable_property_alist_, - SCM_UNDEFINED); - } - else - { - /* - This element is `invalid'; it has been removed from all - dependencies, so let's junk the element itself. - - do not do this for Line_of_score, since that would remove - references to the originals of score-elts, which get then GC'd - (a bad thing.) - */ - suicide(); - } -} - -/* - Note that we still want references to this element to be - rearranged, and not silently thrown away, so we keep pointers - like {broken_into_{drul,array}, original} -*/ -void -Score_element::suicide () -{ - mutable_property_alist_ = SCM_EOL; - immutable_property_alist_ = SCM_EOL; - - set_extent_callback (SCM_EOL, Y_AXIS); - set_extent_callback (SCM_EOL, X_AXIS); - - for (int a= X_AXIS; a <= Y_AXIS; a++) - { - dim_cache_[a].offset_callbacks_ = SCM_EOL; - dim_cache_[a].offsets_left_ = 0; - } -} - -void -Score_element::handle_prebroken_dependencies() -{ -} - -Score_element* -Score_element::find_broken_piece (Line_of_score*) const -{ - return 0; -} - -void -Score_element::translate_axis (Real y, Axis a) -{ - if (isinf (y) || isnan (y)) - programming_error (_(INFINITY_MSG)); - else - { - dim_cache_[a].offset_ += y; - } -} - -Real -Score_element::relative_coordinate (Score_element const*refp, Axis a) const -{ - if (refp == this) - return 0.0; - - /* - We catch PARENT_L_ == nil case with this, but we crash if we did - not ask for the absolute coordinate (ie. REFP == nil.) - - */ - if (refp == dim_cache_[a].parent_l_) - return get_offset (a); - else - return get_offset (a) + dim_cache_[a].parent_l_->relative_coordinate (refp, a); -} - -Real -Score_element::get_offset (Axis a) const -{ - Score_element *me = (Score_element*) this; - while (dim_cache_[a].offsets_left_) - { - int l = --me->dim_cache_[a].offsets_left_; - SCM cb = scm_list_ref (dim_cache_[a].offset_callbacks_, gh_int2scm (l)); - SCM retval = gh_call2 (cb, self_scm (), gh_int2scm (a)); - - Real r = gh_scm2double (retval); - if (isinf (r) || isnan (r)) - { - programming_error (INFINITY_MSG); - r = 0.0; - } - me->dim_cache_[a].offset_ +=r; - } - return dim_cache_[a].offset_; -} - - -MAKE_SCHEME_CALLBACK(Score_element,point_dimension_callback,2); -SCM -Score_element::point_dimension_callback (SCM , SCM ) -{ - return ly_interval2scm ( Interval (0,0)); -} - -bool -Score_element::empty_b (Axis a)const -{ - return ! (gh_pair_p (dim_cache_[a].dimension_ ) || - gh_procedure_p (dim_cache_[a].dimension_ )); -} - -/* - TODO: add - - Score_element *refpoint - - to arguments? - */ -Interval -Score_element::extent (Score_element * refp, Axis a) const -{ - Real x = relative_coordinate (refp, a); - - - Dimension_cache * d = (Dimension_cache *)&dim_cache_[a]; - Interval ext ; - if (gh_pair_p (d->dimension_)) - ; - else if (gh_procedure_p (d->dimension_)) - { - /* - FIXME: add doco on types, and should typecheck maybe? - */ - d->dimension_= gh_call2 (d->dimension_, self_scm(), gh_int2scm (a)); - } - else - return ext; - - if (!gh_pair_p (d->dimension_)) - return ext; - - ext = ly_scm2interval (d->dimension_); - - SCM extra = get_elt_property (a == X_AXIS - ? "extra-extent-X" - : "extra-extent-Y"); - - /* - signs ? - */ - if (gh_pair_p (extra)) - { - ext[BIGGER] += gh_scm2double (gh_cdr (extra)); - ext[SMALLER] += gh_scm2double (gh_car (extra)); - } - - extra = get_elt_property (a == X_AXIS - ? "minimum-extent-X" - : "minimum-extent-Y"); - if (gh_pair_p (extra)) - { - ext.unite (Interval (gh_scm2double (gh_car (extra)), - gh_scm2double (gh_cdr (extra)))); - } - - ext.translate (x); - - return ext; -} - - -Score_element* -Score_element::parent_l (Axis a) const -{ - return dim_cache_[a].parent_l_; -} - -Score_element * -Score_element::common_refpoint (Score_element const* s, Axis a) const -{ - /* - I don't like the quadratic aspect of this code, but I see no other - way. The largest chain of parents might be 10 high or so, so - it shouldn't be a real issue. */ - for (Score_element const *c = this; c; c = c->dim_cache_[a].parent_l_) - for (Score_element const * d = s; d; d = d->dim_cache_[a].parent_l_) - if (d == c) - return (Score_element*)d; - - return 0; -} - - -Score_element * -Score_element::common_refpoint (SCM elist, Axis a) const -{ - Score_element * common = (Score_element*) this; - for (; gh_pair_p (elist); elist = gh_cdr (elist)) - { - Score_element * s = unsmob_element (gh_car (elist)); - if (s) - common = common->common_refpoint (s, a); - } - - return common; -} - -String -Score_element::name () const -{ - SCM meta = get_elt_property ("meta"); - SCM nm = scm_assoc (ly_symbol2scm ("name"), meta); - nm = (gh_pair_p (nm)) ? gh_cdr (nm) : SCM_EOL; - return gh_string_p (nm) ?ly_scm2string (nm) : classname (this); -} - -void -Score_element::add_offset_callback (SCM cb, Axis a) -{ - if (!has_offset_callback_b (cb, a)) - { - dim_cache_[a].offset_callbacks_ = gh_cons (cb, dim_cache_[a].offset_callbacks_ ); - dim_cache_[a].offsets_left_ ++; - } -} - -bool -Score_element::has_extent_callback_b (SCM cb, Axis a)const -{ - return scm_equal_p (cb, dim_cache_[a].dimension_); -} - - -bool -Score_element::has_extent_callback_b (Axis a) const -{ - return gh_procedure_p (dim_cache_[a].dimension_); -} - -bool -Score_element::has_offset_callback_b (SCM cb, Axis a)const -{ - return scm_memq (cb, dim_cache_[a].offset_callbacks_) != SCM_BOOL_F; -} - -void -Score_element::set_extent_callback (SCM dc, Axis a) -{ - dim_cache_[a].dimension_ =dc; -} - -void -Score_element::set_parent (Score_element *g, Axis a) -{ - dim_cache_[a].parent_l_ = g; -} - -MAKE_SCHEME_CALLBACK(Score_element,fixup_refpoint,1); -SCM -Score_element::fixup_refpoint (SCM smob) -{ - Score_element *me = unsmob_element (smob); - for (int a = X_AXIS; a < NO_AXES; a ++) - { - Axis ax = (Axis)a; - Score_element * parent = me->parent_l (ax); - - if (!parent) - continue; - - if (parent->line_l () != me->line_l () && me->line_l ()) - { - Score_element * newparent = parent->find_broken_piece (me->line_l ()); - me->set_parent (newparent, ax); - } - - if (Item * i = dynamic_cast (me)) - { - Item *parenti = dynamic_cast (parent); - - if (parenti && i) - { - Direction my_dir = i->break_status_dir () ; - if (my_dir!= parenti->break_status_dir()) - { - Item *newparent = parenti->find_prebroken_piece (my_dir); - me->set_parent (newparent, ax); - } - } - } - } - return smob; -} - - - -/**************************************************** - SMOB funcs - ****************************************************/ - - -IMPLEMENT_UNSMOB(Score_element, element); -IMPLEMENT_SMOBS(Score_element); -IMPLEMENT_DEFAULT_EQUAL_P(Score_element); - -SCM -Score_element::mark_smob (SCM ses) -{ - Score_element * s = (Score_element*) SCM_CELL_WORD_1(ses); - scm_gc_mark (s->immutable_property_alist_); - scm_gc_mark (s->mutable_property_alist_); - - for (int a =0 ; a < 2; a++) - { - scm_gc_mark (s->dim_cache_[a].offset_callbacks_); - scm_gc_mark (s->dim_cache_[a].dimension_); - } - - if (s->parent_l (Y_AXIS)) - scm_gc_mark (s->parent_l (Y_AXIS)->self_scm ()); - if (s->parent_l (X_AXIS)) - scm_gc_mark (s->parent_l (X_AXIS)->self_scm ()); - - if (s->original_l_) - scm_gc_mark (s->original_l_->self_scm ()); - return s->do_derived_mark (); -} - -int -Score_element::print_smob (SCM s, SCM port, scm_print_state *) -{ - Score_element *sc = (Score_element *) gh_cdr (s); - - scm_puts ("#name ().ch_C(), port); - - /* - don't try to print properties, that is too much hassle. - */ - scm_puts (" >", port); - return 1; -} - -SCM -Score_element::do_derived_mark () -{ - return SCM_EOL; -} - - -SCM -ly_set_elt_property (SCM elt, SCM sym, SCM val) -{ - Score_element * sc = unsmob_element (elt); - - if (!gh_symbol_p (sym)) - { - error ("Not a symbol"); - ly_display_scm (sym); - return SCM_UNSPECIFIED; - } - - if (sc) - { - sc->set_elt_property (sym, val); - } - else - { - error ("Not a score element"); - ly_display_scm (elt); - } - - return SCM_UNSPECIFIED; -} - - -SCM -ly_get_elt_property (SCM elt, SCM sym) -{ - Score_element * sc = unsmob_element (elt); - - if (sc) - { - return sc->get_elt_property (sym); - } - else - { - error ("Not a score element"); - ly_display_scm (elt); - } - return SCM_UNSPECIFIED; -} - - -void -Score_element::discretionary_processing() -{ -} - - - -SCM -spanner_get_bound (SCM slur, SCM dir) -{ - return dynamic_cast (unsmob_element (slur))->get_bound (to_dir (dir))->self_scm (); -} - - - -static SCM interfaces_sym; -static void -init_functions () -{ - interfaces_sym = scm_permanent_object (ly_symbol2scm ("interfaces")); - - scm_make_gsubr ("ly-get-elt-property", 2, 0, 0, (Scheme_function_unknown)ly_get_elt_property); - scm_make_gsubr ("ly-set-elt-property", 3, 0, 0, (Scheme_function_unknown)ly_set_elt_property); - scm_make_gsubr ("ly-get-spanner-bound", 2 , 0, 0, (Scheme_function_unknown) spanner_get_bound); -} - -bool -Score_element::has_interface (SCM k) -{ - SCM ifs = get_elt_property (interfaces_sym); - - return scm_memq (k, ifs) != SCM_BOOL_F; -} - -void -Score_element::set_interface (SCM k) -{ - if (has_interface (k)) - return ; - else - { - set_elt_property (interfaces_sym, - gh_cons (k, get_elt_property (interfaces_sym))); - } -} - - -ADD_SCM_INIT_FUNC(scoreelt, init_functions); -IMPLEMENT_TYPE_P(Score_element, "ly-element?"); diff --git a/scm/chord-names.scm b/scm/chord-names.scm deleted file mode 100644 index 25ddef79a9..0000000000 --- a/scm/chord-names.scm +++ /dev/null @@ -1,521 +0,0 @@ -;;; chord.scm -- to be included in/to replace chord-name.scm -;;; 2000 janneke@gnu.org -;;; - -(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) - ) - -;; -;; (octave notename accidental) -;; - -;; -;; text: scm markup text -- see font.scm and input/test/markup.ly -;; - -;; 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 lilypond -;; * fix append/cons stuff in inner-name-banter -;; * doc strings. - - -;;;;;;;;; -(define chord::names-alist-banter '()) -(set! chord::names-alist-banter - (append - '( - ; C iso C.no3.no5 - (((0 . 0)) . #f) - ; C iso C.no5 - (((0 . 0) (2 . 0)) . #f) - ; Cm iso Cm.no5 - (((0 . 0) (2 . -1)) . ("m")) - ; C2 iso C2.no3 - (((0 . 0) (1 . 0) (4 . 0)) . (super "2")) - ; C4 iso C4.no3 - (((0 . 0) (3 . 0) (4 . 0)) . (super "4")) - ; Cdim iso Cm5- - (((0 . 0) (2 . -1) (4 . -1)) . ("dim")) - ; Co iso Cm5-7- - ; urg - (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (super "o")) - ; Cdim9 - (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ("dim" (super "9"))) - (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ("dim" (super "11"))) - ) - chord::names-alist-banter)) - - -;; NOTE: Duplicates of chord names defined elsewhere occur in this list -;; in order to prevent spurious superscripting of various chord names, -;; such as maj7, maj9, etc. -;; -;; See input/test/american-chords.ly -;; -;; James Hammons, -;; - -;; DONT use non-ascii characters, even if ``it works'' in Windows - -(define chord::names-alist-american '()) - -(set! chord::names-alist-american - (append - '( - (((0 . 0)) . #f) - (((0 . 0) (2 . 0)) . #f) - ;; Root-fifth chord - (((0 . 0) (4 . 0)) . ("5")) - ;; Common triads - (((0 . 0) (2 . -1)) . ("m")) - (((0 . 0) (3 . 0) (4 . 0)) . ("sus")) - (((0 . 0) (2 . -1) (4 . -1)) . ("dim")) -;Alternate: (((0 . 0) (2 . -1) (4 . -1)) . ((super "o"))) - (((0 . 0) (2 . 0) (4 . 1)) . ("aug")) -;Alternate: (((0 . 0) (2 . 0) (4 . 1)) . ("+")) - (((0 . 0) (1 . 0) (4 . 0)) . ("2")) - ;; Common seventh chords - (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (rows (super "o") "7")) - (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . ("maj7")) - (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . ("m7")) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . ("7")) - (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . ("m(maj7)")) - ;jazz: the delta, see jazz-chords.ly - ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (super ((font-family . math) "N")) - ;; slashed o - (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (rows ((raise . 1) "o") ((raise . 0.5) ((kern . -0.5) ((font-relative-size . -3) "/"))) "7")) ; slashed o - (((0 . 0) (2 . 0) (4 . 1) (6 . -1)) . ("aug7")) - (((0 . 0) (2 . 0) (4 . -1) (6 . 0)) . (rows "maj7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5")) - (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows "7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5")) - (((0 . 0) (3 . 0) (4 . 0) (6 . -1)) . ("7sus4")) - ;; Common ninth chords - (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . ("6/9")) ;; we don't want the '/no7' - (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . ("6")) - (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . ("m6")) - (((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . ("add9")) - (((0 . 0) (2 . 0) (4 . 0) (6 . 0) (1 . 0)) . ("maj9")) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) . ("9")) - (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . ("m9")) - - ) - chord::names-alist-american)) - -;; Jazz chords, by Atte Andr'e Jensen -;; NBs: This uses the american list as a base. -;; Some defs take up more than one line, -;; be carefull when messing with ;'s!! - - -;; FIXME -;; -;; This is getting out-of hand? Only exceptional chord names that -;; cannot be generated should be here. -;; Maybe we should have inner-jazz-name and inner-american-name functions; -;; -;; -;; -;; DONT use non-ascii characters, even if ``it works'' in Windows - -(define chord::names-alist-jazz '()) -(set! chord::names-alist-jazz - (append - '( - ;; major chords - ; major sixth chord = 6 - (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . (((raise . 0.5) "6"))) - ; major seventh chord = triangle - (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . (((raise . 0.5)((font-family . "math") "M")))) - ; major chord add nine = add9 - (((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . (((raise . 0.5) "add9"))) - ; major sixth chord with nine = 6/9 - (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . (((raise . 0.5) "6/9"))) - - ;; minor chords - ; minor sixth chord = m6 - (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . (rows("m")((raise . 0.5) "6"))) - ; minor major seventh chord = m triangle - (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (rows ("m") ((raise . 0.5)((font-family . "math") "M")))) - ; minor seventh chord = m7 - (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . (rows("m")((raise . 0.5) "7"))) - ; minor sixth nine chord = m6/9 - (((0 . 0) (2 . -1) (4 . 0) (5 . 0) (1 . 0)) . (rows("m")((raise . 0.5) "6/9"))) - ; minor with added nine chord = madd9 - (((0 . 0) (2 . -1) (4 . 0) (1 . 0)) . (rows("m")((raise . 0.5) "add9"))) - ; minor ninth chord = m9 - (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . (rows("m")((raise . 0.5) "9"))) - - ;; dominant chords - ; dominant seventh = 7 - (((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . (((raise . 0.5) "7"))) - ; augmented dominant = +7 - ;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (((raise . 0.5) "+7"))) ; +7 with both raised - (((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows("+")((raise . 0.5) "7"))) ; +7 with 7 raised - ;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows((raise . 0.5) "7(") - ; ((raise . 0.3)(music (named ("accidentals-1")))) - ; ((raise . 0.5) "5)"))); 7(#5) - ; dominant flat 5 = 7(b5) - (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows((raise . 0.5) "7(") - ((raise . 0.3)(music (named ("accidentals--1")))) - ((raise . 0.5) "5)"))) - ; dominant 9 = 7(9) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) . (((raise . 0.8)"7(9)"))) - ; dominant flat 9 = 7(b9) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1)) . ( - ((raise . 0.8)"7(") - ((raise . 0.3)(music (named ("accidentals--1")))) - ((raise . 0.8)"9)"))) - ; dominant sharp 9 = 7(#9) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1)) . ( - ((raise . 0.8)"7(") - ((raise . 0.3)(music (named ("accidentals-1")))) - ((raise . 0.8)"9)"))) - ; dominant 13 = 7(13) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . 0)) . (((raise . 0.8)"7(13)"))) - ; dominant flat 13 = 7(b13) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . -1)) . ( - ((raise . 0.8)"7(") - ((raise . 0.3)(music (named ("accidentals--1")))) - ((raise . 0.8)"13)"))) - ; dominant 9, 13 = 7(9,13) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . 0)) . (((raise . 0.8)"7(9, 13)"))) - ; dominant flat 9, 13 = 7(b9,13) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . 0)) . ( - ((raise . 0.8)"7(") - ((raise . 0.3)(music (named ("accidentals--1")))) - ((raise . 0.8)"9, 13)"))) - ; dominant sharp 9, 13 = 7(#9,13) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . 0)) . ( - ((raise . 0.8)"7(") - ((raise . 0.3)(music (named ("accidentals-1")))) - ((raise . 0.8)"9, 13)"))) - ; dominant 9, flat 13 = 7(9,b13) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . -1)) . ( - ((raise . 0.8)"7(9, ") - ((raise . 0.3)(music (named ("accidentals--1")))) - ((raise . 0.8)"13)"))) - ; dominant flat 9, flat 13 = 7(b9,b13) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . -1)) . ( - ((raise . 0.8)"7(") - ((raise . 0.3)(music (named ("accidentals--1")))) - ((raise . 0.8)"9, ") - ((raise . 0.3)(music (named ("accidentals--1")))) - ((raise . 0.8)"13)"))) - ; dominant sharp 9, flat 13 = 7(#9,b13) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . -1)) . ( - ((raise . 0.8)"7(") - ((raise . 0.3)(music (named ("accidentals-1")))) - ((raise . 0.8)"9, ") - ((raise . 0.3)(music (named ("accidentals--1")))) - ((raise . 0.8)"13)"))) - - ;; diminished chord(s) - ; diminished seventh chord = o - - - ;; DONT use non-ascii characters, even if ``it works'' in Windows - - ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (((raise . 0.8)"o"))); works, but "o" is a little big - (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ((raise . 0.8) (size . -2) ("o"))) - - ;; half diminshed chords - ; half diminished seventh chord = slashed o - (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (((raise . 0.8)"/o"))) - ; half diminished seventh chord with major 9 = slashed o cancelation 9 - (((0 . 0) (2 . -1) (4 . -1) (6 . -1) (1 . 0)) . ( - ((raise . 0.8)"/o(") - ((raise . 0.3)(music (named ("accidentals-0")))) - ((raise . 0.8)"9)"))); - -;; Missing jazz chord definitions go here (note new syntax: see american for hints) - - ) - 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 - (append '(music) - (list - (append '(named) - (list - (append '((font-relative-size . -2)) - (list (append '((raise . 0.6)) - (list - (string-append "accidentals-" - (number->string (caddr pitch))))))))))))))) - -(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 - '(rows) - (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))) - '((super "/")) - '()) - (let loop ((from additions) (to '())) - (if (pair? from) - (let ((p (car from))) - (loop (cdr from) - (append to - (cons - (list 'super (step->text-banter p)) - (if (or (pair? (cdr from)) - (pair? subtractions)) - '((super "/")) - '()))))) - to)) - (let loop ((from subtractions) (to '())) - (if (pair? from) - (let ((p (car from))) - (loop (cdr from) - (append to - (cons '(super "no") - (cons - (list 'super (step->text-banter p)) - (if (pair? (cdr from)) - '((super "/")) - '())))))) ; nesting? - 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))) - -;; Jazz style--basically similar to american with minor changes -(define (chord::name-jazz 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))) - -(define (new-to-old-pitch p) - (if (pitch? p) - (list (pitch-octave p) (pitch-notename p) (pitch-alteration p)) - #f - )) - - - -;; 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 (default-chord-name-function style pitches base-and-inversion) - ;(display "pitches:") (display pitches) (newline) - ;(display "style:") (display style) (newline) - ;(display "b&i:") (display base-and-inversion) (newline) - (set! pitches (map new-to-old-pitch pitches)) - (set! base-and-inversion (cons (new-to-old-pitch (car base-and-inversion)) - (new-to-old-pitch (cdr base-and-inversion)))) - - (let ((diff (pitch::diff '(0 0 0) (car pitches))) - (name-func - (ly-eval (string->symbol (string-append "chord::name-" style)))) - (names-alist - (ly-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)))))) - -