+2002-04-01 Han-Wen <hanwen@cs.uu.nl>
+
+ * lily/tuplet-bracket.cc (make_bracket): new function
+ (get_x_offset): new function; make tuplet brackets align on stems
+ if stem has same direction.
+ (parallel_beam): be anal about matching bracket to tuplet.
+
+ * lily/lookup.cc (line): new function Lookup::line().
+
+ * scm/tex.scm (dashed-line): change -line to -system in names.
+
+ * lily/box.cc (add_point): new function.
+
+ * flower/include/interval.hh: new function add_point ().
+ new function widen()
+
2002-04-01 Jan Nieuwenhuizen <janneke@gnu.org>
* .cvsignore: Ignore all kinds of lilypond input and output.
datadir=`echo "@datadir@" | sed 's!//!/!g'`
+
# For direct ps output: ps/lilyponddefs.ps
GS_LIB="$datadir/ps:"${GS_LIB:=""}
+export GS_LIB
# bit silly. for ly2dvi, overrules compiled-in datadir...
# Better comment this out. Compiled-in datadir serves exactly the
# Add the installation directory to the teTeX system tree,
# see Documentation/misc/fontinstallation
TEXMF="{$datadir,"`kpsexpand \\$TEXMF`"}"
+export TEXMF
# LILYPONDPREFIX="$datadir"
# export LILYPONDPREFIX
# For direct ps output fonts. Add all available TeX Type1 fonts
-GS_FONTPATH=`kpsewhich -expand-path=\$T1FONTS`:${GS_FONTPATH:=""}
-
-
-
-export GS_LIB GS_FONTPATH TEXMF
+GS_FONTPATH=`kpsewhich -expand-path=\\$T1FONTS`:${GS_FONTPATH:=""}
+export GS_FONTPATH
elem (LEFT) += t;
elem (RIGHT) += t;
}
+ void widen (T t)
+ {
+ elem (LEFT) -= t;
+ elem (RIGHT) += t;
+ }
/**
PRE
*/
void unite (Interval_t<T> h);
void intersect (Interval_t<T> h);
-
+ void add_point (T p) {
+ elem(LEFT) = elem (LEFT) <? p;
+ elem(RIGHT) = elem (RIGHT) >? p;
+ }
T length () const;
T delta () const;
void set_empty () ;
\version "1.3.146"
\header{
+
texidoc="
Tuplets are indicated by a bracket with a number. There should be no
-bracket if there is one beam that matches the length of the tuplet.
+bracket if there is a beam exactly matching the length of the tuplet.
The bracket does not interfere with the stafflines, and the number is
centered in the gap in the bracket.
+
+The bracket stops at the end of the stems, if the stems have the same
+direction as the
+
+
"
+
}
+
\score{
\notes \context Voice \relative c'' {
\times 2/3 { \times 2/3 { a8 b c} c }
(c) 1997--2002 Han-Wen Nienhuys <hanwen@cs.uu.nl>
*/
+
#include <math.h>
#include "lookup.hh"
interval_a_[X_AXIS] *= s;
interval_a_[Y_AXIS] *= s;
}
+
+void
+Box::add_point (Offset o)
+{
+ interval_a_[X_AXIS].add_point (o[X_AXIS]);
+ interval_a_[Y_AXIS].add_point (o[Y_AXIS]);
+}
void translate (Offset o);
/// smallest box enclosing #b#
void set_empty ();
+ void add_point (Offset);
void scale (Real r);
void unite (Box b);
Box ();
static Molecule filledbox (Box b);
static Molecule roundfilledbox (Box b, Real blotdiameter);
static Molecule repeat_slash (Real w, Real slope, Real th);
+ static Molecule line (Real th, Offset from, Offset to);
};
#endif // LOOKUP_HH
-
/*
tuplet-bracket.hh -- part of GNU LilyPond
static void add_column (Grob*me,Item*);
static void add_beam (Grob*me,Grob*);
-
+ static Grob *parallel_beam (Grob *me, Link_array<Grob> cols, bool *equally_long);
static void calc_dy (Grob*,Real *) ;
static void calc_position_and_height (Grob*,Real*,Real *dy);
DECLARE_SCHEME_CALLBACK (after_line_breaking, (SCM ));
+ DECLARE_SCHEME_CALLBACK (before_line_breaking, (SCM ));
+ static Molecule make_bracket (Axis protusion_axis,
+ Real dx, Real dy, Real thick, Real lprotrusion,
+ Real rprotrusion, Real gap, Real left_widen,
+ Real right_widen);
static Direction get_default_dir (Grob*);
};
return Molecule (box, at);
}
+Molecule
+Lookup::line (Real th, Offset f, Offset t)
+{
+ SCM at = (scm_list_n (ly_symbol2scm ("draw-line"),
+ gh_double2scm (th),
+ gh_double2scm (f[X_AXIS]),
+ gh_double2scm (f[Y_AXIS]),
+ gh_double2scm (t[X_AXIS]),
+ gh_double2scm (t[Y_AXIS]),
+ SCM_UNDEFINED));
+
+ Box box;
+ box.add_point (f);
+ box.add_point (t);
+
+ box[X_AXIS].widen (th/2);
+ box[Y_AXIS].widen (th/2);
+
+ return Molecule (box, at);
+}
+
+
Molecule
Lookup::blank (Box b)
{
/*
line preamble.
*/
- output_scheme (scm_list_n (ly_symbol2scm ("start-line"),
+ output_scheme (scm_list_n (ly_symbol2scm ("start-system"),
gh_double2scm (height),
SCM_UNDEFINED));
if (last_line)
{
- output_scheme (scm_list_n (ly_symbol2scm ("stop-last-line"), SCM_UNDEFINED));
+ output_scheme (scm_list_n (ly_symbol2scm ("stop-last-system"), SCM_UNDEFINED));
}
else
{
- output_scheme (scm_list_n (ly_symbol2scm ("stop-line"), SCM_UNDEFINED));
+ output_scheme (scm_list_n (ly_symbol2scm ("stop-system"), SCM_UNDEFINED));
}
}
(c) 1997--2002 Jan Nieuwenhuizen <janneke@gnu.org>
*/
+/*
+ TODO:
+
+ - tuplet bracket should probably be subject to the same rules as
+ beam sloping/quanting.
+
+ - There is no support for kneed brackets, or nested brackets.
+
+ - number placement for parallel beams should be much more advanced:
+ for sloped beams some extra horizontal offset must be introduced.
+
+ - number placement is usually done over the center note, not the
+ graphical center.
+
+ */
+
#include <math.h>
#include "beam.hh"
#include "debug.hh"
#include "font-interface.hh"
#include "molecule.hh"
-#include "paper-column.hh"
#include "paper-def.hh"
#include "text-item.hh"
#include "tuplet-bracket.hh"
#include "stem.hh"
#include "note-column.hh"
-#include "dimensions.hh"
#include "group-interface.hh"
#include "directional-element-interface.hh"
#include "spanner.hh"
#include "staff-symbol-referencer.hh"
+#include "lookup.hh"
+
+
+static Real
+get_x_offset (Grob *g, Grob *common, Direction my_dir)
+{
+ if (Note_column::stem_l (g)
+ && Note_column::dir (g) == my_dir)
+ {
+ g = Note_column::stem_l (g);
+ }
+ return g->relative_coordinate (common, X_AXIS);
+}
+
+
+
+Grob*
+Tuplet_bracket::parallel_beam (Grob *me, Link_array<Grob> cols, bool *equally_long)
+{
+ /*
+ ugh: code dup.
+ */
+ Grob *s1 = Note_column::stem_l (cols[0]);
+ Grob *s2 = Note_column::stem_l (cols.top());
+
+ Grob*b1 = s1 ? Stem::beam_l (s1) : 0;
+ Grob*b2 = s2 ? Stem::beam_l (s2) : 0;
+
+ Spanner*sp = dynamic_cast<Spanner*> (me);
+
+ *equally_long= false;
+ if (! ( b1 && (b1 == b2) && !sp->broken_b() ))
+ return 0;
+
+ Link_array<Grob> beam_stems = Pointer_group_interface__extract_grobs
+ (b1, (Grob*)0, "stems");
+
+
+ *equally_long = (beam_stems[0] == s1 && beam_stems.top() == s2);
+ return b1;
+}
+
/*
TODO:
Grob *me= unsmob_grob (smob);
Molecule mol;
Link_array<Grob> column_arr=
- Pointer_group_interface__extract_grobs (me, (Grob*)0, "columns");
-
+ Pointer_group_interface__extract_grobs (me, (Grob*)0, "note-columns");
if (!column_arr.size ())
return mol.smobbed_copy ();
+ bool equally_long = false;
+ Grob * par_beam = parallel_beam (me, column_arr, &equally_long);
- Grob *b1 = Note_column::stem_l (column_arr[0]);
- Grob *b2 = Note_column::stem_l (column_arr.top());
-
- b1 = b1 ? Stem::beam_l (b1) : 0;
- b2 = b2 ? Stem::beam_l (b2) : 0;
-
-
Spanner*sp = dynamic_cast<Spanner*> (me);
- // Default behaviour: number always, bracket when no beam!
- bool par_beam = b1 && (b1 == b2) && !sp->broken_b() ;
-
- bool bracket_visibility = !par_beam;
+ bool bracket_visibility = !(par_beam && equally_long);
bool number_visibility = true;
- SCM bracket = me->get_grob_property ("tuplet-bracket-visibility");
+ /*
+ Fixme: the type of this prop is sucky.
+ */
+ SCM bracket = me->get_grob_property ("bracket-visibility");
if (gh_boolean_p (bracket))
{
bracket_visibility = gh_scm2bool (bracket);
else if (bracket == ly_symbol2scm ("if-no-beam"))
bracket_visibility = !par_beam;
- SCM numb = me->get_grob_property ("tuplet-number-visibility");
+ SCM numb = me->get_grob_property ("number-visibility");
if (gh_boolean_p (numb))
{
number_visibility = gh_scm2bool (numb);
}
else if (numb == ly_symbol2scm ("if-no-beam"))
number_visibility = !par_beam;
-
- Real ncw = column_arr.top ()->extent (column_arr.top (), X_AXIS).length ();
- Real w = sp->spanner_length () + ncw;
-
+ Grob * commonx = column_arr[0]->common_refpoint (column_arr.top (),X_AXIS);
Direction dir = Directional_element_interface::get (me);
- Real dy = gh_scm2double (me->get_grob_property ("delta-y"));
+
+ Real x0 = get_x_offset (column_arr[0], commonx, dir);
+ Real x1 = get_x_offset (column_arr.top(), commonx, dir);
+ Real w = x1 -x0;
+
+ Real ly = gh_scm2double (me->get_grob_property ("left-position"));
+ Real ry = gh_scm2double (me->get_grob_property ("right-position"));
SCM number = me->get_grob_property ("text");
+
if (gh_string_p (number) && number_visibility)
{
SCM properties = Font_interface::font_alist_chain (me);
num.translate_axis (w/2, X_AXIS);
num.align_to (Y_AXIS, CENTER);
- num.translate_axis (dy/2, Y_AXIS);
+ num.translate_axis ((ry-ly)/2, Y_AXIS);
mol.add_molecule (num);
}
if (bracket_visibility)
{
Real lt = me->paper_l ()->get_var ("linethickness");
-
- SCM thick = me->get_grob_property ("thick");
- SCM gap = me->get_grob_property ("number-gap");
-
- SCM at =scm_list_n (ly_symbol2scm ("tuplet"),
- gh_double2scm (1.0),
- gap,
- gh_double2scm (w),
- gh_double2scm (dy),
- gh_double2scm (gh_scm2double (thick)* lt),
- gh_int2scm (dir),
- SCM_UNDEFINED);
-
- Box b;
- mol.add_molecule (Molecule (b, at));
+
+ SCM thick = me->get_grob_property ("thickness");
+ if (gh_number_p (thick))
+ lt *= gh_scm2double (thick);
+
+ SCM gap = me->get_grob_property ("gap");
+
+ Real prot_size = 0.7; // magic.
+
+ Molecule brack = make_bracket (Y_AXIS,
+ w, ry-ly, lt,
+ -prot_size*dir, -prot_size*dir,
+ gh_scm2double (gap),
+ 0.0, 0.0);
+ mol.add_molecule (brack);
}
+ mol.translate_axis (ly, Y_AXIS);
+ mol.translate_axis (x0 - sp->get_bound (LEFT)->relative_coordinate (commonx,X_AXIS),X_AXIS);
return mol.smobbed_copy ();
}
+/*
+ should move to lookup?
+ */
+Molecule
+Tuplet_bracket::make_bracket (Axis protusion_axis,
+ Real dx, Real dy, Real thick, Real lprotrusion,
+ Real rprotrusion, Real gap, Real left_widen,
+ Real right_widen)
+{
+ Real len = Offset (dx,dy).length ();
+ Real gapx = dx* (gap / len);
+ Real gapy = dy* (gap / len);
+ Axis other = other_axis (protusion_axis);
+
+ Molecule l1 = Lookup::line (thick, Offset(0,0),
+ Offset ( (dx - gapx)/2, (dy - gapy)/2 ));
+ Molecule l2 = Lookup::line (thick, Offset((dx + gapx) / 2,(dy + gapy) / 2),
+
+ Offset (dx,dy));
+
+ Offset protusion;
+ protusion[other] = left_widen;
+ protusion[protusion_axis] = lprotrusion;
+
+ Molecule p1 = Lookup::line (thick, Offset(0,0), protusion);
+
+ protusion[other] = right_widen;
+ protusion[protusion_axis] = rprotrusion;
+ Molecule p2 = Lookup::line (thick, Offset(dx,dy),Offset(dx,dy) + protusion);
+ Molecule m;
+ m.add_molecule (p1);
+ m.add_molecule (p2);
+ m.add_molecule (l1);
+ m.add_molecule (l2);
+
+ return m;
+}
+
/*
use first -> last note for slope, and then correct for disturbing
Tuplet_bracket::calc_position_and_height (Grob*me,Real *offset, Real * dy)
{
Link_array<Grob> column_arr=
- Pointer_group_interface__extract_grobs (me, (Grob*)0, "columns");
+ Pointer_group_interface__extract_grobs (me, (Grob*)0, "note-columns");
- Grob * commony = me->common_refpoint (me->get_grob_property ("columns"), Y_AXIS);
- Grob * commonx = me->common_refpoint (me->get_grob_property ("columns"), X_AXIS);
+ Grob * commony = me->common_refpoint (me->get_grob_property ("note-columns"), Y_AXIS);
+ Grob * commonx = me->common_refpoint (me->get_grob_property ("note-columns"), X_AXIS);
Direction d = Directional_element_interface::get (me);
if (!column_arr.size ())
return;
+
+
- Real x0 = column_arr[0]->relative_coordinate (commonx, X_AXIS);
- Real x1 = column_arr.top ()->relative_coordinate (commonx, X_AXIS);
-
+ Real x0 = get_x_offset (column_arr[0], commonx, d);
+ Real x1 = get_x_offset (column_arr.top(), commonx, d);
+
+ /*
+ Slope.
+ */
Real factor = column_arr.size () > 1 ? 1/ (x1 - x0) : 1.0;
for (int i = 0; i < column_arr.size (); i++)
}
// padding
- *offset += 1.0 *d;
+ *offset += gh_scm2double (me->get_grob_property ("padding")) *d;
/*
horizontal brackets should not collide with staff lines.
-
-
*/
if (*dy == 0)
{
Tuplet_bracket::calc_dy (Grob*me,Real * dy)
{
Link_array<Grob> column_arr=
- Pointer_group_interface__extract_grobs (me, (Grob*)0, "columns");
+ Pointer_group_interface__extract_grobs (me, (Grob*)0, "note-columns");
/*
ugh. refps.
*dy = column_arr.top ()->extent (column_arr.top (), Y_AXIS) [d]
- column_arr[0]->extent (column_arr[0], Y_AXIS) [d];
}
+
+
+/*
+ We depend on the beams if there are any.
+ */
+MAKE_SCHEME_CALLBACK (Tuplet_bracket,before_line_breaking,1);
+SCM
+Tuplet_bracket::before_line_breaking (SCM smob)
+{
+ Grob *me = unsmob_grob (smob);
+ Link_array<Grob> column_arr=
+ Pointer_group_interface__extract_grobs (me, (Grob*)0, "note-columns");
+
+
+ for (int i = column_arr.size(); i--;)
+ {
+ Grob * s =Note_column::stem_l (column_arr[i]);
+ Grob * b = s ? Stem::beam_l (s): 0;
+ if (b)
+ me->add_dependency (b);
+ }
+ return SCM_UNDEFINED;
+}
+
MAKE_SCHEME_CALLBACK (Tuplet_bracket,after_line_breaking,1);
SCM
Tuplet_bracket::after_line_breaking (SCM smob)
{
Grob * me = unsmob_grob (smob);
- Link_array<Note_column> column_arr=
- Pointer_group_interface__extract_grobs (me, (Note_column*)0, "columns");
+ Link_array<Grob> column_arr=
+ Pointer_group_interface__extract_grobs (me, (Grob*)0, "note-columns");
if (!column_arr.size ())
{
me->suicide ();
return SCM_UNSPECIFIED;
}
-
- Direction d = Directional_element_interface::get (me);
- if (!d)
+ if (dynamic_cast<Spanner*> (me)->broken_b ())
{
- d = Tuplet_bracket::get_default_dir (me);
- Directional_element_interface::set (me, d);
-
+ me->warning ( "Tuplet_bracket was across linebreak. Farewell cruel world.");
+ me->suicide();
+ return SCM_UNSPECIFIED;
}
+
+ Direction dir = Directional_element_interface::get (me);
+ if (!dir)
+ {
+ dir = Tuplet_bracket::get_default_dir (me);
+ Directional_element_interface::set (me, dir);
+ }
+
+ bool equally_long = false;
+ Grob * par_beam = parallel_beam (me, column_arr, &equally_long);
+
Real dy, offset;
+ if (!par_beam)
+ {
+ calc_position_and_height (me,&offset,&dy);
+ }
+ else
+ {
+ SCM ps = par_beam->get_grob_property ("positions");
- calc_position_and_height (me,&offset,&dy);
+ Real lp = gh_scm2double (gh_car (ps));
+ Real rp = gh_scm2double (gh_cdr (ps));
- if (!gh_number_p (me->get_grob_property ("delta-y")))
- me->set_grob_property ("delta-y", gh_double2scm (dy));
+ /*
+ duh. magic.
+ */
+ offset = lp + dir * (0.5 + gh_scm2double (me->get_grob_property ("padding")));
+ dy = rp- lp;
+ }
+
+
+ SCM lp = me->get_grob_property ("left-position");
+ SCM rp = me->get_grob_property ("right-position");
+
+ if (gh_number_p (lp) && !gh_number_p (rp))
+ {
+ rp = gh_double2scm (gh_scm2double (lp) + dy);
+ }
+ else if (gh_number_p (rp) && !gh_number_p (lp))
+ {
+ lp = gh_double2scm (gh_scm2double (rp) - dy);
+ }
+ else if (!gh_number_p (rp) && !gh_number_p (lp))
+ {
+ lp = gh_double2scm (offset);
+ rp = gh_double2scm (offset +dy);
+ }
+
+ me->set_grob_property ("left-position", lp);
+ me->set_grob_property ("right-position", rp);
- me->translate_axis (offset, Y_AXIS);
return SCM_UNSPECIFIED;
}
+/*
+ similar to slur.
+ */
Direction
Tuplet_bracket::get_default_dir (Grob*me)
{
Direction d = UP;
- for (SCM s = me->get_grob_property ("columns"); gh_pair_p (s); s = ly_cdr (s))
+ for (SCM s = me->get_grob_property ("note-columns"); gh_pair_p (s); s = ly_cdr (s))
{
Grob * nc = unsmob_grob (ly_car (s));
if (Note_column::dir (nc) < 0)
break;
}
}
-
return d;
}
void
Tuplet_bracket::add_column (Grob*me, Item*n)
{
- Pointer_group_interface::add_grob (me, ly_symbol2scm ("columns"), n);
+ Pointer_group_interface::add_grob (me, ly_symbol2scm ("note-columns"), n);
me->add_dependency (n);
add_bound_item (dynamic_cast<Spanner*> (me), n);
ADD_INTERFACE (Tuplet_bracket,"tuplet-bracket-interface",
"A bracket with a number in the middle, used for tuplets.",
- "columns number-gap delta-y tuplet-bracket-visibility tuplet-number-visibility thick direction");
+ "note-columns padding gap left-position right-position bracket-visibility number-visibility thickness direction");
% hmm
% /setgray { 1 add } bind def
-/staff-line-thickness lilypondpaperstafflinethickness def
+/staff-line-thickness lilypondpaperlinethickness def
/staff-height lilypondpaperstaffheight def
/line-width lilypondpaperlinewidth def
grestore
} bind def
-/start-line % height
+/start-system % height
{
dup base-line-skip gt {
/line-height exch def
line-x line-y translate
} bind def
-/stop-line
+/stop-system
{
/the-line exch def
the-line
"") ; issue no command
(func "select-font" (car name-mag-pair))))
-(define (start-line height)
- (func "start-line" height))
+(define (start-system height)
+ (func "start-system" height))
-(define (stop-line)
- (func "stop-line"))
+(define (stop-system)
+ (func "stop-system"))
-(define (stop-last-line)
- (func "stop-line"))
+(define (stop-last-system)
+ (func "stop-system"))
(define (text s)
(define (end-of-line-invisible d) (if (= d -1) '(#t . #t) '(#f . #f)))
-(define mark-visibility end-of-line-invisible)
-
-
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Bar lines.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(TupletBracket
. (
- (number-gap . 2.0)
- (thick . 1.0)
+ (gap . 2.0)
+ (padding . 0.9)
+ (thickness . 1.6)
+ (before-line-breaking-callback . ,Tuplet_bracket::before_line_breaking)
(after-line-breaking-callback . ,Tuplet_bracket::after_line_breaking)
(molecule-callback . ,Tuplet_bracket::brew_molecule)
(font-family . roman)
(font-shape . italic)
+
(font-relative-size . -1)
(meta . ((interfaces . (text-interface tuplet-bracket-interface font-interface))))
))
(grob-property-description 'bar-line-collapse-height number? "Minimum height of system start delimiter bar-line glyphs. If equal or smaller, the bar-line is removed.")
(grob-property-description 'brace-collapse-height number? "Minimum height of system start delimiter brace glyphs. If equal or smaller, the brace is removed.")
(grob-property-description 'bracket-collapse-height number? "Minimum height of system start delimiter bracket glyphs. If equal or smaller, the bracket is removed.")
-(grob-property-description 'columns list? "list of grobs, typically containing paper-columns, list of note-columns.")
+(grob-property-description 'columns list? "list of grobs, typically containing paper-columns.")
(grob-property-description 'control-points list? "List of 4 offsets (number-pairs) that form control points for the tie/slur shape.")
(grob-property-description 'damping integer? "amount of beam slope damping should beam slope be damped? 0: no, 1: yes, 100000: horizontal beams .")
(grob-property-description 'dash-length number? "the length of a dash.")
For barline, space after a thick line.")
(grob-property-description 'layer number? "The output layer [0..2]. The default is 1.")
+(grob-property-description 'left-position number? "position of left part of spanner.")
+(grob-property-description 'right-position number? "position of right part of spanner.")
(grob-property-description 'left-padding number? "space left of accs.")
(grob-property-description 'right-head ly-grob? "")
(grob-property-description 'left-head ly-grob? "")
(grob-property-description 'non-default boolean? "not set because of existence of a bar?.")
(grob-property-description 'note-width number? "unit for horizontal translation, measured in staff-space.")
(grob-property-description 'note-heads list? "List of note head grobs")
-(grob-property-description 'number-gap number? "size of the gap for tohe number in a tuplet.")
(grob-property-description 'old-accidentals list? "list of (pitch, accidental) pairs.")
(grob-property-description 'padding number? "add this much extra space between objects that are next to each other.")
(grob-property-description 'paren-cautionaries boolean? "Whether to add parenthesis around cautionary accidentals.")
@end table
.")
(grob-property-description 'text-start boolean? "Indicator for whether a piano pedal bracket has leading text, such as Ped.")
-(grob-property-description 'thick number? "thickness, in stafflinethickness.")
(grob-property-description 'thick-thickness number? "thickness, measured in stafflinethickness.")
(grob-property-description 'thickness number? "thickness, measured in stafflinethickness.")
(grob-property-description 'thin-kern number? "space after a hair-line.")
same as setting molecule-callback to #f, but this retains the
dimensions of this grob, which means that you can erase grobs
individually. .")
-(grob-property-description 'tuplet-bracket-visibility boolean-or-symbol? "
+(grob-property-description 'bracket-visibility boolean-or-symbol? "
This controls the visibility of the tuplet bracket.
Setting it to false will prevent printing of the
bracket. Setting the property to #'if-no-beam will make it
print only if there is no beam associated with this tuplet bracket.")
-(grob-property-description 'tuplet-number-visibility boolean-or-symbol? "
-Like @code{tuplet-bracket-visibility}, but for the number.")
+(grob-property-description 'number-visibility boolean-or-symbol? "
+Like @code{bracket-visibility}, but for the number.")
(grob-property-description 'type symbol? "one of: line, dashed-line or dotted-line.")
(grob-property-description 'visibility-lambda procedure? "a function that takes the break direction and returns a cons of booleans containing (TRANSPARENT . EMPTY).")
(grob-property-description 'when moment? "when does this column happen?.")
(grob-property-description 'chord pair? "?")
(grob-property-description 'begin-of-line-visible boolean? "?")
-(grob-property-description 'quant-score number? "Beam quanting score")
-
+(grob-property-description 'quant-score number? "Beam quanting score
+-- can be stored for debugging")
(grob-property-description 'least-squares-dy number?
"ideal beam slope, without damping.")
(grob-property-description 'stem-info pair? "caching of stem parameters")
+(grob-property-description 'note-columns pair? "list of NoteColumn grobs.")
;;;
;;; (c) 2001 Stephen Peters <portnoy@portnoy.org>
-; currently no font commands; this is a helper for pdftex.scm.
-
-(define (pdf-scm action-name)
- ; simple commands to store and update currentpoint. This makes the
- ; other procedures simple rewrites of the PostScript code.
- (define currentpoint (cons 0 0))
- (define (showcp)
- (string-append (ly-number->string (car currentpoint)) " "
- (ly-number->string (cdr currentpoint)) " "))
- (define (moveto x y)
- (set! currentpoint (cons x y))
- (string-append (showcp) "m "))
- (define (moveto-pair pair)
- (moveto (car pair) (cdr pair)))
- (define (rmoveto x y)
- (moveto (+ x (car currentpoint)) (+ y (cdr currentpoint))))
- (define (lineto x y)
- (set! currentpoint (cons x y))
- (string-append (showcp) "l "))
- (define (lineto-pair pair)
- (lineto (car pair) (cdr pair)))
- (define (rlineto x y)
- (lineto (+ x (car currentpoint)) (+ y (cdr currentpoint))))
- (define (curveto x1 y1 x2 y2 x y)
- (set! currentpoint (cons x y))
- (string-append (ly-number->string x1) (ly-number->string y1)
- (ly-number->string x2) (ly-number->string y2)
- (ly-number->string x) (ly-number->string y) "c "))
- (define (curveto-pairs pt1 pt2 pt)
- (curveto (car pt1) (cdr pt1) (car pt2) (cdr pt2) (car pt) (cdr pt)))
- (define (closefill) "h f ")
- (define (closestroke) "S ")
- (define (setlinewidth w) (string-append (ly-number->string w) "w "))
- (define (setgray g) (string-append (ly-number->string g) "g "))
- (define (setlineparams) "1 j 1 J ")
-
- (define (beam width slope thick)
- (let ((ht (* slope width)))
- (string-append (moveto 0 (- (/ thick 2)))
- (rlineto width ht)
- (rlineto 0 thick)
- (lineto 0 (/ thick 2))
- (closefill))))
-
- (define (comment s)
- (string-append "% " s "\n"))
-
- (define (brack-traject pair ds alpha)
- (let ((alpha-rad (* alpha (/ 3.141592654 180))))
- (cons (+ (car pair) (* (cos alpha-rad) ds))
- (+ (cdr pair) (* (sin alpha-rad) ds)))))
-
- (define (bracket arch_angle arch_width arch_height height arch_thick thick)
- (let* ((halfht (+ (/ height 2) thick))
- (farpt (cons (+ thick arch_height)
- (+ (- halfht arch_thick) arch_width)))
- (halfbrack
- (string-append (moveto 0 0)
- (lineto thick 0)
- (lineto thick (- halfht arch_thick))
- (curveto-pairs
- (brack-traject (cons thick
- (- halfht arch_thick))
- (* 0.4 arch_height) 0)
- (brack-traject farpt
- (* -0.25 arch_height)
- arch_angle)
- farpt)
- (curveto-pairs
- (brack-traject farpt
- (* -0.15 arch_height)
- arch_angle)
- (brack-traject (cons (/ thick 2) halfht)
- (/ arch_height 2) 0)
- (cons 0 halfht))
- (lineto 0 0)
- (closefill))))
- (string-append (setlinewidth (/ thick 2))
- (setlineparams)
- "q 1 0 0 -1 0 0 cm " ; flip coords
- halfbrack
- "Q " ; grestore
- halfbrack)))
-
- (define (char i)
- (invoke-char " show" i))
-
- (define (hairpin thick width starth endh )
- (string-append (setlinewidth thick)
- (moveto 0 starth)
- (lineto width endh)
- (moveto 0 (- starth))
- (lineto width (- endh))
- (closestroke)))
-
- (define (dashed-slur thick dash l)
- (string-append (setlineparams)
- "[ " (ly-number->string dash) " "
- (ly-number->string (* 10 thick)) " ] 0 d "
- (setlinewidth thick)
- (moveto-pair (car l))
- (apply curveto (cdr l))
- (closestroke)))
-
- (define (dashed-line thick on off dx dy)
- (string-append (setlineparams)
- "[ " (ly-number->string on) " "
- (ly-number->string off) " ] 0 d "
- (setlinewidth thick)
- (moveto 0 0)
- (lineto dx dy)
- (closestroke)))
-
- (define (repeat-slash width slope beamthick)
- (let* ((height (/ beamthick slope))
- (xwid (sqrt (+ (* beamthick beamthick) (* height height)))))
- (string-append (moveto 0 0)
- (rlineto xwid 0)
- (rlineto width (* slope width))
- (rlineto (- xwid) 0)
- (closefill))))
-
- (define (end-output) "")
-
- (define (experimental-on) "")
-
- (define (filledbox breadth width depth height)
- (string-append (ly-number->string (- breadth))
- (ly-number->string (- depth))
- (ly-number->string (+ breadth width))
- (ly-number->string (+ depth height))
- " re f "))
+
+;currently no font commands; this is a helper for pdftex.scm.
+
+(define-module (scm pdf)
+ )
+
+
+(define this-module (current-module))
+
+(use-modules
+ (guile)
+ )
+
+
+
+ ; simple commands to store and update currentpoint. This makes the
+ ; other procedures simple rewrites of the PostScript code.
+(define currentpoint (cons 0 0))
+(define (showcp)
+ (string-append (ly-number->string (car currentpoint)) " "
+ (ly-number->string (cdr currentpoint)) " "))
+(define (moveto x y)
+ (set! currentpoint (cons x y))
+ (string-append (showcp) "m "))
+(define (moveto-pair pair)
+ (moveto (car pair) (cdr pair)))
+(define (rmoveto x y)
+ (moveto (+ x (car currentpoint)) (+ y (cdr currentpoint))))
+(define (lineto x y)
+ (set! currentpoint (cons x y))
+ (string-append (showcp) "l "))
+(define (lineto-pair pair)
+ (lineto (car pair) (cdr pair)))
+(define (rlineto x y)
+ (lineto (+ x (car currentpoint)) (+ y (cdr currentpoint))))
+(define (curveto x1 y1 x2 y2 x y)
+ (set! currentpoint (cons x y))
+ (string-append (ly-number->string x1) (ly-number->string y1)
+ (ly-number->string x2) (ly-number->string y2)
+ (ly-number->string x) (ly-number->string y) "c "))
+(define (curveto-pairs pt1 pt2 pt)
+ (curveto (car pt1) (cdr pt1) (car pt2) (cdr pt2) (car pt) (cdr pt)))
+(define (closefill) "h f ")
+(define (closestroke) "S ")
+(define (setlinewidth w) (string-append (ly-number->string w) "w "))
+(define (setgray g) (string-append (ly-number->string g) "g "))
+(define (setlineparams) "1 j 1 J ")
+
+(define (beam width slope thick)
+ (let ((ht (* slope width)))
+ (string-append (moveto 0 (- (/ thick 2)))
+ (rlineto width ht)
+ (rlineto 0 thick)
+ (lineto 0 (/ thick 2))
+ (closefill))))
+
+(define (comment s)
+ (string-append "% " s "\n"))
+
+(define (brack-traject pair ds alpha)
+ (let ((alpha-rad (* alpha (/ 3.141592654 180))))
+ (cons (+ (car pair) (* (cos alpha-rad) ds))
+ (+ (cdr pair) (* (sin alpha-rad) ds)))))
+
+(define (bracket arch_angle arch_width arch_height height arch_thick thick)
+ (let* ((halfht (+ (/ height 2) thick))
+ (farpt (cons (+ thick arch_height)
+ (+ (- halfht arch_thick) arch_width)))
+ (halfbrack
+ (string-append (moveto 0 0)
+ (lineto thick 0)
+ (lineto thick (- halfht arch_thick))
+ (curveto-pairs
+ (brack-traject (cons thick
+ (- halfht arch_thick))
+ (* 0.4 arch_height) 0)
+ (brack-traject farpt
+ (* -0.25 arch_height)
+ arch_angle)
+ farpt)
+ (curveto-pairs
+ (brack-traject farpt
+ (* -0.15 arch_height)
+ arch_angle)
+ (brack-traject (cons (/ thick 2) halfht)
+ (/ arch_height 2) 0)
+ (cons 0 halfht))
+ (lineto 0 0)
+ (closefill))))
+ (string-append (setlinewidth (/ thick 2))
+ (setlineparams)
+ "q 1 0 0 -1 0 0 cm " ; flip coords
+ halfbrack
+ "Q " ; grestore
+ halfbrack)))
+
+(define (char i)
+ (invoke-char " show" i))
+
+(define (hairpin thick width starth endh )
+ (string-append (setlinewidth thick)
+ (moveto 0 starth)
+ (lineto width endh)
+ (moveto 0 (- starth))
+ (lineto width (- endh))
+ (closestroke)))
+
+(define (dashed-slur thick dash l)
+ (string-append (setlineparams)
+ "[ " (ly-number->string dash) " "
+ (ly-number->string (* 10 thick)) " ] 0 d "
+ (setlinewidth thick)
+ (moveto-pair (car l))
+ (apply curveto (cdr l))
+ (closestroke)))
+
+(define (dashed-line thick on off dx dy)
+ (string-append (setlineparams)
+ "[ " (ly-number->string on) " "
+ (ly-number->string off) " ] 0 d "
+ (setlinewidth thick)
+ (moveto 0 0)
+ (lineto dx dy)
+ (closestroke)))
+
+(define (repeat-slash width slope beamthick)
+ (let* ((height (/ beamthick slope))
+ (xwid (sqrt (+ (* beamthick beamthick) (* height height)))))
+ (string-append (moveto 0 0)
+ (rlineto xwid 0)
+ (rlineto width (* slope width))
+ (rlineto (- xwid) 0)
+ (closefill))))
+
+(define (end-output) "")
+
+(define (experimental-on) "")
+
+(define (filledbox breadth width depth height)
+ (string-append (ly-number->string (- breadth))
+ (ly-number->string (- depth))
+ (ly-number->string (+ breadth width))
+ (ly-number->string (+ depth height))
+ " re f "))
;; TODO:
;;
;;
;; WORKAROUND:
;;
- (define (roundfilledbox breadth width depth height)
- (filledbox breadth width depth height))
+(define (roundfilledbox breadth width depth height)
+ (filledbox breadth width depth height))
;;
- (define (font-def i s) "")
+(define (font-def i s) "")
- (define (font-switch i) "")
+(define (font-switch i) "")
- (define (header-end) "")
-
- (define (lily-def key val) "")
+(define (header-end) "")
- (define (header creator generate) "")
-
- (define (invoke-char s i)
- (string-append
- "(\\" (inexact->string i 8) ") " s " " ))
-
- (define (placebox x y s) "")
+(define (lily-def key val) "")
- (define (bezier-sandwich l thick)
- (string-append (setlinewidth thick)
- (moveto-pair (list-ref l 7))
- (curveto-pairs (list-ref l 4)
- (list-ref l 5)
- (list-ref l 6))
- (lineto-pair (list-ref l 3))
- (curveto-pairs (list-ref l 0)
- (list-ref l 1)
- (list-ref l 2))
- "B "))
-
- (define (start-line height) "")
-
- (define (stem breadth width depth height)
- (filledbox breadth width depth height))
-
- (define (stop-line) "")
-
- (define (text s) "")
-
- (define (volta h w thick vert_start vert_end)
+(define (header creator generate) "")
+
+(define (invoke-char s i)
+ (string-append
+ "(\\" (inexact->string i 8) ") " s " " ))
+
+(define (placebox x y s) "")
+
+(define (bezier-sandwich l thick)
+ (string-append (setlinewidth thick)
+ (moveto-pair (list-ref l 7))
+ (curveto-pairs (list-ref l 4)
+ (list-ref l 5)
+ (list-ref l 6))
+ (lineto-pair (list-ref l 3))
+ (curveto-pairs (list-ref l 0)
+ (list-ref l 1)
+ (list-ref l 2))
+ "B "))
+
+(define (start-system height) "")
+
+(define (stem breadth width depth height)
+ (filledbox breadth width depth height))
+
+(define (stop-system) "")
+
+(define (text s) "")
+
+(define (volta h w thick vert_start vert_end)
+ (string-append (setlinewidth thick)
+ (setlineparams)
+ (if (= vert_start 0)
+ (string-append (moveto 0 0)
+ (lineto 0 h))
+ (moveto 0 h))
+ (lineto w h)
+ (if (= vert_end 0) (lineto w 0) "")
+ (closestroke)))
+
+(define (tuplet ht gap dx dy thick dir)
+ (let ((gapy (* (/ dy dx) gap)))
(string-append (setlinewidth thick)
(setlineparams)
- (if (= vert_start 0)
- (string-append (moveto 0 0)
- (lineto 0 h))
- (moveto 0 h))
- (lineto w h)
- (if (= vert_end 0) (lineto w 0) "")
- (closestroke)))
-
- (define (tuplet ht gap dx dy thick dir)
- (let ((gapy (* (/ dy dx) gap)))
- (string-append (setlinewidth thick)
- (setlineparams)
- (moveto 0 (- (* ht dir)))
- (lineto 0 0)
- (lineto (/ (- dx gap) 2)
- (/ (- dy gapy) 2))
- (moveto (/ (+ dx gap) 2)
- (/ (+ dy gapy) 2))
- (lineto dx dy)
- (lineto dx (- dy (* ht dir)))
- (closestroke))))
-
- (define (unknown) "\n unknown\n")
-
- ; Problem here -- we're using /F18 for the font, but we don't know
- ; for sure that that will exist.
- (define (ez-ball ch letter-col ball-col)
- (let ((origin (cons 0.45 0)))
- (string-append (setgray 0)
- (setlinewidth 1.1)
- (moveto-pair origin) (lineto-pair origin)
- (closestroke)
- (setgray ball-col)
- (setlinewidth 0.9)
- (moveto-pair origin) (lineto-pair origin)
- (closestroke)
- (setgray letter-col)
- (moveto-pair origin)
- "BT "
- "/F18 0.85 Tf "
- "-0.28 -0.30 Td " ; move for text block
- "[(" ch ")] TJ ET ")))
-
- (define (define-origin a b c ) "")
- (define (no-origin) "")
-
- ;; PS
- (cond ((eq? action-name 'all-definitions)
- `(begin
- (define beam ,beam)
- (define tuplet ,tuplet)
- (define bracket ,bracket)
- (define char ,char)
- (define volta ,volta)
- (define bezier-sandwich ,bezier-sandwich)
- (define dashed-line ,dashed-line)
- (define dashed-slur ,dashed-slur)
- (define hairpin ,hairpin)
- (define end-output ,end-output)
- (define experimental-on ,experimental-on)
- (define filledbox ,filledbox)
- (define roundfilledbox ,roundfilledbox)
- (define font-def ,font-def)
- (define font-switch ,font-switch)
- (define header-end ,header-end)
- (define lily-def ,lily-def)
- (define font-load-command ,font-load-command)
- (define header ,header)
- (define invoke-char ,invoke-char)
-
- (define placebox ,placebox)
- (define repeat-slash ,repeat-slash)
- (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 no-origin ,no-origin)
- (define define-origin ,define-origin)
- (define ez-ball ,ez-ball)
- ))
- ((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 'dashed-line) dashed-line)
- ((eq? action-name 'dashed-slur) dashed-slur)
- ((eq? action-name 'hairpin) hairpin)
- ((eq? action-name 'experimental-on) experimental-on)
- ((eq? action-name 'ez-ball) ez-ball)
- ((eq? action-name 'filledbox) filledbox)
- ((eq? action-name 'roundfilledbox) roundfilledbox)
- ((eq? action-name 'repeat-slash) repeat-slash)
- ((eq? action-name 'select-font) select-font)
- ((eq? action-name 'volta) volta)
- (else (error "unknown tag -- PDF-SCM " action-name))
- )
- )
+ (moveto 0 (- (* ht dir)))
+ (lineto 0 0)
+ (lineto (/ (- dx gap) 2)
+ (/ (- dy gapy) 2))
+ (moveto (/ (+ dx gap) 2)
+ (/ (+ dy gapy) 2))
+ (lineto dx dy)
+ (lineto dx (- dy (* ht dir)))
+ (closestroke))))
+
+(define (unknown) "\n unknown\n")
+
+ ; Problem here -- we're using /F18 for the font, but we don't know
+ ; for sure that that will exist.
+(define (ez-ball ch letter-col ball-col)
+ (let ((origin (cons 0.45 0)))
+ (string-append (setgray 0)
+ (setlinewidth 1.1)
+ (moveto-pair origin) (lineto-pair origin)
+ (closestroke)
+ (setgray ball-col)
+ (setlinewidth 0.9)
+ (moveto-pair origin) (lineto-pair origin)
+ (closestroke)
+ (setgray letter-col)
+ (moveto-pair origin)
+ "BT "
+ "/F18 0.85 Tf "
+ "-0.28 -0.30 Td " ; move for text block
+ "[(" ch ")] TJ ET ")))
+
+(define (define-origin a b c ) "")
+(define (no-origin) "")
+
(define (scm-pdf-output)
(primitive-eval (pdf-scm 'all-definitions)))
;; TODO: port this to the new module framework.
-(define (pdftex-scm action-name)
- (define (unknown)
- "%\n\\unknown%\n")
-
-
- (define (select-font name-mag-pair)
- (let*
- (
- (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 name-mag-pair) " "
- (ly-number->string (cdr name-mag-pair))
- ))
- "") ; issue no command
- (string-append "\\" (cddr c)))
-
-
- ))
-
- (define (beam width slope thick)
- (embedded-pdf ((pdf-scm 'beam) width slope thick)))
-
- (define (bracket arch_angle arch_width arch_height height arch_thick thick)
- (embedded-pdf ((pdf-scm 'bracket) arch_angle arch_width arch_height height arch_thick thick)))
-
- (define (dashed-slur thick dash l)
- (embedded-pdf ((pdf-scm 'dashed-slur) thick dash l)))
-
- (define (hairpin thick w sh eh)
- (embedded-pdf ((pdf-scm 'hairpin) thick w sh eh)))
-
- (define (char i)
- (string-append "\\char" (inexact->string i 10) " "))
-
- (define (dashed-line thick on off dx dy)
- (embedded-pdf ((pdf-scm 'dashed-line) thick on off dx dy)))
-
- (define (font-load-command name-mag command)
- (string-append
- "\\font\\" command "="
- (car name-mag)
- " scaled "
- (ly-number->string (inexact->exact (* 1000 (cdr name-mag))))
- "\n"))
-
- (define (ez-ball c l b)
- (embedded-pdf ((pdf-scm 'ez-ball) c l b)))
-
- (define (embedded-pdf s)
- (string-append "\\embeddedpdf{ " s "}"))
-
- (define (comment s)
- (string-append "% " s))
-
- (define (end-output)
+(define-module (scm pdftex))
+
+(define (unknown)
+ "%\n\\unknown%\n")
+
+
+(define (select-font name-mag-pair)
+ (let*
+ (
+ (c (assoc name-mag-pair font-name-alist))
+ )
+
+ (if (eq? c #f)
(begin
-; uncomment for some stats about lily memory
-; (display (gc-stats))
+ (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 name-mag-pair) " "
+ (ly-number->string (cdr name-mag-pair))
+ ))
+ "") ; issue no command
+ (string-append "\\" (cddr c)))
+
+
+ ))
+
+(define (beam width slope thick)
+ (embedded-pdf ((pdf-scm 'beam) width slope thick)))
+
+(define (bracket arch_angle arch_width arch_height height arch_thick thick)
+ (embedded-pdf ((pdf-scm 'bracket) arch_angle arch_width arch_height height arch_thick thick)))
+
+(define (dashed-slur thick dash l)
+ (embedded-pdf ((pdf-scm 'dashed-slur) thick dash l)))
+
+(define (hairpin thick w sh eh)
+ (embedded-pdf ((pdf-scm 'hairpin) thick w sh eh)))
+
+(define (char i)
+ (string-append "\\char" (inexact->string i 10) " "))
+
+(define (dashed-line thick on off dx dy)
+ (embedded-pdf ((pdf-scm 'dashed-line) thick on off dx dy)))
+
+(define (font-load-command name-mag command)
+ (string-append
+ "\\font\\" command "="
+ (car name-mag)
+ " scaled "
+ (ly-number->string (inexact->exact (* 1000 (cdr name-mag))))
+ "\n"))
+
+(define (ez-ball c l b)
+ (embedded-pdf ((pdf-scm 'ez-ball) c l b)))
+
+(define (embedded-pdf s)
+ (string-append "\\embeddedpdf{ " s "}"))
+
+(define (comment s)
+ (string-append "% " s))
+
+(define (end-output)
+ (begin
+ ; uncomment for some stats about lily memory
+ ; (display (gc-stats))
(string-append "\n\\EndLilyPondOutput"
- ; Put GC stats here.
+ ; Put GC stats here.
)))
-
- (define (experimental-on)
- "")
-
- (define (repeat-slash w a t)
- (embedded-pdf ((pdf-scm 'repeat-slash) w a t)))
-
- (define (font-switch i)
- (string-append
- "\\" (font i) "\n"))
-
- (define (font-def i s)
- (string-append
- "\\font" (font-switch i) "=" s "\n"))
-
- (define (header-end)
- (string-append
- "\\input lilyponddefs\\newdimen\\outputscale \\outputscale=\\lilypondpaperoutputscale pt"
- "\\turnOnPostScript"
- "\\pdfcompresslevel=0"))
-
- ;; Note: this string must match the string in ly2dvi.py!!!
- (define (header creator generate)
- (string-append
- "% Generated automatically by: " creator generate "\n"))
-
- (define (invoke-char s i)
- (string-append
- "\n\\" s "{" (inexact->string i 10) "}" ))
-
- ;;
- ;; need to do something to make this really safe.
- ;;
- (define (output-tex-string s)
- (if security-paranoia
- (if use-regex
- (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post)
- (begin (display "warning: not paranoid") (newline) s))
- s))
-
- (define (lily-def key val)
- (let ((tex-key
- (if use-regex
- (regexp-substitute/global
- #f "_" (output-tex-string key) 'pre "X" 'post)
- (output-tex-string key)))
- (tex-val (output-tex-string val)))
- (if (equal? (sans-surrounding-whitespace tex-val) "")
- (string-append "\\let\\" tex-key "\\undefined\n")
- (string-append "\\def\\" tex-key "{" tex-val "}\n"))))
-
- (define (number->dim x)
- (string-append
- ;;ugh ly-* in backend needs compatibility func for standalone output
- (ly-number->string x) " \\outputscale "))
-
- (define (placebox x y s)
- (string-append
- "\\placebox{"
- (number->dim y) "}{" (number->dim x) "}{" s "}\n"))
-
- (define (bezier-sandwich l thick)
- (embedded-pdf ((pdf-scm 'bezier-sandwich) l thick)))
-
- (define (start-line ht)
- (string-append"\\vbox to " (number->dim ht) "{\\hbox{%\n"))
-
- (define (stop-line)
- "}\\vss}\\interscoreline\n")
- (define (stop-last-line)
- "}\\vss}")
- (define (filledbox breapth width depth height)
- (string-append
- "\\kern" (number->dim (- breapth))
- "\\vrule width " (number->dim (+ breapth width))
- "depth " (number->dim depth)
- "height " (number->dim height) " "))
-
- (define (roundfilledbox x width y height blotdiam)
- (embedded-pdf ((pdf-scm 'roundfilledbox) x width y height blotdiam)))
-
- (define (text s)
- (string-append "\\hbox{" (output-tex-string s) "}"))
-
- (define (tuplet ht gapx dx dy thick dir)
- (embedded-pdf ((pdf-scm 'tuplet) ht gapx dx dy thick dir)))
-
- (define (volta h w thick vert_start vert_end)
- (embedded-pdf ((pdf-scm 'volta) h w thick vert_start vert_end)))
-
- (define (define-origin file line col)
- (if (procedure? point-and-click)
- (string-append "\\special{src:\\string:"
- (point-and-click line col file)
- "}" )
- "")
- )
-
- ; no-origin not supported in PDFTeX
- (define (no-origin) "")
-
- ;; The procedures listed below form the public interface of
- ;; PDFTeX-scm. (should merge the 2 lists)
- (cond ((eq? action-name 'all-definitions)
- `(begin
- (define font-load-command ,font-load-command)
- (define beam ,beam)
- (define bezier-sandwich ,bezier-sandwich)
- (define bracket ,bracket)
- (define char ,char)
- (define dashed-line ,dashed-line)
- (define dashed-slur ,dashed-slur)
- (define hairpin ,hairpin)
- (define end-output ,end-output)
- (define experimental-on ,experimental-on)
- (define filledbox ,filledbox)
- (define font-def ,font-def)
- (define font-switch ,font-switch)
- (define header-end ,header-end)
- (define lily-def ,lily-def)
- (define ez-ball ,ez-ball)
- (define header ,header)
- (define invoke-char ,invoke-char)
-
- (define placebox ,placebox)
- (define select-font ,select-font)
- (define start-line ,start-line)
- (define stop-line ,stop-line)
- (define stop-last-line ,stop-last-line)
- (define text ,text)
- (define tuplet ,tuplet)
- (define volta ,volta)
- (define define-origin ,define-origin)
- (define no-origin ,no-origin)
- (define repeat-slash ,repeat-slash)
- ))
-
- ((eq? action-name 'beam) beam)
- ((eq? action-name 'tuplet) tuplet)
- ((eq? action-name 'bracket) bracket)
- ((eq? action-name 'hairpin) hairpin)
- ((eq? action-name 'dashed-line) dashed-line)
- ((eq? action-name 'dashed-slur) dashed-slur)
- ((eq? action-name 'end-output) end-output)
- ((eq? action-name 'experimental-on) experimental-on)
- ((eq? action-name 'font-def) font-def)
- ((eq? action-name 'font-switch) font-switch)
- ((eq? action-name 'header-end) header-end)
- ((eq? action-name 'lily-def) lily-def)
- ((eq? action-name 'header) header)
- ((eq? action-name 'invoke-char) invoke-char)
-
- ((eq? action-name 'placebox) placebox)
- ((eq? action-name 'bezier-sandwich) bezier-sandwich)
- ((eq? action-name 'start-line) start-line)
- ((eq? action-name 'stem) stem)
- ((eq? action-name 'stop-line) stop-line)
- ((eq? action-name 'stop-last-line) stop-last-line)
- ((eq? action-name 'volta) volta)
- ((eq? action-name 'repeat-slash) repeat-slash)
- (else (error "unknown tag -- PDFTEX " action-name))
- )
+
+(define (experimental-on)
+ "")
+
+(define (repeat-slash w a t)
+ (embedded-pdf ((pdf-scm 'repeat-slash) w a t)))
+
+(define (font-switch i)
+ (string-append
+ "\\" (font i) "\n"))
+
+(define (font-def i s)
+ (string-append
+ "\\font" (font-switch i) "=" s "\n"))
+
+(define (header-end)
+ (string-append
+ "\\input lilyponddefs\\newdimen\\outputscale \\outputscale=\\lilypondpaperoutputscale pt"
+ "\\turnOnPostScript"
+ "\\pdfcompresslevel=0"))
+
+;; Note: this string must match the string in ly2dvi.py!!!
+(define (header creator generate)
+ (string-append
+ "% Generated automatically by: " creator generate "\n"))
+
+(define (invoke-char s i)
+ (string-append
+ "\n\\" s "{" (inexact->string i 10) "}" ))
+
+;;
+;; need to do something to make this really safe.
+;;
+(define (output-tex-string s)
+ (if security-paranoia
+ (if use-regex
+ (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post)
+ (begin (display "warning: not paranoid") (newline) s))
+ s))
+
+(define (lily-def key val)
+ (let ((tex-key
+ (if use-regex
+ (regexp-substitute/global
+ #f "_" (output-tex-string key) 'pre "X" 'post)
+ (output-tex-string key)))
+ (tex-val (output-tex-string val)))
+ (if (equal? (sans-surrounding-whitespace tex-val) "")
+ (string-append "\\let\\" tex-key "\\undefined\n")
+ (string-append "\\def\\" tex-key "{" tex-val "}\n"))))
+
+(define (number->dim x)
+ (string-append
+ ;;ugh ly-* in backend needs compatibility func for standalone output
+ (ly-number->string x) " \\outputscale "))
+
+(define (placebox x y s)
+ (string-append
+ "\\placebox{"
+ (number->dim y) "}{" (number->dim x) "}{" s "}\n"))
+
+(define (bezier-sandwich l thick)
+ (embedded-pdf ((pdf-scm 'bezier-sandwich) l thick)))
+
+(define (start-system ht)
+ (string-append"\\vbox to " (number->dim ht) "{\\hbox{%\n"))
+
+(define (stop-system)
+ "}\\vss}\\interscoreline\n")
+(define (stop-last-system)
+ "}\\vss}")
+(define (filledbox breapth width depth height)
+ (string-append
+ "\\kern" (number->dim (- breapth))
+ "\\vrule width " (number->dim (+ breapth width))
+ "depth " (number->dim depth)
+ "height " (number->dim height) " "))
+
+(define (roundfilledbox x width y height blotdiam)
+ (embedded-pdf ((pdf-scm 'roundfilledbox) x width y height blotdiam)))
+
+(define (text s)
+ (string-append "\\hbox{" (output-tex-string s) "}"))
+
+(define (tuplet ht gapx dx dy thick dir)
+ (embedded-pdf ((pdf-scm 'tuplet) ht gapx dx dy thick dir)))
+
+(define (volta h w thick vert_start vert_end)
+ (embedded-pdf ((pdf-scm 'volta) h w thick vert_start vert_end)))
+
+(define (define-origin file line col)
+ (if (procedure? point-and-click)
+ (string-append "\\special{src:\\string:"
+ (point-and-click line col file)
+ "}" )
+ "")
)
+ ; no-origin not supported in PDFTeX
+(define (no-origin) "")
+
+
(define (scm-pdftex-output)
(primitive-eval (pdftex-scm 'all-definitions)))
(ly-number->string off)
" ] 0 draw_dashed_line"))
+(define (draw-line thick x1 y1 x2 y2)
+
+ (string-append
+ " 1 setlinecap
+ 1 setlinejoin "
+ (ly-number->string thick)
+ " setlinewidth "
+ (ly-number->string x1)
+ " "
+ (ly-number->string y1)
+ " moveto"
+ (ly-number->string x2)
+ " "
+ (ly-number->string y2)
+ " lineto stroke"
+
+ ))
+
(define (repeat-slash wid slope thick)
(string-append (numbers->string (list wid slope thick))
" draw_repeat_slash"))
; TODO: use HEIGHT argument
- (define (start-line height)
+ (define (start-system height)
(string-append
"\n"
(ly-number->string height)
- " start-line {
+ " start-system {
set-ps-scale-to-lily-scale
"))
(string-append (numbers->string (list breapth width depth height))
" draw_box" ))
-(define (stop-line)
- "}\nstop-line\n")
+(define (stop-system)
+ "}\nstop-system\n")
-(define (stop-last-line)
- "}\nstop-line\n")
+(define (stop-last-system)
+ "}\nstop-system\n")
(define (text s)
(string-append "(" s ") show "))
sketch-beziers (list x y (primitive-eval l) thick)))
; TODO: use HEIGHT argument
-(define (start-line height)
+(define (start-system height)
"G()\n"
)
(define (stem x y z w) (filledbox x y z w))
-(define (stop-line)
+(define (stop-system)
"G_()\n")
;; huh?
-(define (stop-last-line)
- (stop-line))
+(define (stop-last-system)
+ (stop-system))
(define (text x y s)
(string-append "txt('" s "',(" (sketch-numbers->string
(define (bezier-sandwich l thick)
(embedded-ps (list 'bezier-sandwich `(quote ,l) thick)))
-(define (start-line ht)
+(define (start-system ht)
(string-append "\\vbox to " (number->dim ht) "{\\hbox{"
"%\n"))
-(define (stop-line)
+(define (stop-system)
"}\\vss}\\interscoreline\n")
-(define (stop-last-line)
+(define (stop-last-system)
"}\\vss}")
(define (filledbox breapth width depth height)
(define (tuplet ht gapx dx dy thick dir)
(embedded-ps (list 'tuplet ht gapx dx dy thick dir)))
+(define (draw-line thick fx fy tx ty)
+ (embedded-ps (list 'draw-line thick fx fy tx ty)))
+
(define (volta h w thick vert_start vert_end)
(embedded-ps (list 'volta h w thick vert_start vert_end)))
(define (between-system-string string)
projects / lilypond.git / commitdiff