* input/regression/rehearsal-mark-letter.ly: new file.
* scm/translation-functions.scm (number->mark-string): new function
(format-mark-letters): new function
(format-mark-numbers): new function
* lily/mark-engraver.cc (process_music): rehearsalMark is now
integer; formatting is done through markFormatter property.
* scm/define-translator-properties.scm: fold all *-done properties
into positioning-done.
* lily/beam.cc (position_beam): new function
(brew_molecule): make sure that positions are calced before making
the molecule.
* ps/music-drawing-routines.ps: take blot as 4th argument.
* lily/beam.cc (brew_molecule): fix beam offsets: overlap with the
stem do avoid small dents.
+2004-01-18 Han-Wen Nienhuys <hanwen@xs4all.nl>
+
+ * input/regression/rehearsal-mark-number.ly: new file.
+
+ * input/regression/rehearsal-mark-letter.ly: new file.
+
+ * scm/translation-functions.scm (number->mark-string): new function
+ (format-mark-letters): new function
+ (format-mark-numbers): new function
+
+ * lily/mark-engraver.cc (process_music): rehearsalMark is now
+ integer; formatting is done through markFormatter property.
+
+ * scm/define-translator-properties.scm: fold all *-done properties
+ into positioning-done.
+
+ * lily/beam.cc (position_beam): new function
+ (brew_molecule): make sure that positions are calced before making
+ the molecule.
+
+ * scm/output*.scm (beam): take 4th argument for function.
+
+ * ps/music-drawing-routines.ps: take blot as 4th argument.
+
+ * lily/beam.cc (brew_molecule): fix beam offsets: overlap with the
+ stem do avoid small dents.
+
+
2004-01-17 Han-Wen Nienhuys <hanwen@xs4all.nl>
+ * VERSION: release 2.1.11
+
* input/regression/balloon.ly: new file.
* lily/balloon.cc (brew_molecule): new file: draw boxes around
MAJOR_VERSION=2
MINOR_VERSION=1
PATCH_LEVEL=11
-MY_PATCH_LEVEL=
+MY_PATCH_LEVEL=hwn1
--- /dev/null
+
+
+\header { texidoc= "Rehearsal marks in letter style: the I is skipped,
+and after Z, we continue with double letters. The mark may be set
+with @code{\mark NUMBER}, or with @code{Score.rehearsalMark}."
+ }
+
+\version "2.1.7"
+
+
+global = \notes {
+ s1 | \mark #6
+ s1 | \mark \default
+ s1 | \mark \default
+ s1 | \mark \default
+ \property Score.rehearsalMark = #24
+ s1 | \mark \default
+ s1 | \mark \default
+ }
+
+
+one = \notes \relative c {
+ c''1 c c c c c c
+}
+
+
+\score{
+\context Staff << \global \one >>
+}
+
--- /dev/null
+\header { texidoc= "
+
+Marks can be printed as numbers.
+By setting @code{markFormatter} we may choose a different style of mark printing. Also, marks can be specified manually, with a markup argument"
+
+ }
+
+\version "2.1.7"
+
+
+global = \notes {
+ \property Score.markFormatter = #format-mark-numbers
+ s1 | \mark \markup { \musicglyph #"scripts-coda" }
+ s1 | \mark \default
+ s1 | \mark \default
+ \property Score.markFormatter
+ = #(lambda (mark context)
+ (make-bold-markup (make-box-markup (number->string mark))))
+
+ s1 | \mark \default
+ s1 | \mark \default
+ }
+
+
+one = \notes \relative c {
+ c''1 c c c c c c
+}
+
+
+\score{
+\context Staff << \global \one >>
+}
+
+++ /dev/null
-
-
-\header { texidoc= " Rehearsal marks are printed over barlines. They
-can be incremented automatically or manually. "}
-
-
-\version "2.1.7"
-
-
-global = \notes {
- s1 | \mark "A"
- s1 | \mark \default
- s1 | \mark \default
- s1 | \mark "12"
- s1 | \mark \default
- s1 | \mark "A2"
- s1 | \mark \markup { mark \column < up \bold down > }
- s1
-}
-
-one = \notes \relative c {
- c''1 c c c c c c
-}
-
-
-\score{
-\context Staff << \global \one >>
-}
-
Grob * me =unsmob_grob (s);
Grob * par = me->get_parent (X_AXIS);
- if (!to_boolean (par->get_grob_property ("alignment-done")))
+ if (!to_boolean (par->get_grob_property ("positioning-done")))
{
- par->set_grob_property ("alignment-done", SCM_BOOL_T);
+ par->set_grob_property ("positioning-done", SCM_BOOL_T);
position_accidentals (par);
}
ADD_INTERFACE(Accidental_placement,
"accidental-placement-interface",
"Take care of complex accidental collisions.",
- "left-padding padding right-padding accidental-grobs alignment-done")
+ "left-padding padding right-padding accidental-grobs positioning-done")
Grob * me = unsmob_grob (element_smob);
Axis ax = (Axis)gh_scm2int (axis);
Grob * par = me->get_parent (ax);
- if (par && !to_boolean (par->get_grob_property ("alignment-done")))
+ if (par && !to_boolean (par->get_grob_property ("positioning-done")))
{
Align_interface::align_elements_to_extents (par, ax);
}
Grob * me = unsmob_grob (element_smob);
Axis ax = (Axis)gh_scm2int (axis);
Grob * par = me->get_parent (ax);
- if (par && !to_boolean (par->get_grob_property ("alignment-done")))
+ if (par && !to_boolean (par->get_grob_property ("positioning-done")))
{
Align_interface::align_to_fixed_distance (par, ax);
}
void
Align_interface::align_to_fixed_distance (Grob *me , Axis a)
{
- me->set_grob_property ("alignment-done", SCM_BOOL_T);
+ me->set_grob_property ("positioning-done", SCM_BOOL_T);
SCM d = me->get_grob_property ("stacking-dir");
void
Align_interface::align_elements_to_extents (Grob * me, Axis a)
{
- me->set_grob_property ("alignment-done", SCM_BOOL_T);
+ me->set_grob_property ("positioning-done", SCM_BOOL_T);
SCM d = me->get_grob_property ("stacking-dir");
ADD_INTERFACE (Align_interface, "align-interface",
" Order grobs top to bottom/left to right/right to left etc.",
- "forced-distance stacking-dir align-dir threshold alignment-done center-element elements axes");
+ "forced-distance stacking-dir align-dir threshold positioning-done center-element elements axes");
struct Foobar
Beam::brew_molecule (SCM grob)
{
Grob *me = unsmob_grob (grob);
+ position_beam (me);
+
Link_array<Grob> stems=
Pointer_group_interface__extract_grobs (me, (Grob*)0, "stems");
Grob* xcommon = common_refpoint_of_array (stems, me, X_AXIS);
SCM last_beaming = SCM_EOL;;
Real last_xposn = -1;
- Real last_width = -1 ;
+ Real last_stem_width = -1 ;
Real gap_length =0.0;
SCM scm_gap = me->get_grob_property ("gap");
how much to stick out for beams across linebreaks
*/
Real break_overshoot = 3.0;
- Real w = (i>0 && st)? xposn - last_xposn : break_overshoot;
- Real stem_offset = 0.0;
- Real width_corr = 0.0;
- if (i == 1)
- {
- stem_offset -= last_width/2;
- width_corr += last_width/2;
- }
-
- if (i == stems.size() -1)
+ Real w = (i > 0 && st) ? xposn - last_xposn : break_overshoot;
+
+ Real stem_offset =0.0;
+ if (i > 0)
{
- width_corr += stem_width/2;
+ w += last_stem_width / 2;
+ stem_offset = -last_stem_width / 2;
}
-
- Molecule whole = Lookup::beam (dydx, w + width_corr, thick);
+ if (st)
+ w += stem_width/ 2 ;
+
+
+ Real blot = me->get_paper ()->get_realvar (ly_symbol2scm ("blotdiameter"));
+ Molecule whole = Lookup::beam (dydx, w, thick, blot);
Molecule gapped;
int gap_count = 0;
if (gh_number_p (me->get_grob_property ("gap-count")))
{
gap_count = gh_scm2int (me->get_grob_property ("gap-count"));
- gapped = Lookup::beam (dydx, w + width_corr - 2 * gap_length, thick);
+ gapped = Lookup::beam (dydx, w - 2 * gap_length, thick, blot);
full_beams.sort (default_compare);
if (stem_dir == UP)
Real w = (i>0 && st) ? (xposn - last_xposn) : break_overshoot;
w = w/2 <? nw_f;
- Molecule half = Lookup::beam (dydx, w, thick);
+ Molecule half = Lookup::beam (dydx, w, thick, blot);
for (int j = lfliebertjes.size(); j--;)
{
Molecule b (half);
last_xposn = xposn;
- last_width = stem_width;
+ last_stem_width = stem_width;
last_beaming = this_beaming;
}
Beam::after_line_breaking (SCM smob)
{
Grob *me = unsmob_grob (smob);
-
+
+ position_beam (me);
+ return SCM_UNSPECIFIED;
+}
+
+void
+Beam::position_beam (Grob *me)
+{
+ if (to_boolean (me->get_grob_property ("positioning-done")))
+ return ;
+
+ me->set_grob_property ("positioning-done", SCM_BOOL_T);
+
/* Copy to mutable list. */
SCM s = ly_deep_copy (me->get_grob_property ("positions"));
me->set_grob_property ("positions", s);
if (ly_car (s) == SCM_BOOL_F)
{
-
// one wonders if such genericity is necessary --hwn.
SCM callbacks = me->get_grob_property ("position-callbacks");
for (SCM i = callbacks; gh_pair_p (i); i = ly_cdr (i))
- gh_call1 (ly_car (i), smob);
+ gh_call1 (ly_car (i), me->self_scm ());
}
set_stem_lengths (me);
- return SCM_UNSPECIFIED;
}
"the ideal slope, how close the result is to the ideal stems, etc.). We "
"take the best scoring combination. "
,
- "knee position-callbacks concaveness-gap concaveness-threshold dir-function quant-score auto-knee-gap gap gap-count chord-tremolo beamed-stem-shorten shorten least-squares-dy damping flag-width-function neutral-direction positions space-function thickness");
+ "knee positioning-done position-callbacks concaveness-gap concaveness-threshold dir-function quant-score auto-knee-gap gap gap-count chord-tremolo beamed-stem-shorten shorten least-squares-dy damping flag-width-function neutral-direction positions space-function thickness");
assert (a == X_AXIS);
Grob *par = me->get_parent (a);
- if (par && !to_boolean (par->get_grob_property ("break-alignment-done")))
+ if (par && !to_boolean (par->get_grob_property ("positioning-done")))
{
- par->set_grob_property ("break-alignment-done", SCM_BOOL_T);
+ par->set_grob_property ("positioning-done", SCM_BOOL_T);
Break_align_interface::do_alignment (par);
}
"\n"
"Rules for this spacing are much more complicated than this. \n"
"See [Wanske] page 126 -- 134, [Ross] pg 143 -- 147\n",
- "break-align-symbol break-alignment-done space-alist");
+ "break-align-symbol space-alist");
ADD_INTERFACE (Break_align_interface, "break-alignment-interface",
"See @ref{break-aligned-interface}.",
- "break-alignment-done");
+ "positioning-done");
assert (a == Y_AXIS);
me = me->get_parent (X_AXIS);
- if (!to_boolean (me->get_grob_property ("collision-done")))
+ if (!to_boolean (me->get_grob_property ("positioning-done")))
{
- me->set_grob_property ("collision-done", SCM_BOOL_T);
+ me->set_grob_property ("positioning-done", SCM_BOOL_T);
do_shifts (me);
}
ADD_INTERFACE (Dot_column, "dot-column-interface",
"Interface that groups dots so they form a column",
- "collision-done direction stem");
+ "positioning-done direction stem");
static void set_beaming (Grob*,Beaming_info_list *);
static void set_stemlens (Grob*);
static int get_beam_count (Grob*me);
-
+ static void position_beam (Grob* me);
static Real get_beam_translation (Grob*me);
static Real get_thickness (Grob*me);
static Molecule slur (Bezier controls, Real cthick, Real thick);
static Molecule bezier_sandwich (Bezier top_curve, Bezier bottom_curve);
static Molecule horizontal_slope (Real width, Real slope, Real height);
- static Molecule beam (Real slope, Real width, Real thick);
+ static Molecule beam (Real slope, Real width, Real thick, Real blot);
static Molecule dashed_slur (Bezier, Real thick, Real dash);
static Molecule blank (Box b);
static Molecule filled_box (Box b);
}
Molecule
-Lookup::beam (Real slope, Real width, Real thick)
+Lookup::beam (Real slope, Real width, Real thick, Real blot)
{
Real height = slope * width;
Real min_y = (0 <? height) - thick/2;
Real max_y = (0 >? height) + thick/2;
-
-
Box b (Interval (0, width),
Interval (min_y, max_y));
-
SCM at = scm_list_n (ly_symbol2scm ("beam"),
gh_double2scm (width),
gh_double2scm (slope),
gh_double2scm (thick),
+ gh_double2scm (blot),
SCM_UNDEFINED);
return Molecule (b, at);
}
*/
#include <ctype.h>
+
#include "bar-line.hh"
-#include "staff-symbol.hh"
#include "engraver-group-engraver.hh"
#include "engraver.hh"
-#include "lily-guile.hh"
-#include "paper-column.hh"
-#include "paper-def.hh"
-#include "side-position-interface.hh"
-#include "staff-symbol-referencer.hh"
#include "item.hh"
-#include "group-interface.hh"
+#include "warn.hh"
#include "text-item.hh"
/**
virtual void stop_translation_timestep ();
virtual void acknowledge_grob (Grob_info);
void create_items (Music*);
- virtual bool try_music (Music *req);
+ virtual bool try_music (Music *ev);
virtual void process_music ();
private:
- Music * mark_req_;
+ Music * mark_ev_;
};
Mark_engraver::Mark_engraver ()
{
text_ =0;
- mark_req_ = 0;
+ mark_ev_ = 0;
}
void
typeset_grob (text_);
text_ =0;
}
- mark_req_ = 0;
+ mark_ev_ = 0;
}
bool
Mark_engraver::try_music (Music* r)
{
- mark_req_ = r;
+ mark_ev_ = r;
return true;
}
void
Mark_engraver::process_music ()
{
- if (mark_req_)
+ if (mark_ev_)
{
- create_items (mark_req_);
+ create_items (mark_ev_);
/*
automatic marks.
*/
+
- SCM m = mark_req_->get_mus_property ("label");
- if (Text_item::markup_p (m))
- {
- text_->set_grob_property ("text",m);
- }
- else
+ SCM m = mark_ev_->get_mus_property ("label");
+ SCM proc = get_property ("markFormatter");
+ if (!Text_item::markup_p (m) &&
+ gh_procedure_p (proc))
{
- String t ;
-
- if (!gh_string_p (m) && !gh_number_p (m))
+ if (!gh_number_p (m))
m = get_property ("rehearsalMark");
-
- if (gh_number_p (m))
+
+ if (scm_integer_p (m) == SCM_BOOL_T
+ && scm_exact_p (m) == SCM_BOOL_T)
{
int mark_count = gh_scm2int (m);
- t = to_string (mark_count);
mark_count ++;
- m = gh_int2scm (mark_count);
- }
- else if (gh_string_p (m))
- {
- t = ly_scm2string (m);
- String next;
- if (t.length ())
- {
- char c = t[0];
- c++;
- t = to_string (c);
- }
- m = scm_makfrom0str (t.to_str0 ());
+ daddy_trans_->set_property ("rehearsalMark",
+ gh_int2scm (mark_count));
}
- else
- {
- m = gh_int2scm (1);
- t = to_string (1);
- }
-
- text_->set_grob_property ("text",
- scm_makfrom0str (t.to_str0 ()));
- SCM series = SCM_EOL;
- SCM family = ly_symbol2scm ("number");
- for (int i=0; i < t.length (); i++)
- {
- if (!isdigit (t[i]))
- {
- /*
- This looks strange, since \mark "A"
- isn't printed in bold.
-
- */
-
- // series = ly_symbol2scm ("bold");
- family = ly_symbol2scm ("roman");
- break;
- }
- }
- if (gh_symbol_p (series))
- text_->set_grob_property ("font-series", series);
- if (gh_symbol_p (family))
- text_->set_grob_property ("font-family", family);
+ if (gh_number_p (m))
+ m = scm_call_2 (proc, m, daddy_trans_->self_scm ());
+ else
+ warning ("rehearsalMark does not have integer value.");
}
- if (gh_number_p (m) || gh_string_p (m))
- daddy_trans_->set_property ("rehearsalMark", m);
+ if (Text_item::markup_p (m))
+ text_->set_grob_property ("text", m);
+ else
+ warning ("Mark label should be markup object.");
}
}
/* creats*/ "RehearsalMark",
/* accepts */ "mark-event",
/* acks */ "bar-line-interface",
-/* reads */ "rehearsalMark stavesFound",
+/* reads */ "rehearsalMark markFormatter stavesFound",
/* write */ "");
me = me->get_parent (a);
- if (! to_boolean (me->get_grob_property ("collision-done")))
+ if (! to_boolean (me->get_grob_property ("positioning-done")))
{
- me->set_grob_property ("collision-done", SCM_BOOL_T);
+ me->set_grob_property ("positioning-done", SCM_BOOL_T);
do_shifts (me);
}
"directions and horizontal shifts. Most of the interesting properties "
"are to be set in @ref{note-column-interface}: these are "
"@code{force-hshift} and @code{horizontal-shift}. ",
- "merge-differently-dotted merge-differently-headed collision-done");
+ "merge-differently-dotted merge-differently-headed positioning-done");
Grob * rc = unsmob_grob (them->get_grob_property ("rest-collision"));
- if (rc && !to_boolean (rc->get_grob_property ("rest-collision-done")))
+ if (rc && !to_boolean (rc->get_grob_property ("positioning-done")))
{
- rc->set_grob_property ("rest-collision-done", SCM_BOOL_T);
+ rc->set_grob_property ("positioning-done", SCM_BOOL_T);
do_shift (rc);
}
ADD_INTERFACE (Rest_collision,"rest-collision-interface",
"Move around ordinary rests (not multi-measure-rests) to avoid "
"conflicts.",
- "maximum-rest-count minimum-distance rest-collision-done elements");
+ "maximum-rest-count minimum-distance positioning-done elements");
Real ss = Staff_symbol_referencer::staff_space (me);
Real thick = gh_scm2double (me->get_grob_property ("beam-thickness"));
Real width = gh_scm2double (me->get_grob_property ("beam-width"));
+ Real blot = me->get_paper ()->get_realvar (ly_symbol2scm ("blotdiameter"));
+
width *= ss;
thick *= ss;
- Molecule a (Lookup::beam (dydx, width, thick));
+ Molecule a (Lookup::beam (dydx, width, thick, blot));
a.translate (Offset (-width/2, width / 2 * dydx));
int tremolo_flags = 0;
fingeringOrientations = #'(up down)
tupletNumberFormatFunction = #denominator-tuplet-formatter
-
+ markFormatter = #format-mark-letters
+ rehearsalMark = #1
subdivideBeams = ##f
allowBeamBreak = ##f
extraNatural = ##t
%%
bassFigureFormatFunction = #make-bass-figure-markup
- metronomeMarkFormatter = #make-metronome-markup
-
-
+ metronomeMarkFormatter = #format-metronome-markup
graceSettings = #`#(
(Voice Stem direction 1)
} bind def
% Nice beam with rounded corners
-/draw_beam % slope width thick
+/draw_beam % slope width thick blot
{
- currentdict /testing known {
- %% real thin lines for testing
- /blot 0.005 def
- }{
- /blot blot-diameter def
- } ifelse
+ /blot exch def
blot setlinewidth
0 setlinecap
(grob-property-description 'after-line-breaking-callback procedure? "Procedure taking a grob as argument.
This procedure is called (using dependency resolution) after line breaking. Return value is ignored.")
(grob-property-description 'align-dir ly:dir? "Which side to align? -1: left side, 0: around center of width, 1: right side.")
-(grob-property-description 'alignment-done boolean? "boolean to administrate whether we've done the alignment already (to ensure that the process is done only once).")
(grob-property-description 'all-elements grob-list? "list of all grobs in this line. Needed for protecting grobs from GC.")
(grob-property-description 'arch-angle number? "turning angle of the hook of a system brace" )
(grob-property-description 'arch-height ly:dimension? "height of the hook of a system brace.")
(grob-property-description 'right-items grob-list? "")
(grob-property-description 'cause scheme? "Any kind of causation objects (i.e. music, or perhaps translator) that was the cause for this grob. ")
(grob-property-description 'font ly:font-metric? "Cached font metric object")
-(grob-property-description 'break-alignment-done boolean? "mark flag to signal we've done alignment already.")
(grob-property-description
'staff-padding ly:dimension?
"Maintain this much space to the staff. It's effect is similar to
")
(grob-property-description 'staff-symbol ly:grob? "the staff symbol grob that we're in.")
-(grob-property-description 'collision-done boolean? "")
+(grob-property-description 'positioning-done boolean?
+ "Used to signal that a positioning element
+did it's job. This ensures that a positioning is only done once.")
+
(grob-property-description 'rest ly:grob? "the staff symbol grob that we're in.")
(grob-property-description 'rest-collision ly:grob? "rest collision that a rest is in.")
-(grob-property-description 'rest-collision-done boolean? "Is this rest collision processed yet?")
(grob-property-description 'script-molecule pair? "Index code for script -- internal, see script.cc.")
)
(translator-property-description 'localKeySignatureChanges list? "Experimental.
[DOCME]")
+
(translator-property-description 'majorSevenSymbol markup? "How should
the major7 be formatted in a chord name?")
+(translator-property-description 'markFormatter procedure? "Procedure
+taking as arguments context and rehearsal mark. It should return the
+formatted mark as a markup object.")
+
(translator-property-description 'measureLength ly:moment? "Length of one
measure in the current time signature last?")
(translator-property-description 'measurePosition ly:moment? "How much
(translator-property-description 'pedalUnaCordaStyle symbol? "see pedalSustainStyle.")
(translator-property-description 'pedalSostenutoStyle symbol? "see pedalSustainStyle.")
-(translator-property-description 'rehearsalMark number-or-string? "The
+(translator-property-description 'rehearsalMark integer? "The
last rehearsal mark printed.")
(translator-property-description 'repeatCommands list? "This property is read to find any command of the form (volta . X), where X is a string or #f")
(translator-property-description 'scriptDefinitions list? "
(let* (
(x-ext (interval-widen (ly:molecule-get-extent mol 0) padding))
(y-ext (interval-widen (ly:molecule-get-extent mol 1) padding))
+ (y-rule (make-filled-box-molecule (cons 0 thick) y-ext))
(x-rule (make-filled-box-molecule (interval-widen x-ext thick)
- (cons 0 thick)))
- (y-rule (make-filled-box-molecule (cons 0 thick) y-ext)))
-
- (set! mol (ly:molecule-combine-at-edge mol 0 1 y-rule (* 0.5 padding)))
- (set! mol (ly:molecule-combine-at-edge mol 0 -1 y-rule (* 0.5 padding)))
- (set! mol (ly:molecule-combine-at-edge mol 1 1 x-rule 0.0))
- (set! mol (ly:molecule-combine-at-edge mol 1 -1 x-rule 0.0))
+ (cons 0 thick)))
+ )
+ (set! mol (ly:molecule-combine-at-edge mol X 1 y-rule padding))
+ (set! mol (ly:molecule-combine-at-edge mol X -1 y-rule padding))
+ (set! mol (ly:molecule-combine-at-edge mol Y 1 x-rule 0.0))
+ (set! mol (ly:molecule-combine-at-edge mol Y -1 x-rule 0.0))
mol))
(define (setgray g) (string-append (ly:number->string g) "g "))
(define (setlineparams) "1 j 1 J ")
-(define (beam width slope thick)
+(define (beam width slope thick blot)
(let ((ht (* slope width)))
(string-append (moveto 0 (- (/ thick 2)))
(rlineto width ht)
))
-(define (beam width slope thick)
- (embedded-pdf (list 'beam width slope thick)))
+(define (beam width slope thick blot)
+ (embedded-pdf (list 'beam width slope thick blot)))
(define (bracket arch_angle arch_width arch_height height arch_thick thick)
(embedded-pdf (list 'bracket arch_angle arch_width arch_height height arch_thick thick)))
;; Interface functions
-(define (beam width slope thick)
+(define (beam width slope thick blot)
(string-append
- (numbers->string (list slope width thick)) " draw_beam" ))
+ (numbers->string (list slope width thick blot)) " draw_beam" ))
;; two beziers
(define (bezier-sandwich l thick)
(define (font-load-command name-mag command)
"")
-(define (beam x y width slope thick)
+(define (beam x y width slope thick blot)
(apply sketch-filled-rectangle
(list width (* slope width) 0 thick x y)))
(define (dot x y radius)
(embedded-ps (list 'dot x y radius)))
-(define (beam width slope thick)
- (embedded-ps (list 'beam width slope thick)))
+(define (beam width slope thick blot)
+ (embedded-ps (list 'beam width slope thick blot)))
(define (bracket arch_angle arch_width arch_height height arch_thick thick)
(embedded-ps (list 'bracket arch_angle arch_width arch_height height arch_thick thick)))
;; metronome marks
-(define-public (make-metronome-markup event context)
+(define-public (format-metronome-markup event context)
(let*
((dur (ly:get-mus-property event 'tempo-unit))
(count (ly:get-mus-property event 'metronome-count))
))))
+
+
+(define number->mark-letter-vector (make-vector 25 #\A))
+
+(do ((i 0 (1+ i))
+ (j 0 (1+ j)) )
+ ((>= i 26))
+ (if (= i (- (char->integer #\I) (char->integer #\A)))
+ (set! i (1+ i)))
+ (vector-set! number->mark-letter-vector j
+ (integer->char (+ i (char->integer #\A)))) )
+
+(define-public (number->mark-string n)
+ "Double letters for big marks."
+ (let*
+ ((l (vector-length number->mark-letter-vector)))
+ (display n) (newline)
+ (display l) (newline)
+
+ (if (>= n l)
+ (string-append (number->mark-string (1- (quotient n l)))
+ (number->mark-string (remainder n l)))
+ (make-string 1 (vector-ref number->mark-letter-vector n)))))
+
+
+(define-public (format-mark-letters mark context)
+ (make-bold-markup (number->mark-string (1- mark))))
+
+(define-public (format-mark-numbers mark context)
+ (make-bold-markup (number->string mark)))
+
projects / lilypond.git / commitdiff