From 1d806d5a5a49dcf192259feac48510cf4e332291 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Tue, 26 Aug 2003 10:59:08 +0000 Subject: [PATCH] * scm/font.scm: remove old markup legacy * GNUmakefile.in (web-clean): remake share/ after web-clean. * lily/breathing-sign.cc (brew_molecule): remove function * lily/text-item.cc: remove old-style markups. (interpret_markup): C++ version of markup function (brew_molecule): idem. --- ChangeLog | 10 ++ GNUmakefile.in | 12 +- lily/breathing-sign.cc | 30 +--- lily/font-interface.cc | 22 +-- lily/include/font-interface.hh | 1 - lily/include/text-item.hh | 15 +- lily/mark-engraver.cc | 2 +- lily/paper-column.cc | 7 +- lily/parser.yy | 9 +- lily/text-item.cc | 277 ++++----------------------------- lily/text-spanner.cc | 6 +- lily/time-signature.cc | 13 +- lily/tuplet-bracket.cc | 3 +- lily/volta-bracket.cc | 4 +- ly/params-init.ly | 41 +---- scm/define-grobs.scm | 6 +- scm/font.scm | 127 +-------------- scm/lily.scm | 19 +++ scm/new-markup.scm | 23 +-- 19 files changed, 105 insertions(+), 522 deletions(-) diff --git a/ChangeLog b/ChangeLog index d81224c876..83ae006cc2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,15 @@ 2003-08-26 Han-Wen Nienhuys + * scm/font.scm: remove old markup legacy + + * GNUmakefile.in (web-clean): remake share/ after web-clean. + + * lily/breathing-sign.cc (brew_molecule): remove function + + * lily/text-item.cc: remove old-style markups. + (interpret_markup): C++ version of markup function + (brew_molecule): idem. + * lily/my-lily-lexer.cc (start_main_input): define input-file-name as Scheme variable. diff --git a/GNUmakefile.in b/GNUmakefile.in index 703d4f177f..6667cc4b2e 100644 --- a/GNUmakefile.in +++ b/GNUmakefile.in @@ -35,15 +35,7 @@ doc: pfa-fonts: $(MAKE) MAKE_PFA_FILES=1 -C mf -ifeq (0,1) - # the font ball; used for 1.8.0 - (cd $(builddir)/share/lilypond/fonts && \ - tar czvf ../../../$(outbase)/type1.tar.gz type1/*.pfa type1/fonts.* type1/lilypond.* ) -else - # the new font ball; to be used for for 1.8.1 - (cd $(builddir)/share/lilypond && \ - tar czvf ../../$(outbase)/type1-$(TOPLEVEL_VERSION).tar.gz fonts/type1/*.pfa fonts/type1/fonts.* dvips/*.map ) -endif +# don't make fontball - we have binary packages for that. web-install: -$(INSTALL) -m 755 -d $(webdir) @@ -87,7 +79,7 @@ ALL-TAGS: web-clean: $(SHELL) $(buildscript-dir)/clean-fonts.sh $(MAKE) out=www clean - + $(MAKE) $(builddir)/share/lilypond-force default: $(config_h) builddir-setup diff --git a/lily/breathing-sign.cc b/lily/breathing-sign.cc index a1743c8c73..e78b5a5016 100644 --- a/lily/breathing-sign.cc +++ b/lily/breathing-sign.cc @@ -24,35 +24,11 @@ #include "font-interface.hh" /* - * TODO: thickness should be a grob property (unit: - * stafflinethickness) rather than hardwired to (staff_space / 6). + TODO: thickness should be a grob property (unit: stafflinethickness) + rather than hardwired to (staff_space / 6). */ -/* - WTF: what does Breathing_sign have to do with text?! - - --hwn - */ -MAKE_SCHEME_CALLBACK (Breathing_sign,brew_molecule,1); -SCM -Breathing_sign::brew_molecule (SCM smob) -{ - Grob *me = unsmob_grob (smob); - SCM text = me->get_grob_property ("text"); - if (text == SCM_EOL) - return divisio_minima (smob); - SCM properties = Font_interface::font_alist_chain (me); - Molecule out = Text_item::interpret_new_markup (smob, properties, text); - SCM space_scm = me->get_grob_property ("word-space"); - if (gh_number_p (space_scm)) - { - Molecule mol; - mol.set_empty (false); - out.add_at_edge (X_AXIS, RIGHT, mol, gh_scm2double (space_scm) * - Staff_symbol_referencer::staff_space (me), 0); - } - return out.smobbed_copy (); -} + /* Simplistic caesura. diff --git a/lily/font-interface.cc b/lily/font-interface.cc index 12bdbf2eb9..846b8a465e 100644 --- a/lily/font-interface.cc +++ b/lily/font-interface.cc @@ -130,31 +130,17 @@ Font_interface::get_font (Grob *me, SCM chain) return fm; } -SCM -Font_interface::add_style (Grob* me, SCM style, SCM chain) -{ - assert (gh_symbol_p (style)); - - SCM style_alist = me->get_paper ()->lookup_variable (ly_symbol2scm ("style-alist")); - SCM entry = scm_assoc (style, style_alist); - if (gh_pair_p (entry)) - { - chain = gh_cons (ly_cdr (entry), chain); - } - return chain; -} - /* -SCM routines: +SCM routines for looking up fonts. -Interpreting music... -MIDI output to wtk1-fugue2.midi... -Track ... +wtk-fugue2, SCM: real 0m31.862s user 0m29.110s sys 0m0.260s +wtk-fugue2, C++: + real 0m26.964s user 0m24.850s sys 0m0.280s diff --git a/lily/include/font-interface.hh b/lily/include/font-interface.hh index ce14d49a48..8c34e96505 100644 --- a/lily/include/font-interface.hh +++ b/lily/include/font-interface.hh @@ -18,7 +18,6 @@ struct Font_interface static SCM font_alist_chain (Grob*); static Font_metric * get_font (Grob*, SCM alist_chain); static Font_metric * get_default_font (Grob*); - static SCM add_style (Grob*, SCM style, SCM alist_chain); static bool wild_compare (SCM field_val, SCM val); DECLARE_SCHEME_CALLBACK (properties_to_font_name, (SCM,SCM)); DECLARE_SCHEME_CALLBACK (get_property_alist_chain, (SCM)); diff --git a/lily/include/text-item.hh b/lily/include/text-item.hh index bc7f7f782f..32d16bf152 100644 --- a/lily/include/text-item.hh +++ b/lily/include/text-item.hh @@ -19,19 +19,14 @@ class Text_item { public: DECLARE_SCHEME_CALLBACK (brew_molecule, (SCM)); - DECLARE_SCHEME_CALLBACK (text_to_molecule, (SCM,SCM, SCM)); - static Molecule text2molecule (Grob *me, SCM text, SCM properties); - static Molecule string2molecule (Grob *me, SCM text, SCM properties); - static Molecule markup_text2molecule (Grob *me, SCM markup_text, SCM properties); + DECLARE_SCHEME_CALLBACK (interpret_markup, (SCM,SCM, SCM)); static bool has_interface (Grob*); - static Molecule interpret_new_markup (SCM grob, SCM achain, SCM markup); -private: - static Molecule lookup_character (Grob *me, Font_metric*, SCM char_name); - static Molecule lookup_text (Grob *me, Font_metric*, SCM text); + static bool markup_p (SCM) ; + }; -bool new_markup_p (SCM) ; -SCM new_markup_brewer (); + + #endif /* TEXT_ITEM */ diff --git a/lily/mark-engraver.cc b/lily/mark-engraver.cc index e0c459684e..0d875ba8c1 100644 --- a/lily/mark-engraver.cc +++ b/lily/mark-engraver.cc @@ -128,7 +128,7 @@ Mark_engraver::process_music () */ SCM m = mark_req_->get_mus_property ("label"); - if (gh_pair_p (m) || new_markup_p (m)) + if (Text_item::markup_p (m)) { text_->set_grob_property ("text",m); } diff --git a/lily/paper-column.cc b/lily/paper-column.cc index 8b990511f5..ab2f46da8b 100644 --- a/lily/paper-column.cc +++ b/lily/paper-column.cc @@ -119,9 +119,10 @@ Paper_column::brew_molecule (SCM p) String r = to_string (Paper_column::get_rank (me)); SCM properties = Font_interface::font_alist_chain (me); - - Molecule t = Text_item::interpret_new_markup (p, properties, - scm_makfrom0str (r.to_str0 ())); + + SCM scm_mol = Text_item::interpret_markup (p, properties, + scm_makfrom0str (r.to_str0 ())); + Molecule t = *unsmob_molecule (scm_mol); t.align_to (X_AXIS, CENTER); t.align_to (Y_AXIS, DOWN); diff --git a/lily/parser.yy b/lily/parser.yy index 3650603e31..9d9ff455e3 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -2327,13 +2327,6 @@ My_lily_parser::beam_check (SCM dur) -bool -markup_p (SCM x) -{ - return gh_pair_p (x) - && SCM_BOOL_F != scm_object_property (gh_car (x), ly_symbol2scm ("markup-signature")); -} - /* @@ -2372,7 +2365,7 @@ My_lily_lexer::try_special_identifiers (SCM * destination, SCM sid) *destination = p->self_scm(); return MUSIC_OUTPUT_DEF_IDENTIFIER; - } else if (new_markup_p (sid)) { + } else if (Text_item::markup_p (sid)) { *destination = sid; return MARKUP_IDENTIFIER; } diff --git a/lily/text-item.cc b/lily/text-item.cc index 8c6e9501eb..ac80893cf2 100644 --- a/lily/text-item.cc +++ b/lily/text-item.cc @@ -9,255 +9,62 @@ #include #include "warn.hh" +#include "grob.hh" #include "text-item.hh" -#include "paper-def.hh" #include "font-interface.hh" -#include "staff-symbol-referencer.hh" -#include "staff-symbol-referencer.hh" -#include "main.hh" -#include "all-font-metrics.hh" -#include "afm.hh" -#include "lookup.hh" #include "virtual-font-metric.hh" -/* - - TEXT: STRING - | (MARKUP? TEXT+) - ; - - HEAD: MARKUP-ITEM | (MARKUP-ITEM+) - - MARKUP-ITEM: PROPERTY | ABBREV | FONT-STYLE - PROPERTY: (key . value) - ABBREV: rows lines roman music bold italic named super sub text - -*/ - -Molecule -Text_item::text2molecule (Grob *me, SCM text, SCM alist_chain) -{ - if (gh_string_p (text)) - return string2molecule (me, text, alist_chain); - else if (gh_pair_p (text)) - { - /* urg, why not just do this in markup_text2molecule ? */ - if (gh_string_p (ly_car (text))) - return markup_text2molecule (me, - gh_append2 (scm_list_n (SCM_EOL, - SCM_UNDEFINED), - text), - alist_chain); - /* - Allow (faulty) texts that are in an extra list: - #'(("foo")) - */ - else if (scm_ilength (text) <= 1) - return text2molecule (me, ly_car (text), alist_chain); - else - return markup_text2molecule (me, text, alist_chain); - } - return Molecule (); -} -MAKE_SCHEME_CALLBACK(Text_item,text_to_molecule,3); +MAKE_SCHEME_CALLBACK(Text_item,interpret_markup,3); SCM -Text_item::text_to_molecule (SCM grob, SCM props, SCM markup) -{ - Grob *me = unsmob_grob (grob); - - return Text_item::text2molecule (me, markup, props).smobbed_copy(); -} - - -Molecule -Text_item::string2molecule (Grob *me, SCM text, SCM alist_chain) -{ - SCM style = ly_assoc_chain (ly_symbol2scm ("font-style"), - alist_chain); - if (gh_pair_p (style) && gh_symbol_p (ly_cdr (style))) - alist_chain = Font_interface::add_style (me, ly_cdr (style), alist_chain); - - Font_metric *fm = Font_interface::get_font (me, alist_chain); - - SCM lookup = ly_assoc_chain (ly_symbol2scm ("lookup"), alist_chain); - - Molecule mol; - if (gh_pair_p (lookup) && ly_cdr (lookup) ==ly_symbol2scm ("name")) - mol = lookup_character (me, fm, text); - else - mol = lookup_text (me, fm, text); - - return mol; -} - -Molecule -Text_item::lookup_character (Grob *, Font_metric*fm, SCM char_name) -{ - return fm->find_by_name (ly_scm2string (char_name)); -} - - - -Molecule -Text_item::lookup_text (Grob *, Font_metric*fm, SCM text) +Text_item::interpret_markup (SCM grob, SCM props, SCM markup) { - SCM list = scm_list_n (ly_symbol2scm ("text"), text, SCM_UNDEFINED); - - if (dynamic_cast (fm)) + if (gh_string_p (markup)) { - /* - ARGH. - */ - programming_error ("Can't use virtual font for text."); - } - else - list = fontify_atom (fm, list); + Grob *me = unsmob_grob (grob); + Font_metric *fm = Font_interface::get_font (me, props); - return Molecule (fm->text_dimension (ly_scm2string (text)), list); -} - - -/* - TODO: - - DOCME. - - - MARKUP_TEXT must be compound (may not be simple string.) - - */ -Molecule -Text_item::markup_text2molecule (Grob *me, SCM markup_text, - SCM alist_chain) -{ - SCM f = me->get_paper ()->lookup_variable (ly_symbol2scm ("markup-to-properties")); - - SCM markup = ly_car (markup_text); - SCM text = ly_cdr (markup_text); - - /* ARGRGRRGRARGRA - */ - - SCM abbrev = me->get_paper ()->lookup_variable (ly_symbol2scm ("abbreviation-alist")); - SCM style = me->get_paper ()->lookup_variable (ly_symbol2scm ("style-alist")); - - SCM p = gh_cons (scm_call_3 (f, abbrev, style, markup), alist_chain); - - Real staff_space = Staff_symbol_referencer::staff_space (me); - - /* - Line mode is default. - */ - Axis axis = X_AXIS; - - SCM a = ly_assoc_chain (ly_symbol2scm ("axis"), p); - if (gh_pair_p (a) && ly_axis_p (ly_cdr (a))) - axis = (Axis)gh_scm2int (ly_cdr (a)); - - Real baseline_skip = 0; - SCM b = ly_assoc_chain (ly_symbol2scm ("baseline-skip"), p); - if (gh_pair_p (b) && gh_number_p (ly_cdr (b))) - baseline_skip = gh_scm2double (ly_cdr (b)) * staff_space; - - Real kern[2] = {0,0}; - - SCM k = ly_assoc_chain (ly_symbol2scm ("kern"), p); - if (gh_pair_p (k) && gh_number_p (ly_cdr (k))) - kern[axis] = gh_scm2double (ly_cdr (k)) * staff_space; - - Real raise = 0; - SCM r = ly_assoc_chain (ly_symbol2scm ("raise"), p); - if (gh_pair_p (r) && gh_number_p (ly_cdr (r))) - raise = gh_scm2double (ly_cdr (r)) * staff_space; - - - Interval extent; - bool extent_b = false; - SCM e = ly_assoc_chain (ly_symbol2scm ("extent"), p); - if (gh_pair_p (e) && ly_number_pair_p (ly_cdr (e))) - { - extent = Interval (gh_scm2double (ly_cadr (e)) * staff_space, - gh_scm2double (ly_cddr (e)) * staff_space); - extent_b = true; - } - - Offset o (kern[X_AXIS], raise - kern[Y_AXIS]); - - Molecule mol = Lookup::filledbox (Box (Interval (0,0), Interval (0,0))); - - SCM cp = ly_deep_copy (p); - if (raise) - { - SCM cr = ly_assoc_chain (ly_symbol2scm ("raise"), cp); - scm_set_cdr_x (cr, gh_int2scm (0)); - } - - while (gh_pair_p (text)) - { - Molecule m = text2molecule (me, ly_car (text), cp); - - if (!m.empty_b ()) + SCM list = scm_list_n (ly_symbol2scm ("text"), markup, SCM_UNDEFINED); + + if (dynamic_cast (fm)) { - m.translate_axis (mol.extent (axis)[axis == X_AXIS ? RIGHT : DOWN] - - (axis == Y_AXIS ? baseline_skip : 0), - axis); - mol.add_molecule (m); + /* + ARGH. + */ + programming_error ("Can't use virtual font for text."); } - text = ly_cdr (text); + else + list = fontify_atom (fm, list); + + Box b = fm->text_dimension (ly_scm2string (markup)); + return Molecule (b, list).smobbed_copy(); } - - - /* Set extend to markup evented value. */ - if (extent_b) + else { - Box b = mol.extent_box (); - SCM expr = mol.get_expr (); - - b[axis] = extent; - mol = Molecule (b, expr); + SCM func = gh_car (markup); + SCM args = gh_cdr (markup); + return scm_apply_2 (func, grob, props, args); } - - mol.translate (o); - - return mol; } -MAKE_SCHEME_CALLBACK (Text_item, brew_molecule, 1); -SCM -Text_item::brew_molecule (SCM smob) +MAKE_SCHEME_CALLBACK(Text_item,brew_molecule,1); +SCM +Text_item::brew_molecule (SCM grob) { - Grob *me = unsmob_grob (smob); - - SCM text = me->get_grob_property ("text"); + Grob * me = unsmob_grob (grob); - SCM properties = Font_interface::font_alist_chain (me); - Molecule mol = Text_item::text2molecule (me, text, properties); - - SCM space = me->get_grob_property ("word-space"); - if (gh_number_p (space)) - { - Molecule m; - m.set_empty (false); - mol.add_at_edge (X_AXIS, RIGHT, m, gh_scm2double (space) - * Staff_symbol_referencer::staff_space (me), 0); - } - return mol.smobbed_copy (); + SCM t = me->get_grob_property ("text"); + SCM chain = Font_interface::font_alist_chain (me); + return interpret_markup (grob, chain, t); } - -ADD_INTERFACE (Text_item,"text-interface", - "A scheme markup text, see @ref{Markup functions}.", - "text baseline-skip word-space"); - - /* Ugh. Duplicated from Scheme. */ bool -new_markup_p (SCM x) +Text_item::markup_p (SCM x) { return gh_string_p (x) || @@ -265,28 +72,10 @@ new_markup_p (SCM x) && SCM_BOOL_F != scm_object_property (gh_car (x), ly_symbol2scm ("markup-signature"))); } -SCM -new_markup_brewer () -{ - static SCM proc ; - - if (!proc) - proc = scm_c_eval_string ("brew-new-markup-molecule"); +ADD_INTERFACE (Text_item,"text-interface", + "A scheme markup text, see @ref{Markup functions}.", + "text baseline-skip word-space"); - return proc; -} -Molecule -Text_item::interpret_new_markup (SCM grob, SCM achain, - SCM markup) -{ - static SCM proc; - if (!proc) - proc = scm_c_eval_string ("interpret-markup"); - if (new_markup_p (markup)) - return *unsmob_molecule (scm_call_3 (proc, grob, achain, markup)); - else - return Molecule(); -} diff --git a/lily/text-spanner.cc b/lily/text-spanner.cc index a7ad249ed6..6037882dd6 100644 --- a/lily/text-spanner.cc +++ b/lily/text-spanner.cc @@ -86,11 +86,9 @@ Text_spanner::brew_molecule (SCM smob) SCM text = index_get_cell (edge_text, d); - /* - TODO: use markup. - */ + if (Text_item::markup_p (text)) + edge[d] = *unsmob_molecule (Text_item::interpret_markup (smob, properties, text)); - edge[d] = Text_item::interpret_new_markup (smob, properties, text); if (!edge[d].empty_b ()) edge[d].align_to (Y_AXIS, CENTER); } diff --git a/lily/time-signature.cc b/lily/time-signature.cc index 3382380da9..187b88b832 100644 --- a/lily/time-signature.cc +++ b/lily/time-signature.cc @@ -95,11 +95,16 @@ Time_signature::numbered_time_signature (Grob*me,int num, int den) SCM chain = Font_interface::font_alist_chain (me); me->set_grob_property ("font-family", ly_symbol2scm ("number")); - Molecule n = - Text_item::interpret_new_markup (me->self_scm(), chain,scm_makfrom0str (to_string (num).to_str0 ())); +SCM sn = + Text_item::interpret_markup (me->self_scm(), chain, + scm_makfrom0str (to_string (num).to_str0 ())); +SCM sd = + Text_item::interpret_markup (me->self_scm(), chain, + scm_makfrom0str (to_string (den).to_str0 ())); + + Molecule n = *unsmob_molecule (sn); + Molecule d = *unsmob_molecule (sd); - Molecule d = - Text_item::interpret_new_markup (me->self_scm(), chain,scm_makfrom0str (to_string (den).to_str0 ())); n.align_to (X_AXIS, CENTER); d.align_to (X_AXIS, CENTER); Molecule m; diff --git a/lily/tuplet-bracket.cc b/lily/tuplet-bracket.cc index 82cca6b7ae..973ac4bc93 100644 --- a/lily/tuplet-bracket.cc +++ b/lily/tuplet-bracket.cc @@ -158,7 +158,8 @@ Tuplet_bracket::brew_molecule (SCM smob) if (gh_string_p (number) && number_visibility) { SCM properties = Font_interface::font_alist_chain (me); - Molecule num = Text_item::interpret_new_markup (smob, properties, number); + SCM snum = Text_item::interpret_markup (smob, properties, number); + Molecule num = *unsmob_molecule (snum); num.align_to (X_AXIS, CENTER); num.translate_axis (w/2, X_AXIS); num.align_to (Y_AXIS, CENTER); diff --git a/lily/volta-bracket.cc b/lily/volta-bracket.cc index e959395fb4..05b5f973fd 100644 --- a/lily/volta-bracket.cc +++ b/lily/volta-bracket.cc @@ -107,8 +107,8 @@ Volta_bracket_interface::brew_molecule (SCM smob) { SCM text = me->get_grob_property ("text"); SCM properties = me->get_property_alist_chain (SCM_EOL); - - Molecule num = Text_item::interpret_new_markup (smob, properties, text); + SCM snum = Text_item::interpret_markup (smob, properties, text); + Molecule num = *unsmob_molecule (snum); mol.add_at_edge (X_AXIS, LEFT, num, - num.extent (X_AXIS).length () - 1.0, 0); diff --git a/ly/params-init.ly b/ly/params-init.ly index 55a37b4eb8..3fb8ab5352 100644 --- a/ly/params-init.ly +++ b/ly/params-init.ly @@ -68,44 +68,5 @@ interscoreline = 4. \mm (font-series . medium) )) -#(define style-alist - '((finger . ((font-family . number) (font-relative-size . -3))) - (volta . ((font-family . number) (font-relative-size . -2))) - (tuplet . ((font-family . roman) (font-shape . italic) (font-relative-size . -1))) - - (timesig . ((font-family . number) )) - (timesig-symbol . ((font-family . music) )) - - (mmrest . ((font-family . number) )) - (mmrest-symbol . ((font-family . music) )) - - (mark-number . ((font-family . number) (font-relative-size . 1))) - (mark-letter . ((font-family . roman) - (font-series . bold) - (font-shape . upright) - (font-relative-size . 2))) - - (script . ((font-family . roman) (font-relative-size . -1))) - (large . ((font-family . roman) (font-relative-size . 1))) - (Large . ((font-series . bold) (font-family . roman) - (font-relative-size . 2))) - (dynamic . ((font-family . dynamic) (font-relative-size . 0))) - )) #(define properties-to-font Font_interface::properties_to_font_name) -#(define markup-to-properties markup-to-properties) -#(define abbreviation-alist - '((columns . ((axis . 0))) - (lines . ((axis . 1))) - (roman . ((font-family . roman))) - (music . ((font-family . music) (lookup . name))) - (finger . ((font-style . finger))) - (bold . ((font-series . bold))) - (upright . ((font-shape . upright))) - (italic . ((font-shape . italic))) - (named . ((lookup . name))) - (overstrike . ((extent . (0 . 0)))) - (super . ((raise . 1) (font-relative-size . -1) (extent . (0 . 0)))) - (sub . ((raise . -1) (font-relative-size . -1) (extent . (0 . 0)))) - (text . ((lookup . value))) - ) - ) + diff --git a/scm/define-grobs.scm b/scm/define-grobs.scm index 697d3d19ce..020d1424ff 100644 --- a/scm/define-grobs.scm +++ b/scm/define-grobs.scm @@ -208,10 +208,8 @@ (first-note . (minimum-space . 1.0)) (right-edge . (extra-space . 0.1)) )) - (molecule-callback . ,Breathing_sign::brew_molecule) - (lookup . name) - (font-family . music) - (text . "scripts-rcomma") + (molecule-callback . ,Text_item::brew_molecule) + (text . ,(make-musicglyph-markup "scripts-rcomma")) (Y-offset-callbacks . (,Breathing_sign::offset_callback)) (break-visibility . ,begin-of-line-invisible) (meta . ((interfaces . (break-aligned-interface breathing-sign-interface text-interface font-interface item-interface )))) diff --git a/scm/font.scm b/scm/font.scm index 025f8f9903..dd5beba6cb 100644 --- a/scm/font.scm +++ b/scm/font.scm @@ -20,22 +20,6 @@ )) - -;; most of these routines have been reimplemented in C++ - -;; TODO TODO . (should not use filtering?) -;; this is bad, since we generate garbage every font-lookup. -;; otoh, if the qualifiers is narrow enough , we don't generate much garbage. - -(define (filter-field field-name value font-descr-alist) - "return those descriptions from FONT-DESCR-LIST whose FIELD-NAME matches VALUE" - (filter - (lambda (x) (let* (field-value (font-field field-name (car x))) - (or (eq? field-value '*) (eq? value field-value)))) - font-descr-alist) - ) - - (define size-independent-fonts `( ((* * * braces *) . ("feta-braces00" @@ -170,28 +154,8 @@ (define (change-rhs-size font-desc from to ) (cons (car font-desc) - (regexp-substitute/global #f from (cdr font-desc) 'pre to 'post)) - - ) + (regexp-substitute/global #f from (cdr font-desc) 'pre to 'post))) -;; -(define (map-alist-keys func list) - "map a function FUNC over the keys of an alist LIST, leaving the vals. " - (if (null? list) - '() - (cons (cons (func (caar list)) (cdar list)) - (map-alist-keys func (cdr list))) - )) - - -;; -(define (map-alist-vals func list) - "map a function FUNC over the vals of LIST, leaving the keys." - (if (null? list) - '() - (cons (cons (caar list) (func (cdar list))) - (map-alist-vals func (cdr list))) - )) (define (change-style-sheet-relative-size sheet x) (map-alist-keys (lambda (descr) (change-relative-size descr x)) sheet)) @@ -207,8 +171,7 @@ (paper20 . 0) (paper23 . 1) (paper26 . 2) - )) - ) + ))) ;; ;; make a kludged up paper-19 style sheet. Broken by virtual fonts. @@ -227,92 +190,6 @@ (cdr (assoc sym font-list-alist)))) - -(define (wild-eq? x y) - (or (eq? x y) - (eq? x '*) - (eq? y '*))) - -(define (font-qualifies? qualifiers font-desc) - "does FONT-DESC satisfy QUALIFIERS?" - (if (null? qualifiers) #t - (if (wild-eq? (font-field (caar qualifiers) font-desc) (cdar qualifiers)) - (font-qualifies? (cdr qualifiers) font-desc) - #f))) - -(define (find-first-font qualifiers fonts) - (if (null? fonts) - "" - (if (font-qualifies? qualifiers (caar fonts)) - (cdar fonts) - (find-first-font qualifiers (cdr fonts)) - ) - )) - - -(define (select-unique-font qualifiers fonts) - "return a single font from FONTS (or a default, if none found) -and warn if the selected font is not unique. -" - (let* ( - (err (current-error-port)) - ) - - - (if (not (= (length fonts) 1)) - (begin - (display "\ncouldn't find unique font satisfying " err) - (write qualifiers err) - (display " found " err) - (if (null? fonts) - (display "none" err) - (write (map cdr fonts) err)) - )) - - (if (null? fonts) - "cmr10" - (cdar fonts)) ; return the topmost. - - )) - - -; there used to be a Scheme properties-to-font-name function, -; but that is superseeded by the C++ version out of speed concerns. - - -(define-public (markup-to-properties abbrev-alist style-alist markup) - "DOCME." - ;; (display "markup: `") - ;; (write markup) - ;; (display "'\n") - - (if (pair? markup) - ;; This is hairy. We want to allow: - ;; ((foo bar) "text") - ;; ((foo (bar . 1)) "text") - ;; ((foo . (0 . 1))) - - (if (and (symbol? (car markup)) - (or (not (pair? (cdr markup))) - (number? (cadr markup)))) - (if (equal? '() (cdr markup)) - (markup-to-properties abbrev-alist style-alist (car markup)) - (list markup)) - - (if (equal? '() (cdr markup)) - (markup-to-properties abbrev-alist style-alist (car markup)) - (append (markup-to-properties abbrev-alist style-alist (car markup)) - (markup-to-properties abbrev-alist style-alist (cdr markup))))) - - ;; markup is single abbreviation - (let ((entry (assoc markup - ;; assoc-chain? - (append abbrev-alist style-alist)))) - (if entry - (cdr entry) - (list (cons markup #t)))))) - - ;;; ascii-script font init (define as-font-sheet-alist '((as5 . (((* * * braces *) . ("as-braces9")) diff --git a/scm/lily.scm b/scm/lily.scm index 07c35bc001..ddb424a603 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -115,6 +115,25 @@ handle (chain-assoc x (cdr alist-list)))))) + +(define (map-alist-vals func list) + "map FUNC over the vals of LIST, leaving the keys." + (if (null? list) + '() + (cons (cons (caar list) (func (cdar list))) + (map-alist-vals func (cdr list))) + )) + +(define (map-alist-keys func list) + "map FUNC over the keys of an alist LIST, leaving the vals. " + (if (null? list) + '() + (cons (cons (func (caar list)) (cdar list)) + (map-alist-keys func (cdr list))) + )) + + + ;;;;;;;;;;;;;;;; ; list diff --git a/scm/new-markup.scm b/scm/new-markup.scm index 824444cd60..a5df938642 100644 --- a/scm/new-markup.scm +++ b/scm/new-markup.scm @@ -53,7 +53,7 @@ for the reader. ;; (define-public (simple-markup grob props . rest) - (Text_item::text_to_molecule grob props (car rest))) + (Text_item::interpret_markup grob props (car rest))) (define-public (stack-molecule-line space molecules) (if (pair? molecules) @@ -686,28 +686,11 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked function. )) -(define-public (brew-new-markup-molecule grob) - (let* - ((t (ly:get-grob-property grob 'text)) - (chain (Font_interface::get_property_alist_chain grob))) - (if (markup? t) - (interpret-markup grob chain t) - (Text_item::text_to_molecule grob chain t) - ))) +(define-public brew-new-markup-molecule Text_item::brew_molecule) (define-public empty-markup (make-simple-markup "")) -(define-public (interpret-markup grob props markup) - (if (string? markup) - (simple-markup grob props markup) - (let* - ( - (func (car markup)) - (args (cdr markup)) - ) - - (apply func (cons grob (cons props args)) ) - ))) +(define-public interpret-markup Text_item::interpret_markup) ;;;;;;;;;;;;;;;; -- 2.39.2