+1.3.99.hwn2
+===========
+
+* Tweaks of .scm font-selection.
+
+* Rewrote font management of Score_element and Paper_def.
+
+* Introduced outputscale: internally do computation in terms of
+outputscale. Prepare to deprecate staffspace internally. Rewrote
+.scm side of font selectioning.
+
+1.3.99.jcn1
+===========
+
+* Made several font size and initialisation fixes.
+
1.3.98.jcn2
===========
- Improved robustness: Lily almost never crashes.
+* Rewritten font selection, Latex-NFSS like
+
* Piano pedal support, Arpeggios
* MIDI: dynamics, tempo changes
PACKAGE_NAME=LilyPond
MAJOR_VERSION=1
MINOR_VERSION=3
-PATCH_LEVEL=99
+PATCH_LEVEL=100
MY_PATCH_LEVEL=
# use the above to send patches: MY_PATCH_LEVEL is always empty for a
+
\score { \notes \relative c{
-c''4 c2 c8 c16 c16 c1 c\breve
-\property Voice.noteHeadStyle = #'diamond
+% anyone wanna pop?
+c''4 c2 c8 c16 c16 c1 c\breve
+\property Voice.NoteHead \push #'style = #'diamond
c4 c2 c8 c16 c16 c1 c\breve
-\property Voice.noteHeadStyle = #'transparent
+\property Voice.NoteHead \push #'style = #'transparent
c4 c2 c8 c16 c16 c1 c\breve
-\property Voice.noteHeadStyle = #'cross
+\property Voice.NoteHead \push #'style = #'cross
c4 c2 c8 c16 c16 c1 c\breve
-\property Voice.noteHeadStyle = #'mensural
+\property Voice.NoteHead \push #'style = #'mensural
c4 c2 c8 c16 c16 c1 c\breve c\longa
-\property Voice.noteHeadStyle = #'harmonic
+\property Voice.NoteHead \push #'style = #'harmonic
c4 c2 c8 c16 c16 c1 c\breve
-\property Voice.noteHeadStyle = #'baroque
+\property Voice.NoteHead \push #'style = #'baroque
c4 c2 c8 c16 c16 c1 c\breve c\longa
+
\context Voice <
\context Thread = TA
- { \property Thread.noteHeadStyle = #'cross
- \property Voice.verticalDirection = \up c16}
+ {
+ \property Thread.NoteHead \push #'style = #'cross
+ \property Voice.Stem \push #'direction = #1
+ c16
+ }
\context Thread = TB
- { \property Thread.noteHeadStyle = #'default a16 }
-
+ { \property Thread.NoteHead \push #'style = #'default a16 }
+
\context Thread = TC
- { \property Thread.noteHeadStyle = #'mensural d16 }
-
+ { \property Thread.NoteHead \push #'style = #'mensural d16 }
+
>
-
+
\context Voice <\context Thread = TA {
- \property Thread.noteHeadStyle = #'default
+ \property Thread.NoteHead \push #'style = #'default
c4 c4 }
\context Thread = TB {
- \property Thread.noteHeadStyle = #'mensural
+ \property Thread.NoteHead \push #'style = #'mensural
c'4 \stemDown c
} >
}
\paper {
-
- }
+
+
+}
}
-\version "1.3.96";
*/
#include "afm.hh"
#include "warn.hh"
+#include "molecule.hh"
Adobe_font_metric::Adobe_font_metric (AFM_Font_info * fi)
{
{
Adobe_font_metric * fm = new Adobe_font_metric (fi);
- return fm->smobbed_self();
+ return fm->self_scm();
}
Box
-Adobe_font_metric::get_char (int code, bool warn) const
+Adobe_font_metric::get_char (int code) const
{
AFM_CharMetricInfo const
- * c = find_ascii_metric (code,warn);
+ * c = find_ascii_metric (code,false);
+ Box b (Interval (0,0),Interval(0,0));
if (c)
- return afm_bbox_to_box (c->charBBox);
- else
- return Box (Interval (0,0),Interval(0,0));
+ b = afm_bbox_to_box (c->charBBox);
+
+ return b;
}
SCM
{
AFM_free (font_inf_);
}
+
+/*
+ return a molecule, without fontification
+ */
+Molecule
+Adobe_font_metric::find_by_name (String s) const
+{
+ AFM_CharMetricInfo const *cm = find_char_metric (s, false);
+
+ if (!cm)
+ {
+ Molecule m;
+ m.set_empty (false);
+ return m;
+ }
+
+ SCM at = (gh_list (ly_symbol2scm ("char"),
+ gh_int2scm (cm->code),
+ SCM_UNDEFINED));
+
+ // at= fontify_atom ((Font_metric*)this, at);
+ Box b = afm_bbox_to_box (cm->charBBox);
+
+ return Molecule (b, at);
+}
{
afm_p_dict_ = new Scheme_hash_table;
tfm_p_dict_ = new Scheme_hash_table;
- scaled_p_dict_ = new Scheme_hash_table;
search_path_.parse_path (path);
}
{
scm_unprotect_object (afm_p_dict_->self_scm ());
scm_unprotect_object (tfm_p_dict_->self_scm ());
- scm_unprotect_object (scaled_p_dict_->self_scm ());
}
Adobe_font_metric *
{
SCM sname = ly_symbol2scm (name.ch_C ());
+ SCM name_str = gh_str02scm (name.ch_C ());
+
SCM val;
if (!afm_p_dict_->try_retrieve (sname, &val))
progress_indication ("[" + path);
val = read_afm_file (path);
- unsmob_metrics (val)->name_ = sname;
+ unsmob_metrics (val)->description_ = gh_cons (name_str, gh_double2scm (1.0));
if (verbose_global_b)
progress_indication ("]");
afm_p_dict_->set (sname,val);
-
+ scm_unprotect_object (val);
}
return dynamic_cast<Adobe_font_metric*> (unsmob_metrics (val));
}
-Scaled_font_metric *
-All_font_metrics::find_scaled (String nm, int m)
-{
- String index = nm + "@" + to_str (m);
- SCM sname = ly_symbol2scm (index.ch_C ());
-
- SCM val;
-
- if (!scaled_p_dict_->try_retrieve (sname, &val))
- {
- Font_metric *f = find_font (nm);
- val = Scaled_font_metric::make_scaled_font_metric (f, m);
- scaled_p_dict_->set (sname, val);
- }
-
-
- return dynamic_cast<Scaled_font_metric*> (unsmob_metrics (val));
-}
Tex_font_metric *
All_font_metrics::find_tfm (String name)
{
SCM sname = ly_symbol2scm (name.ch_C ());
+ SCM name_str = gh_str02scm (name.ch_C ());
SCM val;
if (!tfm_p_dict_->try_retrieve (sname, &val))
if (verbose_global_b)
progress_indication ("]");
- unsmob_metrics (val)->name_ = sname;
+ unsmob_metrics (val)->description_ = gh_cons (name_str, gh_double2scm (1.0));
tfm_p_dict_->set (sname, val);
+
+ scm_unprotect_object (val);
}
return
Font_metric *
All_font_metrics::find_font (String name)
{
- Font_metric * f=0;
-
- f= find_afm (name);
+ Font_metric * f= find_afm (name);
if (f)
return f;
return 0;
}
-SCM
-All_font_metrics::font_descriptions () const
-{
- SCM l[] = {0,0,0};
-
- l[0] = afm_p_dict_->to_alist ();
- l[1] = tfm_p_dict_->to_alist ();
- l[2] = scaled_p_dict_->to_alist ();
- SCM list = SCM_EOL;
- for (int i=0; i < 3; i++)
- {
- for (SCM s = l[i]; gh_pair_p (s); s = gh_cdr (s))
- {
- Font_metric * fm = unsmob_metrics (gh_cdar (s));
-
- list = gh_cons (fm->description (), list);
- }
- }
- return list;
-}
-
-
-
-Font_metric*
-find_font (String name)
-{
- return all_fonts_global_p->find_font (name);
-}
#include "molecule.hh"
#include "paper-def.hh"
-#include "lookup.hh"
#include "arpeggio.hh"
#include "score-element.hh"
#include "stem.hh"
#include "staff-symbol-referencer.hh"
#include "staff-symbol.hh"
#include "warn.hh"
+#include "font-interface.hh"
bool
Arpeggio::has_interface (Score_element* me)
}
Molecule mol;
- Molecule arpeggio = me->paper_l ()->lookup_l (0)->afm_find ("scripts-arpeggio");
+ Molecule arpeggio = Font_interface::get_default_font (me)->find_by_name ("scripts-arpeggio");
Real y = heads[LEFT];
while (y < heads[RIGHT])
Score_element * me = unsmob_element (smob);
Axis a = (Axis)gh_scm2int (axis);
assert (a == X_AXIS);
- Molecule arpeggio = me->paper_l ()->lookup_l (0)->afm_find ("scripts-arpeggio");
+ Molecule arpeggio = Font_interface::get_default_font (me)->find_by_name ("scripts-arpeggio");
return ly_interval2scm (arpeggio.extent (X_AXIS) * 1.5);
}
*/
#include <math.h>
+#include "lookup.hh"
#include "paper-column.hh"
#include "main.hh"
-#include "dimensions.hh"
#include "score-element.hh"
#include "bar.hh"
#include "string.hh"
#include "molecule.hh"
#include "paper-def.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
#include "debug.hh"
#include "all-font-metrics.hh"
#include "item.hh"
Molecule thin = simple_barline (me, hair, h);
Molecule thick = simple_barline (me, fatline, h);
- Molecule colon = me->lookup_l ()->afm_find ("dots-repeatcolon");
+ Molecule colon = Font_interface::get_default_font (me)->find_by_name ("dots-repeatcolon");
Molecule m;
if (str == "")
{
- return me->lookup_l ()->blank (Box (Interval(0, 0), Interval (-h/2, h/2)));
+ return Lookup::blank (Box (Interval(0, 0), Interval (-h/2, h/2)));
}
else if (str == "|")
{
Molecule
-Bar::simple_barline (Score_element*me,Real w, Real h)
+Bar::simple_barline (Score_element*,Real w, Real h)
{
- return me->lookup_l ()->filledbox (Box (Interval(0,w), Interval(-h/2, h/2)));
+ return Lookup::filledbox (Box (Interval(0,w), Interval(-h/2, h/2)));
}
MAKE_SCHEME_CALLBACK(Bar,before_line_breaking ,1);
#include <math.h> // tanh.
-
+#include "molecule.hh"
#include "directional-element-interface.hh"
#include "beaming.hh"
#include "beam.hh"
w = w/2 <? nw_f;
Molecule a;
if (lhalfs) // generates warnings if not
- a = me->lookup_l ()->beam (dydx, w, thick);
+ a = Lookup::beam (dydx, w, thick);
a.translate (Offset (-w, -w * dydx));
for (int j = 0; j < lhalfs; j++)
{
int rwholebeams= Stem::beam_count (here,RIGHT) <? Stem::beam_count (next,LEFT) ;
Real w = next->relative_coordinate (0, X_AXIS) - here->relative_coordinate (0, X_AXIS);
- Molecule a = me->lookup_l ()->beam (dydx, w + stemdx, thick);
+ Molecule a = Lookup::beam (dydx, w + stemdx, thick);
a.translate_axis( - stemdx/2, X_AXIS);
int j = 0;
Real gap_f = 0;
// TODO: notehead widths differ for different types
gap_f = nw_f / 2;
w -= 2 * gap_f;
- a = me->lookup_l ()->beam (dydx, w + stemdx, thick);
+ a = Lookup::beam (dydx, w + stemdx, thick);
}
for (; j < rwholebeams; j++)
w = w/2 <? nw_f;
if (rhalfs)
- a = me->lookup_l ()->beam (dydx, w, thick);
+ a = Lookup::beam (dydx, w, thick);
for (; j < rwholebeams + rhalfs; j++)
{
{
return interval_a_[a];
}
+
+void
+Box::scale (Real s)
+{
+ interval_a_[X_AXIS] *= s;
+ interval_a_[Y_AXIS] *= s;
+}
Break_algorithm::generate_spacing_problem (Link_array<Score_element> curline, Interval line) const
{
Simple_spacer * sp = new Simple_spacer;
- Paper_def * d = pscore_l_->paper_l_;
+
/*
this is hardcoded, but this shouldn't happen anyway.
used to be g et_var ("loose_column_distance");
Interval i1(0, space / 6), i2(-space / 2, space / 2);
Box b(i1, i2);
- return me->lookup_l()->filledbox(b).create_scheme ();
+ return Lookup::filledbox(b).create_scheme ();
}
MAKE_SCHEME_CALLBACK(Breathing_sign,offset_callback,2);
SCM
-Breathing_sign::offset_callback (SCM element_smob, SCM axis)
+Breathing_sign::offset_callback (SCM element_smob, SCM )
{
Score_element *me = unsmob_element (element_smob);
#include "chord.hh"
#include "musical-request.hh"
#include "paper-def.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
#include "paper-def.hh"
#include "main.hh"
#include "dimensions.hh"
#include "chord-name.hh"
#include "molecule.hh"
#include "paper-def.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
#include "score-element.hh"
#include "paper-column.hh"
#include "line-of-score.hh"
SCM func = me->get_elt_property (ly_symbol2scm ("chord-name-function"));
SCM text = gh_call3 (func, style, pitches, gh_cons (inversion, bass));
- SCM properties = gh_append2 (me->immutable_property_alist_,
- me->mutable_property_alist_);
+ SCM properties = gh_list (me->mutable_property_alist_, me->immutable_property_alist_, SCM_UNDEFINED);
Molecule mol = Text_item::text2molecule (me, text, properties);
SCM space = me->get_elt_property ("word-space");
#include "string.hh"
#include "molecule.hh"
#include "item.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
/*
FIXME: should use symbol for #'style.
SCM glyph = sc->get_elt_property ("glyph");
if (gh_string_p (glyph))
{
- return sc->lookup_l ()->afm_find (String (ly_scm2string (glyph))).create_scheme ();
+ return Font_interface::get_default_font (sc)->find_by_name (String (ly_scm2string (glyph))).create_scheme ();
}
else
{
#include "molecule.hh"
#include "crescendo.hh"
#include "spanner.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
#include "dimensions.hh"
#include "paper-def.hh"
#include "debug.hh"
#include "item.hh"
#include "molecule.hh"
#include "paper-def.hh"
+#include "font-interface.hh"
#include "lookup.hh"
#include "staff-symbol-referencer.hh"
#include "directional-element-interface.hh"
Dots::brew_molecule (SCM d)
{
Score_element *sc = unsmob_element (d);
- Molecule mol (sc->lookup_l ()->blank (Box (Interval (0,0),
- Interval (0,0))));
+ /*
+ Molecule mol (Lookup::blank (Box (Interval (0,0),
+ Interval (0,0))));
+ */
+ Molecule mol;
+
SCM c = sc->get_elt_property ("dot-count");
+
if (gh_number_p (c))
{
- Molecule d = sc->lookup_l ()->afm_find (String ("dots-dot"));
-
+ Molecule d = Font_interface::get_default_font (sc)->find_by_name (String ("dots-dot"));
Real dw = d.extent (X_AXIS).length ();
- d.translate_axis (-dw, X_AXIS);
-
+ // d.translate_axis (-dw, X_AXIS);
for (int i = gh_scm2int (c); i--; )
{
d.translate_axis (2*dw,X_AXIS);
- mol.add_molecule (d);
+ mol.add_at_edge (X_AXIS, RIGHT, d, dw);
}
}
return mol.create_scheme ();
--- /dev/null
+/*
+ font-interface.cc -- implement Font_interface
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+ */
+
+#include "all-font-metrics.hh"
+#include "font-metric.hh"
+#include "font-interface.hh"
+#include "score-element.hh"
+#include "paper-def.hh"
+
+/*
+ todO : split up this func, reuse in text_item?
+ */
+Font_metric *
+Font_interface::get_default_font (Score_element*me)
+{
+ Font_metric * fm = unsmob_metrics (me->get_elt_property ("font"));
+ if (fm)
+ return fm;
+
+ SCM ss = me->paper_l ()->style_sheet_;
+
+ SCM proc = gh_cdr (scm_assoc (ly_symbol2scm ("properties-to-font"),
+ ss));
+
+ SCM fonts = gh_cdr (scm_assoc (ly_symbol2scm ("fonts"), ss));
+ SCM defaults = gh_cdr (scm_assoc (ly_symbol2scm ("font-defaults"),
+ ss));
+
+ assert (gh_procedure_p (proc));
+ SCM font_name = gh_call2 (proc, fonts,
+ gh_list (me->mutable_property_alist_,
+ me->immutable_property_alist_,
+ defaults,
+ SCM_UNDEFINED));
+
+ fm = me->paper_l ()->find_font (font_name, 1.0);
+ me->set_elt_property ("font", fm->self_scm ());
+ return fm;
+}
#include <math.h>
#include <ctype.h>
+#include "molecule.hh"
#include "ly-smobs.icc"
#include "font-metric.hh"
#include "string.hh"
break;
default:
- Box b = get_char ((unsigned char)text[i],false);
+ Box b = get_char ((unsigned char)text[i]);
// Ugh, use the width of 'x' for unknown characters
if (b[X_AXIS].length () == 0)
- b = get_char ((unsigned char)'x',false);
+ b = get_char ((unsigned char)'x');
w += b[X_AXIS].length ();
ydims.unite (b[Y_AXIS]);
Box
Scaled_font_metric::text_dimension (String t) const
{
- Real realmag = pow (1.2, magstep_i_);
Box b (orig_l_->text_dimension (t));
- return Box(b[X_AXIS]* realmag, b[Y_AXIS]*realmag);
+ b.scale (magnification_f_);
+ return b;
}
Font_metric::~Font_metric ()
Font_metric::Font_metric ()
{
- name_ = SCM_EOL;
+ description_ = SCM_EOL;
+
+ smobify_self ();
}
Font_metric::Font_metric (Font_metric const &)
Box
-Font_metric::get_char (int, bool)const
+Font_metric::get_char (int )const
{
return Box (Interval(0,0),Interval (0,0));
}
-Scaled_font_metric::Scaled_font_metric (Font_metric* m, int s)
-{
- magstep_i_ = s;
- orig_l_ = m;
-}
-
-SCM
-Scaled_font_metric::make_scaled_font_metric (Font_metric*m, int s)
-{
- Scaled_font_metric *sfm = new Scaled_font_metric (m,s);
- sfm->name_ = m->name_;
-
- return sfm->smobbed_self ();
-}
-
-SCM
-Font_metric::description () const
-{
- return gh_cons (name_, gh_int2scm (0));
-}
-
-
-SCM
-Scaled_font_metric::description () const
-{
- SCM od = orig_l_->description ();
- gh_set_cdr_x (od, gh_int2scm (magstep_i_));
- return od;
-}
-
-
SCM
Font_metric::mark_smob (SCM s)
{
Font_metric * m = (Font_metric*) SCM_CELL_WORD_1(s);
- return m->name_;
+ return m->description_;
}
int
{
Font_metric *m = unsmob_metrics (s);
scm_puts ("#<Font_metric ", port);
- scm_display (m->name_, port);
+ scm_write (m->description_, port);
scm_puts (">", port);
return 1;
}
IMPLEMENT_UNSMOB (Font_metric, metrics);
-IMPLEMENT_SIMPLE_SMOBS (Font_metric);
+IMPLEMENT_SMOBS (Font_metric);
IMPLEMENT_DEFAULT_EQUAL_P(Font_metric);
+IMPLEMENT_TYPE_P (Font_metric, "font-metric?");
+
+Molecule
+Font_metric::find_by_name (String) const
+{
+ assert (false);
+}
+
+
+
#include "grace-align-item.hh"
#include "align-interface.hh"
-#include "lookup.hh"
+
#include "paper-column.hh"
#include "paper-def.hh"
bounds[d] = sp->get_bound (d)->extent (common, X_AXIS)[-d];
}
while (flip (&d) != LEFT);
-
-
Real ss = sp->paper_l ()->get_var ("staffspace");
Real lt = sp->paper_l ()->get_var ("stafflinethickness");
}
}
Box b (Interval (-l/2,l/2), Interval (h,h+th));
- Molecule mol (sp->lookup_l ()->filledbox (b));
+ Molecule mol (Lookup::filledbox (b));
mol.translate_axis (bounds.center ()
-sp->relative_coordinate (common, X_AXIS),
X_AXIS);
{
AFM_Font_info * font_inf_;
- Box get_char (int, bool) const;
+ virtual Box get_char (int) const;
AFM_CharMetricInfo const *find_char_metric (String name, bool warn=true) const;
AFM_CharMetricInfo const *find_ascii_metric (int, bool warn=true) const;
Array<int> ascii_to_metric_idx_;
Dictionary<int> name_to_metric_dict_;
- Adobe_font_metric (AFM_Font_info*);
+ virtual Molecule find_by_name (String) const;
+ Adobe_font_metric (AFM_Font_info*);
};
SCM read_afm_file (String fn);
{
Scheme_hash_table *afm_p_dict_;
Scheme_hash_table *tfm_p_dict_;
- Scheme_hash_table *scaled_p_dict_;
-
File_path search_path_;
public:
~All_font_metrics ();
Adobe_font_metric *find_afm (String name);
Tex_font_metric *find_tfm (String);
Font_metric *find_font (String name);
- Scaled_font_metric* find_scaled (String , int);
+
All_font_metrics (String search_path);
SCM font_descriptions () const;
};
-Font_metric * find_font (String name);
-
#endif /* ALL_FONTS_HH */
void translate (Offset o);
/// smallest box enclosing #b#
void set_empty ();
+ void scale (Real r);
void unite (Box b);
Box();
Box (Interval ix, Interval iy);
--- /dev/null
+/*
+ font-interface.hh -- declare Font_interface
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+ */
+
+#ifndef FONT_INTERFACE_HH
+#define FONT_INTERFACE_HH
+
+#include "lily-proto.hh"
+#include "font-metric.hh"
+
+struct Font_interface
+{
+ static Font_metric * get_default_font (Score_element*);
+};
+
+#endif /* FONT_INTERFACE_HH */
#include "box.hh"
#include "lily-guile.hh"
#include "smobs.hh"
-
+#include "lily-proto.hh"
struct Font_metric
{
- SCM name_;
- virtual SCM description () const;
- virtual Box get_char (int ascii, bool warn) const;
- virtual ~Font_metric ();
- virtual Box text_dimension (String) const;
+public:
+ SCM description_;
+
+ virtual Box get_char (int ascii) const;
+ virtual Box text_dimension (String) const;
+ virtual Molecule find_by_name (String) const;
- DECLARE_SIMPLE_SMOBS(Font_metric,);
+ DECLARE_SMOBS(Font_metric,);
private:
Font_metric (Font_metric const&); // no copy.
protected:
};
+/*
+ Perhaps junk this, and move iface to paper_def?
+ */
struct Scaled_font_metric : public Font_metric
{
- virtual SCM description () const;
virtual Box text_dimension (String) const;
-
- static SCM make_scaled_font_metric (Font_metric*, int);
+ virtual Molecule find_by_name (String) const;
+ static SCM make_scaled_font_metric (Font_metric*, Real);
protected:
Font_metric *orig_l_;
- int magstep_i_;
+ Real magnification_f_;
- Scaled_font_metric (Font_metric*,int);
+ Scaled_font_metric (Font_metric*,Real);
};
Font_metric * unsmob_metrics (SCM s);
#ifndef LOOKUP_HH
#define LOOKUP_HH
-#include "smobs.hh"
-#include "lily-guile.hh"
#include "string.hh"
#include "molecule.hh"
#include "flower-proto.hh"
#include "direction.hh"
#include "box.hh"
-/**
- handy interface to symbol table
- TODO: move this into GUILE?
- */
-class Lookup
+struct Lookup
{
- Lookup ();
- Lookup (Lookup const&);
- DECLARE_SIMPLE_SMOBS(Lookup,);
-public:
-
- static SCM make_lookup ();
- String font_name_;
- Adobe_font_metric * afm_l_;
-
- Molecule afm_find (String, bool warn=true) const;
- Molecule accordion (SCM arg, Real interline_f) const;
-
+ static Molecule accordion (SCM arg, Real interline_f, Font_metric*fm);
static Molecule frame (Box b, Real thick);
static Molecule slur (Bezier controls, Real cthick, Real thick) ;
static Molecule beam (Real, Real, Real) ;
static Molecule blank (Box b) ;
static Molecule filledbox (Box b) ;
};
-Lookup* unsmob_lookup (SCM);
+
#endif // LOOKUP_HH
*/
class Paper_def : public Music_output_def
{
- Protected_scm lookup_alist_;
protected:
VIRTUAL_COPY_CONS(Music_output_def);
+ Protected_scm scaled_fonts_;
public:
+ Protected_scm style_sheet_;
+ SCM font_descriptions ()const;
virtual ~Paper_def ();
static int default_count_i_;
/*
SCM get_scmvar (String id)const;
void reinit ();
Paper_def ();
- void set_lookup (int, SCM lookup_smob);
Paper_def (Paper_def const&);
Interval line_dimensions_int (int) const;
- Lookup const * lookup_l (int sz) const; // TODO naming
virtual int get_next_default_count () const;
static void reset_default_count();
void output_settings (Paper_outputter*) const;
Paper_stream* paper_stream_p () const;
String base_output_str () const;
+ Font_metric * find_font (SCM name, Real mag);
+
// urg
friend int yyparse (void*);
};
Basic output object.
*/
class Score_element {
- /**
- The lookup, determined by the font size. Cache this value.
- */
- Lookup * lookup_l_;
-
public:
SCM immutable_property_alist_;
SCM mutable_property_alist_;
related classes.
*/
Paper_def *paper_l () const;
- Lookup const *lookup_l () const;
/**
add a dependency. It may be the 0 pointer, in which case, it is ignored.
Real hinf, Real r0);
Bezier get_bezier () const;
- void minimise_enclosed_area (Paper_def* paper_l, Real beauty, SCM props);
+ void minimise_enclosed_area (Real beauty, SCM props);
Real fit_factor () const;
void blow_fit ();
Real enclosed_area_f () const;
#include "lily-proto.hh"
#include "lily-guile.hh"
#include "stem-info.hh"
+#include "drul-array.hh"
class Stem
{
public:
static SCM make_tfm (String filename);
- Box get_char (int, bool) const;
+ Box get_char (int) const;
Tex_font_char_metric const *find_ascii (int ascii, bool warn=true) const;
String str () const;
#include "key-item.hh"
#include "molecule.hh"
#include "paper-def.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
#include "staff-symbol-referencer.hh"
+#include "lookup.hh"
/*
FIXME: too much hardcoding here.
for (SCM s = newas; gh_pair_p (s); s = gh_cdr (s))
{
int a = gh_scm2int (gh_cdar (s));
- Molecule m = me->lookup_l ()->afm_find ("accidentals-" + to_str (a));
+ Molecule m = Font_interface::get_default_font (me)->find_by_name ("accidentals-" + to_str (a));
m.translate_axis (calculate_position(me, gh_car (s)) * inter, Y_AXIS);
mol.add_at_edge (X_AXIS, LEFT, m, 0);
}
Interval x(0, inter);
Interval y(0,0);
- mol.add_at_edge (X_AXIS, LEFT, me->lookup_l()->blank (Box(x,y)),0);
+ mol.add_at_edge (X_AXIS, LEFT, Lookup::blank (Box(x,y)),0);
for (; gh_pair_p (old); old = gh_cdr (old))
{
if (found == SCM_EOL || gh_cdr (found) != gh_cdar (old))
{
- Molecule m =me->lookup_l ()->afm_find ("accidentals-0");
+ Molecule m =Font_interface::get_default_font (me)->find_by_name ("accidentals-0");
m.translate_axis (calculate_position (me, gh_car (old)) * inter, Y_AXIS);
mol.add_at_edge (X_AXIS, LEFT, m,0);
/*
font defs;
*/
- SCM font_names = ly_quote_scm (all_fonts_global_p->font_descriptions ());
+ SCM font_names = ly_quote_scm (paper_l()->font_descriptions ());
output_scheme (gh_list (ly_symbol2scm ("define-fonts"),
font_names,
SCM_UNDEFINED));
#include "local-key-item.hh"
#include "molecule.hh"
#include "staff-symbol-referencer.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
#include "paper-def.hh"
#include "musical-request.hh"
#include "rhythmic-head.hh"
#include "misc.hh"
+#include "lookup.hh"
SCM
pitch_less (SCM p1, SCM p2)
Molecule
Local_key_item::parenthesize (Score_element*me, Molecule m)
{
- Molecule open = me->lookup_l ()->afm_find (String ("accidentals-("));
- Molecule close = me->lookup_l ()->afm_find (String ("accidentals-)"));
+ Molecule open = Font_interface::get_default_font (me)->find_by_name (String ("accidentals-("));
+ Molecule close = Font_interface::get_default_font (me)->find_by_name (String ("accidentals-)"));
m.add_at_edge(X_AXIS, LEFT, Molecule(open), 0);
m.add_at_edge(X_AXIS, RIGHT, Molecule(close), 0);
Real dy = (gh_number_p (c0) ? gh_scm2int (c0) : 0 + p.notename_i_)
* note_distance;
- Molecule acc (me->lookup_l ()->afm_find (String ("accidentals-")
+ Molecule acc (Font_interface::get_default_font (me)->find_by_name (String ("accidentals-")
+ to_str (p.accidental_i_)));
if (scm_memq (ly_symbol2scm ("natural"), gh_car (s)) != SCM_BOOL_F)
{
- Molecule prefix = me->lookup_l ()->afm_find (String ("accidentals-0"));
+ Molecule prefix = Font_interface::get_default_font (me)->find_by_name (String ("accidentals-0"));
acc.add_at_edge(X_AXIS, LEFT, Molecule(prefix), 0);
}
Box b(Interval (0, gh_scm2double (pads[d]) * note_distance),
Interval (0,0));
- Molecule m (me->lookup_l ()->blank (b));
+ Molecule m (Lookup::blank (b));
mol.add_at_edge (X_AXIS, d, m, 0);
} while ( flip (&d)!= LEFT);
}
#include <math.h>
#include <ctype.h>
-#include "lookup.hh"
#include "warn.hh"
#include "dimensions.hh"
#include "bezier.hh"
-#include "paper-def.hh"
#include "string-convert.hh"
#include "file-path.hh"
#include "main.hh"
#include "lily-guile.hh"
-#include "all-font-metrics.hh"
-#include "afm.hh"
-#include "scope.hh"
#include "molecule.hh"
-
-
-#include "ly-smobs.icc"
-
-
-Lookup::Lookup ()
-{
- afm_l_ = 0;
-}
-
-Lookup::Lookup (Lookup const& s)
-{
- font_name_ = s.font_name_;
- afm_l_ = 0;
-}
-
-SCM
-Lookup::mark_smob (SCM s)
-{
- return s;
-}
-
-int
-Lookup::print_smob (SCM s, SCM p, scm_print_state*)
-{
- scm_puts ("#<Lookup >#", p);
- return 1;
-}
-
-
-IMPLEMENT_UNSMOB(Lookup, lookup);
-IMPLEMENT_SIMPLE_SMOBS(Lookup);
-IMPLEMENT_DEFAULT_EQUAL_P(Lookup);
-
-SCM
-Lookup::make_lookup ()
-{
- Lookup * l = new Lookup;
- return l->smobbed_self();
-}
-
-
-Molecule
-Lookup::afm_find (String s, bool warn) const
-{
- if (!afm_l_)
- {
- Lookup * me = (Lookup*)(this);
- me->afm_l_ = all_fonts_global_p->find_afm (font_name_);
- if (!me->afm_l_)
- {
- warning (_f ("can't find font: `%s'", font_name_));
- warning (_f ("(search path: `%s')", global_path.str ().ch_C()));
- error (_ ("Aborting"));
- }
- }
- AFM_CharMetricInfo const *cm = afm_l_->find_char_metric (s, warn);
-
- if (!cm)
- {
- Molecule m;
- m.set_empty (false);
- return m;
- }
-
- SCM at = (gh_list (ly_symbol2scm ("char"),
- gh_int2scm (cm->code),
- SCM_UNDEFINED));
-
-
- at= fontify_atom (afm_l_,at);
- return Molecule ( afm_bbox_to_box (cm->charBBox), at);
-}
-
-
-
+#include "lookup.hh"
+#include "font-metric.hh"
Molecule
Lookup::beam (Real slope, Real width, Real thick)
}
Molecule
-Lookup::accordion (SCM s, Real staff_space) const
+Lookup::accordion (SCM s, Real staff_space, Font_metric *fm)
{
Molecule m;
String sym = ly_scm2string(gh_car (s));
if (sym == "Discant")
{
- Molecule r = afm_find("accordion-accDiscant");
+ Molecule r = fm->find_by_name ("accordion-accDiscant");
m.add_molecule(r);
if (reg.left_str(1) == "F")
{
- Molecule d = afm_find("accordion-accDot");
+ Molecule d = fm->find_by_name ("accordion-accDot");
d.translate_axis(staff_space * 2.5 PT, Y_AXIS);
m.add_molecule(d);
reg = reg.right_str(reg.length_i()-1);
}
if (eflag & 0x02)
{
- Molecule d = afm_find("accordion-accDot");
+ Molecule d = fm->find_by_name ("accordion-accDot");
d.translate_axis(staff_space * 1.5 PT, Y_AXIS);
m.add_molecule(d);
}
if (eflag & 0x04)
{
- Molecule d = afm_find("accordion-accDot");
+ Molecule d = fm->find_by_name ("accordion-accDot");
d.translate_axis(staff_space * 1.5 PT, Y_AXIS);
d.translate_axis(0.8 * staff_space PT, X_AXIS);
m.add_molecule(d);
}
if (eflag & 0x01)
{
- Molecule d = afm_find("accordion-accDot");
+ Molecule d = fm->find_by_name ("accordion-accDot");
d.translate_axis(staff_space * 1.5 PT, Y_AXIS);
d.translate_axis(-0.8 * staff_space PT, X_AXIS);
m.add_molecule(d);
}
if (reg.left_str(2) == "SS")
{
- Molecule d = afm_find("accordion-accDot");
+ Molecule d = fm->find_by_name ("accordion-accDot");
d.translate_axis(0.5 * staff_space PT, Y_AXIS);
d.translate_axis(0.4 * staff_space PT, X_AXIS);
m.add_molecule(d);
}
if (reg.left_str(1) == "S")
{
- Molecule d = afm_find("accordion-accDot");
+ Molecule d = fm->find_by_name ("accordion-accDot");
d.translate_axis(0.5 * staff_space PT, Y_AXIS);
m.add_molecule(d);
reg = reg.right_str(reg.length_i()-1);
}
else if (sym == "Freebase")
{
- Molecule r = afm_find("accordion-accFreebase");
+ Molecule r = fm->find_by_name ("accordion-accFreebase");
m.add_molecule(r);
if (reg.left_str(1) == "F")
{
- Molecule d = afm_find("accordion-accDot");
+ Molecule d = fm->find_by_name ("accordion-accDot");
d.translate_axis(staff_space * 1.5 PT, Y_AXIS);
m.add_molecule(d);
reg = reg.right_str(reg.length_i()-1);
}
if (reg == "E")
{
- Molecule d = afm_find("accordion-accDot");
+ Molecule d = fm->find_by_name ("accordion-accDot");
d.translate_axis(staff_space * 0.5 PT, Y_AXIS);
m.add_molecule(d);
}
}
else if (sym == "Bayanbase")
{
- Molecule r = afm_find("accordion-accBayanbase");
+ Molecule r = fm->find_by_name ("accordion-accBayanbase");
m.add_molecule(r);
if (reg.left_str(1) == "T")
{
- Molecule d = afm_find("accordion-accDot");
+ Molecule d = fm->find_by_name ("accordion-accDot");
d.translate_axis(staff_space * 2.5 PT, Y_AXIS);
m.add_molecule(d);
reg = reg.right_str(reg.length_i()-1);
/* include 4' reed just for completeness. You don't want to use this. */
if (reg.left_str(1) == "F")
{
- Molecule d = afm_find("accordion-accDot");
+ Molecule d = fm->find_by_name ("accordion-accDot");
d.translate_axis(staff_space * 1.5 PT, Y_AXIS);
m.add_molecule(d);
reg = reg.right_str(reg.length_i()-1);
}
if (reg.left_str(2) == "EE")
{
- Molecule d = afm_find("accordion-accDot");
+ Molecule d = fm->find_by_name ("accordion-accDot");
d.translate_axis(staff_space * 0.5 PT, Y_AXIS);
d.translate_axis(0.4 * staff_space PT, X_AXIS);
m.add_molecule(d);
}
if (reg.left_str(1) == "E")
{
- Molecule d = afm_find("accordion-accDot");
+ Molecule d = fm->find_by_name ("accordion-accDot");
d.translate_axis(staff_space * 0.5 PT, Y_AXIS);
m.add_molecule(d);
reg = reg.right_str(reg.length_i()-1);
}
else if (sym == "Stdbase")
{
- Molecule r = afm_find("accordion-accStdbase");
+ Molecule r = fm->find_by_name ("accordion-accStdbase");
m.add_molecule(r);
if (reg.left_str(1) == "T")
{
- Molecule d = afm_find("accordion-accDot");
+ Molecule d = fm->find_by_name ("accordion-accDot");
d.translate_axis(staff_space * 3.5 PT, Y_AXIS);
m.add_molecule(d);
reg = reg.right_str(reg.length_i()-1);
}
if (reg.left_str(1) == "F")
{
- Molecule d = afm_find("accordion-accDot");
+ Molecule d = fm->find_by_name ("accordion-accDot");
d.translate_axis(staff_space * 2.5 PT, Y_AXIS);
m.add_molecule(d);
reg = reg.right_str(reg.length_i()-1);
}
if (reg.left_str(1) == "M")
{
- Molecule d = afm_find("accordion-accDot");
+ Molecule d = fm->find_by_name ("accordion-accDot");
d.translate_axis(staff_space * 2 PT, Y_AXIS);
d.translate_axis(staff_space PT, X_AXIS);
m.add_molecule(d);
}
if (reg.left_str(1) == "E")
{
- Molecule d = afm_find("accordion-accDot");
+ Molecule d = fm->find_by_name ("accordion-accDot");
d.translate_axis(staff_space * 1.5 PT, Y_AXIS);
m.add_molecule(d);
reg = reg.right_str(reg.length_i()-1);
}
if (reg.left_str(1) == "S")
{
- Molecule d = afm_find("accordion-accDot");
+ Molecule d = fm->find_by_name ("accordion-accDot");
d.translate_axis(staff_space * 0.5 PT, Y_AXIS);
m.add_molecule(d);
reg = reg.right_str(reg.length_i()-1);
for the rectangle */
else if (sym == "SB")
{
- Molecule r = afm_find("accordion-accSB");
+ Molecule r = fm->find_by_name ("accordion-accSB");
m.add_molecule(r);
}
else if (sym == "BB")
{
- Molecule r = afm_find("accordion-accBB");
+ Molecule r = fm->find_by_name ("accordion-accBB");
m.add_molecule(r);
}
else if (sym == "OldEE")
{
- Molecule r = afm_find("accordion-accOldEE");
+ Molecule r = fm->find_by_name ("accordion-accOldEE");
m.add_molecule(r);
}
else if (sym == "OldEES")
{
- Molecule r = afm_find("accordion-accOldEES");
+ Molecule r = fm->find_by_name ("accordion-accOldEES");
m.add_molecule(r);
}
return m;
#include "musical-request.hh"
#include "item.hh"
#include "paper-def.hh"
-#include "lookup.hh"
+#include "font-metric.hh"
#include "side-position-interface.hh"
ADD_THIS_TRANSLATOR (Lyric_engraver);
Real w = sp->spanner_length () - leftext - righttrim*ss;
Real h = sl * gh_scm2double (sp->get_elt_property ("height"));
- Molecule mol (sp->lookup_l ()->filledbox ( Box (Interval (0,w), Interval (0,h))));
+ Molecule mol (Lookup::filledbox ( Box (Interval (0,w), Interval (0,h))));
mol.translate (Offset (leftext, 0));
return mol.create_scheme();
}
#include <math.h>
#include <libc-extension.hh>
-#include "font-metric.hh"
+#include "font-metric.hh"
#include "dimensions.hh"
#include "interval.hh"
#include "string.hh"
SCM
fontify_atom(Font_metric * met, SCM f)
{
- return gh_list (ly_symbol2scm ("fontify"),
- ly_quote_scm (met->description ()), f, SCM_UNDEFINED);
+ if (f == SCM_EOL)
+ return f;
+ else
+ return gh_list (ly_symbol2scm ("fontify"),
+ ly_quote_scm (met->description_), f, SCM_UNDEFINED);
}
SCM
#include "debug.hh"
#include "paper-def.hh"
#include "paper-column.hh" // urg
-#include "lookup.hh"
+#include "font-interface.hh"
#include "rest.hh"
#include "molecule.hh"
#include "misc.hh"
Real pad = s.empty_b ()
? 0.0 : gh_scm2double (me->get_elt_property ("padding")) * staff_space;
- Molecule r (me->lookup_l ()->afm_find ("rests-" + to_str (k)));
+ Molecule r (Font_interface::get_default_font (me)->find_by_name ("rests-" + to_str (k)));
if (k == 0)
r.translate_axis (staff_space, Y_AXIS);
else
{
String idx = ("rests-") + to_str (-4);
- s = me->lookup_l ()->afm_find (idx);
+ s = Font_interface::get_default_font (me)->find_by_name (idx);
}
mol.add_molecule (s);
if (measures > 1)
{
- SCM properties = gh_append2 (me->immutable_property_alist_,
- me->mutable_property_alist_);
+ SCM properties = gh_list (me->mutable_property_alist_,
+ me->immutable_property_alist_,
+ SCM_UNDEFINED);
Molecule s =
Text_item::text2molecule (me,
ly_str02scm (to_str (measures).ch_C ()),
{"partcombine", PARTCOMBINE},
{"score", SCORE},
{"script", SCRIPT},
+ {"stylesheet", STYLESHEET},
{"skip", SKIP},
{"textscript", TEXTSCRIPT},
{"tempo", TEMPO},
#include "dots.hh"
#include "note-head.hh"
#include "debug.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
#include "molecule.hh"
#include "musical-request.hh"
Note_head::ledger_line (Interval xwid, Score_element *me)
{
Drul_array<Molecule> endings;
- endings[LEFT] = me->lookup_l()->afm_find ("noteheads-ledgerending");
+ endings[LEFT] = Font_interface::get_default_font (me)->find_by_name ("noteheads-ledgerending");
Molecule *e = &endings[LEFT];
endings[RIGHT] = *e;
}
// ugh: use gh_call ()
- Molecule out = me->lookup_l()->afm_find (String ("noteheads-") +
+ Molecule out = Font_interface::get_default_font (me)->find_by_name (String ("noteheads-") +
ly_scm2string (scm_eval2 (gh_list (ly_symbol2scm("find-notehead-symbol"),
me->get_elt_property ("duration-log"),
ly_quote_scm(style),
#include <math.h>
+#include "all-font-metrics.hh"
#include "string.hh"
#include "misc.hh"
#include "paper-def.hh"
#include "debug.hh"
-#include "lookup.hh"
+#include "font-metric.hh"
#include "main.hh"
#include "scope.hh"
#include "file-results.hh" // urg? header_global_p
Paper_def::Paper_def ()
{
- lookup_alist_ = SCM_EOL;
+ style_sheet_ = SCM_EOL;
+ scaled_fonts_ = SCM_EOL;
}
-
Paper_def::~Paper_def ()
{
}
Paper_def::Paper_def (Paper_def const&src)
: Music_output_def (src)
{
- SCM n = SCM_EOL;
- for (SCM s = src.lookup_alist_; gh_pair_p(s); s = gh_cdr (s))
- {
- n = scm_acons (gh_caar(s), gh_cdar (s), n);
- }
-
- lookup_alist_ = n;
+ scaled_fonts_ = SCM_EOL;
+ style_sheet_ = src.style_sheet_;
}
return 0.0;
}
+ Real sc = 1.0;
+ SCM ssc;
+ if (scope_p_->try_retrieve (ly_symbol2scm ("outputscale"), &ssc))
+ {
+ sc = gh_scm2double (ssc);
+ }
if (gh_number_p (val))
{
- return gh_scm2double (val);
+ return gh_scm2double (val) / sc;
}
else
{
return Interval (ind, lw);
}
-void
-Paper_def::set_lookup (int i, SCM l)
-{
- assert (unsmob_lookup (l));
- lookup_alist_ = scm_assq_set_x(lookup_alist_, gh_int2scm (i), l);
-}
-Lookup const *
-Paper_def::lookup_l (int i) const
-{
- SCM l = scm_assq (gh_int2scm(i), lookup_alist_);
- return l == SCM_BOOL_F ? 0 : unsmob_lookup (gh_cdr (l));
-}
int Paper_def::default_count_i_ = 0;
return str;
}
+/*
+ todo: use symbols and hashtable idx?
+*/
+Font_metric *
+Paper_def::find_font (SCM fn, Real m)
+{
+ SCM key = gh_cons (fn, gh_double2scm (m));
+ SCM met = scm_assoc (key, scaled_fonts_);
+
+ if (gh_pair_p (met))
+ return unsmob_metrics (gh_cdr (met));
+
+ SCM ssc;
+ if (scope_p_->try_retrieve (ly_symbol2scm ("outputscale"), &ssc))
+ {
+ m /= gh_scm2double (ssc);
+ }
+
+ Font_metric* f = all_fonts_global_p->find_font (ly_scm2string (fn));
+ SCM val = Scaled_font_metric::make_scaled_font_metric (f, m);
+ scaled_fonts_ = scm_acons (key, val, scaled_fonts_ );
+
+ scm_unprotect_object (val);
+
+ return dynamic_cast<Scaled_font_metric*> (unsmob_metrics (val));
+}
+
+/*
+ Return alist to translate internally used fonts back to real-world
+ coordinates. */
+SCM
+Paper_def::font_descriptions ()const
+{
+
+
+ SCM l = SCM_EOL;
+ for (SCM s = scaled_fonts_; gh_pair_p (s); s = gh_cdr(s))
+ {
+ SCM desc = gh_caar (s);
+ SCM mdesc = unsmob_metrics (gh_cdar (s))->description_;
+
+ l = gh_cons (gh_cons (mdesc, desc), l);
+ }
+ return l;
+}
#include "array.hh"
#include "string-convert.hh"
#include "debug.hh"
-#include "lookup.hh"
+#include "font-metric.hh"
#include "main.hh"
#include "scope.hh"
#include "identifier.hh"
{
if (verbatim_scheme_b_)
{
- SCM result = scm_eval2 (scm_listify (ly_symbol2scm ("scm->string"),
- ly_quote_scm (gh_car (s)), SCM_UNDEFINED),
- SCM_EOL);
-
+ SCM p;
+
+ p = scm_mkstrport (SCM_INUM0,
+ scm_make_string (SCM_INUM0, SCM_UNDEFINED),
+ SCM_OPN | SCM_WRTNG,
+ "Paper_outputter::dump_scheme()");
+
+ SCM wr =scm_eval2 (ly_symbol2scm ("write"), SCM_EOL);
+ scm_apply (wr, s, gh_list (p, SCM_UNDEFINED));
+
+ SCM result = scm_strport_to_string (p);
*stream_p_ << ly_scm2string (result);
}
else
-void
-Paper_outputter::output_font_def (int i, String str)
-{
- SCM scm = gh_list (ly_symbol2scm ("font-def"),
- gh_int2scm (i),
- ly_str02scm (str.ch_l ()),
- SCM_UNDEFINED);
-
- output_scheme (scm);
-}
void
Paper_outputter::output_Real_def (String k, Real v)
#include "main.hh"
#include "debug.hh"
-#include "lookup.hh"
+#include "font-metric.hh"
#include "spanner.hh"
#include "paper-def.hh"
#include "line-of-score.hh"
outputter_l_ = new Paper_outputter (paper_l_->paper_stream_p ());
;
outputter_l_->output_header ();
- outputter_l_->output_version();
+ outputter_l_->output_version ();
if (header_global_p)
outputter_l_->output_scope (header_global_p, "mudela");
outputter_l_->output_scope (paper_l_->scope_p_, "mudelapaper");
SCM scm;
- if(experimental_features_global_b)
+ if (experimental_features_global_b)
{
SCM scm = gh_list (ly_symbol2scm ("experimental-on"), SCM_UNDEFINED);
outputter_l_->output_scheme (scm);
}
scm = gh_list (ly_symbol2scm ("header-end"), SCM_UNDEFINED);
outputter_l_->output_scheme (scm);
-
- line_l_->output_lines ();
+ line_l_->output_lines ();
scm = gh_list (ly_symbol2scm ("end-output"), SCM_UNDEFINED);
outputter_l_->output_scheme (scm);
%token SCRIPT
%token SKIP
%token SPANREQUEST
+%token STYLESHEET
%token COMMANDSPANREQUEST
%token TEMPO
%token OUTPUTPROPERTY
| music_output_def_body translator_spec_block {
$$->assign_translator ($2);
}
+ | music_output_def_body STYLESHEET embedded_scm {
+ dynamic_cast<Paper_def*> ($$)-> style_sheet_ = $3;
+ }
| music_output_def_body tempo_request semicolon {
/*
junk this ? there already is tempo stuff in
*/
dynamic_cast<Midi_def*> ($$)->set_tempo ($2->dur_.length_mom (), $2->metronome_i_);
}
- | music_output_def_body bare_int '=' FONT STRING { // ugh, what a syntax
- SCM sl = Lookup::make_lookup();
- Lookup * l =unsmob_lookup (sl);
- l->font_name_ = ly_scm2string ($5);
- dynamic_cast<Paper_def*> ($$)->set_lookup ($2, sl);
- }
| music_output_def_body error {
}
#include "musical-request.hh"
#include "score-element.hh"
#include "item.hh"
-#include "lookup.hh"
#include "lily-guile.hh"
#include "rhythmic-head.hh"
#include "stem.hh"
#include "molecule.hh"
#include "paper-def.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
#include "rest.hh"
#include "dots.hh"
#include "paper-score.hh"
String idx = ("rests-") + to_str (gh_scm2int (balltype))
+ (ledger_b ? "o" : "") + style;
- return me-> lookup_l ()->afm_find (idx).create_scheme();
+ return Font_interface::get_default_font (me)->find_by_name (idx).create_scheme();
}
#include "rhythmic-head.hh"
#include "debug.hh"
-#include "molecule.hh"
-#include "paper-def.hh"
-#include "lookup.hh"
#include "rest.hh"
-#include "dots.hh"
-#include "paper-score.hh"
#include "stem.hh"
#include "staff-symbol-referencer.hh"
#include "item.hh"
--- /dev/null
+#include "font-metric.hh"
+#include "string.hh"
+#include "molecule.hh"
+
+
+Scaled_font_metric::Scaled_font_metric (Font_metric* m, Real magn)
+{
+ magnification_f_ = magn;
+ SCM desc = m->description_;
+
+ Real total_mag = magn * gh_scm2double (gh_cdr (desc));
+ description_ = gh_cons (gh_car (desc), gh_double2scm (total_mag));
+ orig_l_ = m;
+}
+
+SCM
+Scaled_font_metric::make_scaled_font_metric (Font_metric*m, Real s)
+{
+ Scaled_font_metric *sfm = new Scaled_font_metric (m,s);
+ return sfm->self_scm ();
+}
+
+Molecule
+Scaled_font_metric::find_by_name (String s) const
+{
+ Molecule m = orig_l_->find_by_name (s);
+ Box b = m.extent_box ();
+ b.scale (magnification_f_);
+ Molecule q(b,fontify_atom ((Font_metric*) this, m.get_expr ()));
+
+ return q ;
+}
// we do not copy the self_scm () field!
}
-
-
-
SCM
Scheme_hash_table::mark_smob (SCM s)
{
#include "misc.hh"
#include "paper-score.hh"
#include "paper-def.hh"
-#include "lookup.hh"
#include "molecule.hh"
#include "score-element.hh"
#include "debug.hh"
*/
pscore_l_=0;
- lookup_l_ =0;
status_i_ = 0;
original_l_ = 0;
immutable_property_alist_ = basicprops;
mutable_property_alist_ = SCM_EOL;
status_i_ = s.status_i_;
- lookup_l_ = s.lookup_l_;
pscore_l_ = s.pscore_l_;
smobify_self ();
return pscore_l_ ? pscore_l_->paper_l_ : 0;
}
-Lookup const *
-Score_element::lookup_l () const
-{
- /*
- URG junkthis, caching is clumsy.
- */
- if (!lookup_l_)
- {
- Score_element * urg = (Score_element*)this;
- SCM sz = urg->remove_elt_property ("font-relative-size");
- int i = (gh_number_p (sz))
- ? gh_scm2int (sz)
- : 0;
-
- urg->lookup_l_ = (Lookup*)pscore_l_->paper_l_->lookup_l (i);
- }
- return lookup_l_;
-}
-
void
Score_element::calculate_dependencies (int final, int busy, SCM funcname)
{
#include "debug.hh"
#include "script.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
#include "side-position-interface.hh"
#include "paper-def.hh"
#include "item.hh"
+#include "molecule.hh"
+#include "lookup.hh"
Molecule
Script::get_molecule(Score_element * me, Direction d)
SCM key = gh_car (s);
if (key == ly_symbol2scm ("feta"))
{
- return me->lookup_l ()->afm_find ("scripts-" +
+ return Font_interface::get_default_font (me)->find_by_name ("scripts-" +
ly_scm2string (index_cell (gh_cdr (s), d)));
}
else if (key == ly_symbol2scm ("accordion"))
{
- return me->lookup_l ()->accordion (gh_cdr (s), me->paper_l()->get_var("staffspace"));
+ return Lookup::accordion (gh_cdr (s), me->paper_l()->get_var("staffspace"), Font_interface::get_default_font (me));
}
else
assert (false);
void
-Separating_group_spanner::set_interface (Score_element*me)
+Separating_group_spanner::set_interface (Score_element*)
{
}
algorithm, instead of this homebrew.
*/
void
-Slur_bezier_bow::minimise_enclosed_area (Paper_def* paper_l, Real beauty,
+Slur_bezier_bow::minimise_enclosed_area (Real beauty,
SCM bezier_props)
{
Real length = curve_.control_[3][X_AXIS];
Molecule a;
SCM d = me->get_elt_property ("dashed");
if (gh_number_p (d))
- a = me->lookup_l ()->dashed_slur (one, thick, thick * gh_scm2double (d));
+ a = Lookup::dashed_slur (one, thick, thick * gh_scm2double (d));
else
- a = me->lookup_l ()->slur (one, Directional_element_interface::get (me) * thick, thick);
+ a = Lookup::slur (one, Directional_element_interface::get (me) * thick, thick);
return a.create_scheme();
}
if (gh_number_p (ssb))
sb = gh_scm2double (ssb);
- bb.minimise_enclosed_area (me->paper_l(), sb, details);
+ bb.minimise_enclosed_area ( sb, details);
SCM sbf = scm_assq (ly_symbol2scm ("force-blowfit"), details);
Real bff = 1.0;
if (gh_pair_p (sbf) && gh_number_p (gh_cdr (sbf)))
*/
#include "span-bar.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
#include "dimensions.hh"
#include "paper-def.hh"
#include "molecule.hh"
#include "spanner.hh"
+
MAKE_SCHEME_CALLBACK(Staff_symbol,brew_molecule,1);
SCM
for (int i=0; i < l; i++)
{
Molecule a =
- me->lookup_l ()->filledbox (Box (Interval (0,width),
+ Lookup::filledbox (Box (Interval (0,width),
Interval (-t/2, t/2)));
a.translate_axis (height - i * staff_space (me), Y_AXIS);
width *= ss;
thick *= ss;
- Molecule a (me->lookup_l ()->beam (dydx, width, thick));
+ Molecule a (Lookup::beam (dydx, width, thick));
a.translate (Offset (-width/2, width / 2 * dydx));
int tremolo_flags;
*/
#include <math.h> // m_pi
+#include "lookup.hh"
#include "directional-element-interface.hh"
#include "note-head.hh"
#include "stem.hh"
#include "debug.hh"
#include "paper-def.hh"
#include "rhythmic-head.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
#include "molecule.hh"
#include "paper-column.hh"
#include "misc.hh"
}
char c = (get_direction (me) == UP) ? 'u' : 'd';
- Molecule m = me->lookup_l ()->afm_find (String ("flags-") + to_str (c) +
+ Molecule m = Font_interface::get_default_font (me)->find_by_name (String ("flags-") + to_str (c) +
to_str (flag_i (me)));
if (!style.empty_b ())
- m.add_molecule(me->lookup_l ()->afm_find (String ("flags-") + to_str (c) + style));
+ m.add_molecule(Font_interface::get_default_font (me)->find_by_name (String ("flags-") + to_str (c) + style));
return m;
}
if (!invisible_b (me))
{
Real stem_width = gh_scm2double (me->get_elt_property ("thickness")) * me->paper_l ()->get_var ("stafflinethickness");
- Molecule ss =me->lookup_l ()->filledbox (Box (Interval (-stem_width/2, stem_width/2),
- Interval (stem_y[DOWN]*dy, stem_y[UP]*dy)));
+ Molecule ss =Lookup::filledbox (Box (Interval (-stem_width/2, stem_width/2),
+ Interval (stem_y[DOWN]*dy, stem_y[UP]*dy)));
mol.add_molecule (ss);
}
*/
#include "score-element.hh"
#include "molecule.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
#include "string.hh"
// update comment --hwn
}
else
idx += String (&text.byte_C ()[i], 1);
- Molecule m = e->lookup_l ()->afm_find (idx);
+ Molecule m = Font_interface::get_default_font (e)->find_by_name (idx);
if (!m.empty_b ())
mol.add_at_edge (X_AXIS, RIGHT, m, 0);
}
#include "system-start-delimiter.hh"
#include "paper-def.hh"
#include "molecule.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
#include "all-font-metrics.hh"
#include "score-element.hh"
+#include "lookup.hh"
Molecule
System_start_delimiter::staff_bracket (Score_element*me,Real height)
{
Real w = me->paper_l ()->get_var ("stafflinethickness") *
gh_scm2double (me->get_elt_property ("thickness"));
- return me->lookup_l ()->filledbox (Box (Interval(0,w), Interval(-h/2, h/2)));
+ return Lookup::filledbox (Box (Interval(0,w), Interval(-h/2, h/2)));
}
MAKE_SCHEME_CALLBACK(System_start_delimiter,after_line_breaking,1);
Molecule
System_start_delimiter::staff_brace (Score_element*me,Real y)
{
- Real staffht = me->paper_l ()->get_var ("staffheight");
- int staff_size = int (rint (staffht ));
+ int staff_size = 20; // URG.
// URG
Real step = 1.0;
int idx = int (((maxht - step) <? y - minht) / step);
idx = idx >? 0;
- SCM l = scm_assoc (ly_str02scm ("brace"),
- scm_eval2 (ly_symbol2scm ("cmr-alist"), SCM_EOL));
+ Font_metric *fm = Font_interface::get_default_font (me);
- String nm = "feta-braces";
- if (l != SCM_BOOL_F)
- nm = ly_scm2string (gh_cdr (l));
- nm += to_str (staff_size);
- SCM e =gh_list (ly_symbol2scm ("char"), gh_int2scm (idx), SCM_UNDEFINED);
- SCM at = (e);
-
- at = fontify_atom (find_font (nm), at);
+ SCM at =gh_list (ly_symbol2scm ("char"), gh_int2scm (idx), SCM_UNDEFINED);
+ at = fontify_atom (fm, at);
Box b (Interval (0,0), Interval (-y/2, y/2));
(c) 1998--2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
Jan Nieuwenhuizen <janneke@gnu.org>
*/
+#include <math.h>
#include "debug.hh"
#include "text-item.hh"
#include "paper-def.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
#include "staff-symbol-referencer.hh"
#include "staff-symbol-referencer.hh"
#include "main.hh"
PROPERTY: (key . value)
ABBREV: rows lines roman music bold italic named super sub text, or any font-style
*/
+
+/*
+ TODO:
+
+ rewrite routines and syntax to be like
+
+ TEXT: STRING
+ | (head-expression* TEXT*)
+ ;
+
+ head-expression is a list, containing a tag and a variable number of
+ arguments. If necessary, the number of arguments can be stored in a alist,
+
+ '(
+ (tag1 . argcount1)
+ (tag2 . argcount2)
+
+ ... etc
+
+ )
+
+ or even entries like
+
+ (tag . (argcount function-to-handle-the-tag ))
+
+ */
+
Molecule
-Text_item::text2molecule (Score_element *me, SCM text, SCM properties)
+Text_item::text2molecule (Score_element *me, SCM text, SCM alist_chain)
{
if (gh_string_p (text))
- return string2molecule (me, text, properties);
+ return string2molecule (me, text, alist_chain);
else if (gh_list_p (text))
{
if (!gh_pair_p (gh_car (text)) && gh_string_p (gh_car (text)))
- return string2molecule (me, gh_car (text), properties);
+ return string2molecule (me, gh_car (text), alist_chain);
else
- return markup_sentence2molecule (me, text, properties);
+ return markup_sentence2molecule (me, text, alist_chain);
}
return Molecule ();
}
-static
SCM
-get_elt_property (Score_element *me, char const *name)
-{
- SCM s = me->get_elt_property (name);
- if (s == SCM_EOL)
- error (_f ("No `%s' defined for %s", name, me->name ()));
- return s;
-}
-
-Molecule
-Text_item::string2molecule (Score_element *me, SCM text, SCM properties)
+ly_assoc_chain (SCM key, SCM achain)
{
- SCM style = scm_assoc (ly_symbol2scm ("font-style"), properties);
- SCM paper = me->get_elt_property ("style-sheet");
- if (paper == SCM_EOL)
- paper = scm_string_to_symbol (me->paper_l ()->get_scmvar ("style_sheet"));
-
- // should move fallback to scm
- SCM font_name = ly_str02scm ("cmr10");
- if (gh_pair_p (style))
+ if (gh_pair_p (achain))
{
- SCM f = get_elt_property (me, "style-to-font-name");
- if (gh_procedure_p (f))
- font_name = gh_call2 (f, paper, gh_cdr (style));
+ SCM handle = scm_assoc (key, gh_car (achain));
+ if (gh_pair_p (handle))
+ return handle;
+ else
+ return ly_assoc_chain (key, gh_cdr (achain));
}
else
+ return SCM_BOOL_F;
+}
+
+Molecule
+Text_item::string2molecule (Score_element *me, SCM text, SCM alist_chain)
+{
+ SCM style = ly_assoc_chain (ly_symbol2scm ("font-style"),
+ alist_chain);
+ if (gh_pair_p (style))
+ style = gh_cdr (style);
+
+ SCM sheet = me->paper_l ()->style_sheet_;
+
+ if (gh_symbol_p (style))
{
- SCM f = get_elt_property (me, "properties-to-font-name");
- if (gh_procedure_p (f))
- font_name = gh_call2 (f, paper, properties);
+ SCM style_alist = gh_cdr (scm_assoc (ly_symbol2scm ("style-alist"), sheet));
+ SCM entry = scm_assoc (style, style_alist);
+ entry = gh_pair_p (entry) ? gh_cdr (entry) : SCM_EOL;
+ alist_chain = gh_cons (entry, alist_chain);
}
-
+
+ SCM fonts = gh_cdr (scm_assoc (ly_symbol2scm ("fonts"), sheet));
+ SCM proc = gh_cdr (scm_assoc (ly_symbol2scm ("properties-to-font"), sheet));
+ SCM font_name = gh_call2 (proc, fonts, alist_chain);
+
+#if 0
SCM lookup = scm_assoc (ly_symbol2scm ("lookup"), properties);
Molecule mol;
if (gh_pair_p (lookup) && ly_symbol2string (gh_cdr (lookup)) == "name")
mol = lookup_character (me, font_name, text);
else
- mol = lookup_text (me, font_name, text);
+#endif
+ Molecule mol = lookup_text (me, font_name, text);
return mol;
}
-/*
- caching / use some form of Lookup without 'paper'?
-*/
Molecule
-Text_item::lookup_character (Score_element *me, SCM font_name, SCM char_name)
+Text_item::lookup_character (Score_element *, SCM font_name, SCM char_name)
{
Adobe_font_metric *afm = all_fonts_global_p->find_afm (ly_scm2string (font_name));
-
+
if (!afm)
{
warning (_f ("can't find font: `%s'", ly_scm2string (font_name)));
warning (_f ("(search path: `%s')", global_path.str ().ch_C()));
error (_ ("Aborting"));
}
+ Font_metric * fm = afm;
- AFM_CharMetricInfo const *metric =
- afm->find_char_metric (ly_scm2string (char_name), true);
-
- if (!metric)
- {
- Molecule m;
- m.set_empty (false);
- return m;
- }
-
- SCM list = gh_list (ly_symbol2scm ("char"),
- gh_int2scm (metric->code),
- SCM_UNDEFINED);
-
- list = fontify_atom (afm, list);
- return Molecule (afm_bbox_to_box (metric->charBBox), list);
+ return fm->find_by_name (ly_scm2string (char_name));
}
+
Molecule
Text_item::lookup_text (Score_element *me, SCM font_name, SCM text)
{
SCM magnification = me->get_elt_property ("font-magnification");
Font_metric* metric = 0;
if (gh_number_p (magnification))
- metric = all_fonts_global_p->find_scaled (ly_scm2string (font_name),
- gh_scm2int (magnification));
+ {
+#if 0
+ Real realmag = pow (1.2, gh_scm2int (magnification));
+ metric = all_fonts_global_p->find_scaled (ly_scm2string (font_name), realmag);
+#endif
+ assert (false);
+ }
else
- metric = all_fonts_global_p->find_font (ly_scm2string (font_name));
+ metric = me->paper_l ()->find_font (font_name, 1.0);
SCM list = gh_list (ly_symbol2scm ("text"), text, SCM_UNDEFINED);
list = fontify_atom (metric, list);
Molecule
Text_item::markup_sentence2molecule (Score_element *me, SCM markup_sentence,
- SCM properties)
+ SCM alist_chain)
{
+ /*
+ FIXME
+ */
+ return Molecule ();
+
+ SCM sheet = me->paper_l ()->style_sheet_;
+ SCM f = gh_cdr (scm_assoc (ly_symbol2scm ("markup-abbrev-to-properties-alist"), sheet));
+
SCM markup = gh_car (markup_sentence);
SCM sentence = gh_cdr (markup_sentence);
- SCM f = get_elt_property (me, "markup-to-properties");
- SCM p = gh_append2 (gh_call1 (f, markup), properties);
+
+ SCM p = gh_cons (gh_call1 (f, markup), alist_chain);
Axis align = X_AXIS;
SCM a = scm_assoc (ly_symbol2scm ("align"), p);
SCM text = me->get_elt_property ("text");
- SCM properties = gh_append2 (me->immutable_property_alist_,
- me->mutable_property_alist_);
+ SCM properties = gh_list (me->immutable_property_alist_,
+ me->mutable_property_alist_, SCM_UNDEFINED);
Molecule mol = Text_item::text2molecule (me, text, properties);
#include "text-item.hh"
#include "text-spanner.hh"
#include "spanner.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
#include "dimensions.hh"
#include "paper-def.hh"
#include "debug.hh"
text_style = ly_scm2string (s);
#endif
- SCM properties = gh_append2 (me->immutable_property_alist_,
- me->mutable_property_alist_);
+ SCM properties = gh_list (me->mutable_property_alist_,
+ me->immutable_property_alist_,
+ SCM_UNDEFINED);
SCM edge_text = me->get_elt_property ("edge-text");
Drul_array<Molecule> edge;
if (gh_pair_p (edge_text))
else if (warn)
{
- warning (_f ("can't find ascii character: `%d'", ascii));
+ warning (_f ("can't find ascii character %d", ascii));
}
return &dummy_static_char_metric;
}
Box
-Tex_font_metric::get_char (int a, bool w) const
+Tex_font_metric::get_char (int a) const
{
- return find_ascii (a, w)->dimensions ();
+ Box b = find_ascii (a)->dimensions () ;
+ return b;
}
SCM
Tex_font_metric::make_tfm (String fn)
{
- Tex_font_metric * tfm_p = new Tex_font_metric;
+ Tex_font_metric * tfm_p = new Tex_font_metric;
Tex_font_metric_reader reader (fn);
tfm_p->info_ = reader.info_;
tfm_p->char_metrics_ = reader.char_metrics_;
tfm_p->ascii_to_metric_idx_ = reader.ascii_to_metric_idx_;
- return tfm_p->smobbed_self ();
+ return tfm_p->self_scm ();
}
*/
#include <math.h>
+
#include "spanner.hh"
#include "lookup.hh"
#include "paper-def.hh"
i++;
}
- Molecule a = me->lookup_l ()->slur (b, Directional_element_interface::get (me) * thick, thick);
+ Molecule a = Lookup::slur (b, Directional_element_interface::get (me) * thick, thick);
return a.create_scheme ();
}
#include "text-item.hh"
#include "time-signature.hh"
#include "paper-def.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
MAKE_SCHEME_CALLBACK(Time_signature,brew_molecule,1);
// First guess: s contains only the signature style
String symbolname = "timesig-" + s + to_str (n) + "/" + to_str (d);
- Molecule m = me->lookup_l ()->afm_find (symbolname, false);
+ Molecule m = Font_interface::get_default_font (me)->find_by_name (symbolname);
if (!m.empty_b())
return m;
// Second guess: s contains the full signature name
- m = me->lookup_l ()->afm_find ("timesig-"+s, false);
+ m = Font_interface::get_default_font (me)->find_by_name ("timesig-"+s);
if (!m.empty_b ())
return m;
Molecule
Time_signature::time_signature (Score_element*me,int num, int den)
{
- /*
- UGH: need to look at fontsize.
- TODO: specify using scm markup.
- */
- SCM properties = gh_append2 (me->immutable_property_alist_,
- me->mutable_property_alist_);
+ SCM chain = gh_list (me->mutable_property_alist_, me->immutable_property_alist_, SCM_UNDEFINED);
+
Molecule n = Text_item::text2molecule (me,
ly_str02scm (to_str (num).ch_C ()),
- properties);
+ chain);
Molecule d = Text_item::text2molecule (me,
ly_str02scm (to_str (den).ch_C ()),
- properties);
+ chain);
n.align_to (X_AXIS, CENTER);
d.align_to (X_AXIS, CENTER);
Molecule m;
#include "beam.hh"
#include "box.hh"
#include "debug.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
#include "molecule.hh"
#include "paper-column.hh"
#include "paper-def.hh"
SCM number = me->get_elt_property ("text");
if (gh_string_p (number) && number_visibility)
{
- SCM properties = gh_append2 (me->immutable_property_alist_,
- me->mutable_property_alist_);
+ SCM properties = gh_list ( me->mutable_property_alist_,
+ me->immutable_property_alist_,
+
+ SCM_UNDEFINED);
Molecule num = Text_item::text2molecule (me, number, properties);
num.align_to (X_AXIS, CENTER);
num.translate_axis (w/2, X_AXIS);
#include "box.hh"
#include "debug.hh"
-#include "lookup.hh"
+#include "font-interface.hh"
#include "molecule.hh"
#include "paper-column.hh"
#include "paper-def.hh"
void
Volta_spanner::set_interface (Score_element*me)
{
- Side_position::set_axis (me, Y_AXIS);
- Directional_element_interface::set (me, UP);
}
-
/*
this is too complicated. Yet another version of side-positioning,
badly implemented.
* Should look for system_start_delim to find left edge of staff.
-
*/
MAKE_SCHEME_CALLBACK(Volta_spanner,brew_molecule,1);
Box b (Interval (0, w), Interval (0, h));
Molecule mol (b, at);
SCM text = me->get_elt_property("text");
- SCM properties = gh_append2 (me->immutable_property_alist_,
- me->mutable_property_alist_);
+ SCM properties = gh_list (me->mutable_property_alist_, me->immutable_property_alist_,SCM_UNDEFINED);
Molecule num = Text_item::text2molecule (me, text, properties);
mol.add_at_edge (X_AXIS, LEFT, num, - num.extent (X_AXIS).length ()
paper_eleven = \paper {
staffheight = 11.0\pt;
- style_sheet = "paper11";
-
- -1=\font "feta11"
- -2=\font "feta11"
- 0=\font "feta11"
+ \stylesheet #(make-style-sheet 'paper11)
\include "params.ly";
}
paper_thirteen = \paper {
staffheight = 13.0\pt;
- style_sheet = "paper13";
-
- 0=\font "feta13"
- -1=\font "feta11"
+ \stylesheet #(make-style-sheet 'paper13)
+
\include "params.ly";
}
paper_sixteen = \paper {
staffheight = 16.0\pt;
- style_sheet = "paper16";
-
- 0 = \font "feta16"
- -1 = \font "feta13"
- -2 = \font "feta11"
- -3 = \font "feta11"
+ \stylesheet #(make-style-sheet 'paper16)
\include "params.ly";
}
paper_twenty = \paper {
staffheight = 20.0\pt;
- style_sheet = "paper20";
-
- 0 = \font "feta20"
- -1 = \font "feta16"
- -2 = \font "feta13"
- -3 = \font "feta11"
-
+ \stylesheet #(make-style-sheet 'paper20)
+
\include "params.ly";
}
paper_twentythree = \paper {
staffheight = 23.0\pt;
- style_sheet = "paper23";
-
- -2 = \font "feta16"
- -1 = \font "feta20"
- 0 = \font "feta23"
-
+ \stylesheet #(make-style-sheet 'paper23)
\include "params.ly";
}
paper_twentysix = \paper {
staffheight = 26.0\pt;
- style_sheet = "paper26";
-
- 0=\font "feta26"
- -1 = \font "feta23"
- -2 = \font "feta20"
+ \stylesheet #(make-style-sheet 'paper26)
\include "params.ly";
}
-% params.ly
-% generic paper parameters
-
-%{
-
-TODO:
-
-* cleanup
-* use elt properties, iso. paper variables.
-
-%}
-
+% JUNKME.
papersizename = \papersize ;
staffspace = \staffheight / 4.0;
stafflinethickness = \staffspace / 10.0;
-
-%{
-The space taken by a note is determined by the formula
-
- SPACE = arithmetic_multiplier * ( C + log2 (TIME) ))
-
-where TIME is the amount of time a note occupies. The value of C is
-chosen such that the smallest space within a measure is
-arithmetic_basicspace:
-
- C = arithmetic_basicspace - log2 (mininum (SHORTEST, 1/8))
-
-The smallest space is the one following the shortest note in the
-measure, or the space following a hypothetical 1/8 note. Typically
-arithmetic_basicspace is set to a value so that the shortest note
-takes about two noteheads of space (ie, is followed by a notehead of
-space):
-
- 2*quartwidth = arithmetic_multiplier * ( C + log2 (SHORTEST) ))
-
- { using: C = arithmetic_basicspace - log2 (mininum (SHORTEST, 1/8)) }
- { assuming: SHORTEST <= 1/8 }
-
- = arithmetic_multiplier *
- ( arithmetic_basicspace - log2 (SHORTEST) + log2 (SHORTEST) )
-
- = arithmetic_multiplier * arithmetic_basicspace
-
- { choose: arithmetic_multiplier = 1.0*quartwidth (why?)}
-
- = quartwidth * arithmetic_basicspace
-
- =>
-
- arithmetic_basicspace = 2/1 = 2
-
-If you want to space your music wider, use something like:
-
- arithmetic_basicspace = 4.;
-
-%}
-% We use 0.9*\quartwidth, because 1.0 seems to wide.
-% quartwidth == 1.32 * staffspace
-% We don't adjust arithmetic_basicspace accordingly (why not?)
-arithmetic_multiplier = 0.9 * 1.32 * \staffspace ;
-arithmetic_basicspace = 2.0;
-
-
-
-% URG: the magic constants for area asymmetry
-bezier_pct_c0 = -0.2;
-bezier_pct_c3 = 0.000006;
-bezier_pct_out_max = 0.8;
-bezier_pct_in_max = 1.2;
-bezier_area_steps = 1.0;
-
-
-% vertical space between lines of text.
-line_kern = \staffspace;
-
-
-% optical correction amount.
-stemSpacingCorrection = 0.5*\staffspace;
-
-
-%{
- relative strength of space following breakable columns (eg. prefatory matter)
- %}
-breakable_column_space_strength = 2.0;
-
-% space after inline clefs and such get this much stretched
-decrease_nonmus_spacing_factor = 1.0 ;
-
-%{
- space before musical columns (eg. taken by accidentals) get this much
- stretched when they follow a musical column, in absence of grace notes.
-
- 0.0 means no extra space (accidentals are ignored)
-%}
-musical_to_musical_left_spacing_factor = 0.4;
-
-%{
- stretch space this much if there are grace notes before the column
-%}
-before_grace_spacing_factor = 1.2;
-
-%{
-If columns do not have spacing information set, set it to this much
-%}
-loose_column_distance = 2.0 * \staffspace;
-
-%{
-Relative cost of compressing (vs. stretching). Increasing this
-will cause scores to be set looser
-.
-%}
-
-compression_energy_factor = 0.6;
+outputscale = \staffheight / 4.0;
\translator { \NoteNamesContext }
\translator { \ScoreContext }
%
font_identifier:="feta-braces23";
-font_size 23;
+font_size 22.5; %% feta23 = 22.5pt ...
mode_setup;
-staffsize#:=23pt#;
+staffsize#:=22.5pt#;
input feta-beugel;
end.
-
% feta-din10.mf
% part of LilyPond's pretty-but-neat music font
-design_size:=10;
+design_size:=10; % feta20 = 20pt
input feta-din;
--- /dev/null
+% feta-din11.mf
+% part of LilyPond's pretty-but-neat music font
+
+design_size:=11.25; % feta23 = 22.5pt
+
+input feta-din;
+
+end.
+
--- /dev/null
+% feta-din13.mf
+% part of LilyPond's pretty-but-neat music font
+
+design_size:=13; % feta26 = 26pt
+
+input feta-din;
+
+end.
+
--- /dev/null
+% feta-din16.mf
+% part of LilyPond's pretty-but-neat music font
+
+design_size:=16;
+
+input feta-din;
+
+end.
+
% feta-din4.mf
% part of LilyPond's pretty-but-neat music font
-% size:=4;
-design_size:=16*4/15;
+design_size:=3.82; % 6.5/1.2/1.2 din5 = 6.5/1.2 : din7 = 6.5pt
input feta-din.mf;
% feta-din5.mf
% part of LilyPond's pretty-but-neat music font
-% size:=5;
-design_size:=20*4/15;
+design_size:=4.58; % 6.5/1.2 : din7 = 6.5pt
input feta-din.mf;
-% feta-din5.mf
+% feta-din7.mf
% part of LilyPond's pretty-but-neat music font
-% size:=5;
-design_size:=26*4/15;
+design_size:=6.5; % feta13 = 13pt
input feta-din.mf;
% feta-din8.mf
% part of LilyPond's pretty-but-neat music font
-design_size:=8;
+design_size:=8; % feta16 = 16pt
input feta-din.mf;
-
% feta-nummer10.mf
% part of LilyPond's pretty-but-neat music font
-design_size:=10;
+design_size:=10; % feta20 = 20pt
input feta-nummer;
--- /dev/null
+% feta-nummer11.mf
+% part of LilyPond's pretty-but-neat music font
+
+design_size:=11.25; % feta23 = 22.5pt
+
+input feta-nummer;
+
+end.
+
--- /dev/null
+% feta-nummer13.mf
+% part of LilyPond's pretty-but-neat music font
+
+design_size:=13; % feta26 = 26pt
+
+input feta-nummer;
+
+end.
+
% feta-nummer4.mf
% part of LilyPond's pretty-but-neat music font
-% size:=4;
-design_size:=16*4/15;
+design_size:=3.82; % 6.5/1.2/1.2 nummer5 = 6.5/1.2 : nummer7 = 6.5pt
input feta-nummer.mf;
% feta-nummer5.mf
% part of LilyPond's pretty-but-neat music font
-% size:=5;
-design_size:=20*4/15;
+design_size:=4.58; % 6.5/1.2 : nummer7 = 6.5pt
input feta-nummer.mf;
-% feta-nummer5.mf
+% feta-nummer7.mf
% part of LilyPond's pretty-but-neat music font
-% size:=5;
-design_size:=26*4/15;
+design_size:=6.5; % feta13 = 13pt
input feta-nummer.mf;
% feta-nummer8.mf
% part of LilyPond's pretty-but-neat music font
-design_size:=8;
+design_size:=8; % feta16 = 16pt
input feta-nummer.mf;
-% feta16.mf
+% feta23.mf
% part of LilyPond's pretty-but-neat music font
-% font_identifier:="feta16";
-% font_size 16pt#;
-
input feta-autometric;
+% why is this 22.5?
fet_beginfont("feta", 22.5);
staffsize#:=22.5pt#;
test:=0;
--- /dev/null
+
+;;;; AsciiScript as
+(define (as-scm action-name)
+
+ (define (beam width slope thick)
+ (string-append
+ (func "set-line-char" "#")
+ (func "rline-to" width (* width slope))
+ ))
+
+ ; simple flat slurs
+ (define (bezier-sandwich l thick)
+ (let (
+ (c0 (cadddr l))
+ (c1 (cadr l))
+ (c3 (caddr l)))
+ (let* ((x (car c0))
+ (dx (- (car c3) x))
+ (dy (- (cdr c3) (cdr c0)))
+ (rc (/ dy dx))
+ (c1-dx (- (car c1) x))
+ (c1-line-y (+ (cdr c0) (* c1-dx rc)))
+ (dir (if (< c1-line-y (cdr c1)) 1 -1))
+ (y (+ -1 (* dir (max (* dir (cdr c0)) (* dir (cdr c3)))))))
+ (string-append
+ (func "rmove-to" x y)
+ (func "put" (if (< 0 dir) "/" "\\\\"))
+ (func "rmove-to" 1 (if (< 0 dir) 1 0))
+ (func "set-line-char" "_")
+ (func "h-line" (- dx 1))
+ (func "rmove-to" (- dx 1) (if (< 0 dir) -1 0))
+ (func "put" (if (< 0 dir) "\\\\" "/"))))))
+
+ (define (bracket arch_angle arch_width arch_height width height arch_thick thick)
+ (string-append
+ (func "rmove-to" (+ width 1) (- (/ height -2) 1))
+ (func "put" "\\\\")
+ (func "set-line-char" "|")
+ (func "rmove-to" 0 1)
+ (func "v-line" (+ height 1))
+ (func "rmove-to" 0 (+ height 1))
+ (func "put" "/")
+ ))
+
+ (define (char i)
+ (func "char" i))
+
+ (define (define-origin a b c ) "")
+
+ (define (end-output)
+ (func "end-output"))
+
+ (define (experimental-on)
+ "")
+
+ (define (filledbox breapth width depth height)
+ (let ((dx (+ width breapth))
+ (dy (+ depth height)))
+ (string-append
+ (func "rmove-to" (* -1 breapth) (* -1 depth))
+ (if (< dx dy)
+ (string-append
+ (func "set-line-char"
+ (if (<= dx 1) "|" "#"))
+ (func "v-line" dy))
+ (string-append
+ (func "set-line-char"
+ (if (<= dy 1) "-" "="))
+ (func "h-line" dx))))))
+
+ (define (font-load-command name-mag command)
+ (func "load-font" (car name-mag) (magstep (cdr name-mag))))
+
+ (define (header creator generate)
+ (func "header" creator generate))
+
+ (define (header-end)
+ (func "header-end"))
+
+ ;; urg: this is good for half of as2text's execution time
+ (define (xlily-def key val)
+ (string-append "(define " key " " (arg->string val) ")\n"))
+
+ (define (lily-def key val)
+ (if
+ (or (equal? key "mudelapaperlinewidth")
+ (equal? key "mudelapaperstaffheight"))
+ (string-append "(define " key " " (arg->string val) ")\n")
+ ""))
+
+ (define (no-origin) "")
+
+ (define (placebox x y s)
+ (let ((ey (inexact->exact y)))
+ (string-append "(move-to " (number->string (inexact->exact x)) " "
+ (if (= 0.5 (- (abs y) (abs ey)))
+ (number->string y)
+ (number->string ey))
+ ")\n" s)))
+
+ (define (select-font name-mag-pair)
+ (let* ((c (assoc name-mag-pair font-name-alist)))
+ (if (eq? c #f)
+ (begin
+ (ly-warn
+ (string-append
+ "Programming error: No such font known "
+ (car name-mag-pair))))
+ "") ; issue no command
+ (func "select-font" (car font-name-symbol)))))
+
+ (define (start-line height)
+ (func "start-line" height))
+
+ (define (stop-line)
+ (func "stop-line"))
+
+ (define (text s)
+ (func "text" s))
+
+ (define (tuplet ht gap dx dy thick dir) "")
+
+ (define (volta h w thick vert-start vert-end)
+ ;; urg
+ (string-append
+ (func "set-line-char" "|")
+ (func "rmove-to" 0 -4)
+ ;; definition strange-way around
+ (if (= 0 vert-start)
+ (func "v-line" h)
+ "")
+ (func "rmove-to" 1 h)
+ (func "set-line-char" "_")
+ (func "h-line" (- w 1))
+ (func "set-line-char" "|")
+ (if (= 0 vert-end)
+ (string-append
+ (func "rmove-to" (- w 1) (* -1 h))
+ (func "v-line" (* -1 h)))
+ "")))
+
+ (cond ((eq? action-name 'all-definitions)
+ `(begin
+ (define beam ,beam)
+ (define bracket ,bracket)
+ (define char ,char)
+ (define define-origin ,define-origin)
+ ;;(define crescendo ,crescendo)
+ (define bezier-sandwich ,bezier-sandwich)
+ ;;(define dashed-slur ,dashed-slur)
+ ;;(define decrescendo ,decrescendo)
+ (define end-output ,end-output)
+ (define experimental-on ,experimental-on)
+ (define filledbox ,filledbox)
+ ;;(define font-def ,font-def)
+ (define font-load-command ,font-load-command)
+ ;;(define font-switch ,font-switch)
+ (define header ,header)
+ (define header-end ,header-end)
+ (define lily-def ,lily-def)
+ ;;(define invoke-char ,invoke-char)
+ ;;(define invoke-dim1 ,invoke-dim1)
+ (define no-origin ,no-origin)
+ (define placebox ,placebox)
+ (define select-font ,select-font)
+ (define start-line ,start-line)
+ ;;(define stem ,stem)
+ (define stop-line ,stop-line)
+ (define stop-last-line ,stop-line)
+ (define text ,text)
+ (define tuplet ,tuplet)
+ (define volta ,volta)
+ ))
+ ((eq? action-name 'tuplet) tuplet)
+ ;;((eq? action-name 'beam) beam)
+ ;;((eq? action-name 'bezier-sandwich) bezier-sandwich)
+ ;;((eq? action-name 'bracket) bracket)
+ ((eq? action-name 'char) char)
+ ;;((eq? action-name 'crescendo) crescendo)
+ ;;((eq? action-name 'dashed-slur) dashed-slur)
+ ;;((eq? action-name 'decrescendo) decrescendo)
+ ;;((eq? action-name 'experimental-on) experimental-on)
+ ((eq? action-name 'filledbox) filledbox)
+ ((eq? action-name 'select-font) select-font)
+ ;;((eq? action-name 'volta) volta)
+ (else (error "unknown tag -- MUSA-SCM " action-name))
+ )
+ )
+
+
(X-offset-callbacks . (,Side_position::aligned_side))
(direction . -1)
(staff-position . 0.0)
- (meta . ,(element-description "Arpeggio" arpeggio-interface side-position-interface))
+ (meta . ,(element-description "Arpeggio" arpeggio-interface side-position-interface font-interface))
))
(BarLine . (
(thin-kern . 3.0)
(hair-thickness . 1.6)
(thick-thickness . 6.0)
- (meta . ,(element-description "BarLine" bar-line-interface ))
+ (meta . ,(element-description "BarLine" bar-line-interface font-interface))
))
(BarNumber . (
(visibility-lambda . ,begin-of-line-visible)
(padding . 1.0)
(direction . 1)
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
(markup-to-properties . ,markup-to-properties)
(font-family . roman)
+
(font-relative-size . -1)
(meta . ,(element-description "BarNumber"
- text-interface break-aligned-interface))
+ text-interface font-interface break-aligned-interface))
))
(Beam . ,basic-beam-properties)
(molecule-callback . ,Clef::brew_molecule)
(before-line-breaking-callback . ,Clef::before_line_breaking)
(breakable . #t)
+ (font-family . music)
(break-align-symbol . Clef_item)
(visibility-lambda . ,begin-of-line-visible)
(Y-offset-callbacks . (,Staff_symbol_referencer::callback))
- (meta . ,(element-description "Clef" clef-interface break-aligned-interface ))
+ (meta . ,(element-description "Clef" clef-interface font-interface break-aligned-interface ))
))
(ChordNames . (
(molecule-callback . ,Chord_name::brew_molecule)
(after-line-breaking-callback . ,Chord_name::after_line_breaking)
(chord-name-function . ,default-chord-name-function)
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
(markup-to-properties . ,markup-to-properties)
- (font-relative-size . 0)
- (font-family . roman)
- (font-shape . upright)
- (meta . ,(element-description "ChordNames" chord-name-interface))
+ (meta . ,(element-description "ChordNames" font-interface chord-name-interface))
))
(NoteCollision . (
(Dots . (
(molecule-callback . ,Dots::brew_molecule)
(dot-count . 1)
+ (font-family . music)
(staff-position . 0.0)
(Y-offset-callbacks . (,Dots::quantised_position_callback ,Staff_symbol_referencer::callback))
- (meta . ,(element-description "Dots" dot-interface ))
+ (meta . ,(element-description "Dots" font-interface dot-interface ))
))
(DynamicText . (
(molecule-callback . ,Text_item::brew_molecule)
(script-priority . 100)
(font-style . dynamic)
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
(markup-to-properties . ,markup-to-properties)
(self-alignment-Y . 0)
- (meta . ,(element-description "DynamicText" text-interface ))
+ (meta . ,(element-description "DynamicText" font-interface text-interface ))
))
(DynamicLineSpanner . (
(X-offset-callbacks . (,Side_position::centered_on_parent ,Side_position::aligned_on_self))
(padding . 3.0)
(self-alignment-X . 0)
+
(font-style . finger)
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
(markup-to-properties . ,markup-to-properties)
- (meta . ,(element-description "Fingering" finger-interface text-script-interface text-interface side-position-interface))
+ (meta . ,(element-description "Fingering" finger-interface font-interface text-script-interface text-interface side-position-interface))
))
(GraceAlignment . (
(molecule-callback . ,Text_item::brew_molecule)
(break-align-symbol . Instrument_name)
(visibility-lambda . ,begin-of-line-visible)
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
(markup-to-properties . ,markup-to-properties)
(font-family . roman)
- (meta . ,(element-description "InstrumentName" text-interface break-aligned-interface))
+ (meta . ,(element-description "InstrumentName" font-interface text-interface break-aligned-interface))
))
(KeySignature . (
(break-align-symbol . Key_item)
(visibility-lambda . ,begin-of-line-visible)
(breakable . #t)
- (meta . ,(element-description "KeySignature" key-signature-interface break-aligned-interface))
+ (meta . ,(element-description "KeySignature" key-signature-interface font-interface break-aligned-interface))
))
(Accidentals . (
(direction . -1)
(left-padding . 0.2)
(right-padding . 0.4)
- (meta . ,(element-description "Accidentals" accidentals-interface))
+ (meta . ,(element-description "Accidentals" accidentals-interface font-interface ))
))
(LineOfScore . (
(non-rhythmic . #t)
(word-space . 0.6)
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
(markup-to-properties . ,markup-to-properties)
(font-family . roman)
+ (font-shape . upright)
+ (font-relative-size . 0)
- (meta . ,(element-description "LyricText" lyric-syllable-interface text-interface))
+ (meta . ,(element-description "LyricText" lyric-syllable-interface text-interface font-interface ))
))
(RehearsalMark . (
(molecule-callback . ,Text_item::brew_molecule)
(breakable . #t)
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
(markup-to-properties . ,markup-to-properties)
(font-style . mark)
(visibility-lambda . ,end-of-line-invisible)
(expand-limit . 10)
(padding . 2.0) ; staffspace
(minimum-width . 12.5) ; staffspace
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
(markup-to-properties . ,markup-to-properties)
(font-style . mmrest)
- (meta . ,(element-description "MultiMeasureRest" multi-measure-rest-interface ))
+ (meta . ,(element-description "MultiMeasureRest" multi-measure-rest-interface font-interface ))
))
(NoteColumn . (
(molecule-callback . ,Note_head::brew_molecule)
(Y-offset-callbacks . (,Staff_symbol_referencer::callback))
(meta . ,(element-description "NoteHead"
- rhythmic-head-interface
+ rhythmic-head-interface font-interface
note-head-interface ))
))
(NoteName . (
(style . default)
(molecule-callback . ,Text_item::brew_molecule)
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
(markup-to-properties . ,markup-to-properties)
- (font-family . roman)
- (font-relative-size . 0)
(meta . ,(element-description "NoteName"
- note-name-interface
- general-element-interface))
- ))
+ note-name-interface font-interface
+ general-element-interface))
+ ))
(OctavateEight . (
(self-alignment-X . 0)
(Y-offset-callbacks . (,Side_position::aligned_side))
(molecule-callback . ,Text_item::brew_molecule)
(font-shape . italic)
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
(markup-to-properties . ,markup-to-properties)
- (meta . ,(element-description "OctavateEight" text-interface ))
+ (meta . ,(element-description "OctavateEight" text-interface font-interface ))
))
(PaperColumn . (
(Script . (
(molecule-callback . ,Script::brew_molecule)
(X-offset-callbacks . (,Side_position::centered_on_parent))
- (meta . ,(element-description "Script" script-interface side-position-interface))
+ (meta . ,(element-description "Script" script-interface side-position-interface font-interface))
))
(ScriptColumn . (
(molecule-callback . ,Text_item::brew_molecule)
(break-align-symbol . Clef_item)
(visibility-lambda . ,begin-of-line-visible)
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
(markup-to-properties . ,markup-to-properties)
(font-family . roman)
-(meta . ,(element-description "StanzaNumber" break-aligned-interface text-interface))
+(meta . ,(element-description "StanzaNumber" break-aligned-interface text-interface font-interface))
))
(StaffSymbol . (
,Side_position::centered_on_parent))
(no-spacing-rods . #t)
(font-shape . italic)
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
(markup-to-properties . ,markup-to-properties)
(self-alignment-X . 0)
- (meta . ,(element-description "SostenutoPedal" text-interface ))
+ (meta . ,(element-description "SostenutoPedal" text-interface font-interface))
))
(Stem . (
; if stem is on middle line, choose this direction.
(default-neutral-direction . 1)
(X-offset-callbacks . (,Stem::off_callback))
- (meta . ,(element-description "Stem" stem-interface ))
+ (meta . ,(element-description "Stem" stem-interface font-interface))
))
(StemTremolo . (
(,Side_position::aligned_side
,Side_position::centered_on_parent))
- (meta . ,(element-description "SustainPedal" sustain-pedal-interface side-position-interface))
+ (meta . ,(element-description "SustainPedal" sustain-pedal-interface side-position-interface font-interface))
))
(SystemStartDelimiter . (
(arch-width . 1.5)
(bracket-thick . 0.25)
(bracket-width . 2.0)
+ (font-family . braces)
+ (font-point-size . 20)
(Y-extent-callback . #f)
- (meta . ,(element-description "SystemStartDelimiter" system-start-delimiter ))
+ (meta . ,(element-description "SystemStartDelimiter" system-start-delimiter font-interface))
))
(TextScript . (
(molecule-callback . ,Text_item::brew_molecule)
(no-spacing-rods . #t)
(padding . 0.5)
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
(markup-to-properties . ,markup-to-properties)
(font-family . roman)
- (meta . ,(element-description "TextScript" text-script-interface text-interface side-position-interface ))
+ (font-shape . italic)
+ (font-relative-size . 0)
+ (meta . ,(element-description "TextScript" text-script-interface text-interface side-position-interface font-interface ))
))
(TextSpanner . (
(molecule-callback . ,Text_spanner::brew_molecule)
(font-shape . italic)
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
(markup-to-properties . ,markup-to-properties)
(type . "line")
(direction . 1)
- (meta . ,(element-description "TextSpanner" text-spanner-interface ))
+ (meta . ,(element-description "TextSpanner" text-spanner-interface font-interface))
))
(Tie . (
(molecule-callback . ,Tie::brew_molecule)
(break-align-symbol . Time_signature)
(visibility-lambda . ,all-visible)
(breakable . #t)
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
(markup-to-properties . ,markup-to-properties)
(font-style . timesig)
-
- (meta . ,(element-description "TimeSignature" time-signature-interface ))
+ (meta . ,(element-description "TimeSignature" time-signature-interface font-interface))
))
(TupletBracket . (
(thick . 1.0)
(after-line-breaking-callback . ,Tuplet_spanner::after_line_breaking)
(molecule-callback . ,Tuplet_spanner::brew_molecule)
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
(markup-to-properties . ,markup-to-properties)
- (font-shape . italic)
+ (font-style . tuplet)
(meta . ,(element-description "TupletBracket" text-interface
- tuplet-bracket-interface))
+ tuplet-bracket-interface font-interface))
))
- (UnaChordaPdeal . (
+ (UnaChordaPedal . (
(molecule-callback . ,Text_item::brew_molecule)
(font-shape . italic)
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
(markup-to-properties . ,markup-to-properties)
(no-spacing-rods . #t)
(self-alignment-X . 0)
(Y-offset-callbacks .
(,Side_position::aligned_side
,Side_position::centered_on_parent))
- (meta . ,(element-description "UnaChordaPedal" text-interface ))
+ (meta . ,(element-description "UnaChordaPedal" text-interface font-interface))
))
(VoltaBracket . (
(molecule-callback . ,Volta_spanner::brew_molecule)
+
(direction . 1)
- (padding . 5)
- (properties-to-font-name . ,properties-to-font-name)
- (style-to-font-name . ,style-to-font-name)
+ (padding . 1)
(markup-to-properties . ,markup-to-properties)
(font-style . volta)
-
+ (Y-offset-callbacks . (,Side_position::aligned_side))
(thickness . 1.6) ; stafflinethickness
(height . 2.0) ; staffspace;
(minimum-space . 25)
- (meta . ,(element-description "VoltaBracket" volta-bracket-interface side-position-interface))
+ (meta . ,(element-description "VoltaBracket" volta-bracket-interface side-position-interface font-interface))
))
(VerticalAlignment . (
(define style-to-font-alist
`(
- (finger . ((font-family . number) (font-relative-size . -3)))
- (volta . ((font-family . number) (font-relative-size . -2)))
- (timesig . ((font-family . number) (font-relative-size . 0)))
- (mmrest . ((font-family . number) (font-relative-size . -1)))
- (mark . ((font-family . number) (font-relative-size . 1)))
- (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-series . bold) (font-family . dynamic) (font-relative-size . 0)))
))
(define (font-field name font-descr)
((eq? name 'font-shape) 2)
((eq? name 'font-family) 3)
((eq? name 'font-name) 4)
- ((eq? name 'font-point-size-size) 5)
+ ((eq? name 'font-point-size) 5)
+ (else (ly-warning "unknown font field name"))
)
))
(define paper20-style-sheet-alist
'(
- ((0 medium upright music feta 20) . "feta20")
- ((-1 medium upright music feta 16) . "feta16")
- ((-2 medium upright music feta 13) . "feta13")
- ((-3 medium upright music feta 13) . "feta11")
- ((-4 medium upright music feta 13) . "feta11")
- ((1 medium upright music feta 23) . "feta23")
- ((2 medium upright music feta 26) . "feta26")
- ((0 medium upright braces feta-braces 20) . "feta-braces20")
- ((0 medium italic roman cmti 10) . "cmti10")
- ((1 medium italic roman cmti 12) . "cmti12")
- ((3 bold italic dynamic feta 10) . "feta-din13")
- ((2 bold italic dynamic feta 10) . "feta-din13")
- ((1 bold italic dynamic feta 10) . "feta-din12")
- ((0 bold italic dynamic feta 10) . "feta-din10")
- ((-1 bold italic dynamic feta 10) . "feta-din8")
- ((-2 bold italic dynamic feta 10) . "feta-din7")
- ((-3 bold italic dynamic feta 10) . "feta-din6")
- ((-4 bold italic dynamic feta 10) . "feta-din5")
- ((-5 bold italic dynamic feta 10) . "feta-din4")
((3 medium upright number feta-nummer 13) . "feta-nummer13")
((2 medium upright number feta-nummer 13) . "feta-nummer13")
- ((1 medium upright number feta-nummer 12) . "feta-nummer12")
+ ((1 medium upright number feta-nummer 11) . "feta-nummer11")
((0 medium upright number feta-nummer 10) . "feta-nummer10")
((-1 medium upright number feta-nummer 8) . "feta-nummer8")
((-2 medium upright number feta-nummer 6) . "feta-nummer6")
((-3 medium upright roman cmr 6) . "cmr6" )
((-4 medium upright roman cmr 5) . "cmr5" )
((-5 medium upright roman cmr 4) . "cmr4" )
+ ((-1 medium italic roman cmti 8) . "cmti8")
+ ((0 medium italic roman cmti 10) . "cmti10")
+ ((1 medium italic roman cmti 12) . "cmti12")
((2 bold upright roman cmbx 10) . "cmbx10")
((1 bold upright roman cmbx 12) . "cmbx12")
+ ((2 bold upright roman cmbx 14) . "cmbx14")
((-3 medium upright math msam 10) . "msam10")
((-2 medium upright math msam 10) . "msam10")
((-1 medium upright math msam 10) . "msam10")
((0 medium upright math msam 10) . "msam10")
- ))
-
+ ;; should use the same brace font every where and fix C++ code.
+ ((0 medium upright braces feta-braces 20) . "feta-braces20")
+ ((2 medium upright braces feta-braces 26) . "feta-braces26")
+ ((1 medium upright braces feta-braces 23) . "feta-braces23")
+ ((3 bold italic dynamic feta 16) . "feta-din16")
+ ((2 bold italic dynamic feta 16) . "feta-din16")
+ ((3 bold italic dynamic feta 10) . "feta-din13")
+ ((2 bold italic dynamic feta 10) . "feta-din13")
+ ((1 bold italic dynamic feta 10) . "feta-din12")
+ ((0 bold italic dynamic feta 10) . "feta-din10")
+ ((-1 bold italic dynamic feta 10) . "feta-din8")
+ ((-2 bold italic dynamic feta 10) . "feta-din7")
+ ((-3 bold italic dynamic feta 10) . "feta-din6")
+ ((-4 bold italic dynamic feta 10) . "feta-din5")
+ ((-5 bold italic dynamic feta 10) . "feta-din4")
+ ((0 medium upright music feta 20) . "feta20")
+ ((-1 medium upright music feta 16) . "feta16")
+ ((-2 medium upright music feta 13) . "feta13")
+ ((-3 medium upright music feta 13) . "feta11")
+ ((-4 medium upright music feta 13) . "feta11")
+ ((1 medium upright music feta 23) . "feta23")
+ ((2 medium upright music feta 26) . "feta26")
+ ((-1 medium upright math msam 10) . "msam10")
+ ((-2 medium upright math msam 10) . "msam10")
+ ((-3 medium upright math msam 10) . "msam10")
+ ))
-;; return a FONT-DESCR with relative size incremented by INCREMENT
-(define (change-relative-size font-desc increment)
- (cons (+ increment (car font-desc)) (cdr font-desc))
+;; return a FONT-DESCR with relative size decremented by DECREMENT
+(define (change-relative-size font-desc decrement)
+ (cons (- (car font-desc) decrement) (cdr font-desc))
)
;; map a function FUNC over the keys of an alist LIST, leaving the vals.
;; make style sheet for each paper version.
-(define style-sheet-alist
+(define font-list-alist
(map-alist-vals (lambda (x) (change-style-sheet-relative-size
paper20-style-sheet-alist x))
'((paper11 . -3)
)
+(define (make-style-sheet sym)
+ `((fonts . ,(cdr (assoc sym font-list-alist)))
+ (font-defaults
+ . ((font-family . music)
+ (font-relative-size . 0)
+ (font-shape . upright)
+ (font-series . medium)
+ ))
+ (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) (font-relative-size . 0)))
+ (mmrest . ((font-family . number) (font-relative-size . 1)))
+ (mark . ((font-family . number) (font-relative-size . 1)))
+ (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-series . bold) (font-family . dynamic) (font-relative-size . 0)))
+ ))
+ (properties-to-font . ,properties-to-font-name)
+
+ ;; FIXME: this is a not-so-cool idea to use ALIGN
+ ;; RAISE, LOOKUP, since they are not proper elt-properties,
+ ;; and might interfere with them.
+ (markup-abbrev-to-properties-alist
+ . ((rows . ((align . 0)))
+ (lines . ((align . 1)))
+ (roman . ((font-family . roman)))
+ (music . ((font-family . music)))
+ (finger . ((font-style . finger)))
+ (bold . ((font-series . bold)))
+ (italic . ((font-shape . italic)))
+ (named . ((lookup . name)))
+ (super . ((raise . 1) (font-relative-size . -1)))
+ (sub . ((raise . -1) (font-relative-size . -1)))
+ (text . ((lookup . value)))
+ )
+ )
+
+ )
+ )
+
+
+
(define (font-regexp-to-font-name paper regexp)
(let ((style-sheet (cdr (assoc paper style-sheet-alist))))
(let loop ((fonts style-sheet))
'())))))
;; reduce the font list by successively applying a font-qualifier.
-(define (qualifiers-to-fontname qualifiers font-descr-alist)
+(define (qualifiers-to-fontnames qualifiers font-descr-alist)
(if (null? qualifiers)
- (if (null? font-descr-alist)
- ""
- (cdar font-descr-alist)) ; return the topmost.
+ font-descr-alist
- (qualifiers-to-fontname
+ (qualifiers-to-fontnames
(cdr qualifiers)
(filter-field (caar qualifiers) (cdar qualifiers) font-descr-alist)
)
))
-(define (properties-to-font-name paper properties-alist)
+
+;; does FONT-DESC satisfy QUALIFIERS?
+(define (font-qualifies? qualifiers font-desc)
+ (if (null? qualifiers) #t
+ (if (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))
+ )
+ ))
+
+
+;; return a single font from FONTS (or a default, if none found)
+;; and warn if the selected font is not unique.
+(define (select-unique-font qualifiers fonts)
(let* (
- (fonts (cdr (assoc paper style-sheet-alist)))
+ (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.
+
+ ))
+
+(define (chain-assoc x alist-list)
+ (if (null? alist-list)
+ #f
+ (let* (
+ (handle (assoc x (car alist-list)))
+ )
+ (if (pair? handle)
+ handle
+ (chain-assoc x (cdr alist-list))
+ )
+ )
+ )
+ )
+
+;; TODO
+;; add support for override by font-name
+;; very often-used; hard-code in C++, and use SCM glue code.
+
+(define (properties-to-font-name fonts properties-alist-list)
+ (let* (
;; change order to change priorities of qualifiers.
(q-order '(font-name font-family font-series font-shape font-point-size font-relative-size))
- (rawqualifiers (map (lambda (x) (assoc x properties-alist))
+ (rawqualifiers (map (lambda (x) (chain-assoc x properties-alist-list))
q-order))
-
(qualifiers (filter-list pair? rawqualifiers))
- (fontnm (qualifiers-to-fontname qualifiers fonts))
- (err (current-error-port))
+ (selected (find-first-font qualifiers fonts))
+ (err (current-error-port))
)
- (if (eq? fontnm "")
+ (if (equal? selected "")
(begin
- (display "\ncouldn't find font satisfying " err)
+ (display "\ncouldn't find any font satisfying " err)
(write qualifiers err)
- (display "\n" err)
"cmr10"
)
- fontnm)
-
-
+ selected) ; return the topmost.
))
-
(define markup-abbrev-to-properties-alist
(append
- '(
- (rows . ((align . 0)))
- (lines . ((align . 1)))
- (roman . ((font-family . roman)))
- (music . ((font-family . music)))
- (finger . ((font-style . finger)))
- (bold . ((font-series . bold)))
- (italic . ((font-shape . italic)))
- (named . ((lookup . name)))
- (super . ((raise . 1) (font-relative-size . -1)))
- (sub . ((raise . -1) (font-relative-size . -1)))
- (text . ((lookup . value)))
- )
- (map (lambda (x) (cons (car x) (cons 'font-style (car x))))
+ (map (lambda (x) (cons (car x) (cons 'font-style (car x))))
style-to-font-alist)))
-
+
(define (markup-to-properties markup)
;;(display "markup: `")
;;(display markup)
; fixme, how's this supposed to work?
; and why don't we import font-setting from elt?
-(define (style-to-font-name paper style)
+(define (style-to-font-name sheet style)
(let* ((entry (assoc style style-to-font-alist))
- (qs (if entry (cdr entry) '()))
- (sheet (cdr (assoc paper style-sheet-alist)))
- (fontnm (qualifiers-to-fontname qs sheet))
- (err (current-error-port)))
- (if (eq? fontnm "")
+ (qualifiers (if entry (cdr entry) '()))
+ (font (find-first-font qualifiers sheet))
+ (err (current-error-port))
+ )
+
+ (if (equal? font "")
(begin
- (display "\ncouldn't find font satisfying " err)
- (display qs err)
- (display "\n" err)
- "cmr10")
- fontnm)))
+ (display "\ncouldn't find any font satisfying " err)
+ (write qualifiers err)
+ "cmr10"
+ )
+ font) ; return the topmost.
+ ))
-
+
; (define (test-module)
(property-description 'dot-count integer? "number of dots")
)))
+(define font-interface
+ (lily-interface
+ 'font-interface
+ "Any symbol that is typeset through fixed sets of glyphs (ie. fonts)"
+ (list
+ (property-description 'font-style symbol? "a precooked set of font definitions, eg. finger volta timesig mark script large Large dynamic")
+ (property-description 'font-series symbol? "partial font definition: medium, bold")
+ (property-description 'font-shape symbol? "partial font definition: upright or italic")
+ (property-description 'font-family symbol? "partial font definition: music roman braces dynamic math ...")
+ (property-description 'font-name symbol? "partial font definition: base name of font file FIXME: should override other partials")
+ (property-description 'font-point-size number? "partial font definition: exact font size in points FIXME: should override font-relative-size")
+ (property-description 'font-relative-size number? "partial font definition: the relative size, 0 is style-sheet's normal size, -1 is smaller, +1 is bigger")
+ )))
+
+
(define text-interface
(lily-interface
'text-interface
<dt> any font-style<dd> finger volta timesig mmrest mark script large Large dynamic
</dl>
" )
- (property-description 'font-style symbol? "font definition for a special purpose, one of: finger volta timesig mark script large Large dynamic")
- (property-description 'font-series symbol? "partial font definition: medium, bold")
- (property-description 'font-shape symbol? "partial font definition: upright or italic")
- (property-description 'font-family symbol? "partial font definition: music roman braces dynamic math ...")
- (property-description 'font-name symbol? "partial font definition: base name of font file FIXME: should override other partials")
- (property-description 'font-point-size number? "partial font definition: exact font size in points FIXME: should override font-relative-size")
- (property-description 'font-relative-size number? "partial font definition: the relative size, 0 is style-sheet's normal size, -1 is smaller, +1 is bigger")
-
;; Should move this somewhere else?
(property-description 'align number? "the alignment of the text, 0 is horizontal, 1 is vertical")
(property-description 'lookup symbol? "lookup method: 'value for plain text, 'name for character-name")
;
; (c) 1998 Jan Nieuwenhuizen <janneke@gnu.org>
-
;
; This file contains various routines in Scheme that are easier to
; do here than in C++. At present it is an unorganised mess. Sorry.
;
-
; We should repartition the entire scm side of lily in a
; more sane way, using namesspaces/modules?
(define (number-pair? x)
(and (pair? x) (number? (car x)) (number? (cdr x))))
+(define (object-type obj)
+ (cond
+ ((dir? obj) "direction")
+ ((number-pair? obj) "pair of numbers")
+ ((ly-input-location? obj) "input location")
+ ((ly-element? obj) "graphic element")
+ ((pair? obj) "pair")
+ ((integer? obj) "integer")
+ ((list? obj) "list")
+ ((symbol? obj) "symbol")
+ ((string? obj) "string")
+ ((boolean? obj) "boolean")
+ ((moment? obj) "moment")
+ ((number? obj) "number")
+ ((char? obj) "char")
+ ((input-port? obj) "input port")
+ ((output-port? obj) "output port")
+ ((vector? obj) "vector")
+ ((procedure? obj) "procedure")
+ (else "unknown type")
+ ))
+
+
(define (type-name predicate)
(cond
((eq? predicate dir?) "direction")
(if (< duration 0) "mensural" "")))
((default) (number->string duration))
(else
- (string-append (number->string duration) (symbol->string style)))))
+ (string-append (number->string duration) (symbol->string style))))
+ )
;;;;;;;; TeX
-;; this is silly, can't we use something like
-;; roman-0, roman-1 roman+1 ?
-(define cmr-alist
- '(("bold" . "cmbx")
- ("brace" . "feta-braces")
- ("default" . "cmr10")
- ("dynamic" . "feta-din")
- ("feta" . "feta")
- ("feta-1" . "feta")
- ("feta-2" . "feta")
- ("typewriter" . "cmtt")
- ("italic" . "cmti")
- ("msam" . "msam")
- ("roman" . "cmr")
- ("script" . "cmr")
- ("large" . "cmbx")
- ("Large" . "cmbx")
- ("mark" . "feta-nummer")
- ("finger" . "feta-nummer")
- ("timesig" . "feta-nummer")
- ("number" . "feta-nummer")
- ("volta" . "feta-nummer"))
-)
-
(define (string-encode-integer i)
(cond
((= i 0) "o")
(else (string-append
(make-string 1 (integer->char (+ 65 (modulo i 26))))
(string-encode-integer (quotient i 26))
- )
+ ))
)
)
- )
-(define (magstep i)
- (cdr (assoc i '((-4 . 482)
- (-3 . 579)
- (-2 . 694)
- (-1 . 833)
- (0 . 1000)
- (1 . 1200)
- (2 . 1440)
- (3 . 1728)
- (4 . 2074))
- )
- )
- )
-
(define default-script-alist '())
(define font-name-alist '())
-(define (font-command name-mag)
- (cons name-mag
- (string-append "magfont"
- (string-encode-integer (hashq (car name-mag) 1000000))
+(define (tex-encoded-fontswitch name-mag)
+ (let* (
+ (iname-mag (car name-mag))
+ (ename-mag (cdr name-mag))
+ )
+ (cons iname-mag
+ (cons ename-mag
+ (string-append "magfont"
+ (string-encode-integer
+ (hashq (car ename-mag) 1000000))
"m"
- (string-encode-integer (cdr name-mag)))
+ (string-encode-integer
+ (inexact->exact (* 1000 (cdr ename-mag))))
- )
- )
-(define (define-fonts names)
- (set! font-name-alist (map font-command names))
+ )
+ )
+ )))
+
+(define (define-fonts internal-external-name-mag-pairs)
+ (set! font-name-alist (map tex-encoded-fontswitch
+ internal-external-name-mag-pairs))
(apply string-append
(map (lambda (x)
- (font-load-command (car x) (cdr x))) font-name-alist)
- ))
+ (font-load-command (car x) (cdr x)))
+ (map cdr font-name-alist)
-(define (fontify name exp)
- (string-append (select-font name)
+ )))
+
+(define (fontify name-mag-pair exp)
+ (string-append (select-font name-mag-pair)
exp)
)
"%\n\\unknown%\n")
- (define (select-font font-name-symbol)
+ (define (select-font name-mag-pair)
(let*
(
- (c (assoc font-name-symbol font-name-alist))
+ (c (assoc name-mag-pair font-name-alist))
)
(if (eq? c #f)
(begin
+ (display "FAILED\n")
+ (display (object-type (car name-mag-pair)))
+ (display (object-type (caaar font-name-alist)))
+
(ly-warn (string-append
- "Programming error: No such font known " (car font-name-symbol)))
- "") ; issue no command
- (string-append "\\" (cdr c)))
+ "Programming error: No such font known "
+ (car name-mag-pair) " "
+ (number->string (cdr name-mag-pair))
+ ))
+ "") ; issue no command
+ (string-append "\\" (cddr c)))
))
(define (font-load-command name-mag command)
(string-append
"\\font\\" command "="
- (symbol->string (car name-mag))
+ (car name-mag)
" scaled "
- (number->string (magstep (cdr name-mag)))
+ (number->string (inexact->exact (* 1000 (cdr name-mag))))
"\n"))
(define (embedded-ps s)
(ly-gulp-file "lily.ps") 'pre " %\n" 'post)
(ly-gulp-file "lily.ps"))
"}"
- "\\input lilyponddefs \\turnOnPostScript"))
+ "\\input lilyponddefs\\newdimen\\outputscale \\outputscale=\\mudelapaperoutputscale pt\\turnOnPostScript"))
(define (header creator generate)
(string-append
(define (number->dim x)
(string-append
- (ly-number->string x) " pt "))
+ (ly-number->string x) " \\outputscale "))
(define (placebox x y s)
(string-append
"lilyfont"
(make-string 1 (integer->char (+ 65 i)))))
- (define (mag-to-size m)
- (number->string (case m
- (0 12)
- (1 12)
- (2 14) ; really: 14.400
- (3 17) ; really: 17.280
- (4 21) ; really: 20.736
- (5 24) ; really: 24.888
- (6 30) ; really: 29.856
- )))
-
-
- (define (select-font font-name-symbol)
+
+ (define (select-font name-mag-pair)
(let*
(
- (c (assoc font-name-symbol font-name-alist))
+ (c (assoc name-mag-pair font-name-alist))
)
(if (eq? c #f)
(begin
+ (display name-mag-pair)
+ (display font-name-alist)
(ly-warn (string-append
- "Programming error: No such font known " (car font-name-symbol)))
- "") ; issue no command
+ "Programming error: No such font known " (car name-mag-pair))
+ (number->string (cdr name-mag-pair))
+ )
+
+ "") ; issue no command
(string-append " " (cdr c) " "))
-
-
))
(define (font-load-command name-mag command)
" { /"
(symbol->string (car name-mag))
" findfont "
- (number->string (magstep (cdr name-mag)))
+ (number->string (cdr name-mag))
" 1000 div 12 mul scalefont setfont } bind def "
"\n"))
((string? arg) (string-append "\"" arg "\""))
((symbol? arg) (string-append "\"" (symbol->string arg) "\""))))
+; ugh: naming.
(define (func name . args)
(string-append
"(" name
1
(if (< x 0) -1 1)))
-;;;; AsciiScript as
-(define (as-scm action-name)
-
- (define (beam width slope thick)
- (string-append
- (func "set-line-char" "#")
- (func "rline-to" width (* width slope))
- ))
-
- ; simple flat slurs
- (define (bezier-sandwich l thick)
- (let (
- (c0 (cadddr l))
- (c1 (cadr l))
- (c3 (caddr l)))
- (let* ((x (car c0))
- (dx (- (car c3) x))
- (dy (- (cdr c3) (cdr c0)))
- (rc (/ dy dx))
- (c1-dx (- (car c1) x))
- (c1-line-y (+ (cdr c0) (* c1-dx rc)))
- (dir (if (< c1-line-y (cdr c1)) 1 -1))
- (y (+ -1 (* dir (max (* dir (cdr c0)) (* dir (cdr c3)))))))
- (string-append
- (func "rmove-to" x y)
- (func "put" (if (< 0 dir) "/" "\\\\"))
- (func "rmove-to" 1 (if (< 0 dir) 1 0))
- (func "set-line-char" "_")
- (func "h-line" (- dx 1))
- (func "rmove-to" (- dx 1) (if (< 0 dir) -1 0))
- (func "put" (if (< 0 dir) "\\\\" "/"))))))
-
- (define (bracket arch_angle arch_width arch_height width height arch_thick thick)
- (string-append
- (func "rmove-to" (+ width 1) (- (/ height -2) 1))
- (func "put" "\\\\")
- (func "set-line-char" "|")
- (func "rmove-to" 0 1)
- (func "v-line" (+ height 1))
- (func "rmove-to" 0 (+ height 1))
- (func "put" "/")
- ))
-
- (define (char i)
- (func "char" i))
-
- (define (define-origin a b c ) "")
-
- (define (end-output)
- (func "end-output"))
-
- (define (experimental-on)
- "")
-
- (define (filledbox breapth width depth height)
- (let ((dx (+ width breapth))
- (dy (+ depth height)))
- (string-append
- (func "rmove-to" (* -1 breapth) (* -1 depth))
- (if (< dx dy)
- (string-append
- (func "set-line-char"
- (if (<= dx 1) "|" "#"))
- (func "v-line" dy))
- (string-append
- (func "set-line-char"
- (if (<= dy 1) "-" "="))
- (func "h-line" dx))))))
-
- (define (font-load-command name-mag command)
- (func "load-font" (car name-mag) (magstep (cdr name-mag))))
-
- (define (header creator generate)
- (func "header" creator generate))
-
- (define (header-end)
- (func "header-end"))
-
- ;; urg: this is good for half of as2text's execution time
- (define (xlily-def key val)
- (string-append "(define " key " " (arg->string val) ")\n"))
-
- (define (lily-def key val)
- (if
- (or (equal? key "mudelapaperlinewidth")
- (equal? key "mudelapaperstaffheight"))
- (string-append "(define " key " " (arg->string val) ")\n")
- ""))
-
- (define (no-origin) "")
-
- (define (placebox x y s)
- (let ((ey (inexact->exact y)))
- (string-append "(move-to " (number->string (inexact->exact x)) " "
- (if (= 0.5 (- (abs y) (abs ey)))
- (number->string y)
- (number->string ey))
- ")\n" s)))
-
- (define (select-font font-name-symbol)
- (let* ((c (assoc font-name-symbol font-name-alist)))
- (if (eq? c #f)
- (begin
- (ly-warn
- (string-append
- "Programming error: No such font known "
- (car font-name-symbol)))
- "") ; issue no command
- (func "select-font" (car font-name-symbol)))))
-
- (define (start-line height)
- (func "start-line" height))
-
- (define (stop-line)
- (func "stop-line"))
-
- (define (text s)
- (func "text" s))
-
- (define (tuplet ht gap dx dy thick dir) "")
-
- (define (volta h w thick vert-start vert-end)
- ;; urg
- (string-append
- (func "set-line-char" "|")
- (func "rmove-to" 0 -4)
- ;; definition strange-way around
- (if (= 0 vert-start)
- (func "v-line" h)
- "")
- (func "rmove-to" 1 h)
- (func "set-line-char" "_")
- (func "h-line" (- w 1))
- (func "set-line-char" "|")
- (if (= 0 vert-end)
- (string-append
- (func "rmove-to" (- w 1) (* -1 h))
- (func "v-line" (* -1 h)))
- "")))
-
- (cond ((eq? action-name 'all-definitions)
- `(begin
- (define beam ,beam)
- (define bracket ,bracket)
- (define char ,char)
- (define define-origin ,define-origin)
- ;;(define crescendo ,crescendo)
- (define bezier-sandwich ,bezier-sandwich)
- ;;(define dashed-slur ,dashed-slur)
- ;;(define decrescendo ,decrescendo)
- (define end-output ,end-output)
- (define experimental-on ,experimental-on)
- (define filledbox ,filledbox)
- ;;(define font-def ,font-def)
- (define font-load-command ,font-load-command)
- ;;(define font-switch ,font-switch)
- (define header ,header)
- (define header-end ,header-end)
- (define lily-def ,lily-def)
- ;;(define invoke-char ,invoke-char)
- ;;(define invoke-dim1 ,invoke-dim1)
- (define no-origin ,no-origin)
- (define placebox ,placebox)
- (define select-font ,select-font)
- (define start-line ,start-line)
- ;;(define stem ,stem)
- (define stop-line ,stop-line)
- (define stop-last-line ,stop-line)
- (define text ,text)
- (define tuplet ,tuplet)
- (define volta ,volta)
- ))
- ((eq? action-name 'tuplet) tuplet)
- ;;((eq? action-name 'beam) beam)
- ;;((eq? action-name 'bezier-sandwich) bezier-sandwich)
- ;;((eq? action-name 'bracket) bracket)
- ((eq? action-name 'char) char)
- ;;((eq? action-name 'crescendo) crescendo)
- ;;((eq? action-name 'dashed-slur) dashed-slur)
- ;;((eq? action-name 'decrescendo) decrescendo)
- ;;((eq? action-name 'experimental-on) experimental-on)
- ((eq? action-name 'filledbox) filledbox)
- ((eq? action-name 'select-font) select-font)
- ;;((eq? action-name 'volta) volta)
- (else (error "unknown tag -- MUSA-SCM " action-name))
- )
- )
-
-
(define (gulp-file name)
(let* ((port (open-file name "r"))
(content (let loop ((text ""))
% header info (macros/defs, etc) should go into a \special{! ... },
% note the ! sign. See dvips.info for details.
%
-
+\def\lilySpace{ }
\def\turnOnPostScript{%
% This sets CTM so that you get to the currentpoint
% by executing a 0 0 moveto
\def\embeddedps##1{%
- \special{ps: @beginspecial @setspecial ##1 @endspecial}
+ \special{ps: @beginspecial @setspecial
+ \mudelapaperoutputscale\lilySpace\mudelapaperoutputscale\lilySpace scale ##1 @endspecial}%
}
}
projects / lilypond.git / commitdiff