2004-02-12 Han-Wen Nienhuys <hanwen@xs4all.nl>
+ * scm/documentation-generate.scm (markup-doc-string): dump
+ markup-commands.tely
+
+ * scm/define-markup-commands.scm (override): new file.
+ Move documentation from refman into doc-strings.
+
+ * input/test/staff-container.ly: fix example.
+
+ * ly/engraver-init.ly (AncientRemoveEmptyStaffContext): remove
+ StaffContainer
+
+ * lily/grob.cc: remove point_dimension_callback
+ (Grob): read forced dimensions from X-extent and Y-extent.
+ (get_paper): remove preset_extent.
+
+ * scm/define-grobs.scm (all-grob-descriptions): remove
+ point_dimension_callback.
+
+ * lily/dynamic-engraver.cc (acknowledge_grob): attach dynamic
+ textscript to head. This makes no-spacing-rods work on
+ DynamicText.
+
* lily/chord-name.cc: remove props chord, bass, inversion.
* Documentation/user/appendices.itely: add Scheme functions,
@cindex \NAME\@c
@end macro
+
+
@macro inputfileref{DIR,NAME}
@uref{../../../../\DIR\/out-www/collated-files.html#\NAME\,@file{\DIR\/\NAME\}}@c
@end macro
@end macro
@end ifnottex
+@macro usermanref{NAME}
+@ref{\NAME\}@c
+@end macro
+
@macro refbugs
@noindent
@heading Bugs
composition methods.
@lilypond[staffsize=11,noquote]
-\property Score.TimeSignature \override #'style = #'()
+\property Score.TimeSignature \override #'style =\turnOff
\notes\context PianoStaff <<
\context Staff = SA \relative c' {
\key bes \major
subject.
@lilypond
-\property Score.TimeSignature \override #'style = #'()
+\property Score.TimeSignature \override #'style = \turnOff
%\property Score.TextScript \set #'font-style = #'large
\notes\relative c'' {
\time 4/4
* Contemporary notation::
* Special notation::
* Tuning output::
+* Text markup::
* Global layout::
* Sound::
@end menu
* Constructing a tweak::
* Applyoutput::
* Font selection::
-* Text markup::
@end menu
@node Text markup
-@subsection Text markup
+@section Text markup
@cindex text markup
@cindex markup text
@cindex font size, texts
-
-
-
-@menu
-* Common text markup commands::
-* Markup construction in scheme::
-* Markup command definition::
-@end menu
-
-@node Common text markup commands
-@subsubsection Common text markup commands
-
-
-The following size commands set absolute sizes:
-
-@cindex @code{\teeny}
-@cindex @code{\tiny}
-@cindex @code{\small}
-@cindex @code{\large}
-@cindex @code{\huge}
-
-@table @code
-@item \teeny
-@item \tiny
-@item \small
-@item \large
-@item \huge
-@end table
-
-You can also make letter larger or smaller relative to their neighbors,
-with the commands @code{\larger} and @code{\smaller}.
-@cindex smaller
-@cindex larger
-
-@cindex font style, for texts
-@cindex @code{\bold}
-@cindex @code{\dynamic}
-@cindex @code{\number}
-@cindex @code{\italic}
-
-The following font change commands are defined:
-@table @code
-@item \dynamic
-changes to the font used in dynamic signs. This font does not
-contain all characters of the alphabet, so when producing ``piu f'',
-the ``piu'' should be done in a different font.
-
-
-@item \number
-changes to the font used in time signatures. It only contains
-numbers and a few punctuation marks.
-@item \italic
-changes @code{font-shape} to @code{italic}.
-@item \bold
-changes @code{font-series} to @code{bold}.
-@end table
-
-@cindex raising text
-@cindex lowering text
-@cindex moving text
-@cindex translating text
-
-@cindex @code{\sub}
-@cindex @code{\super}
-
-Raising and lowering texts can be done with @code{\super} and
-@code{\sub}:
-
-@lilypond[verbatim,fragment,relative=1]
- c1^\markup { E "=" mc \super "2" }
-@end lilypond
-
-@cindex @code{\raise}
-
-If you want to give an explicit amount for lowering or raising, use
-@code{\raise}. This command takes a Scheme valued first argument, and
-a markup object as second argument:
-@c
-@lilypond[verbatim,fragment,relative=1,quote]
- c1^\markup { C \small \raise #1.0 \bold { "9/7+" }}
-@end lilypond
-The argument to @code{\raise} is the vertical displacement amount,
-measured in (global) staff spaces. @code{\raise} and @code{\super}
-raise objects in relation to their surrounding markups. They cannot be
-used to move a single text up or down, when it is above or below a
-note, since the mechanism that positions it next to the note cancels
-any vertical shift. For vertical positioning, use the @code{padding}
-and/or @code{extra-offset} properties.
-
-Other commands taking single arguments include
-@table @code
-
-@item \bracket, \hbracket
- Bracket the argument markup with normal and horizontal brackets
-respectively.
-
-@item \musicglyph
-@cindex @code{\musicglyph}
- This is converted to a musical symbol, e.g. @code{\musicglyph
-#"accidentals-0"} will select the natural sign from the music font.
-See @ref{The Feta font} for a complete listing of the possible glyphs.
-
-@item \char
-This produces a single character, e.g. @code{\char #65} produces the
-letter 'A'.
-
-@item \note @var{duration} @var{dir}
-@cindex @code{\note}
-
-This produces a note with a stem pointing in @var{dir} direction, with
-the @var{duration} for the note head type and augmentation dots. For
-example, @code{\note #"4." #-0.75} creates a dotted quarter note, with
-a shortened down stem.
-
-@item \hspace #@var{amount}
-@cindex @code{\hspace}
-This produces a invisible object taking horizontal space.
-@example
-\markup @{ A \hspace #2.0 B @}
-@end example
-will put extra space between A and B, on top of the space that is
-normally inserted before elements on a line.
-
-@item \fontsize #@var{size}
-@cindex @code{\fontsize}
-This sets the relative font size, eg.
-@example
-A \fontsize #2 @{ B C @} D
-@end example
-
-
-This will enlarge the B and the C by two steps.
-@item \translate #(cons @var{x} @var{y})
-@cindex \translate
-This translates an object. Its first argument is a cons of numbers
-@example
-A \translate #(cons 2 -3) @{ B C @} D
-@end example
-This moves `B C' 2 spaces to the right, and 3 down, relative to its
-surroundings. This command cannot be used to move isolated scripts
-vertically, for the same reason that @code{\raise} cannot be used for
-that.
-
-@item \magnify #@var{mag}
-@cindex @code{\magnify}
-This sets the font magnification for the its argument. In the following
-example, the middle A will be 10% larger:
-@example
-A \magnify #1.1 @{ A @} A
-@end example
-
-
-@item \override #(@var{key} . @var{value})
-@cindex @code{\override}
-This overrides a formatting property for its argument. The argument
-should be a key/value pair, e.g.
-@example
- m \override #'(font-family . math) m m
-@end example
-@end table
-
In markup mode you can compose expressions, similar to mathematical
expressions, XML documents and music expressions. The braces group
notes into horizontal lines. Other types of lists also exist: you can
with @code{\raise}. For moving and aligning complete objects, grob
properties should be used.
-@seealso
-Internals: @internalsref{Markup-functions} contains a complete list of
-all markup commands.
+
+@seealso
Init files: @file{scm/new-markup.scm}.
@refbugs
-@cindex kerning
-
-
Text layout is ultimately done by @TeX{}, which does kerning of
letters. LilyPond does not account for kerning, so texts will be
spaced slightly too wide.
+@menu
+* Overview of text markup commands::
+* Markup construction in scheme::
+* Markup command definition::
+@end menu
+
+@node Overview of text markup commands
+@subsection Overview of text markup commands
+
+@include markup-commands.tely
+
@node Markup construction in scheme
-@subsubsection Markup construction in scheme
+@subsection Markup construction in scheme
@cindex defining markup commands
@end lisp
@node Markup command definition
-@subsubsection Markup command definition
+@subsection Markup command definition
New markup commands can be defined thanks to the @code{def-markup-command} scheme macro.
@lisp
-(def-markup-command (@emph{command-name} @emph{paper} @emph{props} @emph{arg1} @emph{arg2} ...) (@emph{arg1-type?} @emph{arg2-type?} ...)
+(def-markup-command (@var{command-name} @var{paper} @var{props} @var{arg1} @var{arg2} ...)
+ (@var{arg1-type?} @var{arg2-type?} ...)
..command body..)
- @emph{argi}: i@emph{th} command argument
- @emph{argi-type?}: a type predicate for the i@emph{th} argument
- @emph{paper}: the `paper' definition
- @emph{props}: a list of alists, containing all active properties.
+ @var{argi}: i@var{th} command argument
+ @var{argi-type?}: a type predicate for the i@var{th} argument
+ @var{paper}: the `paper' definition
+ @var{props}: a list of alists, containing all active properties.
@end lisp
As a simple example, we show how to add a @code{\smallcaps} command,
For example, in this example:
@lilypond[fragment]
-\property Staff.TimeSignature = #'()
+\property Staff.TimeSignature = \turnOff
\key d \major
d' cis' fis'
@end lilypond
of A-flat, it gets an accidental:
@lilypond[fragment]
-\property Staff.TimeSignature = #'()
+\property Staff.TimeSignature =\turnOff
\key as \major
d'
@end lilypond
@cindex Preset Extent
-Grob extents may be hard coded using grob properties. This
-requires Grob::preset_extent () function.
-
+Grob extents may be hard coded using grob properties.
The lyrics in this example have extent (-10,10) which is why they are
spaced so widely.
\score {
\context Lyrics \lyrics {
foo --
- \property Lyrics . LyricText \set #'X-extent-callback = #Grob::preset_extent
+
\property Lyrics . LyricText \set #'X-extent = #'(-10.0 . 10.0)
bar baz
}
texidoc = "
-Container By splitting the grouping (Axis_group_engraver) and creation
+Container by splitting the grouping (Axis_group_engraver) and creation
functionality into separate contexts, you can override interesting
things.
-%%
-%% s4 would create a staff.
-%%
-quarterSkip = #(make-skip-music (ly:make-duration 2 0))
-
\score {
\notes \relative c'' <<
\new StaffContainer {
%% need << >>, otherwise we descend to the voice inside SA
<< \new Staff { c4 c4 } >>
- \quarterSkip
+ \skip 4 % s4 would create staff.
<< \new Staff { b4 b4 } >>
}
\new StaffContainer {
- \quarterSkip
- << \context Staff { e d f } >>
- \quarterSkip
+ \skip 4
+ << \context Staff { e d f \bar ":|" } >>
+ \skip 4
}
>>
\type Engraver_group_engraver
\consists Clef_engraver
\consists Time_signature_engraver
+ \consists Separating_line_group_engraver
\consistsend "Axis_group_engraver"
\accepts "Staff"
\translator {
\StaffContext
\remove Axis_group_engraver
+ \remove Separating_line_group_engraver
\remove Clef_engraver
\remove Time_signature_engraver
}
stems_ = new Link_array<Item>;
grouping_ = new Beaming_info_list;
- beam_settings_ = get_property ("Beam");
+ beam_settings_ = updated_grob_properties (daddy_trans_, ly_symbol2scm ("Beam"));
beam_start_moment_ = now_mom ();
beam_start_location_ = *unsmob_moment (get_property ("measurePosition"));
String type = get_daddy_grav ()->context_name ();
SCM dims = get_property ("verticalExtent");
- if (gh_pair_p (dims) && gh_number_p (ly_car (dims))
- && gh_number_p (ly_cdr (dims)))
- {
- staffline_->set_extent (Grob::preset_extent_proc, Y_AXIS);
- staffline_->set_grob_property ("Y-extent", dims);
- }
+ if (is_number_pair (dims))
+ staffline_->set_extent (dims, Y_AXIS);
dims = get_property ("minimumVerticalExtent");
- if (gh_pair_p (dims) && gh_number_p (ly_car (dims))
- && gh_number_p (ly_cdr (dims)))
+ if (is_number_pair (dims) )
staffline_->set_grob_property ("minimum-Y-extent", dims);
dims = get_property ("extraVerticalExtent");
- if (gh_pair_p (dims) && gh_number_p (ly_car (dims))
- && gh_number_p (ly_cdr (dims)))
+ if (is_number_pair (dims))
staffline_->set_grob_property ("extra-Y-extent", dims);
Grob * it = unsmob_grob (get_property ("currentCommandColumn"));
-
staffline_->set_bound (RIGHT,it);
typeset_grob (staffline_);
{
Item *align_;
Protected_scm column_alist_;
- Item *edge_;
+ Item *left_edge_;
void add_to_group (SCM,Item*);
protected:
typeset_grob (align_);
align_ = 0;
}
- if (edge_)
+ if (left_edge_)
{
- typeset_grob (edge_);
- edge_ = 0;
+ typeset_grob (left_edge_);
+ left_edge_ = 0;
}
}
Break_align_engraver::Break_align_engraver ()
{
column_alist_ = SCM_EOL;
- edge_ = 0;
+ left_edge_ = 0;
align_ = 0;
}
announce_grob (align_, SCM_EOL);
- edge_ = make_item ("LeftEdge");
- add_to_group (edge_->get_grob_property ("break-align-symbol"), edge_);
- announce_grob(edge_, SCM_EOL);
+ left_edge_ = make_item ("LeftEdge");
+ add_to_group (left_edge_->get_grob_property ("break-align-symbol"), left_edge_);
+ announce_grob(left_edge_, SCM_EOL);
}
add_to_group (align_name, item);
if (script_ && !script_->get_parent (X_AXIS))
{
- script_->set_parent (i.grob_, X_AXIS);
+ SCM head = scm_last_pair (i.grob_->get_grob_property ("heads"));
+ if (gh_pair_p (head))
+ script_->set_parent (unsmob_grob (head), X_AXIS);
}
}
eg. when using \override with StaffSymbol. */
char const*onames[] = {"X-offset-callbacks", "Y-offset-callbacks"};
+ char const*xnames[] = {"X-extent", "Y-extent"};
char const*enames[] = {"X-extent-callback", "Y-extent-callback"};
for (int a = X_AXIS; a <= Y_AXIS; a++)
}
SCM cb = get_grob_property (enames[a]);
-
+ SCM xt = get_grob_property (xnames[a]);
+
/*
- Should change default to be empty?
+ Should change default to empty?
*/
- if (cb != SCM_BOOL_F
+ if (is_number_pair (xt))
+ cb = xt;
+ else if (cb != SCM_BOOL_F
&& !gh_procedure_p (cb) && !gh_pair_p (cb)
- && gh_procedure_p (get_grob_property ("print-function"))
- )
+ && gh_procedure_p (get_grob_property ("print-function")))
cb = molecule_extent_proc;
dim_cache_[a].dimension_ = cb;
return ly_interval2scm (e);
}
-MAKE_SCHEME_CALLBACK (Grob,preset_extent,2);
-SCM
-Grob::preset_extent (SCM element_smob, SCM scm_axis)
-{
- Grob *s = unsmob_grob (element_smob);
- Axis a = (Axis) gh_scm2int (scm_axis);
-
- SCM ext = s->get_grob_property ((a == X_AXIS)
- ? "X-extent"
- : "Y-extent");
-
- if (is_number_pair (ext))
- return ext;
- else
- return ly_interval2scm (Interval());
-}
-
-
-
Paper_def*
Grob::get_paper () const
{
}
-MAKE_SCHEME_CALLBACK (Grob,point_dimension_callback,2);
-SCM
-Grob::point_dimension_callback (SCM , SCM)
-{
- return ly_interval2scm (Interval (0,0));
-}
-
bool
Grob::is_empty (Axis a)const
{
"Y-extent-callback print-function extra-offset spacing-procedure "
"staff-symbol interfaces dependencies X-extent Y-extent extra-X-extent "
"meta layer before-line-breaking-callback "
-"after-line-breaking-callback extra-Y-extent minimum-X-extent "
+"after-line-breaking-callback extra-Y-extent minimum-X-extent X-extent Y-extent "
"minimum-Y-extent transparent");
void suicide ();
bool live () const;
- DECLARE_SCHEME_CALLBACK (preset_extent, (SCM smob, SCM axis));
- DECLARE_SCHEME_CALLBACK (point_dimension_callback, (SCM smob, SCM axis));
DECLARE_SCHEME_CALLBACK (molecule_extent, (SCM smob, SCM axis));
static SCM ly_set_grob_property (SCM, SCM,SCM);
Music * r = reqs_[i];
// URG: Text vs TextScript
- String basic = "TextScript";
-
- Item *text = new Item (get_property (basic.to_str0 ()));
+ Item *text = make_item ("TextScript");
Axis ax = Y_AXIS;
}
ADD_INTERFACE (Text_item,"text-interface",
- "A scheme markup text, see @ref{Markup functions}.",
+ "A scheme markup text, see @usermanref{Markup functions}.",
"text baseline-skip word-space");
}
-\translator {
- \type Engraver_group_engraver
- \consists "Axis_group_engraver"
- minimumVerticalExtent = ##f
- extraVerticalExtent = ##f
- verticalExtent = ##f
- localKeySignature = #'()
-
- \accepts Staff
- \name StaffContainer
-}
-
\translator {
\type "Engraver_group_engraver"
\name InnerChoirStaff
\accepts "TabStaff"
\accepts "VaticanaStaff"
\accepts "GregorianTranscriptionStaff"
- \accepts "StaffContainer"
\accepts "StaffGroup"
\accepts "RhythmicStaff"
\accepts "DrumStaff"
(apply define-grob-property x))
`(
- (X-extent-callback ,procedure? "procedure taking an grob and axis
+ (X-extent-callback ,procedure? "Procedure taking a grob and axis
argument, returning a number-pair. The return value is the extent of
the grob. If this value is set to @code{#f}, the object is empty in
the X direction.")
(LeftEdge
. (
(break-align-symbol . left-edge)
- (X-extent-callback . ,Grob::point_dimension_callback)
+ (X-extent . (0 . 0))
(breakable . #t)
(space-alist . (
(custos . (extra-space . 0.0))
(length . 0.66)
(spacing-procedure . ,Hyphen_spanner::set_spacing_rods)
(print-function . ,Hyphen_spanner::print)
- (Y-extent-callback . ,Grob::point_dimension_callback)
+ (Y-extent . (0 . 0))
(meta . ((interfaces . (lyric-interface lyric-hyphen-interface
spanner-interface))))
))
(print-function . ,Lyric_extender::print)
(thickness . 0.8) ; linethickness
(minimum-length . 1.5)
- (Y-extent-callback . ,Grob::point_dimension_callback)
+ (Y-extent . (0 . 0))
(meta . ((interfaces . (lyric-interface
lyric-extender-interface spanner-interface))))
))
--- /dev/null
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; markup commands
+;; TODO:
+;; each markup function should have a doc string with
+;; syntax, description and example.
+;;
+
+
+(def-markup-command (simple paper props str) (string?)
+ "A simple text-string; @code{\\markup @{ foo @}} is equivalent with
+@code{\\markup @{ \\simple #\"foo\" @}}.
+"
+ (interpret-markup paper props str))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; fonts
+
+(define (font-markup qualifier value)
+ (lambda (paper props arg)
+ (interpret-markup paper
+ (prepend-alist-chain qualifier value props)
+ arg)))
+
+
+
+(define-public empty-markup
+ (make-simple-markup ""))
+
+(def-markup-command (line paper props args) (markup-list?)
+ "Put @var{args} in a horizontal line. The property @code{word-space} determines
+the space between each markup in @var{args}.
+"
+ (stack-molecule-line
+ (cdr (chain-assoc 'word-space props))
+ (map (lambda (m) (interpret-markup paper props m)) args)))
+
+(def-markup-command (combine paper props m1 m2) (markup? markup?)
+ "Print two markups on top of each other."
+ (ly:molecule-add
+ (interpret-markup paper props m1)
+ (interpret-markup paper props m2)))
+
+
+(def-markup-command (finger paper props arg) (markup?)
+ "Set the argument as small numbers."
+ (interpret-markup paper
+ (cons '((font-size . -4) (font-family . number)) props)
+ arg))
+
+
+(def-markup-command (fontsize paper props mag arg) (number? markup?)
+ "This sets the relative font size, eg.
+@example
+A \\fontsize #2 @{ B C @} D
+@end example
+
+
+This will enlarge the B and the C by two steps.
+"
+ (interpret-markup
+ paper
+ (prepend-alist-chain 'font-size mag props)
+ arg))
+
+(def-markup-command (magnify paper props sz arg) (number? markup?)
+ "This sets the font magnification for the its argument. In the following
+example, the middle A will be 10% larger:
+@example
+A \\magnify #1.1 @{ A @} A
+@end example
+
+Note: magnification only works if a font-name is explicitly selected.
+Use @code{\\fontsize} otherwise."
+
+ (interpret-markup
+ paper
+ (prepend-alist-chain 'font-magnification sz props)
+ arg))
+
+(def-markup-command (bold paper props arg) (markup?)
+ "Switch to bold font-series"
+ (interpret-markup paper (prepend-alist-chain 'font-series 'bold props) arg))
+
+(def-markup-command (sans paper props arg) (markup?)
+ "Switch to the sans-serif family"
+ (interpret-markup paper (prepend-alist-chain 'font-family 'sans props) arg))
+
+(def-markup-command (number paper props arg) (markup?)
+ "Set font family to @code{number}, which yields the font used for
+time signatures and fingerings. This font only contains numbers and
+some punctuation. It doesn't have any letters. "
+ (interpret-markup paper (prepend-alist-chain 'font-family 'number props) arg))
+
+(def-markup-command (roman paper props arg) (markup?)
+ "Set font family to @code{roman}."
+ (interpret-markup paper (prepend-alist-chain 'font-family 'roman props) arg))
+
+(def-markup-command (huge paper props arg) (markup?)
+ "Set font size to +2."
+ (interpret-markup paper (prepend-alist-chain 'font-size 2 props) arg))
+
+(def-markup-command (large paper props arg) (markup?)
+ "Set font size to +1."
+ (interpret-markup paper (prepend-alist-chain 'font-size 1 props) arg))
+
+(def-markup-command (normalsize paper props arg) (markup?)
+ "Set font size to default."
+ (interpret-markup paper (prepend-alist-chain 'font-size 0 props) arg))
+
+(def-markup-command (small paper props arg) (markup?)
+ "Set font size to -1."
+ (interpret-markup paper (prepend-alist-chain 'font-size -1 props) arg))
+
+(def-markup-command (tiny paper props arg) (markup?)
+ "Set font size to -2."
+ (interpret-markup paper (prepend-alist-chain 'font-size -2 props) arg))
+
+(def-markup-command (teeny paper props arg) (markup?)
+ "Set font size to -3."
+ (interpret-markup paper (prepend-alist-chain 'font-size -3 props) arg))
+
+(def-markup-command (dynamic paper props arg) (markup?)
+ "Use the dynamic font. This font only contains s, f, m, z, p, and
+r. When producing phrases, like ``piu f'', the normal words (like
+``piu'') should be done in a different font.
+The recommend font for this is bold and italic
+"
+ (interpret-markup paper (prepend-alist-chain 'font-family 'dynamic props) arg))
+
+(def-markup-command (italic paper props arg) (markup?)
+ (interpret-markup paper (prepend-alist-chain 'font-shape 'italic props) arg))
+
+(def-markup-command (typewriter paper props arg) (markup?)
+ (interpret-markup paper (prepend-alist-chain 'font-family 'typewriter props) arg))
+
+(def-markup-command (doublesharp paper props) ()
+ (interpret-markup paper props (markup #:musicglyph "accidentals-4")))
+(def-markup-command (threeqsharp paper props) ()
+ (interpret-markup paper props (markup #:musicglyph "accidentals-3")))
+(def-markup-command (sharp paper props) ()
+ (interpret-markup paper props (markup #:musicglyph "accidentals-2")))
+(def-markup-command (semisharp paper props) ()
+ (interpret-markup paper props (markup #:musicglyph "accidentals-1")))
+(def-markup-command (natural paper props) ()
+ (interpret-markup paper props (markup #:musicglyph "accidentals-0")))
+(def-markup-command (semiflat paper props) ()
+ (interpret-markup paper props (markup #:musicglyph "accidentals--1")))
+(def-markup-command (flat paper props) ()
+ (interpret-markup paper props (markup #:musicglyph "accidentals--2")))
+(def-markup-command (threeqflat paper props) ()
+ (interpret-markup paper props (markup #:musicglyph "accidentals--3")))
+(def-markup-command (doubleflat paper props) ()
+ (interpret-markup paper props (markup #:musicglyph "accidentals--4")))
+
+
+(def-markup-command (column paper props args) (markup-list?)
+ (stack-lines
+ -1 0.0 (cdr (chain-assoc 'baseline-skip props))
+ (map (lambda (m) (interpret-markup paper props m)) args)))
+
+(def-markup-command (dir-column paper props args) (markup-list?)
+ "Make a column of args, going up or down, depending on the setting
+of the #'direction layout property."
+ (let* ((dir (cdr (chain-assoc 'direction props))))
+ (stack-lines
+ (if (number? dir) dir -1)
+ 0.0
+ (cdr (chain-assoc 'baseline-skip props))
+ (map (lambda (x) (interpret-markup paper props x)) args))))
+
+(def-markup-command (center paper props args) (markup-list?)
+ (let* ((mols (map (lambda (x) (interpret-markup paper props x)) args))
+ (cmols (map (lambda (x) (ly:molecule-align-to! x X CENTER)) mols)))
+ (stack-lines -1 0.0 (cdr (chain-assoc 'baseline-skip props)) mols)))
+
+(def-markup-command (right-align paper props arg) (markup?)
+ (let* ((m (interpret-markup paper props arg)))
+ (ly:molecule-align-to! m X RIGHT)
+ m))
+
+(def-markup-command (left-align paper props arg) (markup?)
+ (let* ((m (interpret-markup paper props arg)))
+ (ly:molecule-align-to! m X LEFT)
+ m))
+
+(def-markup-command (halign paper props dir arg) (number? markup?)
+ "Set horizontal alignment. @var{dir} = -1 is left, @var{dir} = 1 is
+right, values in between vary alignment accordingly."
+
+
+ (let* ((m (interpret-markup paper props arg)))
+ (ly:molecule-align-to! m X dir)
+ m))
+
+(def-markup-command (musicglyph paper props glyph-name) (string?)
+ "This is converted to a musical symbol, e.g. @code{\\musicglyph
+#\"accidentals-0\"} will select the natural sign from the music font.
+See @usermanref{The Feta font} for a complete listing of the possible glyphs.
+"
+ (ly:find-glyph-by-name
+ (ly:paper-get-font paper (cons '((font-name . ())
+ (font-shape . *)
+ (font-series . *)
+ (font-family . music))
+ props))
+ glyph-name))
+
+
+(def-markup-command (lookup paper props glyph-name) (string?)
+ "Lookup a glyph by name."
+ (ly:find-glyph-by-name (ly:paper-get-font paper props)
+ glyph-name))
+
+(def-markup-command (char paper props num) (integer?)
+ "This produces a single character, e.g. @code{\\char #65} produces the
+letter 'A'."
+ (ly:get-glyph (ly:paper-get-font paper props) num))
+
+(def-markup-command (raise paper props amount arg) (number? markup?)
+ "
+This raises @var{arg}, by the distance @var{amount}.
+A negative @var{amount} indicates lowering:
+@c
+@lilypond[verbatim,fragment,relative=1,quote]
+ c1^\\markup { C \\small \\raise #1.0 \\bold { \"9/7+\" }}
+@end lilypond
+The argument to @code{\\raise} is the vertical displacement amount,
+measured in (global) staff spaces. @code{\\raise} and @code{\\super}
+raise objects in relation to their surrounding markups.
+
+If the text object itself is positioned above or below the staff, then
+@code{\\raise} cannot be used to move it, since the mechanism that
+positions it next to the staff cancels any shift made with
+@code{\\raise}. For vertical positioning, use the @code{padding}
+and/or @code{extra-offset} properties. "
+
+
+ (ly:molecule-translate-axis (interpret-markup paper props arg)
+ amount Y))
+
+(def-markup-command (fraction paper props arg1 arg2) (markup? markup?)
+ "Make a fraction of two markups.
+
+Syntax: \\fraction MARKUP1 MARKUP2."
+ (let* ((m1 (interpret-markup paper props arg1))
+ (m2 (interpret-markup paper props arg2)))
+ (ly:molecule-align-to! m1 X CENTER)
+ (ly:molecule-align-to! m2 X CENTER)
+ (let* ((x1 (ly:molecule-get-extent m1 X))
+ (x2 (ly:molecule-get-extent m2 X))
+ (line (ly:round-filled-box (interval-union x1 x2) '(-0.05 . 0.05) 0.0))
+ ;; should stack mols separately, to maintain LINE on baseline
+ (stack (stack-lines -1 0.2 0.6 (list m1 line m2))))
+ (ly:molecule-align-to! stack Y CENTER)
+ (ly:molecule-align-to! stack X LEFT)
+ ;; should have EX dimension
+ ;; empirical anyway
+ (ly:molecule-translate-axis stack 0.75 Y))))
+
+
+;; TODO: better syntax.
+
+(def-markup-command (note-by-number paper props log dot-count dir) (number? number? number?)
+ "Syntax: \\note-by-number #LOG #DOTS #DIR. By using fractional values
+for DIR, you can obtain longer or shorter stems."
+ (let* ((font (ly:paper-get-font paper (cons '((font-family . music)) props)))
+ (stemlen (max 3 (- log 1)))
+ (headgl (ly:find-glyph-by-name
+ font
+ (string-append "noteheads-" (number->string (min log 2)))))
+ (stemth 0.13)
+ (stemy (* dir stemlen))
+ (attachx (if (> dir 0)
+ (- (cdr (ly:molecule-get-extent headgl X)) stemth)
+ 0))
+ (attachy (* dir 0.28))
+ (stemgl (and (> log 0)
+ (ly:round-filled-box
+ (cons attachx (+ attachx stemth))
+ (cons (min stemy attachy)
+ (max stemy attachy))
+ (/ stemth 3))))
+ (dot (ly:find-glyph-by-name font "dots-dot"))
+ (dotwid (interval-length (ly:molecule-get-extent dot X)))
+ (dots (and (> dot-count 0)
+ (apply ly:molecule-add
+ (map (lambda (x)
+ (ly:molecule-translate-axis
+ dot (* (+ 1 (* 2 x)) dotwid) X) )
+ (iota dot-count 1)))))
+ (flaggl (and (> log 2)
+ (ly:molecule-translate
+ (ly:find-glyph-by-name font
+ (string-append "flags-"
+ (if (> dir 0) "u" "d")
+ (number->string log)))
+ (cons (+ attachx (/ stemth 2)) stemy)))))
+ (if flaggl
+ (set! stemgl (ly:molecule-add flaggl stemgl)))
+ (if (ly:molecule? stemgl)
+ (set! stemgl (ly:molecule-add stemgl headgl))
+ (set! stemgl headgl))
+ (if (ly:molecule? dots)
+ (set! stemgl
+ (ly:molecule-add
+ (ly:molecule-translate-axis dots
+ (+ (if (and (> dir 0) (> log 2))
+ (* 1.5 dotwid)
+ 0)
+ ;; huh ? why not necessary?
+ ;;(cdr (ly:molecule-get-extent headgl X))
+ dotwid)
+ X)
+ stemgl)))
+ stemgl))
+
+(use-modules (ice-9 regex))
+
+(define-public log2
+ (let ((divisor (log 2)))
+ (lambda (z) (inexact->exact (/ (log z) divisor)))))
+
+(define (parse-simple-duration duration-string)
+ "Parse the `duration-string', eg ''4..'' or ''breve.'', and return a (log dots) list."
+ (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)") duration-string)))
+ (if (and match (string=? duration-string (match:substring match 0)))
+ (let ((len (match:substring match 1))
+ (dots (match:substring match 2)))
+ (list (cond ((string=? len "breve") -1)
+ ((string=? len "longa") -2)
+ ((string=? len "maxima") -3)
+ (else (log2 (string->number len))))
+ (if dots (string-length dots) 0)))
+ (error "This is not a valid duration string:" duration-string))))
+
+(def-markup-command (note paper props duration dir) (string? number?)
+ "This produces a note with a stem pointing in @var{dir} direction, with
+the @var{duration} for the note head type and augmentation dots. For
+example, @code{\\note #\"4.\" #-0.75} creates a dotted quarter note, with
+a shortened down stem."
+
+ (let ((parsed (parse-simple-duration duration)))
+ (note-by-number-markup paper props (car parsed) (cadr parsed) dir)))
+
+(def-markup-command (normal-size-super paper props arg) (markup?)
+ "A superscript which does not use a smaller font."
+ (ly:molecule-translate-axis (interpret-markup
+ paper
+ props arg)
+ (* 0.5 (cdr (chain-assoc 'baseline-skip props)))
+ Y))
+
+(def-markup-command (super paper props arg) (markup?)
+ "
+@cindex raising text
+@cindex lowering text
+@cindex moving text
+@cindex translating text
+
+@cindex @code{\\super}
+
+
+Raising and lowering texts can be done with @code{\\super} and
+@code{\\sub}:
+
+@lilypond[verbatim,fragment,relative=1]
+ c1^\\markup { E \"=\" mc \\super \"2\" }
+@end lilypond
+
+"
+
+ (ly:molecule-translate-axis
+ (interpret-markup
+ paper
+ (cons `((font-size . ,(- (chain-assoc-get 'font-size props 0) 3))) props)
+ arg)
+ (* 0.5 (cdr (chain-assoc 'baseline-skip props)))
+ Y))
+
+(def-markup-command (translate paper props offset arg) (number-pair? markup?)
+ "This translates an object. Its first argument is a cons of numbers
+@example
+A \\translate #(cons 2 -3) @{ B C @} D
+@end example
+This moves `B C' 2 spaces to the right, and 3 down, relative to its
+surroundings. This command cannot be used to move isolated scripts
+vertically, for the same reason that @code{\\raise} cannot be used for
+that.
+
+. "
+ (ly:molecule-translate (interpret-markup paper props arg)
+ offset))
+
+(def-markup-command (sub paper props arg) (markup?)
+ "Syntax: \\sub MARKUP."
+ (ly:molecule-translate-axis
+ (interpret-markup
+ paper
+ (cons `((font-size . ,(- (chain-assoc-get 'font-size props 0) 3))) props)
+ arg)
+ (* -0.5 (cdr (chain-assoc 'baseline-skip props)))
+ Y))
+
+(def-markup-command (normal-size-sub paper props arg) (markup?)
+ (ly:molecule-translate-axis
+ (interpret-markup paper props arg)
+ (* -0.5 (cdr (chain-assoc 'baseline-skip props)))
+ Y))
+
+(def-markup-command (hbracket paper props arg) (markup?)
+ "Horizontal brackets around @var{arg}."
+ (let ((th 0.1) ;; todo: take from GROB.
+ (m (interpret-markup paper props arg)))
+ (bracketify-molecule m X th (* 2.5 th) th)))
+
+(def-markup-command (bracket paper props arg) (markup?)
+ "Vertical brackets around @var{arg}."
+ (let ((th 0.1) ;; todo: take from GROB.
+ (m (interpret-markup paper props arg)))
+ (bracketify-molecule m Y th (* 2.5 th) th)))
+
+;; todo: fix negative space
+(def-markup-command (hspace paper props amount) (number?)
+ "This produces a invisible object taking horizontal space.
+@example
+\\markup @{ A \\hspace #2.0 B @}
+@end example
+will put extra space between A and B, on top of the space that is
+normally inserted before elements on a line.
+"
+ (if (> amount 0)
+ (ly:make-molecule "" (cons 0 amount) '(-1 . 1) )
+ (ly:make-molecule "" (cons amount amount) '(-1 . 1))))
+
+(def-markup-command (override paper props new-prop arg) (pair? markup?)
+ "Add the first argument in to the property list. Properties may be
+any sort of property supported by @internalsref{font-interface} and
+@internalsref{text-interface}, for example
+
+@verbatim
+\\override #'(font-family . married) \"bla\"
+@end verbatim
+
+"
+ (interpret-markup paper (cons (list new-prop) props) arg))
+
+(def-markup-command (smaller paper props arg) (markup?)
+ "Decrease the font size relative to current setting"
+ (let* ((fs (chain-assoc-get 'font-size props 0))
+ (entry (cons 'font-size (- fs 1))))
+ (interpret-markup paper (cons (list entry) props) arg)))
+
+
+(def-markup-command (bigger paper props arg) (markup?)
+ "Increase the font size relative to current setting"
+ (let* ((fs (chain-assoc-get 'font-size props 0))
+ (entry (cons 'font-size (+ fs 1))))
+ (interpret-markup paper (cons (list entry) props) arg)))
+
+(def-markup-command larger (markup?)
+ bigger-markup)
+
+(def-markup-command (box paper props arg) (markup?)
+ "Draw a box round @var{arg}"
+
+ (let ((th 0.1)
+ (pad 0.2)
+ (m (interpret-markup paper props arg)))
+ (box-molecule m th pad)))
+
+(def-markup-command (strut paper props) ()
+
+ "Create a box of the same height as the space in the current font.
+
+FIXME: is this working?
+"
+
+ (let ((m (Text_item::interpret_markup paper props " ")))
+ (ly:molecule-set-extent! m X '(1000 . -1000))
+ m))
+
+(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 (number->markletter-string n)
+ "Double letters for big marks."
+ (let*
+ ((l (vector-length number->mark-letter-vector)))
+
+ (if (>= n l)
+ (string-append (number->markletter-string (1- (quotient n l)))
+ (number->markletter-string (remainder n l)))
+ (make-string 1 (vector-ref number->mark-letter-vector n)))))
+
+
+(def-markup-command (markletter paper props num) (integer?)
+ "Make a markup letter for @var{num}. The letters start with A to Z
+(skipping I), and continues with double letters."
+
+ (Text_item::interpret_markup paper props (number->markletter-string num)))
+
(
(doc-str (procedure-documentation func) )
(f-name (symbol->string (procedure-name func)))
+ (c-name (regexp-substitute/global #f "-markup$" f-name 'pre "" 'post))
(sig (object-property func 'markup-signature))
- (sig-str (string-join (map type-name sig) " "))
- )
+ (arg-names
+ (map symbol->string
+ (cddr (cadr (procedure-source func)))))
+
+ (sig-type-names (map type-name sig))
+ (signature (zip arg-names sig-type-names))
+ (signature-str
+ (string-join
+ (map (lambda (x) (string-append
+ "@var{" (car x) "} (" (cadr x) ")" ))
+ (zip arg-names sig-type-names))
+ " " )))
(string-append
- "\n\n@b{"
- f-name
- "}\n\n@findex " f-name "\n"
- "\n\n@i{Argument types}: " sig-str
- (if (string? doc-str)
- (string-append
- "\n\n@i{Description}: \n\n"
- doc-str)
- "")
+ "\n\n@item @code{\\" c-name "} " signature-str
+ "\n@findex " f-name "\n"
+ "\n@cindex " c-name "\n"
+ (if (string? doc-str)
+ doc-str
+ "")
)))
(define (markup-function<? a b)
(string<? (symbol->string (procedure-name a)) (symbol->string (procedure-name b))))
+(define (markup-doc-string)
+ (string-append
+
+ "@table @asis"
+ (apply string-append
+
+ (map doc-markup-function
+ (sort markup-function-list markup-function<?) ) )
+ "\n@end table"
+
+ ))
+
(define (markup-doc-node)
(make <texi-node>
#:name "Markup functions"
#:desc "Definitions of the markup functions."
-
-
- #:text (apply string-append
-
- "A @code{\\markup} mode command, eg. @code{bold}, is
-coupled with a Scheme function (@code{bold-markup}) implementing the
-formatting. For use in Scheme, a function @code{make-bold-markup} is
-also defined, which constructs a Markup expression.
-
-This chapter describes all of the @code{...-markup} functions.
-
-"
-
- (map doc-markup-function
- (sort markup-function-list markup-function<?) ))
- ))
-
-
+ #:text (markup-doc-string)))
;; are described...
(define no-copies #f)
+
+
+
+
+
+
+
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(dump-node (all-scheme-functions-doc)
+ (open-output-file "scheme-functions.tely")
+ 2)
+
+(display
+ (markup-doc-string)
+
+ (open-output-file "markup-commands.tely")
+ )
+
+(dump-node
+ (make <texi-node>
+ #:name "Layout property overview"
+ #:desc "All user serviceable layout properties"
+ #:text (backend-properties-doc-string all-user-grob-properties))
+
+ (open-output-file "layout-properties.tely")
+ 2)
+
+(dump-node
+ (make <texi-node>
+ #:name "Context property overview"
+ #:desc "All user serviceable context properties"
+ #:text (translation-properties-doc-string all-user-translation-properties))
+
+ (open-output-file "context-properties.tely")
+ 2)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
(define file-name "lilypond-internals")
(define outname (string-append file-name ".texi"))
+
+
(define out-port (open-output-file outname))
(writing-wip outname)
+
+
+
+
(display
(string-append
"@c -*-texinfo-*-"
(translation-doc-node)
(backend-doc-node)
(all-scheme-functions-doc)
- (markup-doc-node)
(make <texi-node>
#:name "Index"
#:text "
(newline (current-error-port))
-(dump-node (all-scheme-functions-doc)
- (open-output-file "scheme-functions.tely")
- 2)
-
-(dump-node
- (make <texi-node>
- #:name "Layout property overview"
- #:desc "All user serviceable layout properties"
- #:text (backend-properties-doc-string all-user-grob-properties))
-
- (open-output-file "layout-properties.tely")
- 2)
-
-(dump-node
- (make <texi-node>
- #:name "Context property overview"
- #:desc "All user serviceable context properties"
- #:text (translation-properties-doc-string all-user-translation-properties))
-
- (open-output-file "context-properties.tely")
- 2)
"slur.scm"
"font.scm"
+ "define-markup-commands.scm"
"define-grob-properties.scm"
"define-grobs.scm"
"define-grob-interfaces.scm"
))
-
-
-
(set! type-p-name-alist
`(
(,boolean-or-symbol? . "boolean or symbol")
;;; definitions and user defined markups.
(defmacro-public def-markup-command (command-and-args signature . body)
- "Define a COMMAND-markup function after command-and-args and body,
+ "
+
+* Define a COMMAND-markup function after command-and-args and body,
register COMMAND-markup and its signature,
-add COMMAND-markup to markup-function-list,
-sets COMMAND-markup markup-signature and markup-keyword object properties,
-define a make-COMMAND-markup function.
+
+* add COMMAND-markup to markup-function-list,
+
+* sets COMMAND-markup markup-signature and markup-keyword object properties,
+
+* define a make-COMMAND-markup function.
+
Syntax:
(def-markup-command (COMMAND paper props arg1 arg2 ...) (arg1-type? arg2-type? ...)
\"documentation string\"
(make-line-markup (list-insert-separator markups sep))
empty-markup))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; markup commands
-;; TODO:
-;; each markup function should have a doc string with
-;; syntax, description and example.
-;;
-
(define-public brew-new-markup-molecule Text_item::print)
-
(define-public interpret-markup Text_item::interpret_markup)
+(define-public (prepend-alist-chain key val chain)
+ (cons (acons key val (car chain)) (cdr chain)))
+
-(def-markup-command (simple paper props str) (string?)
- "A simple text-string; @code{\\markup @{ foo @}} is equivalent with
-@code{\\markup @{ \\simple #\"foo\" @}}.
-"
- (interpret-markup paper props str))
-(define-public empty-markup (make-simple-markup ""))
(define-public (stack-molecule-line space molecules)
(if (pair? molecules)
(car molecules))
'()))
-(def-markup-command (line paper props markps) (markup-list?)
- "A horizontal line of markups. Syntax:
-\\line << MARKUPS >>
-"
- (stack-molecule-line
- (cdr (chain-assoc 'word-space props))
- (map (lambda (m) (interpret-markup paper props m)) markps)))
-
-(def-markup-command (combine paper props m1 m2) (markup? markup?)
- "Overstrike two markups."
- (ly:molecule-add
- (interpret-markup paper props m1)
- (interpret-markup paper props m2)))
-
-(def-markup-command (finger paper props arg) (markup?)
- (interpret-markup paper
- (cons '((font-size . -4) (font-family . number)) props)
- arg))
-
-(define-public (set-property-markup qualifier)
- (lambda (paper props qualifier-val markp)
- (interpret-markup paper
- (cons (cons `(,qualifier . ,qualifier-val) (car props)) (cdr props))
- markp)))
-
-(def-markup-command fontsize (number? markup?)
- (set-property-markup 'font-size))
-
-(def-markup-command magnify (number? markup?)
- (set-property-markup 'font-magnification))
-
-(define (font-markup qualifier value)
- (lambda (paper props markp)
- (interpret-markup paper
- (cons (cons `(,qualifier . ,value) (car props)) (cdr props))
- markp)))
-
-(def-markup-command bold (markup?)
- (font-markup 'font-series 'bold))
-
-(def-markup-command sans (markup?)
- (font-markup 'font-family 'sans))
-
-(def-markup-command number (markup?)
- (font-markup 'font-family 'number))
-
-(def-markup-command roman (markup?)
- (font-markup 'font-family 'roman))
-
-(def-markup-command huge (markup?)
- (font-markup 'font-size 2))
-
-(def-markup-command large (markup?)
- (font-markup 'font-size 1))
-
-(def-markup-command normalsize (markup?)
- (font-markup 'font-size 0))
-
-(def-markup-command small (markup?)
- (font-markup 'font-size -1))
-
-(def-markup-command tiny (markup?)
- (font-markup 'font-size -2))
-
-(def-markup-command teeny (markup?)
- (font-markup 'font-size -3))
-
-(def-markup-command dynamic (markup?)
- (font-markup 'font-family 'dynamic))
-
-(def-markup-command italic (markup?)
- (font-markup 'font-shape 'italic))
-
-(def-markup-command typewriter (markup?)
- (font-markup 'font-family 'typewriter))
-
-(def-markup-command (doublesharp paper props) ()
- (interpret-markup paper props (markup #:musicglyph "accidentals-4")))
-(def-markup-command (threeqsharp paper props) ()
- (interpret-markup paper props (markup #:musicglyph "accidentals-3")))
-(def-markup-command (sharp paper props) ()
- (interpret-markup paper props (markup #:musicglyph "accidentals-2")))
-(def-markup-command (semisharp paper props) ()
- (interpret-markup paper props (markup #:musicglyph "accidentals-1")))
-(def-markup-command (natural paper props) ()
- (interpret-markup paper props (markup #:musicglyph "accidentals-0")))
-(def-markup-command (semiflat paper props) ()
- (interpret-markup paper props (markup #:musicglyph "accidentals--1")))
-(def-markup-command (flat paper props) ()
- (interpret-markup paper props (markup #:musicglyph "accidentals--2")))
-(def-markup-command (threeqflat paper props) ()
- (interpret-markup paper props (markup #:musicglyph "accidentals--3")))
-(def-markup-command (doubleflat paper props) ()
- (interpret-markup paper props (markup #:musicglyph "accidentals--4")))
-
-
-(def-markup-command (column paper props mrkups) (markup-list?)
- (stack-lines
- -1 0.0 (cdr (chain-assoc 'baseline-skip props))
- (map (lambda (m) (interpret-markup paper props m)) mrkups)))
-
-(def-markup-command (dir-column paper props mrkups) (markup-list?)
- "Make a column of args, going up or down, depending on the setting
-of the #'direction layout property."
- (let* ((dir (cdr (chain-assoc 'direction props))))
- (stack-lines
- (if (number? dir) dir -1)
- 0.0
- (cdr (chain-assoc 'baseline-skip props))
- (map (lambda (x) (interpret-markup paper props x)) mrkups))))
-
-(def-markup-command (center paper props mrkups) (markup-list?)
- (let* ((mols (map (lambda (x) (interpret-markup paper props x)) mrkups))
- (cmols (map (lambda (x) (ly:molecule-align-to! x X CENTER)) mols)))
- (stack-lines -1 0.0 (cdr (chain-assoc 'baseline-skip props)) mols)))
-
-(def-markup-command (right-align paper props mrkup) (markup?)
- (let* ((m (interpret-markup paper props mrkup)))
- (ly:molecule-align-to! m X RIGHT)
- m))
-
-(def-markup-command (left-align paper props mrkup) (markup?)
- (let* ((m (interpret-markup paper props mrkup)))
- (ly:molecule-align-to! m X LEFT)
- m))
-
-(def-markup-command (halign paper props dir mrkup) (number? markup?)
- "Set horizontal alignment. Syntax: halign A MARKUP. A=-1 is LEFT,
-A=1 is right, values in between vary alignment accordingly."
- (let* ((m (interpret-markup paper props mrkup)))
- (ly:molecule-align-to! m X dir)
- m))
-
-(def-markup-command (musicglyph paper props glyph-name) (string?)
- (ly:find-glyph-by-name
- (ly:paper-get-font paper (cons '((font-name . ())
- (font-shape . *)
- (font-series . *)
- (font-family . music))
- props))
- glyph-name))
-
-
-(def-markup-command (lookup paper props glyph-name) (string?)
- "Lookup a glyph by name."
- (ly:find-glyph-by-name (ly:paper-get-font paper props)
- glyph-name))
-
-(def-markup-command (char paper props num) (integer?)
- "Syntax: \\char NUMBER. "
- (ly:get-glyph (ly:paper-get-font paper props) num))
-
-(def-markup-command (raise paper props amount mrkup) (number? markup?)
- "Syntax: \\raise AMOUNT MARKUP. "
- (ly:molecule-translate-axis (interpret-markup paper props mrkup)
- amount Y))
-
-(def-markup-command (fraction paper props mrkup1 mrkup2) (markup? markup?)
- "Make a fraction of two markups.
-
-Syntax: \\fraction MARKUP1 MARKUP2."
- (let* ((m1 (interpret-markup paper props mrkup1))
- (m2 (interpret-markup paper props mrkup2)))
- (ly:molecule-align-to! m1 X CENTER)
- (ly:molecule-align-to! m2 X CENTER)
- (let* ((x1 (ly:molecule-get-extent m1 X))
- (x2 (ly:molecule-get-extent m2 X))
- (line (ly:round-filled-box (interval-union x1 x2) '(-0.05 . 0.05) 0.0))
- ;; should stack mols separately, to maintain LINE on baseline
- (stack (stack-lines -1 0.2 0.6 (list m1 line m2))))
- (ly:molecule-align-to! stack Y CENTER)
- (ly:molecule-align-to! stack X LEFT)
- ;; should have EX dimension
- ;; empirical anyway
- (ly:molecule-translate-axis stack 0.75 Y))))
-
-
-;; TODO: better syntax.
-
-(def-markup-command (note-by-number paper props log dot-count dir) (number? number? number?)
- "Syntax: \\note-by-number #LOG #DOTS #DIR. By using fractional values
-for DIR, you can obtain longer or shorter stems."
- (let* ((font (ly:paper-get-font paper (cons '((font-family . music)) props)))
- (stemlen (max 3 (- log 1)))
- (headgl (ly:find-glyph-by-name
- font
- (string-append "noteheads-" (number->string (min log 2)))))
- (stemth 0.13)
- (stemy (* dir stemlen))
- (attachx (if (> dir 0)
- (- (cdr (ly:molecule-get-extent headgl X)) stemth)
- 0))
- (attachy (* dir 0.28))
- (stemgl (and (> log 0)
- (ly:round-filled-box
- (cons attachx (+ attachx stemth))
- (cons (min stemy attachy)
- (max stemy attachy))
- (/ stemth 3))))
- (dot (ly:find-glyph-by-name font "dots-dot"))
- (dotwid (interval-length (ly:molecule-get-extent dot X)))
- (dots (and (> dot-count 0)
- (apply ly:molecule-add
- (map (lambda (x)
- (ly:molecule-translate-axis
- dot (* (+ 1 (* 2 x)) dotwid) X) )
- (iota dot-count 1)))))
- (flaggl (and (> log 2)
- (ly:molecule-translate
- (ly:find-glyph-by-name font
- (string-append "flags-"
- (if (> dir 0) "u" "d")
- (number->string log)))
- (cons (+ attachx (/ stemth 2)) stemy)))))
- (if flaggl
- (set! stemgl (ly:molecule-add flaggl stemgl)))
- (if (ly:molecule? stemgl)
- (set! stemgl (ly:molecule-add stemgl headgl))
- (set! stemgl headgl))
- (if (ly:molecule? dots)
- (set! stemgl
- (ly:molecule-add
- (ly:molecule-translate-axis dots
- (+ (if (and (> dir 0) (> log 2))
- (* 1.5 dotwid)
- 0)
- ;; huh ? why not necessary?
- ;;(cdr (ly:molecule-get-extent headgl X))
- dotwid)
- X)
- stemgl)))
- stemgl))
-
-(use-modules (ice-9 regex))
-
-(define-public log2
- (let ((divisor (log 2)))
- (lambda (z) (inexact->exact (/ (log z) divisor)))))
-
-(define (parse-simple-duration duration-string)
- "Parse the `duration-string', eg ''4..'' or ''breve.'', and return a (log dots) list."
- (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)") duration-string)))
- (if (and match (string=? duration-string (match:substring match 0)))
- (let ((len (match:substring match 1))
- (dots (match:substring match 2)))
- (list (cond ((string=? len "breve") -1)
- ((string=? len "longa") -2)
- ((string=? len "maxima") -3)
- (else (log2 (string->number len))))
- (if dots (string-length dots) 0)))
- (error "This is not a valid duration string:" duration-string))))
-
-(def-markup-command (note paper props duration-string dir) (string? number?)
- "This produces a note with a stem pointing in @var{dir} direction, with
-the @var{duration} for the note head type and augmentation dots. For
-example, @code{\note #\"4.\" #-0.75} creates a dotted quarter note, with
-a shortened down stem."
- (let ((parsed (parse-simple-duration duration-string)))
- (note-by-number-markup paper props (car parsed) (cadr parsed) dir)))
-
-(def-markup-command (normal-size-super paper props mrkup) (markup?)
- (ly:molecule-translate-axis (interpret-markup
- paper
- props mrkup)
- (* 0.5 (cdr (chain-assoc 'baseline-skip props)))
- Y))
-
-(def-markup-command (super paper props mrkup) (markup?)
- "Syntax: \\super MARKUP. "
- (ly:molecule-translate-axis
- (interpret-markup
- paper
- (cons `((font-size . ,(- (chain-assoc-get 'font-size props 0) 3))) props)
- mrkup)
- (* 0.5 (cdr (chain-assoc 'baseline-skip props)))
- Y))
-
-(def-markup-command (translate paper props offset mrkup) (number-pair? markup?)
- "Syntax: \\translate OFFSET MARKUP. "
- (ly:molecule-translate (interpret-markup paper props mrkup)
- offset))
-
-(def-markup-command (sub paper props mrkup) (markup?)
- "Syntax: \\sub MARKUP."
- (ly:molecule-translate-axis
- (interpret-markup
- paper
- (cons `((font-size . ,(- (chain-assoc-get 'font-size props 0) 3))) props)
- mrkup)
- (* -0.5 (cdr (chain-assoc 'baseline-skip props)))
- Y))
-
-(def-markup-command (normal-size-sub paper props mrkup) (markup?)
- (ly:molecule-translate-axis
- (interpret-markup paper props mrkup)
- (* -0.5 (cdr (chain-assoc 'baseline-skip props)))
- Y))
-
-(def-markup-command (hbracket paper props mrkup) (markup?)
- "Horizontal brackets around its single argument. Syntax \\hbracket MARKUP."
- (let ((th 0.1) ;; todo: take from GROB.
- (m (interpret-markup paper props mrkup)))
- (bracketify-molecule m X th (* 2.5 th) th)))
-
-(def-markup-command (bracket paper props mrkup) (markup?)
- "Vertical brackets around its single argument. Syntax \\bracket MARKUP."
- (let ((th 0.1) ;; todo: take from GROB.
- (m (interpret-markup paper props mrkup)))
- (bracketify-molecule m Y th (* 2.5 th) th)))
-
-;; todo: fix negative space
-(def-markup-command (hspace paper props amount) (number?)
- "Syntax: \\hspace NUMBER."
- (if (> amount 0)
- (ly:make-molecule "" (cons 0 amount) '(-1 . 1) )
- (ly:make-molecule "" (cons amount amount) '(-1 . 1))))
-
-(def-markup-command (override paper props new-prop mrkup) (pair? markup?)
- "Add the first argument in to the property list. Properties may be
-any sort of property supported by @ref{font-interface} and
-@ref{text-interface}, for example
-
-\\override #'(font-family . married) \"bla\"
-"
- (interpret-markup paper (cons (list new-prop) props) mrkup))
-
-(def-markup-command (smaller paper props mrkup) (markup?)
- "Syntax: \\smaller MARKUP"
- (let* ((fs (chain-assoc-get 'font-size props 0))
- (entry (cons 'font-size (- fs 1))))
- (interpret-markup paper (cons (list entry) props) mrkup)))
-(def-markup-command (bigger paper props mrkup) (markup?)
- "Syntax: \\bigger MARKUP"
- (let* ((fs (chain-assoc-get 'font-size props 0))
- (entry (cons 'font-size (+ fs 1))))
- (interpret-markup paper (cons (list entry) props) mrkup)))
-(def-markup-command larger (markup?)
- bigger-markup)
-(def-markup-command (box paper props mrkup) (markup?)
- "Syntax: \\box MARKUP"
- (let ((th 0.1)
- (pad 0.2)
- (m (interpret-markup paper props mrkup)))
- (box-molecule m th pad)))
-(def-markup-command (strut paper props) ()
- "Syntax: \\strut
- A box of the same height as the space.
-"
- (let ((m (Text_item::interpret_markup paper props " ")))
- (ly:molecule-set-extent! m X '(1000 . -1000))
- m))
-
-(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 (number->markletter-string n)
- "Double letters for big marks."
- (let*
- ((l (vector-length number->mark-letter-vector)))
-
- (if (>= n l)
- (string-append (number->markletter-string (1- (quotient n l)))
- (number->markletter-string (remainder n l)))
- (make-string 1 (vector-ref number->mark-letter-vector n)))))
-
-
-(def-markup-command (markletter paper props num) (number?)
- "Markup letters: skip I and do double letters for big marks.
-Syntax: \\markletter #25"
- (Text_item::interpret_markup paper props (number->markletter-string num)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(if #f
- (define (typecheck-with-error x)
- (catch
- 'markup-format
- (lambda () (markup? x))
- (lambda (key message arg)
- (display "\nERROR: markup format error: \n")
- (display message)
- (newline)
- (write arg (current-output-port))))))
-
-;; test make-foo-markup functions
-(if #f
- (begin
- (newline)
- (newline)
- (display (make-line-markup (list (make-simple-markup "FOO"))))
-
- (make-line-markup (make-simple-markup "FOO"))
- (make-line-markup (make-simple-markup "FOO") (make-simple-markup "foo"))
- (make-raise-markup "foo" (make-simple-markup "foo"))))
-
-;;
-;; test typecheckers. Not wholly useful, because errors are detected
-;; in other places than they're made.
-;;
-(if #f
- (begin
- ;; To get error messages, see above to install the alternate
- ;; typecheck routine for markup?.
- (display (typecheck-with-error `(,simple-markup "foobar")))
- (display (typecheck-with-error `(,simple-markup "foobar")))
- (display (typecheck-with-error `(,simple-markup 1)))
- (display
- (typecheck-with-error `(,line-markup ((,simple-markup "foobar"))
- (,simple-markup 1))))
- (display
- (typecheck-with-error `(,line-markup (,simple-markup "foobar")
- (,simple-markup "bla"))))))
str = re.sub (r'LyricsVoice', 'Lyrics', str)
str = re.sub (r'tupletInvisible',
r"TupletBracket \\set #'transparent", str)
-
+# str = re.sub (r'molecule', 'collage', str)
+#molecule -> collage
+ str = re.sub (r"\\property\s+[a-zA-Z]+\s*\.\s*[a-zA-Z]+\s*"
+ + r"\\set\s*#'X-extent-callback\s*=\s*#Grob::preset_extent",
+ "", str)
+
return str
conversions.append (((2,1,21), conv, """molecule-callback -> print-function,
brew-new-markup-molecule -> Text_item::print
LyricsVoice -> Lyrics
tupletInvisible -> TupletBracket \set #'transparent
+Grob::preset_extent removed.
""" ))
projects / lilypond.git / commitdiff