+2004-12-26 Jan Nieuwenhuizen <janneke@gnu.org>
+
+ * scm: Cleanups.
+
+ * Documentation/user/changing-defaults.itely: Fix internalsrefs
+ {Tunable context properties},
+ {All layout objects},
+ {Music definitions}.
+
2004-12-25 Han-Wen Nienhuys <hanwen@xs4all.nl>
* scm/framework-ps.scm: remove all encoding code.
A full description of all available context properties is in the
program reference, see
@ifhtml
-@internalsref{Tunable-context-properties}.
+@internalsref{Tunable context properties}.
@end ifhtml
@ifnothtml
Translation @arrow{} Tunable context properties.
Internals: @internalsref{OverrideProperty}, @internalsref{RevertProperty},
@internalsref{PropertySet}, @internalsref{All-backend-properties}, and
-@internalsref{All-layout-objects}.
+@internalsref{All layout objects}.
@refbugs
The program reference can also be browsed like a normal document. It
contains a chapter on
@ifhtml
-@internalsref{Music-definitions},
+@internalsref{Music definitions},
@end ifhtml
@ifnothtml
@code{Music definitions}
# Specific builders
-# experiment: switch off for speed.
-if 0:
- env['DIFF_PY'] = '$srcdir/stepmake/bin/package-diff.py'
- a = '$PYTHON $DIFF_PY $__verbose --outdir=${TARGET.dir}'
- patch = Builder (action = a, suffix = '.diff', src_suffix = '.tar.gz')
- env.Append (BUILDERS = {'PATCH': patch})
+env['DIFF_PY'] = '$srcdir/stepmake/bin/package-diff.py'
+a = '$PYTHON $DIFF_PY $__verbose --outdir=${TARGET.dir}'
+patch = Builder (action = a, suffix = '.diff', src_suffix = '.tar.gz')
+env.Append (BUILDERS = {'PATCH': patch})
atvars = [
'BASH',
/** Find a file.
- Seach in the current dir (DUH! FIXME?), in the construction-arg
- (what's that?, and in any other appended directory, in this order.
+ Check absolute file name, search in the current dir (DUH! FIXME!),
+ in the construction-arg (what's that?), and in any other appended
+ directory, in this order.
@return
The file name if found, or empty string if not found. */
if (!name.length () || (name == "-") )
return name;
- /*
- TODO: should check for absolute path
- */
- if (FILE *f =fopen (name.to_str0 (), "r"))
+ /* Handle absolute file name. */
+ if (name[0] == DIRSEP)
{
- fclose (f);
- return name;
+ if (FILE *f = fopen (name.to_str0 (), "r"))
+ {
+ fclose (f);
+ return name;
+ }
}
for (int i = 0; i < size (); i++)
msgstr ""
"Project-Id-Version: PACKAGE VERSION\n"
"Report-Msgid-Bugs-To: \n"
-"POT-Creation-Date: 2004-11-05 15:16+0100\n"
+"POT-Creation-Date: 2004-12-23 10:44+0100\n"
"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
"Language-Team: LANGUAGE <LL@li.org>\n"
#: lilylib.py:65 lilypond-book.py:91 lilypond-latex.py:109 midi2ly.py:100
#: mup2ly.py:75 ps2png.py:40 main.cc:131 lily/main.cc:131 lily/main.cc:132
+#: lily/main.cc:130
msgid "print this help"
msgstr ""
#. for --output-format.
#. Bug in option parser: --output=foe is taken as an abbreviation
#. for --output-format.
+#. Bug in option parser: --output =foe is taken as an abbreviation
+#. for --output-format.
#: lilypond-book.py:89 main.cc:130 lily/main.cc:130 lily/main.cc:131
+#: lily/main.cc:129
msgid "EXT"
msgstr ""
msgstr ""
#: lilypond-book.py:92 lilypond-book.py:94 lilypond-latex.py:114 main.cc:133
-#: lily/main.cc:133 lily/main.cc:134
+#: lily/main.cc:133 lily/main.cc:134 lily/main.cc:132
msgid "DIR"
msgstr ""
#: lilypond-latex.py:112 lilypond-latex.py:123 midi2ly.py:102 main.cc:134
#: main.cc:136 lily/main.cc:134 lily/main.cc:136 lily/main.cc:135
-#: lily/main.cc:137
+#: lily/main.cc:137 lily/main.cc:133
msgid "FILE"
msgstr ""
#. junkme?
#: lilypond-latex.py:121 main.cc:135 lily/main.cc:135 lily/main.cc:136
+#: lily/main.cc:134
msgid "produce MIDI output only"
msgstr ""
#: lilypond-latex.py:123 midi2ly.py:102 mup2ly.py:76 main.cc:136
-#: lily/main.cc:136 lily/main.cc:137
+#: lily/main.cc:136 lily/main.cc:137 lily/main.cc:135
msgid "write output to FILE"
msgstr ""
#: lilypond-latex.py:820 includable-lexer.cc:57 kpath.cc:134 lily-guile.cc:89
#: lily-parser.cc:275 lily/includable-lexer.cc:57 lily/kpath.cc:134
-#: lily/lily-guile.cc:89 lily/lily-parser.cc:275
+#: lily/lily-guile.cc:89 lily/lily-parser.cc:275 lily/kpath.cc:128
+#: lily/lily-guile.cc:100 lily/lily-parser.cc:282
#, c-format, python-format
msgid "can't find file: `%s'"
msgstr ""
msgid "treat every text as a lyric"
msgstr ""
-#: midi2ly.py:149 mup2ly.py:143 input.cc:88 lily/input.cc:88
+#: midi2ly.py:149 mup2ly.py:143 input.cc:88 lily/input.cc:88 lily/input.cc:87
msgid "warning: "
msgstr ""
#: midi2ly.py:164 midi2ly.py:1017 midi2ly.py:1082 mup2ly.py:146 mup2ly.py:160
-#: input.cc:93 lily/input.cc:93
+#: input.cc:93 lily/input.cc:93 lily/input.cc:92
msgid "error: "
msgstr ""
msgstr ""
#: accidental-engraver.cc:194 lily/accidental-engraver.cc:201
-#: lily/accidental-engraver.cc:243
+#: lily/accidental-engraver.cc:243 lily/accidental-engraver.cc:239
#, c-format
msgid "Accidental typesetting list must begin with context-name: %s"
msgstr ""
#: accidental-engraver.cc:222 lily/accidental-engraver.cc:229
-#: lily/accidental-engraver.cc:271
+#: lily/accidental-engraver.cc:271 lily/accidental-engraver.cc:267
#, c-format
msgid "ignoring unknown accidental: %s"
msgstr ""
#: accidental-engraver.cc:239 lily/accidental-engraver.cc:246
-#: lily/accidental-engraver.cc:288
+#: lily/accidental-engraver.cc:288 lily/accidental-engraver.cc:284
#, c-format
msgid "Accidental rule must be pair or context-name; Found %s"
msgstr ""
#: accidental.cc:221 key-signature-interface.cc:137 lily/accidental.cc:221
#: lily/key-signature-interface.cc:137 lily/accidental.cc:222
+#: lily/key-signature-interface.cc:133
#, c-format
msgid "accidental `%s' not found"
msgstr ""
-#: afm.cc:143 lily/afm.cc:143
+#: afm.cc:143 lily/afm.cc:143 lily/afm.cc:144
#, c-format
msgid "Error parsing AFM file: `%s'"
msgstr ""
#. FIXME: broken sentence
#. FIXME: broken sentence
#. FIXME: broken sentence
+#. FIXME: broken sentence
#: all-font-metrics.cc:95 lily/all-font-metrics.cc:95
+#: lily/all-font-metrics.cc:100
#, c-format
msgid "checksum mismatch for font file: `%s'"
msgstr ""
#: all-font-metrics.cc:97 lily/all-font-metrics.cc:97
+#: lily/all-font-metrics.cc:102
#, c-format
msgid "does not match: `%s'"
msgstr ""
#: all-font-metrics.cc:103 lily/all-font-metrics.cc:103
+#: lily/all-font-metrics.cc:108
msgid "Rebuild all .afm files, and remove all .pk and .tfm files."
msgstr ""
#: all-font-metrics.cc:105 lily/all-font-metrics.cc:105
+#: lily/all-font-metrics.cc:110
msgid "Rerun with -V to show font paths."
msgstr ""
#: all-font-metrics.cc:107 lily/all-font-metrics.cc:107
+#: lily/all-font-metrics.cc:112
msgid "A script for removing font-files is delivered with the source-code:"
msgstr ""
#: all-font-metrics.cc:184 lily/all-font-metrics.cc:184
+#: lily/all-font-metrics.cc:221
#, c-format
msgid "can't find font: `%s'"
msgstr ""
#: all-font-metrics.cc:185 lily/all-font-metrics.cc:185
+#: lily/all-font-metrics.cc:222
msgid "Loading default font"
msgstr ""
#: all-font-metrics.cc:200 lily/all-font-metrics.cc:200
+#: lily/all-font-metrics.cc:237
#, c-format
msgid "can't find default font: `%s'"
msgstr ""
#: all-font-metrics.cc:201 includable-lexer.cc:59 lily-parser.cc:268
#: lily/all-font-metrics.cc:201 lily/includable-lexer.cc:59
-#: lily/lily-parser.cc:268
+#: lily/lily-parser.cc:268 lily/all-font-metrics.cc:238
+#: lily/lily-parser.cc:275
#, c-format
msgid "(search path: `%s')"
msgstr ""
#: all-font-metrics.cc:202 lily/all-font-metrics.cc:202
+#: lily/all-font-metrics.cc:239
msgid "Giving up"
msgstr ""
#: auto-change-iterator.cc:67 change-iterator.cc:61
#: lily/auto-change-iterator.cc:67 lily/change-iterator.cc:61
+#: lily/auto-change-iterator.cc:66
msgid "Can't switch translators, I'm there already"
msgstr ""
#: axis-group-engraver.cc:117 lily/axis-group-engraver.cc:117
+#: lily/axis-group-engraver.cc:112
msgid ""
"Axis_group_engraver: vertical group already has a parent.\n"
"Do you have two Axis_group_engravers?\n"
msgid "barcheck failed at: %s"
msgstr ""
-#: beam-engraver.cc:139 lily/beam-engraver.cc:139
+#: beam-engraver.cc:139 lily/beam-engraver.cc:139 lily/beam-engraver.cc:138
msgid "already have a beam"
msgstr ""
#: beam-engraver.cc:211 lily/beam-engraver.cc:211 lily/beam-engraver.cc:210
+#: lily/beam-engraver.cc:209
msgid "unterminated beam"
msgstr ""
#: beam-engraver.cc:244 chord-tremolo-engraver.cc:174
#: lily/beam-engraver.cc:244 lily/chord-tremolo-engraver.cc:174
#: lily/beam-engraver.cc:243 lily/chord-tremolo-engraver.cc:171
+#: lily/beam-engraver.cc:242 lily/chord-tremolo-engraver.cc:169
msgid "stem must have Rhythmic structure"
msgstr ""
#: beam-engraver.cc:258 lily/beam-engraver.cc:258 lily/beam-engraver.cc:257
+#: lily/beam-engraver.cc:256
msgid "stem doesn't fit in beam"
msgstr ""
#: beam-engraver.cc:259 lily/beam-engraver.cc:259 lily/beam-engraver.cc:258
+#: lily/beam-engraver.cc:257
msgid "beam was started here"
msgstr ""
msgstr ""
#: break-align-interface.cc:214 lily/break-align-interface.cc:214
+#: lily/break-align-interface.cc:213
#, c-format
msgid "No spacing entry from %s to `%s'"
msgstr ""
#.
#. last->translator_id_string () = get_change ()->change_to_id_string ();
#.
+#.
+#. We could change the current translator's id, but that would make
+#. errors hard to catch
+#.
+#. last->translator_id_string () = get_change ()->change_to_id_string ();
+#.
#: change-iterator.cc:93 lily/change-iterator.cc:93
msgid "I'm one myself"
msgstr ""
msgstr ""
#: chord-tremolo-engraver.cc:100 lily/chord-tremolo-engraver.cc:100
+#: lily/chord-tremolo-engraver.cc:98
#, c-format
msgid "Chord tremolo with %d elements. Must have two elements."
msgstr ""
#: chord-tremolo-engraver.cc:140 lily/chord-tremolo-engraver.cc:140
-#: lily/chord-tremolo-engraver.cc:137
+#: lily/chord-tremolo-engraver.cc:137 lily/chord-tremolo-engraver.cc:135
msgid "unterminated chord tremolo"
msgstr ""
#: chord-tremolo-iterator.cc:64 lily/chord-tremolo-iterator.cc:64
+#: lily/chord-tremolo-iterator.cc:65
msgid "no one to print a tremolos"
msgstr ""
-#: clef.cc:64 lily/clef.cc:64
+#: clef.cc:64 lily/clef.cc:64 lily/clef.cc:57
#, c-format
msgid "clef `%s' not found"
msgstr ""
-#: cluster.cc:123 lily/cluster.cc:123
+#: cluster.cc:123 lily/cluster.cc:123 lily/cluster.cc:122
#, c-format
msgid "unknown cluster style `%s'"
msgstr ""
msgid "can't find: `%s'"
msgstr ""
-#: context.cc:164 lily/context.cc:164 lily/context.cc:163
+#: context.cc:164 lily/context.cc:164 lily/context.cc:163 lily/context.cc:217
#, c-format
msgid "Cannot find or create `%s' called `%s'"
msgstr ""
-#: context.cc:201 lily/context.cc:201 lily/context.cc:200
+#: context.cc:201 lily/context.cc:201 lily/context.cc:200 lily/context.cc:315
#, c-format
msgid "can't find or create: `%s'"
msgstr ""
-#: custos.cc:85 lily/custos.cc:85
+#: custos.cc:85 lily/custos.cc:85 lily/custos.cc:84
#, c-format
msgid "custos `%s' not found"
msgstr ""
#: dynamic-engraver.cc:186 span-dynamic-performer.cc:86
#: lily/dynamic-engraver.cc:186 lily/span-dynamic-performer.cc:86
#: lily/dynamic-engraver.cc:185 lily/dynamic-engraver.cc:182
+#: lily/dynamic-engraver.cc:179 lily/span-dynamic-performer.cc:84
msgid "can't find start of (de)crescendo"
msgstr ""
#: dynamic-engraver.cc:196 lily/dynamic-engraver.cc:196
#: lily/dynamic-engraver.cc:195 lily/dynamic-engraver.cc:192
+#: lily/dynamic-engraver.cc:189
msgid "already have a decrescendo"
msgstr ""
#: dynamic-engraver.cc:198 lily/dynamic-engraver.cc:198
#: lily/dynamic-engraver.cc:197 lily/dynamic-engraver.cc:194
+#: lily/dynamic-engraver.cc:191
msgid "already have a crescendo"
msgstr ""
#: dynamic-engraver.cc:201 lily/dynamic-engraver.cc:201
#: lily/dynamic-engraver.cc:200 lily/dynamic-engraver.cc:197
+#: lily/dynamic-engraver.cc:194
msgid "Cresc started here"
msgstr ""
#: dynamic-engraver.cc:307 lily/dynamic-engraver.cc:317
#: lily/dynamic-engraver.cc:321 lily/dynamic-engraver.cc:318
+#: lily/dynamic-engraver.cc:315
msgid "unterminated (de)crescendo"
msgstr ""
#: event-chord-iterator.cc:56 output-property-music-iterator.cc:29
#: lily/event-chord-iterator.cc:56 lily/output-property-music-iterator.cc:29
+#: lily/event-chord-iterator.cc:57
#, c-format
msgid "Junking event: `%s'"
msgstr ""
-#: event.cc:49 lily/event.cc:49 lily/music.cc:184
+#: event.cc:49 lily/event.cc:49 lily/music.cc:184 lily/music.cc:185
#, c-format
msgid "Transposition by %s makes alteration larger than two"
msgstr ""
-#: event.cc:72 lily/event.cc:72 lily/event.cc:50
+#: event.cc:72 lily/event.cc:72 lily/event.cc:50 lily/event.cc:49
#, c-format
msgid "octave check failed; expected %s, found: %s"
msgstr ""
msgstr ""
#: folded-repeat-iterator.cc:65 lily/folded-repeat-iterator.cc:65
+#: lily/folded-repeat-iterator.cc:66
msgid "no one to print a repeat brace"
msgstr ""
#: glissando-engraver.cc:100 lily/glissando-engraver.cc:100
+#: lily/glissando-engraver.cc:99
msgid "Unterminated glissando."
msgstr ""
#: global-context.cc:150 lily/global-context.cc:150 lily/global-context.cc:157
+#: lily/global-context.cc:163
#, c-format
msgid "can't find `%s' context"
msgstr ""
#: gourlay-breaking.cc:199 lily/gourlay-breaking.cc:199
+#: lily/gourlay-breaking.cc:200
#, c-format
msgid "Optimal demerits: %f"
msgstr ""
#: gourlay-breaking.cc:204 lily/gourlay-breaking.cc:204
+#: lily/gourlay-breaking.cc:205
msgid "No feasible line breaking found"
msgstr ""
msgid "include files are not allowed"
msgstr ""
-#: input.cc:99 lily/input.cc:99
+#: input.cc:99 lily/input.cc:99 lily/input.cc:98
msgid "non fatal error: "
msgstr ""
#: input.cc:107 source-file.cc:135 source-file.cc:228 lily/input.cc:107
-#: lily/source-file.cc:135 lily/source-file.cc:228
+#: lily/source-file.cc:135 lily/source-file.cc:228 lily/input.cc:106
+#: lily/source-file.cc:132 lily/source-file.cc:225
msgid "position unknown"
msgstr ""
-#: key-performer.cc:90 lily/key-performer.cc:90
+#: key-performer.cc:90 lily/key-performer.cc:90 lily/key-performer.cc:87
msgid "FIXME: key change merge"
msgstr ""
-#: kpath.cc:83 lily/kpath.cc:83
+#: kpath.cc:83 lily/kpath.cc:83 lily/kpath.cc:79
#, c-format
msgid "kpathsea can not find TFM file: `%s'"
msgstr ""
-#: kpath.cc:129 lily/kpath.cc:129
+#: kpath.cc:129 lily/kpath.cc:129 lily/kpath.cc:123
#, c-format
msgid "kpathsea can not find file: `%s'"
msgstr ""
#: ligature-engraver.cc:152 lily/ligature-engraver.cc:152
+#: lily/ligature-engraver.cc:153
msgid "can't find start of ligature"
msgstr ""
#: ligature-engraver.cc:158 lily/ligature-engraver.cc:158
+#: lily/ligature-engraver.cc:159
msgid "no right bound"
msgstr ""
#: ligature-engraver.cc:184 lily/ligature-engraver.cc:184
+#: lily/ligature-engraver.cc:185
msgid "already have a ligature"
msgstr ""
#: ligature-engraver.cc:200 lily/ligature-engraver.cc:200
+#: lily/ligature-engraver.cc:201
msgid "no left bound"
msgstr ""
#: ligature-engraver.cc:256 lily/ligature-engraver.cc:256
+#: lily/ligature-engraver.cc:257
msgid "unterminated ligature"
msgstr ""
#: ligature-engraver.cc:280 lily/ligature-engraver.cc:280
+#: lily/ligature-engraver.cc:281
msgid "ignoring rest: ligature may not contain rest"
msgstr ""
#: ligature-engraver.cc:281 lily/ligature-engraver.cc:281
+#: lily/ligature-engraver.cc:282
msgid "ligature was started here"
msgstr ""
-#: lily-guile.cc:91 lily/lily-guile.cc:91
+#: lily-guile.cc:91 lily/lily-guile.cc:91 lily/lily-guile.cc:102
#, c-format
msgid "(load path: `%s')"
msgstr ""
#: lily-guile.cc:559 lily/lily-guile.cc:559 lily/lily-guile.cc:575
+#: lily/lily-guile.cc:596
#, c-format
msgid "Can't find property type-check for `%s' (%s)."
msgstr ""
#: lily-guile.cc:562 lily/lily-guile.cc:562 lily/lily-guile.cc:578
+#: lily/lily-guile.cc:599
msgid "Perhaps you made a typing error?"
msgstr ""
#: lily-guile.cc:568 lily/lily-guile.cc:568 lily/lily-guile.cc:584
+#: lily/lily-guile.cc:605
msgid "Doing assignment anyway."
msgstr ""
#: lily-guile.cc:582 lily/lily-guile.cc:582 lily/lily-guile.cc:598
+#: lily/lily-guile.cc:619
#, c-format
msgid "Type check for `%s' failed; value `%s' must be of type `%s'"
msgstr ""
#: lily-lexer.cc:220 lily/lily-lexer.cc:220 lily/lily-lexer.cc:224
+#: lily/lily-lexer.cc:221
#, c-format
msgid "Identifier name is a keyword: `%s'"
msgstr ""
#: lily-lexer.cc:237 lily/lily-lexer.cc:237 lily/lily-lexer.cc:241
+#: lily/lily-lexer.cc:238
#, c-format
msgid "error at EOF: %s"
msgstr ""
-#: lily-parser.cc:97 lily/lily-parser.cc:97
+#: lily-parser.cc:97 lily/lily-parser.cc:97 lily/lily-parser.cc:98
msgid "Parsing..."
msgstr ""
#: lily-parser.cc:110 lily-parser.cc:143 lily/lily-parser.cc:110
-#: lily/lily-parser.cc:143
+#: lily/lily-parser.cc:143 lily/lily-parser.cc:116
msgid "Braces don't match"
msgstr ""
-#: lily-parser.cc:267 lily/lily-parser.cc:267
+#: lily-parser.cc:267 lily/lily-parser.cc:267 lily/lily-parser.cc:274
#, c-format
msgid "can't find init file: `%s'"
msgstr ""
msgid "Now processing `%s'"
msgstr ""
-#: main.cc:91 lily/main.cc:91 lily/main.cc:92
+#: main.cc:91 lily/main.cc:91 lily/main.cc:92 lily/main.cc:90
msgid ""
"This program is free software. It is covered by the GNU General Public\n"
"License and you are welcome to change it and/or distribute copies of it\n"
"information.\n"
msgstr ""
-#: main.cc:97 lily/main.cc:97 lily/main.cc:98
+#: main.cc:97 lily/main.cc:97 lily/main.cc:98 lily/main.cc:96
msgid ""
" This program is free software; you can redistribute it and/or\n"
"modify it under the terms of the GNU General Public License version 2\n"
"Boston, MA 02111-1307, USA.\n"
msgstr ""
-#: main.cc:126 lily/main.cc:126 lily/main.cc:127
+#: main.cc:126 lily/main.cc:126 lily/main.cc:127 lily/main.cc:125
msgid "EXPR"
msgstr ""
msgid "set options, use -e '(ly:option-usage)' for help"
msgstr ""
-#: main.cc:130 lily/main.cc:130 lily/main.cc:131
+#: main.cc:130 lily/main.cc:130 lily/main.cc:131 lily/main.cc:129
msgid "select back-end to use"
msgstr ""
-#: main.cc:132 lily/main.cc:132 lily/main.cc:133
+#: main.cc:132 lily/main.cc:132 lily/main.cc:133 lily/main.cc:131
msgid "FIELD"
msgstr ""
-#: main.cc:132 lily/main.cc:132 lily/main.cc:133
+#: main.cc:132 lily/main.cc:132 lily/main.cc:133 lily/main.cc:131
msgid "write header field to BASENAME.FIELD"
msgstr ""
-#: main.cc:133 lily/main.cc:133 lily/main.cc:134
+#: main.cc:133 lily/main.cc:133 lily/main.cc:134 lily/main.cc:132
msgid "add DIR to search path"
msgstr ""
-#: main.cc:134 lily/main.cc:134 lily/main.cc:135
+#: main.cc:134 lily/main.cc:134 lily/main.cc:135 lily/main.cc:133
msgid "use FILE as init file"
msgstr ""
-#: main.cc:137 lily/main.cc:137 lily/main.cc:138
+#: main.cc:137 lily/main.cc:137 lily/main.cc:138 lily/main.cc:136
msgid "generate a preview"
msgstr ""
msgstr ""
#: main.cc:410 lily/main.cc:410 lily/main.cc:412 lily/main.cc:415
+#: lily/main.cc:420
#, c-format
msgid "This option is for developers only."
msgstr ""
#: main.cc:411 lily/main.cc:411 lily/main.cc:413 lily/main.cc:416
+#: lily/main.cc:421
#, c-format
msgid "Read the sources for more information."
msgstr ""
#: mensural-ligature-engraver.cc:248 mensural-ligature-engraver.cc:383
#: lily/mensural-ligature-engraver.cc:248
#: lily/mensural-ligature-engraver.cc:383
+#: lily/mensural-ligature-engraver.cc:247
+#: lily/mensural-ligature-engraver.cc:382
msgid "unexpected case fall-through"
msgstr ""
#: mensural-ligature-engraver.cc:259 lily/mensural-ligature-engraver.cc:259
+#: lily/mensural-ligature-engraver.cc:258
msgid "ligature with less than 2 heads -> skipping"
msgstr ""
#: mensural-ligature-engraver.cc:279 lily/mensural-ligature-engraver.cc:279
+#: lily/mensural-ligature-engraver.cc:278
msgid "can not determine pitch of ligature primitive -> skipping"
msgstr ""
#: mensural-ligature-engraver.cc:302 lily/mensural-ligature-engraver.cc:302
+#: lily/mensural-ligature-engraver.cc:301
msgid "prime interval within ligature -> skipping"
msgstr ""
#: mensural-ligature-engraver.cc:312 lily/mensural-ligature-engraver.cc:312
+#: lily/mensural-ligature-engraver.cc:311
msgid "mensural ligature: duration none of L, B, S -> skipping"
msgstr ""
#: mensural-ligature.cc:161 lily/mensural-ligature.cc:161
+#: lily/mensural-ligature.cc:162
msgid "Mensural_ligature:unexpected case fall-through"
msgstr ""
#: mensural-ligature.cc:171 lily/mensural-ligature.cc:171
+#: lily/mensural-ligature.cc:172
msgid "Mensural_ligature: (join_left == 0)"
msgstr ""
-#: midi-item.cc:153 lily/midi-item.cc:153
+#: midi-item.cc:153 lily/midi-item.cc:153 lily/midi-item.cc:151
#, c-format
msgid "no such MIDI instrument: `%s'"
msgstr ""
-#: midi-item.cc:257 lily/midi-item.cc:257
+#: midi-item.cc:257 lily/midi-item.cc:257 lily/midi-item.cc:255
msgid "silly pitch"
msgstr ""
-#: midi-item.cc:273 lily/midi-item.cc:273
+#: midi-item.cc:273 lily/midi-item.cc:273 lily/midi-item.cc:271
#, c-format
msgid "Experimental: temporarily fine tuning (of %d cents) a channel."
msgstr ""
-#: midi-stream.cc:40 lily/midi-stream.cc:40
+#: midi-stream.cc:40 lily/midi-stream.cc:40 lily/midi-stream.cc:39
#, c-format
msgid "could not write file: `%s'"
msgstr ""
#.
#. music for the softenon children?
#.
+#.
+#. music for the softenon children?
+#.
#: new-fingering-engraver.cc:155 lily/new-fingering-engraver.cc:155
+#: lily/new-fingering-engraver.cc:153
msgid "music for the martians."
msgstr ""
#: new-fingering-engraver.cc:235 lily/new-fingering-engraver.cc:235
+#: lily/new-fingering-engraver.cc:233
msgid "Fingerings are also not down?! Putting them down anyway."
msgstr ""
#: new-lyric-combine-music-iterator.cc:245
#: lily/new-lyric-combine-music-iterator.cc:245
+#: lily/new-lyric-combine-music-iterator.cc:244
#, c-format
msgid "cannot find Voice `%s'"
msgstr ""
msgid "Too many clashing notecolumns. Ignoring them."
msgstr ""
-#: note-head.cc:45 lily/note-head.cc:45
+#: note-head.cc:45 lily/note-head.cc:45 lily/note-head.cc:68
#, c-format
msgid "note head `%s' not found"
msgstr ""
msgid "Paper output to `%s'..."
msgstr ""
-#: paper-score.cc:68 lily/paper-score.cc:68
+#: paper-score.cc:68 lily/paper-score.cc:68 lily/paper-score.cc:67
#, c-format
msgid "Element count %d (spanners %d) "
msgstr ""
-#: paper-score.cc:72 lily/paper-score.cc:72
+#: paper-score.cc:72 lily/paper-score.cc:72 lily/paper-score.cc:71
msgid "Preprocessing graphical objects..."
msgstr ""
#: parse-scm.cc:77 lily/parse-scm.cc:77 lily/parse-scm.cc:84
+#: lily/parse-scm.cc:82
msgid "GUILE signaled an error for the expression beginning here"
msgstr ""
#: percent-repeat-engraver.cc:110 lily/percent-repeat-engraver.cc:110
-#: lily/percent-repeat-engraver.cc:106
+#: lily/percent-repeat-engraver.cc:106 lily/percent-repeat-engraver.cc:101
msgid "Don't know how to handle a percent repeat of this length."
msgstr ""
#: percent-repeat-engraver.cc:170 lily/percent-repeat-engraver.cc:170
-#: lily/percent-repeat-engraver.cc:166
+#: lily/percent-repeat-engraver.cc:166 lily/percent-repeat-engraver.cc:161
msgid "unterminated percent repeat"
msgstr ""
#: percent-repeat-iterator.cc:53 lily/percent-repeat-iterator.cc:53
+#: lily/percent-repeat-iterator.cc:54
msgid "no one to print a percent"
msgstr ""
msgid "Track ... "
msgstr ""
-#: performance.cc:93 lily/performance.cc:93
+#: performance.cc:93 lily/performance.cc:93 lily/performance.cc:92
msgid "Creator: "
msgstr ""
-#: performance.cc:113 lily/performance.cc:113
+#: performance.cc:113 lily/performance.cc:113 lily/performance.cc:112
msgid "at "
msgstr ""
-#: performance.cc:167 lily/performance.cc:167
+#: performance.cc:167 lily/performance.cc:167 lily/performance.cc:166
#, c-format
msgid "MIDI output to `%s'..."
msgstr ""
#: phrasing-slur-engraver.cc:99 slur-engraver.cc:114
#: lily/phrasing-slur-engraver.cc:99 lily/slur-engraver.cc:114
+#: lily/slur-engraver.cc:113
msgid "unterminated slur"
msgstr ""
#: piano-pedal-engraver.cc:237 lily/piano-pedal-engraver.cc:237
+#: lily/piano-pedal-engraver.cc:232
msgid "Need 3 strings for piano pedals. No pedal made. "
msgstr ""
#: piano-pedal-engraver.cc:252 piano-pedal-engraver.cc:267
#: piano-pedal-performer.cc:82 lily/piano-pedal-engraver.cc:252
#: lily/piano-pedal-engraver.cc:267 lily/piano-pedal-performer.cc:82
+#: lily/piano-pedal-engraver.cc:247 lily/piano-pedal-engraver.cc:262
+#: lily/piano-pedal-performer.cc:80
#, c-format
msgid "can't find start of piano pedal: `%s'"
msgstr ""
#: piano-pedal-engraver.cc:318 lily/piano-pedal-engraver.cc:318
+#: lily/piano-pedal-engraver.cc:313
#, c-format
msgid "can't find start of piano pedal bracket: `%s'"
msgstr ""
#: property-iterator.cc:94 lily/property-iterator.cc:94
+#: lily/property-iterator.cc:95
#, c-format
msgid "Not a grob name, `%s'."
msgstr ""
msgstr ""
#: quote-iterator.cc:183 lily/quote-iterator.cc:199 lily/quote-iterator.cc:204
-#: lily/quote-iterator.cc:208
+#: lily/quote-iterator.cc:208 lily/quote-iterator.cc:251
#, c-format
msgid "In quotation: junking event %s"
msgstr ""
#: relative-octave-check.cc:25 lily/relative-octave-check.cc:25
+#: lily/relative-octave-check.cc:26
msgid "Failed octave check, got: "
msgstr ""
-#: rest-collision.cc:132 lily/rest-collision.cc:132
+#: rest-collision.cc:132 lily/rest-collision.cc:132 lily/rest-collision.cc:133
msgid "rest direction not set. Cannot resolve collision."
msgstr ""
#: rest-collision.cc:144 rest-collision.cc:187 lily/rest-collision.cc:144
-#: lily/rest-collision.cc:187
+#: lily/rest-collision.cc:187 lily/rest-collision.cc:145
+#: lily/rest-collision.cc:188
msgid "too many colliding rests"
msgstr ""
-#: rest.cc:136 lily/rest.cc:136
+#: rest.cc:136 lily/rest.cc:136 lily/rest.cc:138
#, c-format
msgid "rest `%s' not found"
msgstr ""
msgstr ""
#: score.cc:100 score.cc:126 lily/score.cc:100 lily/score.cc:126
-#: lily/score.cc:102 lily/score.cc:128
+#: lily/score.cc:102 lily/score.cc:128 lily/score.cc:112 lily/score.cc:140
msgid "Need music in a score"
msgstr ""
-#: score.cc:116 lily/score.cc:116 lily/score.cc:118
+#: score.cc:116 lily/score.cc:116 lily/score.cc:118 lily/score.cc:130
msgid "Interpreting music... "
msgstr ""
-#: score.cc:137 lily/score.cc:137 lily/score.cc:139
+#: score.cc:137 lily/score.cc:137 lily/score.cc:139 lily/score.cc:151
#, c-format
msgid "elapsed time: %.2f seconds"
msgstr ""
-#: score.cc:312 lily/score.cc:312 lily/score.cc:322
+#: score.cc:312 lily/score.cc:312 lily/score.cc:322 lily/score.cc:345
msgid "Already have music in score"
msgstr ""
-#: score.cc:313 lily/score.cc:313 lily/score.cc:323
+#: score.cc:313 lily/score.cc:313 lily/score.cc:323 lily/score.cc:346
msgid "This is the previous music"
msgstr ""
#. FIXME:
#. FIXME:
#. FIXME:
+#. FIXME:
#: script-engraver.cc:102 lily/script-engraver.cc:102
+#: lily/script-engraver.cc:101
msgid "Do not know how to interpret articulation: "
msgstr ""
#: script-engraver.cc:103 lily/script-engraver.cc:103
+#: lily/script-engraver.cc:102
msgid "Scheme encoding: "
msgstr ""
#. this shouldn't happen, but let's continue anyway.
#. this shouldn't happen, but let's continue anyway.
#. this shouldn't happen, but let's continue anyway.
+#. this shouldn't happen, but let's continue anyway.
#: separation-item.cc:53 separation-item.cc:97 lily/separation-item.cc:53
-#: lily/separation-item.cc:97
+#: lily/separation-item.cc:97 lily/separation-item.cc:54
+#: lily/separation-item.cc:98
msgid "Separation_item: I've been drinking too much"
msgstr ""
#: simple-spacer.cc:489 lily/simple-spacer.cc:489 lily/simple-spacer.cc:484
-#: lily/simple-spacer.cc:499
+#: lily/simple-spacer.cc:499 lily/simple-spacer.cc:506
#, c-format
msgid "No spring between column %d and next one"
msgstr ""
-#: slur-engraver.cc:124 lily/slur-engraver.cc:124
+#: slur-engraver.cc:124 lily/slur-engraver.cc:124 lily/slur-engraver.cc:123
msgid "No slur to end"
msgstr ""
-#: source-file.cc:50 lily/source-file.cc:50
+#: source-file.cc:50 lily/source-file.cc:50 lily/source-file.cc:47
#, c-format
msgid "can't open file: `%s'"
msgstr ""
-#: source-file.cc:63 lily/source-file.cc:63
+#: source-file.cc:63 lily/source-file.cc:63 lily/source-file.cc:60
#, c-format
msgid "Huh? Got %d, expected %d characters"
msgstr ""
#: spacing-spanner.cc:388 lily/spacing-spanner.cc:388
+#: lily/spacing-spanner.cc:386
#, c-format
msgid "Global shortest duration is %s"
msgstr ""
#. FIXME:
#. FIXME:
#. FIXME:
+#. FIXME:
#: stem-engraver.cc:125 lily/stem-engraver.cc:125
#, c-format
msgid "Adding note head to incompatible stem (type = %d)"
msgid "Don't you want polyphonic voices instead?"
msgstr ""
-#: stem.cc:126 lily/stem.cc:126
+#: stem.cc:126 lily/stem.cc:126 lily/stem.cc:125
msgid "Weird stem size; check for narrow beams"
msgstr ""
msgid "flag stroke `%s' not found"
msgstr ""
-#: system.cc:134 lily/system.cc:134
+#: system.cc:134 lily/system.cc:134 lily/system.cc:149
#, c-format
msgid "Element count %d."
msgstr ""
-#: system.cc:272 lily/system.cc:272
+#: system.cc:272 lily/system.cc:272 lily/system.cc:302
#, c-format
msgid "Grob count %d"
msgstr ""
-#: system.cc:286 lily/system.cc:286
+#: system.cc:286 lily/system.cc:286 lily/system.cc:320
msgid "Calculating line breaks..."
msgstr ""
#: text-spanner-engraver.cc:63 lily/text-spanner-engraver.cc:63
+#: lily/text-spanner-engraver.cc:62
msgid "can't find start of text spanner"
msgstr ""
#: text-spanner-engraver.cc:77 lily/text-spanner-engraver.cc:77
+#: lily/text-spanner-engraver.cc:76
msgid "already have a text spanner"
msgstr ""
#: text-spanner-engraver.cc:139 lily/text-spanner-engraver.cc:139
+#: lily/text-spanner-engraver.cc:138
msgid "unterminated text spanner"
msgstr ""
#. more of a programming error.
#. Not using ngettext's plural feature here, as this message is
#. more of a programming error.
+#. Not using ngettext's plural feature here, as this message is
+#. more of a programming error.
#: tfm-reader.cc:108 lily/tfm-reader.cc:108
#, c-format
msgid "TFM header of `%s' has only %u word (s)"
msgid "%s: TFM file has %u parameters, which is more than the %u I can handle"
msgstr ""
-#: tfm.cc:73 lily/tfm.cc:73
+#: tfm.cc:73 lily/tfm.cc:73 lily/tfm.cc:71
#, c-format
msgid "can't find ascii character: %d"
msgstr ""
-#: tie-engraver.cc:165 lily/tie-engraver.cc:173
+#: tie-engraver.cc:165 lily/tie-engraver.cc:173 lily/tie-engraver.cc:171
msgid "lonely tie"
msgstr ""
#: time-scaled-music-iterator.cc:24 lily/time-scaled-music-iterator.cc:24
+#: lily/time-scaled-music-iterator.cc:25
msgid "no one to print a tuplet start bracket"
msgstr ""
#.
#. OTOH, Tristan Keuris writes 8/20 in his Intermezzi.
#.
+#.
+#. Todo: should make typecheck?
+#.
+#. OTOH, Tristan Keuris writes 8/20 in his Intermezzi.
+#.
#: time-signature-engraver.cc:57 lily/time-signature-engraver.cc:57
+#: lily/time-signature-engraver.cc:55
#, c-format
msgid "Found strange time signature %d/%d."
msgstr ""
#. (Here really with a warning!)
#. If there is no such symbol, we default to the numbered style.
#. (Here really with a warning!)
-#: time-signature.cc:91 lily/time-signature.cc:91
+#. If there is no such symbol, we default to the numbered style.
+#. (Here really with a warning!)
+#: time-signature.cc:91 lily/time-signature.cc:91 lily/time-signature.cc:85
#, c-format
msgid "time signature symbol `%s' not found; reverting to numbered style"
msgstr ""
msgstr ""
#: trill-spanner-engraver.cc:71 lily/trill-spanner-engraver.cc:71
+#: lily/trill-spanner-engraver.cc:70
msgid "can't find start of trill spanner"
msgstr ""
#: trill-spanner-engraver.cc:85 lily/trill-spanner-engraver.cc:85
+#: lily/trill-spanner-engraver.cc:84
msgid "already have a trill spanner"
msgstr ""
#: trill-spanner-engraver.cc:145 lily/trill-spanner-engraver.cc:145
+#: lily/trill-spanner-engraver.cc:144
msgid "unterminated trill spanner"
msgstr ""
-#: tuplet-bracket.cc:448 lily/tuplet-bracket.cc:447
+#: tuplet-bracket.cc:448 lily/tuplet-bracket.cc:447 lily/tuplet-bracket.cc:451
msgid "Killing tuplet bracket across linebreak."
msgstr ""
#: vaticana-ligature-engraver.cc:342 lily/vaticana-ligature-engraver.cc:342
+#: lily/vaticana-ligature-engraver.cc:341
#, c-format
msgid ""
"ignored prefix (es) `%s' of this head according to restrictions of the "
msgstr ""
#: vaticana-ligature.cc:92 lily/vaticana-ligature.cc:92
+#: lily/vaticana-ligature.cc:93
msgid "ascending vaticana style flexa"
msgstr ""
#: vaticana-ligature.cc:181 lily/vaticana-ligature.cc:181
+#: lily/vaticana-ligature.cc:182
msgid "Vaticana_ligature: zero join (delta_pitch == 0)"
msgstr ""
-#: volta-engraver.cc:141 lily/volta-engraver.cc:141
+#: volta-engraver.cc:141 lily/volta-engraver.cc:141 lily/volta-engraver.cc:140
msgid "No volta spanner to end"
msgstr ""
-#: volta-engraver.cc:152 lily/volta-engraver.cc:152
+#: volta-engraver.cc:152 lily/volta-engraver.cc:152 lily/volta-engraver.cc:151
msgid "Already have a volta spanner. Stopping that one prematurely."
msgstr ""
-#: volta-engraver.cc:156 lily/volta-engraver.cc:156
+#: volta-engraver.cc:156 lily/volta-engraver.cc:156 lily/volta-engraver.cc:155
msgid "Also have a stopped spanner. Giving up."
msgstr ""
msgid "unterminated phrasing slur"
msgstr ""
-#: lily/score.cc:328
+#: lily/score.cc:328 lily/score.cc:351
msgid "Error found in this music expression. Ignoring it"
msgstr ""
-#: lily/lily-parser.cc:284
+#: lily/lily-parser.cc:284 lily/lily-parser.cc:291
#, c-format
msgid "Processing `%s'"
msgstr ""
-#: lily/main.cc:128
+#: lily/main.cc:128 lily/main.cc:126
msgid "set option, use -e '(ly:option-usage)' for help"
msgstr ""
-#: lily/main.cc:139
+#: lily/main.cc:139 lily/main.cc:137
msgid "don't generate full pages"
msgstr ""
#. No version number or newline here. It confuses help2man.
-#: lily/main.cc:194
+#. No version number or newline here. It confuses help2man.
+#: lily/main.cc:194 lily/main.cc:192
#, c-format
msgid "Usage: %s [OPTION]... FILE..."
msgstr ""
-#: lily/paper-outputter.cc:116
+#: lily/paper-outputter.cc:116 lily/paper-outputter.cc:113
#, c-format
msgid "Layout output to `%s'..."
msgstr ""
-#: lily/performance.cc:50
+#: lily/performance.cc:50 lily/performance.cc:49
msgid "Track..."
msgstr ""
+
+#: lily/coherent-ligature-engraver.cc:84
+#, c-format
+msgid "gotcha: ptr =%ul"
+msgstr ""
+
+#: lily/coherent-ligature-engraver.cc:96
+#, c-format
+msgid "distance =%f"
+msgstr ""
+
+#: lily/coherent-ligature-engraver.cc:139
+#, c-format
+msgid ""
+"Coherent_ligature_engraver: setting `spacing-increment = 0.01': ptr =%ul"
+msgstr ""
+
+#: lily/kpath.cc:55
+#, c-format
+msgid "kpathsea can not find AFM file `%s'"
+msgstr ""
+
+#: lily/context.cc:151
+#, c-format
+msgid "Cannot find or create new `%s'"
+msgstr ""
+
+#: lily/score-engraver.cc:106 lily/score-engraver.cc:115
+#: lily/score-engraver.cc:117
+#, c-format
+msgid "cannot find `%s'"
+msgstr ""
+
+#: lily/score-engraver.cc:108
+msgid "Music font has not been installed properly.\n"
+msgstr ""
+
+#: lily/score-engraver.cc:109
+#, c-format
+msgid "Search path `%s'\n"
+msgstr ""
+
+#: lily/score-engraver.cc:110
+msgid "Aborting"
+msgstr ""
+
+#: lily/score-engraver.cc:119
+#, c-format
+msgid "Install the ec-fonts-mftraced package from: %s."
+msgstr ""
+
+#: lily/score-engraver.cc:122
+msgid "Aborting."
+msgstr ""
+
+#: lily/vaticana-ligature-engraver.cc:571
+#, c-format
+msgid "Vaticana_ligature_engraver: setting `spacing-increment = %f': ptr =%ul"
+msgstr ""
+
+#: lily/modified-font-metric.cc:39
+#, c-format
+msgid "conflicting metric coding (%s) and font_encoding (%s)"
+msgstr ""
+
+#: lily/open-type-font.cc:32
+#, c-format
+msgid "Cannot allocate %d bytes"
+msgstr ""
+
+#: lily/open-type-font.cc:37
+#, c-format
+msgid "Could not load %s font table"
+msgstr ""
+
+#: lily/open-type-font.cc:91
+#, c-format
+msgid "Unsupported font format: %s"
+msgstr ""
+
+#: lily/open-type-font.cc:95
+#, c-format
+msgid "Unknown error: %d reading font file: %s"
+msgstr ""
+
+#: lily/open-type-font.cc:150
+#, c-format
+msgid "FT_Get_Glyph_Name() returned error: %d"
+msgstr ""
-;;;; figured bass support ...
+;;;; bass-figure.scm -- implement Scheme output routines for TeX
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 1998--2004 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
(ly:add-interface
-'bass-figure-interface
+ 'bass-figure-interface
"A bass figure, including bracket"
'())
-
-
(define-public (format-bass-figure figures context grob)
;; TODO: support slashed numerals here.
(define (fig-to-markup fig-music)
- (let*
- ((align-accs (eq? #t (ly:context-property context 'alignBassFigureAccidentals)))
- (fig (ly:music-property fig-music 'figure))
- (acc (ly:music-property fig-music 'alteration))
- (acc-markup #f)
- (fig-markup
- (if (markup? fig)
- fig
- (if align-accs (make-simple-markup " ")
- (if (not (eq? acc '()))
- (make-simple-markup "")
- (make-strut-markup)))
- )))
+ (let* ((align-accs
+ (eq? #t (ly:context-property context 'alignBassFigureAccidentals)))
+ (fig (ly:music-property fig-music 'figure))
+ (acc (ly:music-property fig-music 'alteration))
+ (acc-markup #f)
+ (fig-markup
+ (if (markup? fig)
+ fig
+ (if align-accs (make-simple-markup " ")
+ (if (not (eq? acc '()))
+ (make-simple-markup "")
+ (make-strut-markup))))))
(if (number? acc)
(make-line-markup (list fig-markup
(alteration->text-accidental-markup acc)))
- fig-markup)
- ))
+ fig-markup)))
(define (filter-brackets i figs acc)
(cond
(set! (ly:grob-property grob 'text)
(make-bracketed-y-column-markup
(sort (filter-brackets 0 figures '()) <)
- (map fig-to-markup figures)
- )))
+ (map fig-to-markup figures))))
;;
-;
-; DOCME: what goes into this func, what comes out.
-
+;; DOCME: what goes into this func, what comes out.
(define (dir-compare up down)
(sign (- up down)))
(let ((maj (dir-compare (car count) (cdr count))))
(if (not (= maj 0))
maj
- (beam-dir-median count total))
- ))
-
+ (beam-dir-median count total))))
(define-public (beam-dir-mean count total)
(dir-compare (car total) (cdr total)))
(> (cdr count) 0))
(dir-compare (/ (car total) (car count)) (/ (cdr total) (cdr count)))
(dir-compare (car count) (cdr count))))
-
(define ((check-beam-quant posl posr) beam)
"Check whether BEAM has POSL and POSR quants. POSL are (POSITION
. QUANT) pairs, where QUANT is -1 (hang), 0 (center), 1 (sit) or -2/ 2 (inter)
"
- (let*
- ((posns (ly:grob-property beam 'positions))
- (thick (ly:grob-property beam 'thickness))
- (layout (ly:grob-layout beam))
- (lthick (ly:output-def-lookup layout 'linethickness))
- (staff-thick lthick) ; fixme.
- (quant->coord (lambda (p q)
- (if (= 2 (abs q))
- (+ p (/ q 4.0))
- (+ p (- (* 0.5 q thick) (* 0.5 q lthick))))))
- (want-l (quant->coord (car posl) (cdr posl)))
- (want-r (quant->coord (car posr) (cdr posr)))
- (almost-equal (lambda (x y) (< (abs (- x y)) 1e-3))))
+ (let* ((posns (ly:grob-property beam 'positions))
+ (thick (ly:grob-property beam 'thickness))
+ (layout (ly:grob-layout beam))
+ (lthick (ly:output-def-lookup layout 'linethickness))
+ (staff-thick lthick) ; fixme.
+ (quant->coord (lambda (p q)
+ (if (= 2 (abs q))
+ (+ p (/ q 4.0))
+ (+ p (- (* 0.5 q thick) (* 0.5 q lthick))))))
+ (want-l (quant->coord (car posl) (cdr posl)))
+ (want-r (quant->coord (car posr) (cdr posr)))
+ (almost-equal (lambda (x y) (< (abs (- x y)) 1e-3))))
(if (or (not (almost-equal want-l (car posns)))
(not (almost-equal want-r (cdr posns))))
(begin
(ly:warn
- "Error in beam quanting found. Want (~S,~S) found (~S)."
- want-l want-r posns )
+ "Error in beam quanting found. Want (~S,~S) found (~S)."
+ want-l want-r posns )
(set! (ly:grob-property beam 'quant-score)
(format "(~S,~S)" want-l want-r)))
- (set! (ly:grob-property beam 'quant-score) "")
-
-
- )))
+ (set! (ly:grob-property beam 'quant-score) ""))))
(define ((check-beam-slope-sign comparison) beam)
"Check whether the slope of BEAM is correct wrt. COMPARISON."
- (let*
- ((posns (ly:grob-property beam 'positions))
- (slope-sign (- (cdr posns) (car posns)))
- (correct (comparison slope-sign 0)))
+ (let* ((posns (ly:grob-property beam 'positions))
+ (slope-sign (- (cdr posns) (car posns)))
+ (correct (comparison slope-sign 0)))
(if (not correct)
(procedure-name comparison) slope-sign)
(set! (ly:grob-property beam 'quant-score)
(format "~S 0" (procedure-name comparison) )))
- (set! (ly:grob-property beam 'quant-score) "")
+ (set! (ly:grob-property beam 'quant-score) ""))))
-
- )))
-
(define-public (check-quant-callbacks l r)
(list Beam::least_squares
- Beam::check_concave
- Beam::slope_damping
- Beam::shift_region_to_valid
- Beam::quanting
- (check-beam-quant l r)
- ))
+ Beam::check_concave
+ Beam::slope_damping
+ Beam::shift_region_to_valid
+ Beam::quanting
+ (check-beam-quant l r)))
+
-
(define-public (check-slope-callbacks comparison)
(list Beam::least_squares
- Beam::check_concave
- Beam::slope_damping
- Beam::shift_region_to_valid
- Beam::quanting
- (check-beam-slope-sign comparison)
- ))
+ Beam::check_concave
+ Beam::slope_damping
+ Beam::shift_region_to_valid
+ Beam::quanting
+ (check-beam-slope-sign comparison)))
-
;;;; chord-generic-names.scm -- Compile chord names
;;;;
;;;; source file of the GNU LilyPond music typesetter
-;;;;
+;;;;
;;;; (c) 2003-2004 Jan Nieuwenhuizen <janneke@gnu.org>
(define-public (banter-chord-names pitches bass inversion context)
(ugh-compat-double-plus-new-chord->markup
- 'banter pitches bass inversion context '())
- )
-
+ 'banter pitches bass inversion context '()))
(define-public (jazz-chord-names pitches bass inversion context)
(ugh-compat-double-plus-new-chord->markup
- 'jazz pitches bass inversion context '())
- )
-
+ 'jazz pitches bass inversion context '()))
(define-public (ugh-compat-double-plus-new-chord->markup
style pitches bass inversion context options)
input/test/dpncnt.ly).
"
-
(define (step-nr pitch)
(let* ((pitch-nr (+ (* 7 (ly:pitch-octave pitch))
(ly:pitch-notename pitch)))
(root-nr (+ (* 7 (ly:pitch-octave (car pitches)))
(ly:pitch-notename (car pitches)))))
(+ 1 (- pitch-nr root-nr))))
-
+
(define (next-third pitch)
(ly:pitch-transpose pitch
(ly:make-pitch 0 2 (if (or (= (step-nr pitch) 3)
(normalized-pitch (ly:pitch-transpose pitch diff))
(alteration (ly:pitch-alteration normalized-pitch)))
(if (= (step-nr pitch) 7) (+ alteration SEMI-TONE) alteration)))
-
+
(define (pitch-unalter pitch)
(let ((alteration (step-alteration pitch)))
(if (= alteration 0)
((NATURAL) "")
((SHARP) "+")
((DOUBLE-SHARP) "++"))))))
-
+
(define (step->markup-accidental pitch)
(make-line-markup
(list (accidental->markup (step-alteration pitch))
(list (ly:context-property context 'majorSevenSymbol))
(list (accidental->markup (step-alteration pitch))
(make-simple-markup (number->string (step-nr pitch)))))))
-
+
;; tja, kennok
(define (make-sub->markup step->markup)
(lambda (pitch)
(make-line-markup (list (make-simple-markup "no")
(step->markup pitch)))))
-
+
(define (step-based-sub->markup step->markup pitch)
(make-line-markup (list (make-simple-markup "no") (step->markup pitch))))
-
+
(define (get-full-list pitch)
(if (<= (step-nr pitch) (step-nr (last pitches)))
(cons pitch (get-full-list (next-third pitch)))
(partial-match (cdr exceptions))))
#f))
- (if #f (begin
+ (if #f (begin
(write-me "pitches: " pitches)))
(let* ((full-exceptions
(ly:context-property context 'chordNameExceptionsFull))
;; (all pitches)
(all (append (take full (length partial-pitches) )
(drop pitches (length partial-pitches) )))
-
+
(highest (last all))
(missing (list-minus full (map pitch-unalter all)))
(consecutive (get-consecutive 1 all))
(altered (filter step-even-or-altered? all))
(cons-alt (filter step-even-or-altered? consecutive))
(base (list-minus consecutive altered)))
-
+
(if #f (begin
(write-me "full:" full)
;; root
;; + steps:altered + (highest all -- if not altered)
;; + subs:missing
-
+
(let* ((root->markup (assoc-get
'root->markup options note-name->markup))
(step->markup (assoc-get
(step-based-sub->markup step->markup x))))
(sep (assoc-get
'separator options (make-simple-markup "/"))))
-
+
(if
(pair? full-markup)
(make-line-markup (list (root->markup root) full-markup))
-
+
(make-line-markup
(list
(root->markup root)
(list partial-markup-suffix)
(list (map sub->markup missing)))
sep)))))))
-
-
+
+
((jazz)
;; root
;; + steps:(highest base) + cons-alt
'separator options (make-simple-markup " ")))
(add-prefix (assoc-get 'add-prefix options
(make-simple-markup " add"))))
-
+
(if
(pair? full-markup)
(make-line-markup (list (root->markup root) full-markup))
-
+
(make-line-markup
(list
(root->markup root)
(make-normal-size-super-markup
(make-line-markup
(list
-
+
;; kludge alert: omit <= 5
;;(markup-join (map step->markup
;; (cons (last base) cons-alt)) sep)
-
+
;; This fixes:
;; c C5 -> C
;; c:2 C5 2 -> C2
(if (> (step-nr tb) 5)
(cons tb cons-alt)
cons-alt))) sep)
-
+
(if (pair? rest)
add-prefix
empty-markup)
(markup-join (map step->markup rest) sep)
partial-markup-suffix))))))))
-
+
(else empty-markup))))
#f
(if (= (- x 1) (ly:pitch-steps (car ps)))
(car ps)
- (get-step x (cdr ps)))
- ))
+ (get-step x (cdr ps)))))
(define (replace-step p ps)
"Copy PS, but replace the step of P in PS."
(if (null? ps)
'()
- (let*
- (
- (t (replace-step p (cdr ps)))
- )
-
+ (let* ((t (replace-step p (cdr ps))))
(if (= (ly:pitch-steps p) (ly:pitch-steps (car ps)))
(cons p t)
- (cons (car ps) t)
- ))
- ))
+ (cons (car ps) t)))))
(define (remove-step x ps)
"Copy PS, but leave out the Xth step."
(if (null? ps)
'()
- (let*
- (
- (t (remove-step x (cdr ps)))
- )
-
+ (let* ((t (remove-step x (cdr ps))))
(if (= (- x 1) (ly:pitch-steps (car ps)))
t
- (cons (car ps) t)
- ))
- ))
+ (cons (car ps) t)))))
(define-public (ignatzek-chord-names
'()
(if (< (ly:pitch-steps (car ps)) (- x 1))
(remove-uptil-step x (cdr ps))
- ps)
- ))
+ ps)))
(define name-root (ly:context-property context 'chordRootNamer))
(define name-note
(let ((nn (ly:context-property context 'chordNoteNamer)))
(if (eq? nn '())
- ; replacing the next line with name-root gives guile-error...? -rz
+ ; replacing the next line with name-root gives guile-error...? -rz
;; apparently sequence of defines is equivalent to let, not let* ? -hwn
(ly:context-property context 'chordRootNamer)
alteration-pitches
addition-pitches
suffix-modifiers
- bass-pitch
- )
+ bass-pitch)
"Format for the given (lists of) pitches. This is actually more
work than classifying the pitches."
(define (filter-main-name p)
- "The main name: don't print anything for natural 5 or 3."
- (if
- (or (not (ly:pitch? p))
- (and (is-natural-alteration? p)
- (or (= (pitch-step p) 5)
- (= (pitch-step p) 3))))
- '()
- (list (name-step p))
- ))
+ "The main name: don't print anything for natural 5 or 3."
+ (if
+ (or (not (ly:pitch? p))
+ (and (is-natural-alteration? p)
+ (or (= (pitch-step p) 5)
+ (= (pitch-step p) 3))))
+ '()
+ (list (name-step p))))
(define (glue-word-to-step word x)
(make-line-markup
(list
(make-simple-markup word)
- (name-step x)))
- )
+ (name-step x))))
(define (suffix-modifier->markup mod)
(if (or (= 4 (pitch-step mod))
(= 2 (pitch-step mod)))
(glue-word-to-step "sus" mod)
- (glue-word-to-step "huh" mod)
- ))
+ (glue-word-to-step "huh" mod)))
(define (prefix-modifier->markup mod)
(if (and (= 3 (pitch-step mod))
(= FLAT (ly:pitch-alteration mod)))
(make-simple-markup "m")
- (make-simple-markup "huh")
- ))
+ (make-simple-markup "huh")))
(define (filter-alterations alters)
"Filter out uninteresting (natural) pitches from ALTERS."
(if
(null? alters)
'()
- (let*
- (
- (l (filter altered? alters))
- (lp (last-pair alters))
- )
+ (let* ((lst (filter altered? alters))
+ (lp (last-pair alters)))
;; we want the highest also if unaltered
(if (and (not (altered? (car lp)))
(> (pitch-step (car lp)) 5))
- (append l (last-pair alters))
- l)
- )))
+ (append lst (last-pair alters))
+ lst))))
(define (name-step pitch)
(define (step-alteration pitch)
(- (ly:pitch-alteration pitch)
- (natural-chord-alteration pitch)
- ))
+ (natural-chord-alteration pitch)))
- (let*
- (
- (num-markup (make-simple-markup
- (number->string (pitch-step pitch))))
- (args (list num-markup))
- (total (if (= (ly:pitch-alteration pitch) 0)
- (if (= (pitch-step pitch) 7)
- (list (ly:context-property context 'majorSevenSymbol))
- args)
- (cons (accidental->markup (step-alteration pitch)) args)
- ))
- )
+ (let* ((num-markup (make-simple-markup
+ (number->string (pitch-step pitch))))
+ (args (list num-markup))
+ (total (if (= (ly:pitch-alteration pitch) 0)
+ (if (= (pitch-step pitch) 7)
+ (list (ly:context-property context 'majorSevenSymbol))
+ args)
+ (cons (accidental->markup (step-alteration pitch)) args))))
(make-line-markup total)))
add-markups) sep))
(base-stuff (if (ly:pitch? bass-pitch)
(list sep (name-note bass-pitch))
- '()))
- )
+ '())))
(set! base-stuff
(append
(markup-join prefixes sep)
(make-super-markup to-be-raised-stuff))
base-stuff))
- (make-line-markup base-stuff)
-
- ))
+ (make-line-markup base-stuff)))
(define (ignatzek-format-exception
root
exception-markup
bass-pitch)
- (make-line-markup
- `(
- ,(name-root root)
- ,exception-markup
- .
- ,(if (ly:pitch? bass-pitch)
+ (make-line-markup
+ `(
+ ,(name-root root)
+ ,exception-markup
+ .
+ ,(if (ly:pitch? bass-pitch)
(list (ly:context-property context 'chordNameSeparator)
(name-note bass-pitch))
- '()))))
+ '()))))
- (let*
- (
- (root (car in-pitches))
- (pitches (map (lambda (x) (ly:pitch-diff x root)) (cdr in-pitches)))
- (exceptions (ly:context-property context 'chordNameExceptions))
- (exception (assoc-get pitches exceptions))
- (prefixes '())
- (suffixes '())
- (add-steps '())
- (main-name #f)
- (bass-note
- (if (ly:pitch? inversion)
- inversion
- bass))
- (alterations '())
- )
-
+ (let* ((root (car in-pitches))
+ (pitches (map (lambda (x) (ly:pitch-diff x root)) (cdr in-pitches)))
+ (exceptions (ly:context-property context 'chordNameExceptions))
+ (exception (assoc-get pitches exceptions))
+ (prefixes '())
+ (suffixes '())
+ (add-steps '())
+ (main-name #f)
+ (bass-note
+ (if (ly:pitch? inversion)
+ inversion
+ bass))
+ (alterations '()))
+
(if exception
- (ignatzek-format-exception root exception bass-note)
-
- (begin ; no exception.
-
- ; handle sus4 and sus2 suffix: if there is a 3 together with
- ; sus2 or sus4, then we explicitly say add3.
- (map
- (lambda (j)
- (if (get-step j pitches)
- (begin
- (if (get-step 3 pitches)
- (begin
- (set! add-steps (cons (get-step 3 pitches) add-steps))
- (set! pitches (remove-step 3 pitches))
- ))
- (set! suffixes (cons (get-step j pitches) suffixes))
- )
- )
- ) '(2 4) )
+ (ignatzek-format-exception root exception bass-note)
+
+ (begin ; no exception.
+
+ ; handle sus4 and sus2 suffix: if there is a 3 together with
+ ; sus2 or sus4, then we explicitly say add3.
+ (map
+ (lambda (j)
+ (if (get-step j pitches)
+ (begin
+ (if (get-step 3 pitches)
+ (begin
+ (set! add-steps (cons (get-step 3 pitches) add-steps))
+ (set! pitches (remove-step 3 pitches))))
+ (set! suffixes (cons (get-step j pitches) suffixes))))
+ ) '(2 4) )
- ;; do minor-3rd modifier.
- (if (and (get-step 3 pitches)
- (= (ly:pitch-alteration (get-step 3 pitches)) FLAT))
- (set! prefixes (cons (get-step 3 pitches) prefixes)))
-
- ;; lazy bum. Should write loop.
- (cond
- ((get-step 7 pitches) (set! main-name (get-step 7 pitches)))
- ((get-step 6 pitches) (set! main-name (get-step 6 pitches)))
- ((get-step 5 pitches) (set! main-name (get-step 5 pitches)))
- ((get-step 4 pitches) (set! main-name (get-step 4 pitches)))
- ((get-step 3 pitches) (set! main-name (get-step 3 pitches))))
+ ;; do minor-3rd modifier.
+ (if (and (get-step 3 pitches)
+ (= (ly:pitch-alteration (get-step 3 pitches)) FLAT))
+ (set! prefixes (cons (get-step 3 pitches) prefixes)))
+
+ ;; lazy bum. Should write loop.
+ (cond
+ ((get-step 7 pitches) (set! main-name (get-step 7 pitches)))
+ ((get-step 6 pitches) (set! main-name (get-step 6 pitches)))
+ ((get-step 5 pitches) (set! main-name (get-step 5 pitches)))
+ ((get-step 4 pitches) (set! main-name (get-step 4 pitches)))
+ ((get-step 3 pitches) (set! main-name (get-step 3 pitches))))
- (let* ((3-diff? (lambda (x y)
- (= (- (pitch-step y) (pitch-step x)) 2)))
- (split (split-at-predicate
- 3-diff? (remove-uptil-step 5 pitches))))
- (set! alterations (append alterations (car split)))
- (set! add-steps (append add-steps (cdr split)))
- (set! alterations (delq main-name alterations))
- (set! add-steps (delq main-name add-steps))
+ (let* ((3-diff? (lambda (x y)
+ (= (- (pitch-step y) (pitch-step x)) 2)))
+ (split (split-at-predicate
+ 3-diff? (remove-uptil-step 5 pitches))))
+ (set! alterations (append alterations (car split)))
+ (set! add-steps (append add-steps (cdr split)))
+ (set! alterations (delq main-name alterations))
+ (set! add-steps (delq main-name add-steps))
- ;; chords with natural (5 7 9 11 13) or leading subsequence.
- ;; etc. are named by the top pitch, without any further
- ;; alterations.
- (if (and
- (ly:pitch? main-name)
- (= 7 (pitch-step main-name))
- (is-natural-alteration? main-name)
- (pair? (remove-uptil-step 7 alterations))
- (reduce (lambda (x y) (and x y)) #t
- (map is-natural-alteration? alterations)))
- (begin
- (set! main-name (last alterations))
- (set! alterations '())))
+ ;; chords with natural (5 7 9 11 13) or leading subsequence.
+ ;; etc. are named by the top pitch, without any further
+ ;; alterations.
+ (if (and
+ (ly:pitch? main-name)
+ (= 7 (pitch-step main-name))
+ (is-natural-alteration? main-name)
+ (pair? (remove-uptil-step 7 alterations))
+ (reduce (lambda (x y) (and x y)) #t
+ (map is-natural-alteration? alterations)))
+ (begin
+ (set! main-name (last alterations))
+ (set! alterations '())))
- (ignatzek-format-chord-name
- root prefixes main-name alterations add-steps suffixes bass-note))))))
+ (ignatzek-format-chord-name
+ root prefixes main-name alterations add-steps suffixes bass-note))))))
"Stencil as markup"
stil)
-
(def-markup-command (score layout props score) (ly:score?)
"Inline an image of music."
- (let*
- ((systems (ly:score-embedded-format score layout)))
+ (let* ((systems (ly:score-embedded-format score layout)))
(if (= 0 (vector-length systems))
(begin
(ly:warn "No systems found in \\score markup. Did you forget \\layout?")
empty-markup)
(begin
- (let*
- ((stencil (ly:paper-system-stencil (vector-ref systems 0))))
+ (let* ((stencil (ly:paper-system-stencil (vector-ref systems 0))))
(ly:stencil-align-to! stencil Y CENTER)
stencil)))))
(def-markup-command (simple layout props str) (string?)
"A simple text string; @code{\\markup @{ foo @}} is equivalent with
@code{\\markup @{ \\simple #\"foo\" @}}."
- (interpret-markup layout props str))
+ (interpret-markup layout props str))
(def-markup-command (encoded-simple layout props sym str) (symbol? string?)
"A text string, encoded with encoding @var{sym}. See
@usermanref{Text encoding} for more information."
(Text_interface::interpret_string layout
- props sym str))
+ props sym str))
;; TODO: use font recoding.
"
(let* ((orig-stencils
- (map (lambda (x) (interpret-markup layout props x))
- markups))
+ (map (lambda (x) (interpret-markup layout props x))
+ markups))
(stencils
(map (lambda (stc)
(if (ly:stencil-empty? stc)
(def-markup-command (fromproperty layout props symbol) (symbol?)
"Read the @var{symbol} from property settings, and produce a stencil from the markup contained within. If @var{symbol} is not defined, it returns an empty markup"
- (let*
- ((m (chain-assoc-get symbol props)))
+ (let* ((m (chain-assoc-get symbol props)))
(if (markup? m)
(interpret-markup layout props m)
(def-markup-command (on-the-fly layout props procedure arg) (symbol? markup?)
"Apply the @var{procedure} markup command to
@var{arg}. @var{procedure} should take a single argument."
- (let*
- ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg))))
+ (let* ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg))))
(set-object-property! anonymous-with-signature
- 'markup-signature
- (list markup?))
+ 'markup-signature
+ (list markup?))
- (interpret-markup layout props (list anonymous-with-signature arg))
- ))
+ (interpret-markup layout props (list anonymous-with-signature arg))))
(def-markup-command (combine layout props m1 m2) (markup? markup?)
"Print two markups on top of each other."
- (let*
- ((s1 (interpret-markup layout props m1))
- (s2 (interpret-markup layout props m2)))
-
+ (let* ((s1 (interpret-markup layout props m1))
+ (s2 (interpret-markup layout props m2)))
+
(ly:stencil-add s1 s2)))
(def-markup-command (finger layout props arg) (markup?)
"Set @code{font-shape} to @code{caps}."
(interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg))
-;(def-markup-command (latin-i layout props arg) (markup?)
-; "TEST latin1 encoding."
-; (interpret-markup layout (prepend-alist-chain 'font-shape 'latin1 props) arg))
+ ;(def-markup-command (latin-i layout props arg) (markup?)
+ ; "TEST latin1 encoding."
+ ; (interpret-markup layout (prepend-alist-chain 'font-shape 'latin1 props) arg))
(def-markup-command (dynamic layout props arg) (markup?)
"Use the dynamic font. This font only contains @b{s}, @b{f}, @b{m},
(stack-lines
(if (number? dir) dir -1)
0.0
- (chain-assoc-get 'baseline-skip props)
+ (chain-assoc-get 'baseline-skip props)
(map (lambda (x) (interpret-markup layout props x)) args))))
(def-markup-command (center-align layout props args) (markup-list?)
(let* ((m (interpret-markup layout props arg)))
(ly:stencil-align-to! m axis dir)
- m
- ))
+ m))
(def-markup-command (halign layout props dir arg) (number? markup?)
"Set horizontal alignment. If @var{dir} is @code{-1}, then it is
"
(ly:font-get-glyph
(ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
- props))
+ props))
glyph-name))
(def-markup-command (lookup layout props glyph-name) (string?)
"Lookup a glyph by name."
(ly:font-get-glyph (ly:paper-get-font layout props)
- glyph-name))
+ glyph-name))
(def-markup-command (char layout props num) (integer?)
"Produce a single character, e.g. @code{\\char #65} produces the
(ly:stencil-translate-axis (interpret-markup layout props arg)
- amount Y))
+ amount Y))
(def-markup-command (fraction layout props arg1 arg2) (markup? markup?)
"Make a fraction of two markups."
(size (chain-assoc-get 'font-size props 0))
(stem-length (* (magstep size) (max 3 (- log 1))))
(head-glyph (ly:font-get-glyph
- font
- (string-append "noteheads-s" (number->string (min log 2)))))
+ font
+ (string-append "noteheads-s" (number->string (min log 2)))))
(stem-thickness 0.13)
(stemy (* dir stem-length))
(attachx (if (> dir 0)
0))
(attachy (* dir 0.28))
(stem-glyph (and (> log 0)
- (ly:round-filled-box
- (cons attachx (+ attachx stem-thickness))
- (cons (min stemy attachy)
- (max stemy attachy))
- (/ stem-thickness 3))))
+ (ly:round-filled-box
+ (cons attachx (+ attachx stem-thickness))
+ (cons (min stemy attachy)
+ (max stemy attachy))
+ (/ stem-thickness 3))))
(dot (ly:font-get-glyph font "dots-dot"))
(dotwid (interval-length (ly:stencil-extent dot X)))
(dots (and (> dot-count 0)
(flaggl (and (> log 2)
(ly:stencil-translate
(ly:font-get-glyph font
- (string-append "flags-"
- (if (> dir 0) "u" "d")
- (number->string log)))
+ (string-append "flags-"
+ (if (> dir 0) "u" "d")
+ (number->string log)))
(cons (+ attachx (/ stem-thickness 2)) stemy)))))
(if flaggl
(set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
(set! stem-glyph
(ly:stencil-add
(ly:stencil-translate-axis dots
- (+ (if (and (> dir 0) (> log 2))
- (* 1.5 dotwid)
- 0)
- ;; huh ? why not necessary?
- ;;(cdr (ly:stencil-extent head-glyph X))
- dotwid)
- X)
+ (+ (if (and (> dir 0) (> log 2))
+ (* 1.5 dotwid)
+ 0)
+ ;; huh ? why not necessary?
+ ;;(cdr (ly:stencil-extent head-glyph X))
+ dotwid)
+ X)
stem-glyph)))
stem-glyph))
"Set @var{arg} in superscript with a normal font size."
(ly:stencil-translate-axis (interpret-markup
- layout
- props arg)
- (* 0.5 (chain-assoc-get 'baseline-skip props))
- Y))
+ layout
+ props arg)
+ (* 0.5 (chain-assoc-get 'baseline-skip props))
+ Y))
(def-markup-command (super layout props arg) (markup?)
"
"
(ly:stencil-translate (interpret-markup layout props arg)
- offset))
+ offset))
(def-markup-command (sub layout props arg) (markup?)
"Set @var{arg} in subscript."
(m (interpret-markup layout props arg)))
(box-stencil m th pad)))
-;FIXME: is this working?
+ ;FIXME: is this working?
(def-markup-command (strut layout props) ()
"Create a box of the same height as the space in the current font."
(define (number->markletter-string n)
"Double letters for big marks."
- (let*
- ((l (vector-length number->mark-letter-vector)))
+ (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)))))
+ (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 layout props num) (integer?)
- "Make a markup letter for @var{num}. The letters start with A to Z
+ "Make a markup letter for @var{num}. The letters start with A to Z
(skipping I), and continues with double letters."
-
- (Text_interface::interpret_markup layout props (number->markletter-string num)))
-
-
+
+ (Text_interface::interpret_markup layout props (number->markletter-string num)))
(def-markup-command (bracketed-y-column layout props indices args)
"Make a column of the markups in @var{args}, putting brackets around
the elements marked in @var{indices}, which is a list of numbers."
- (define (sublist l start stop)
+ (define (sublist l start stop)
(take (drop l start) (- (1+ stop) start)) )
(define (stencil-list-extent ss axis)
(cons
(apply min (map (lambda (x) (car (ly:stencil-extent x axis))) ss))
(apply max (map (lambda (x) (cdr (ly:stencil-extent x axis))) ss))))
-
+
(define (stack-stencils stencils bskip last-stencil)
(cond
((null? stencils) '())
(cons (car stencils)
(stack-stencils (cdr stencils) bskip (car stencils))))
(else
- (let*
- ((orig (car stencils))
- (dir (chain-assoc-get 'direction props DOWN))
- (new (ly:stencil-moved-to-edge last-stencil Y dir
- orig
- 0.1 bskip))
- )
+ (let* ((orig (car stencils))
+ (dir (chain-assoc-get 'direction props DOWN))
+ (new (ly:stencil-moved-to-edge last-stencil Y dir
+ orig
+ 0.1 bskip)))
- (cons new (stack-stencils (cdr stencils) bskip new))))
- ))
+ (cons new (stack-stencils (cdr stencils) bskip new))))))
(define (make-brackets stencils indices acc)
(if (and stencils
(pair? indices)
(pair? (cdr indices)))
- (let*
- ((encl (sublist stencils (car indices) (cadr indices)))
- (x-ext (stencil-list-extent encl X))
- (y-ext (stencil-list-extent encl Y))
- (thick 0.10)
- (pad 0.35)
- (protusion (* 2.5 thick))
- (lb
- (ly:stencil-translate-axis
- (ly:bracket Y y-ext thick protusion)
- (- (car x-ext) pad) X))
- (rb (ly:stencil-translate-axis
- (ly:bracket Y y-ext thick (- protusion))
- (+ (cdr x-ext) pad) X))
- )
+ (let* ((encl (sublist stencils (car indices) (cadr indices)))
+ (x-ext (stencil-list-extent encl X))
+ (y-ext (stencil-list-extent encl Y))
+ (thick 0.10)
+ (pad 0.35)
+ (protusion (* 2.5 thick))
+ (lb
+ (ly:stencil-translate-axis
+ (ly:bracket Y y-ext thick protusion)
+ (- (car x-ext) pad) X))
+ (rb (ly:stencil-translate-axis
+ (ly:bracket Y y-ext thick (- protusion))
+ (+ (cdr x-ext) pad) X)))
(make-brackets
stencils (cddr indices)
(append
(list lb rb)
- acc)))
+ acc)))
acc))
- (let*
- ((stencils
- (map (lambda (x)
- (interpret-markup
- layout
- props
- x)) args))
- (leading
- (chain-assoc-get 'baseline-skip props))
- (stacked (stack-stencils stencils 1.25 #f))
- (brackets (make-brackets stacked indices '()))
- )
+ (let* ((stencils
+ (map (lambda (x)
+ (interpret-markup
+ layout
+ props
+ x)) args))
+ (leading
+ (chain-assoc-get 'baseline-skip props))
+ (stacked (stack-stencils stencils 1.25 #f))
+ (brackets (make-brackets stacked indices '())))
(apply ly:stencil-add
- (append stacked brackets)
- )))
-
-
-
-
-
-
-
-
+ (append stacked brackets))))
;;;; (c) 1998--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
;;;; Jan Nieuwenhuizen <janneke@gnu.org>
-
;; TODO: should link back into user manual.
(define-public music-descriptions
`(
(AbsoluteDynamicEvent
. (
- (description . "Creates a dynamic mark.
+ (description . "Creates a dynamic mark.
Syntax: @var{note}@code{\\x},
where x is one of \\ppp, \\pp, \\p, \\mp, \\mf, \\f, \\ff, \\fff.")
;; separate non articulation scripts
(ArticulationEvent
. (
- (description . "Adds an articulation marking to a note.
+ (description . "Adds an articulation marking to a note.
Syntax:
@var{note}@code{X}@code{Y}, where X is a direction (up @code{^}, down
))
(BeamEvent
. (
- (description . "Starts or stops a beam.
+ (description . "Starts or stops a beam.
Syntax for manual control:
c8-[ c c-] c8")
))
(BreakEvent
. (
- (description . "Create a line break, Syntax: \\break or page break, Syntax: \\pagebreak.")
+ (description . "Create a line break, Syntax: \\break or page break, Syntax: \\pagebreak.")
(internal-class-name . "Event")
(types . (general-music break-event event))
(description . "A note that is part of a cluster.")
(internal-class-name . "Event")
- ; not a note-event, to ensure that Note_engraver doesn't eat it.
+ ; not a note-event, to ensure that Note_engraver doesn't eat it.
(types . (general-music cluster-note-event melodic-event rhythmic-event event))
))
(internal-class-name . "Event")
(types . (general-music dynamic-event decrescendo-event event))
))
-
+
(ExtenderEvent
. (
(description . "Extend lyrics.")
(iterator-ctor . ,Simple_music_iterator::constructor)
(types . (general-music event rhythmic-event skip-event))
))
-
+
(SkipEvent
. (
(description . "Filler that takes up duration, but does not print anything.
(define music-name-to-property-table (make-vector 59 '()))
-
;; init hash table,
;; transport description to an object property.
(set!
(set-object-property! (car x)
'music-description
(cdr (assq 'description (cdr x))))
- (let
- ((l (cdr x)))
+ (let ((l (cdr x)))
(set! l (assoc-set! l 'name (car x)))
(set! l (assq-remove! l 'description))
(hashq-set! music-name-to-property-table (car x) l)
(set-props music-properties)
m)))
-
(define-public (make-repeated-music name)
(let* ((handle (assoc name '(("volta" . VoltaRepeatedMusic)
("unfold" . UnfoldedRepeatedMusic)
-;;; backend-documentation-lib.scm -- Functions for backend documentation
-;;;
-;;; source file of the GNU LilyPond music typesetter
-;;;
-;;; (c) 2000--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
-;;; Jan Nieuwenhuizen <janneke@gnu.org>
-
+;;;; backend-documentation-lib.scm -- Functions for backend documentation
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 2000--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; Jan Nieuwenhuizen <janneke@gnu.org>
(define (interface-doc-string interface grob-description)
- (let*
- ((name (car interface))
- (desc (cadr interface))
- (props (sort (caddr interface) symbol<?))
- (docfunc (lambda (pr)
- (property->texi
- 'backend pr grob-description)))
- (iprops (filter (lambda (x) (object-property x 'backend-internal) ) props))
- (uprops (filter (lambda (x) (not (object-property x 'backend-internal)) ) props))
- (user-propdocs (map docfunc uprops))
- (internal-propdocs (map docfunc iprops)))
-
- (string-append
- desc
-
- (if (pair? uprops)
- (string-append
- "\n\n@unnumberedsubsubsec User settable properties:\n"
- (description-list->texi user-propdocs))
- "")
-
- (if (pair? iprops)
- (string-append
- "\n\n@unnumberedsubsubsec Internal properties: \n"
- (description-list->texi internal-propdocs)
- )
- "")
- )
- ))
-
+ (let* ((name (car interface))
+ (desc (cadr interface))
+ (props (sort (caddr interface) symbol<?))
+ (docfunc (lambda (pr)
+ (property->texi
+ 'backend pr grob-description)))
+ (iprops (filter (lambda (x) (object-property x 'backend-internal) ) props))
+ (uprops (filter (lambda (x) (not (object-property x 'backend-internal)) ) props))
+ (user-propdocs (map docfunc uprops))
+ (internal-propdocs (map docfunc iprops)))
+
+ (string-append
+ desc
+
+ (if (pair? uprops)
+ (string-append
+ "\n\n@unnumberedsubsubsec User settable properties:\n"
+ (description-list->texi user-propdocs))
+ "")
+
+ (if (pair? iprops)
+ (string-append
+ "\n\n@unnumberedsubsubsec Internal properties: \n"
+ (description-list->texi internal-propdocs))
+ ""))))
(define iface->grob-table (make-vector 61 '()))
;; extract ifaces, and put grob into the hash table.
(map
(lambda (x)
- (let*
- (
- (metah (assoc 'meta (cdr x)))
- (meta (cdr metah))
- (ifaces (cdr (assoc 'interfaces meta)))
- )
+ (let* ((metah (assoc 'meta (cdr x)))
+ (meta (cdr metah))
+ (ifaces (cdr (assoc 'interfaces meta))))
(map (lambda (iface)
(hashq-set!
iface->grob-table iface
(cons (car x)
- (hashq-ref iface->grob-table iface '())
- )))
- ifaces)
- ))
+ (hashq-ref iface->grob-table iface '()))))
+ ifaces)))
all-grob-descriptions)
;; First level Interface description
(sort
(map symbol->string
(hashq-ref iface->grob-table (car interface) '() ))
- string<?)
-
- )))
-
- )))
+ string<?)))))))
(define (grob-alist->texi alist)
- (let*
- ((uprops (filter (lambda (x) (not (object-property x 'backend-internal)))
- (map car alist))))
+ (let* ((uprops (filter (lambda (x) (not (object-property x 'backend-internal)))
+ (map car alist))))
(description-list->texi
(map (lambda (y) (property->texi 'backend y alist))
- uprops)
- )))
-
+ uprops))))
(define (grob-doc description)
"Given a property alist DESCRIPTION, make a documentation
node."
- (let*
- ((metah (assoc 'meta description))
- (meta (cdr metah))
- (name (cdr (assoc 'name meta)))
-; (bla (display name))
- (ifaces (map lookup-interface (cdr (assoc 'interfaces meta))))
- (ifacedoc (map (lambda (iface)
- (if (pair? iface)
- (ref-ify (symbol->string (car iface)))
- (error (format "Error making doc of ~s" name))))
- (reverse ifaces)))
- (engravers (filter
- (lambda (x) (engraver-makes-grob? name x)) all-engravers-list))
- (namestr (symbol->string name))
- (engraver-names (map symbol->string (map ly:translator-name engravers))))
+ (let* ((metah (assoc 'meta description))
+ (meta (cdr metah))
+ (name (cdr (assoc 'name meta)))
+ ;; (bla (display name))
+ (ifaces (map lookup-interface (cdr (assoc 'interfaces meta))))
+ (ifacedoc (map (lambda (iface)
+ (if (pair? iface)
+ (ref-ify (symbol->string (car iface)))
+ (error (format "Error making doc of ~s" name))))
+ (reverse ifaces)))
+ (engravers (filter
+ (lambda (x) (engraver-makes-grob? name x)) all-engravers-list))
+ (namestr (symbol->string name))
+ (engraver-names (map symbol->string (map ly:translator-name engravers))))
(make <texi-node>
#:name namestr
"\n\nStandard settings: \n\n"
(grob-alist->texi description)
"\n\nThis object supports the following interfaces: \n"
- (human-listify ifacedoc)
- ))
- ))
+ (human-listify ifacedoc)))))
(define (all-grobs-doc)
(make <texi-node>
(define interface-description-alist
(hash-fold
(lambda (key val prior)
- (cons (cons key val) prior)
- )
+ (cons (cons key val) prior))
'() (ly:all-grob-interfaces)))
(set! interface-description-alist (sort interface-description-alist alist<?))
-
;;;;;;;;;; check for dangling backend properties.
(define (mark-interface-properties entry)
- (map (lambda (x) (set-object-property! x 'iface-marked #t)) (caddr (cdr entry)))
- )
+ (map (lambda (x) (set-object-property! x 'iface-marked #t)) (caddr (cdr entry))))
(map mark-interface-properties interface-description-alist)
;;;;;;;;;;;;;;;;
(define (lookup-interface name)
- (let* (
- (entry (hashq-ref (ly:all-grob-interfaces) name '() ))
- )
-
+ (let* ((entry (hashq-ref (ly:all-grob-interfaces) name '() )))
(if (equal? entry #f)
(error "Unknown interface" name))
-
- entry
-))
+ entry))
(define (all-interfaces-doc)
(make <texi-node>
#:name "Graphical Object Interfaces"
#:desc "Building blocks of graphical objects"
#:children
- (map interface-doc interface-description-alist)
- ))
+ (map interface-doc interface-description-alist)))
(define (backend-properties-doc-string lst)
- (let*
- (
- (ps (sort (map symbol->string lst) string<?))
- (descs (map (lambda (prop)
- (property->texi 'backend (string->symbol prop) '()))
- ps))
- (texi (description-list->texi descs))
- )
+ (let* ((ps (sort (map symbol->string lst) string<?))
+ (descs (map (lambda (prop)
+ (property->texi 'backend (string->symbol prop) '())) ps))
+ (texi (description-list->texi descs)))
texi))
-
-;(dump-node (grob-doc (cdadr all-grob-descriptions)) (current-output-port) 0 )
+;;(dump-node (grob-doc (cdadr all-grob-descriptions)) (current-output-port) 0 )
(define (backend-doc-node)
(make <texi-node>
#:name "Backend"
(list
(all-grobs-doc)
(all-interfaces-doc)
- (make <texi-node>
- #:name "User backend properties"
- #:desc "All tunable properties in a big list"
- #:text (backend-properties-doc-string all-user-grob-properties))
- (make <texi-node>
- #:name "Internal backend properties"
- #:desc "All internal layout properties in a big list"
- #:text (backend-properties-doc-string all-internal-grob-properties))
- )))
+ (make <texi-node>
+ #:name "User backend properties"
+ #:desc "All tunable properties in a big list"
+ #:text (backend-properties-doc-string all-user-grob-properties))
+ (make <texi-node>
+ #:name "Internal backend properties"
+ #:desc "All internal layout properties in a big list"
+ #:text (backend-properties-doc-string all-internal-grob-properties)))))
'() (ly:get-all-function-documentation)))
(define (all-scheme-functions-doc)
- (let*
- ((fdocs (map (lambda (x)
- (document-scheme-function (car x) (cadr x) (cddr x))
- )
- all-scheme-functions)
- )
- (sfdocs (sort fdocs string<?)))
+ (let* ((fdocs (map (lambda (x)
+ (document-scheme-function (car x) (cadr x) (cddr x)))
+ all-scheme-functions))
+ (sfdocs (sort fdocs string<?)))
(make <texi-node>
#:name "Scheme functions"
#:desc "Primitive functions exported by LilyPond"
#:text
- (apply string-append sfdocs))
- ))
+ (apply string-append sfdocs))))
-
-; (dump-node (all-scheme-functions-doc) (current-output-port) 0 )
+;; (dump-node (all-scheme-functions-doc) (current-output-port) 0 )
;;;; Jan Nieuwenhuizen <janneke@gnu.org>
(define (doc-markup-function func)
- (let*
- ((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))
- (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))
- " " )))
-
+ (let* ((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))
+ (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@item @code{\\" c-name "} " signature-str
-
- "\n@findex " f-name "\n"
- "\n@cindex @code{" c-name "}\n"
-
- (if (string? doc-str)
- doc-str
- "")
- )))
+ (string-append
+ "\n\n@item @code{\\" c-name "} " signature-str
+
+ "\n@findex " f-name "\n"
+ "\n@cindex @code{" 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"
-
- ))
+
+ "@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 "Music properties"
#:desc "All music properties, including descriptions"
#:text
- (let* (
- (ps (sort (map symbol->string all-music-properties) string<?))
- (descs (map (lambda (prop)
- (property->texi 'music (string->symbol prop)))
- ps))
- (texi (description-list->texi descs))
- )
- texi)
- ))
+ (let* ((ps (sort (map symbol->string all-music-properties) string<?))
+ (descs (map (lambda (prop)
+ (property->texi 'music (string->symbol prop)))
+ ps))
+ (texi (description-list->texi descs)))
+ texi)))
(define music-types->names (make-vector 61 '()))
(map (lambda (entry)
- (let*
- (
- (types (cdr (assoc 'types (cdr entry) )))
- )
+ (let* ((types (cdr (assoc 'types (cdr entry)))))
(map (lambda (type)
(hashq-set! music-types->names type
(cons (car entry)
- (hashq-ref music-types->names type '())))
-
- ) types)
-
- ))
- music-descriptions)
-
-
+ (hashq-ref music-types->names type '()))))
+ types)))
+ music-descriptions)
(define (strip-description x)
- (cons (symbol->string (car x))
- ""))
+ (cons (symbol->string (car x))
+ ""))
(define (music-type-doc entry)
(make <texi-node>
(human-listify
(sort
(map (lambda (x) (ref-ify (symbol->string x)))
- (cdr entry)) string<?))
+ (cdr entry)) string<?))
"\n\nAccepted by: "
(human-listify
(map ly:translator-name
(filter
(lambda (x) (engraver-accepts-music-type? (car entry) x)) all-engravers-list)))))
- "\n\n"
- )))
+ "\n\n")))
(define (music-types-doc)
(make <texi-node>
#:children
(map music-type-doc
(sort
- (hash-table->alist music-types->names) alist<?))
- ))
+ (hash-table->alist music-types->names) alist<?))))
(define (music-doc-str obj)
- (let*
- (
- (namesym (car obj))
- (props (cdr obj))
- (types (cdr (assoc 'types props)))
- )
+ (let* ((namesym (car obj))
+ (props (cdr obj))
+ (types (cdr (assoc 'types props))))
(string-append
(object-property namesym 'music-description)
(human-listify
(map ref-ify
(map symbol->string (map ly:translator-name
- (filter
- (lambda (x) (engraver-accepts-music-types? types x)) all-engravers-list)))))
+ (filter
+ (lambda (x) (engraver-accepts-music-types? types x)) all-engravers-list)))))
"\n\nProperties: \n"
(description-list->texi
(map
(lambda (x) (property->texi 'music x props))
- (map car props)))
-
- )
- ))
+ (map car props))))))
(define (music-object-doc obj)
(make <texi-node>
#:name (symbol->string (car obj))
- #:text (music-doc-str obj)
- ))
+ #:text (music-doc-str obj)))
(define (music-expressions-doc)
(make <texi-node>
#:name "Music expressions"
#:desc "Objects that represent music."
#:children
- (map music-object-doc music-descriptions)
- ))
-
+ (map music-object-doc music-descriptions)))
+
(define (music-doc-node)
(make <texi-node>
#:name "Music definitions"
(list
(music-expressions-doc)
(music-types-doc)
- (music-props-doc))
- ))
-
-
-
-
+ (music-props-doc))))
;;;; (c) 2000--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
;;;; Jan Nieuwenhuizen <janneke@gnu.org>
-
(define (engraver-makes-grob? name-symbol grav)
- (memq name-symbol (assoc 'grobs-created (ly:translator-description grav)))
- )
+ (memq name-symbol (assoc 'grobs-created (ly:translator-description grav))))
(define (engraver-accepts-music-type? name-symbol grav)
- (memq name-symbol (assoc 'events-accepted (ly:translator-description grav)))
-
- )
+ (memq name-symbol (assoc 'events-accepted (ly:translator-description grav))))
(define (engraver-accepts-music-types? types grav)
(if (null? types)
#f
(or
(engraver-accepts-music-type? (car types) grav)
- (engraver-accepts-music-types? (cdr types) grav)))
- )
+ (engraver-accepts-music-types? (cdr types) grav))))
(define (engraver-doc-string engraver in-which-contexts)
- (let* (
- (propsr (cdr (assoc 'properties-read (ly:translator-description engraver))))
+ (let* ((propsr (cdr (assoc 'properties-read (ly:translator-description engraver))))
(propsw (cdr (assoc 'properties-written (ly:translator-description engraver))))
(accepted (cdr (assoc 'events-accepted (ly:translator-description engraver))))
(name-sym (ly:translator-name engraver))
(name-str (symbol->string name-sym))
(desc (cdr (assoc 'description (ly:translator-description engraver))))
- (grobs (engraver-grobs engraver))
- )
+ (grobs (engraver-grobs engraver)))
(string-append
desc
(map (lambda (x)
(string-append
"@ref{"
- (symbol->string x)
- "}")) accepted)
- ))
- "")
+ (symbol->string x)
+ "}")) accepted)))
+ "")
"\n\n"
(if (pair? propsr)
(string-append
(if (null? propsw)
""
(string-append
- "Properties (write)"
+ "Properties (write)"
(description-list->texi
(map (lambda (x) (property->texi 'translation x '())) propsw))))
(if (null? grobs)
(string-append
"This engraver creates the following layout objects: \n "
(human-listify (map ref-ify (uniq-list (sort grobs string<? ))))
- ".")
- )
+ "."))
"\n\n"
(if in-which-contexts
- (let*
- ((layout-alist (ly:output-description $defaultlayout))
- (context-description-alist (map cdr layout-alist))
- (contexts
- (apply append
- (map
- (lambda (x)
- (let*
- ((context (cdr (assoc 'context-name x)))
- (group (assq-ref x 'group-type))
- (consists (append
- (if group
- (list group)
- '())
- (cdr (assoc 'consists x))
- ))
-
-
- )
- (if (member name-sym consists)
- (list context)
- '())))
- context-description-alist))))
+ (let* ((layout-alist (ly:output-description $defaultlayout))
+ (context-description-alist (map cdr layout-alist))
+ (contexts
+ (apply append
+ (map
+ (lambda (x)
+ (let* ((context (cdr (assoc 'context-name x)))
+ (group (assq-ref x 'group-type))
+ (consists (append
+ (if group
+ (list group)
+ '())
+ (cdr (assoc 'consists x)))))
+ (if (member name-sym consists)
+ (list context)
+ '())))
+ context-description-alist))))
(string-append
"@code{" name-str "} is part of contexts: "
(human-listify (map ref-ify
(sort
- (map symbol->string contexts) string<?)))))
- ""
- ))))
-
-
-
+ (map symbol->string contexts) string<?)))))
+ ""))))
;; First level Engraver description
(define (engraver-doc grav)
(make <texi-node>
#:name (symbol->string (ly:translator-name grav))
- #:text (engraver-doc-string grav #t)
- ))
+ #:text (engraver-doc-string grav #t)))
;; Second level, part of Context description
(define name->engraver-table (make-vector 61 '()))
(define (document-engraver-by-name name)
"NAME is a symbol."
- (let*
- (
- (eg (find-engraver-by-name name ))
- )
+ (let* ((eg (find-engraver-by-name name )))
(cons (string-append "@code{" (ref-ify (symbol->string name)) "}")
- (engraver-doc-string eg #f)
- )
- ))
+ (engraver-doc-string eg #f))))
(define (document-property-operation op)
- (let
- ((tag (car op))
- (body (cdr op))
- (sym (cadr op))
- )
-
- (cond
- ((equal? tag 'push)
- (string-append
- "@item "
- (if (null? (cddr body))
- "Revert "
- "Set "
- )
- "grob-property @code{"
- (symbol->string (cadr body))
- "} in @ref{" (symbol->string sym)
- "}"
- (if (not (null? (cddr body)))
- (string-append " to @code{" (scm->texi (cadr (cdr body))) "}" )
- )
- "\n"
- )
-
- )
- ((equal? (object-property sym 'is-grob?) #t) "")
- ((equal? (car op) 'assign)
- (string-append
- "@item Set translator property @code{"
- (symbol->string (car body))
- "} to @code{"
- (scm->texi (cadr body))
- "}\n"
- )
- )
- )
- ))
-
+ (let ((tag (car op))
+ (body (cdr op))
+ (sym (cadr op)))
+
+ (cond
+ ((equal? tag 'push)
+ (string-append
+ "@item "
+ (if (null? (cddr body))
+ "Revert "
+ "Set ")
+ "grob-property @code{"
+ (symbol->string (cadr body))
+ "} in @ref{" (symbol->string sym)
+ "}"
+ (if (not (null? (cddr body)))
+ (string-append " to @code{" (scm->texi (cadr (cdr body))) "}" ))
+ "\n"))
+ ((equal? (object-property sym 'is-grob?) #t) "")
+ ((equal? (car op) 'assign)
+ (string-append
+ "@item Set translator property @code{"
+ (symbol->string (car body))
+ "} to @code{"
+ (scm->texi (cadr body))
+ "}\n")))))
(define (context-doc context-desc)
- (let*
- (
- (name-sym (cdr (assoc 'context-name context-desc)))
- (name (symbol->string name-sym))
- (aliases (map symbol->string (cdr (assoc 'aliases context-desc))))
- (desc-handle (assoc 'description context-desc))
- (desc (if (and (pair? desc-handle) (string? (cdr desc-handle)))
- (cdr desc-handle) "(not documented)"))
-
- (accepts (cdr (assoc 'accepts context-desc)))
- (group (assq-ref context-desc 'group-type))
+ (let* ((name-sym (cdr (assoc 'context-name context-desc)))
+ (name (symbol->string name-sym))
+ (aliases (map symbol->string (cdr (assoc 'aliases context-desc))))
+ (desc-handle (assoc 'description context-desc))
+ (desc (if (and (pair? desc-handle) (string? (cdr desc-handle)))
+ (cdr desc-handle) "(not documented)"))
+
+ (accepts (cdr (assoc 'accepts context-desc)))
+ (group (assq-ref context-desc 'group-type))
- (consists (append
- (if group (list group)
- '())
- (cdr (assoc 'consists context-desc))
- ))
- (props (cdr (assoc 'property-ops context-desc)))
- (grobs (context-grobs context-desc))
- (grob-refs (map (lambda (x) (ref-ify x)) grobs)) )
+ (consists (append
+ (if group (list group)
+ '())
+ (cdr (assoc 'consists context-desc))))
+ (props (cdr (assoc 'property-ops context-desc)))
+ (grobs (context-grobs context-desc))
+ (grob-refs (map (lambda (x) (ref-ify x)) grobs)) )
(make <texi-node>
#:name name
"\n\nThis context sets the following properties:\n"
"@itemize @bullet\n"
(apply string-append (map document-property-operation props))
- "@end itemize\n"
- )
- ""
- )
+ "@end itemize\n")
+ "")
(if (null? accepts)
"\n\nThis context is a `bottom' context; it can not contain other contexts."
"\n\nThis context is built from the following engravers: "
(description-list->texi
- (map document-engraver-by-name consists))
- ))))
+ (map document-engraver-by-name consists))))))
(define (engraver-grobs grav)
(let* ((eg (if (symbol? grav)
grav)))
(if (eq? eg #f)
'()
- (map symbol->string (cdr (assoc 'grobs-created (ly:translator-description eg)))))
- ))
+ (map symbol->string (cdr (assoc 'grobs-created (ly:translator-description eg)))))))
(define (context-grobs context-desc)
- (let* (
- (group (assq-ref context-desc 'group-type))
+ (let* ((group (assq-ref context-desc 'group-type))
(consists (append
(if group
(list group)
'())
- (cdr (assoc 'consists context-desc))
- ))
+ (cdr (assoc 'consists context-desc))))
(grobs (apply append
- (map engraver-grobs consists))
- ))
- grobs
- ))
-
-
+ (map engraver-grobs consists))))
+ grobs))
(define (all-contexts-doc)
- (let* (
- (layout-alist
+ (let* ((layout-alist
(sort (ly:output-description $defaultlayout)
(lambda (x y) (symbol<? (car x) (car y)))))
(names (sort (map symbol->string (map car layout-alist)) string<?))
- (contexts (map cdr layout-alist))
- )
+ (contexts (map cdr layout-alist)))
(make <texi-node>
#:name "Contexts"
#:desc "Complete descriptions of all contexts"
#:children
- (map context-doc contexts)
- )
- ))
-
+ (map context-doc contexts))))
(define all-engravers-list (ly:get-all-translators))
(set! all-engravers-list
(map engraver-doc all-engravers-list)))
(define (translation-properties-doc-string lst)
- (let*
- ((ps (sort (map symbol->string lst) string<?))
- (sortedsyms (map string->symbol ps))
- (propdescs
- (map
- (lambda (x) (property->texi 'translation x '()))
- sortedsyms))
- (texi (description-list->texi propdescs)))
- texi
- ))
-
+ (let* ((ps (sort (map symbol->string lst) string<?))
+ (sortedsyms (map string->symbol ps))
+ (propdescs
+ (map
+ (lambda (x) (property->texi 'translation x '()))
+ sortedsyms))
+ (texi (description-list->texi propdescs)))
+ texi))
(define (translation-doc-node)
(make <texi-node>
#:name "Internal context properties"
#:desc "All internal context properties"
#:text (translation-properties-doc-string
- all-internal-translation-properties))
- ) ) )
+ all-internal-translation-properties)))))
-;;; generate-documentation.scm -- Generate documentation
-;;;
-;;; source file of the GNU LilyPond music typesetter
-;;;
-;;; (c) 2000--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
-;;; Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; generate-documentation.scm -- Generate documentation
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 2000--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; Jan Nieuwenhuizen <janneke@gnu.org>
;;; File entry point for generated documentation
-
;;; Running LilyPond on this file generates the documentation
-;(set-debug-cell-accesses! 5000)
+;;(set-debug-cell-accesses! 5000)
;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;; TODO : make modules of these!
;;;;;;;;;;;;;;;;
-; todo: naming: grob vs. layout property
+;; todo: naming: grob vs. layout property
(map ly:load '("documentation-lib.scm"
"document-functions.scm"
"document-translation.scm"
"document-music.scm"
"document-backend.scm"
- "document-markup.scm"
- ))
+ "document-markup.scm"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(display
(translation-properties-doc-string all-user-translation-properties)
(open-output-file "context-properties.tely") )
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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
(texi-file-head "LilyPond program-reference" file-name
@end ignore
-"
-
-
- ) out-port)
+")
+ out-port)
(define top-node
(make <texi-node>
@printindex fn
-\n@bye"
-
-
- )
- )))
-
+\n@bye"))))
(dump-node top-node out-port 0)
(newline (current-error-port))
(use-modules (oop goops)
(srfi srfi-13)
- (srfi srfi-1)
- )
+ (srfi srfi-1))
(define-class <texi-node> ()
(children #:init-value '() #:accessor node-children #:init-keyword #:children)
(text #:init-value "" #:accessor node-text #:init-keyword #:text)
(name #:init-value "" #:accessor node-name #:init-keyword #:name)
- (description #:init-value "" #:accessor node-desc #:init-keyword #:desc)
- )
+ (description #:init-value "" #:accessor node-desc #:init-keyword #:desc))
(define (menu-entry x)
(cons
(node-name x)
- (node-desc x))
- )
+ (node-desc x)))
(define (dump-node node port level)
(display
"\n\n"
(if (pair? (node-children node))
(texi-menu
- (map (lambda (x) (menu-entry x) )
+ (map (lambda (x) (menu-entry x))
(node-children node)))
- ""))
+ ""))
port)
(map (lambda (x) (dump-node x port (+ 1 level)))
- (node-children node))
- )
+ (node-children node)))
(define (processing name)
(display (string-append "\nProcessing " name " ... ") (current-error-port)))
x)
(define (scm->texi x)
- (string-append "@code{" (texify (scm->string x)) "}")
- )
+ (string-append "@code{" (texify (scm->string x)) "}"))
;;
(symbol->string (procedure-name val))
(string-append
(if (self-evaluating? val) "" "'")
- (call-with-output-string (lambda (port) (display val port)))
- )))
+ (call-with-output-string (lambda (port) (display val port))))))
(define (texi-section-command level)
(cdr (assoc level '(
- ;; Hmm, texinfo doesn't have ``part''
- (0 . "@top")
- (1 . "@unnumbered")
- (2 . "@unnumberedsec")
- (3 . "@unnumberedsubsec")
- (4 . "@unnumberedsubsubsec")
- (5 . "@unnumberedsubsubsec")
- ))))
+ ;; Hmm, texinfo doesn't have ``part''
+ (0 . "@top")
+ (1 . "@unnumbered")
+ (2 . "@unnumberedsec")
+ (3 . "@unnumberedsubsec")
+ (4 . "@unnumberedsubsubsec")
+ (5 . "@unnumberedsubsubsec")))))
(define (one-item->texi label-desc-pair)
"Document one (LABEL . DESC); return empty string if LABEL is empty string.
"
(if (eq? (car label-desc-pair) "")
""
- (string-append "\n@item " (car label-desc-pair) "\n" (cdr label-desc-pair))
- ))
+ (string-append "\n@item " (car label-desc-pair) "\n" (cdr label-desc-pair))))
(define (description-list->texi items-alist)
(define (texi-menu items-alist)
"Generate what is between @menu and @end menu."
- (let
- (
- (maxwid (apply max (map (lambda (x) (string-length (car x)))
- items-alist)))
- )
+ (let ((maxwid
+ (apply max (map (lambda (x) (string-length (car x))) items-alist))))
-
-
- (string-append
- "\n@menu"
- (apply string-append
- (map (lambda (x)
- (string-append
- (string-pad-right
- (string-append "\n* " (car x) ":: ")
- (+ maxwid 8)
- )
- (cdr x))
- )
- items-alist))
- "\n@end menu\n"
- ;; Menus don't appear in html, so we make a list ourselves
- "\n@ignore\n"
- "\n@ifhtml\n"
- (description-list->texi (map (lambda (x) (cons (ref-ify (car x)) (cdr x)))
- items-alist))
- "\n@end ifhtml\n"
- "\n@end ignore\n")))
-
-
-
+ (string-append
+ "\n@menu"
+ (apply string-append
+ (map (lambda (x)
+ (string-append
+ (string-pad-right
+ (string-append "\n* " (car x) ":: ")
+ (+ maxwid 8))
+ (cdr x)))
+ items-alist))
+ "\n@end menu\n"
+ ;; Menus don't appear in html, so we make a list ourselves
+ "\n@ignore\n"
+ "\n@ifhtml\n"
+ (description-list->texi (map (lambda (x) (cons (ref-ify (car x)) (cdr x)))
+ items-alist))
+ "\n@end ifhtml\n"
+ "\n@end ignore\n")))
(define (texi-file-head name file-name top)
(string-append
"\n* GNU " name ": (" file-name "). " name "."
"\n@end direntry\n"
"@documentlanguage en\n"
- "@documentencoding ISO-8859-1\n"
-
- ))
-
+ "@documentencoding ISO-8859-1\n"))
(define (context-name name)
name)
((null? l) "none")
((null? (cdr l)) (car l))
((null? (cddr l)) (string-append (car l) " and " (cadr l)))
- (else (string-append (car l) ", " (human-listify (cdr l))))
- ))
+ (else (string-append (car l) ", " (human-listify (cdr l))))))
(define (writing-wip x)
(display (string-append "\nWriting " x " ... ") (current-error-port)))
(type (object-property sym type?-name))
(typename (type-name type))
(desc (object-property sym doc-name))
- (handle (assoc sym alist))
- )
+ (handle (assoc sym alist)))
(if (eq? desc #f)
(error "No description for property ~S" sym))
-
+
(cons
(string-append "@code{" name "} "
"(" typename ")"
":\n\n"
(scm->texi (cdr handle))
"\n\n")
- "")
-
-
- )
- desc)
-
- ))
+ ""))
+ desc)))
(define (make-node fprops size-family)
(if (null? fprops)
(make-font-tree-leaf (car size-family) (cdr size-family))
- (let*
- ((qual (next-qualifier default-qualifier-order fprops)))
+ (let* ((qual (next-qualifier default-qualifier-order fprops)))
(make-font-tree-node qual
(assoc-get qual fprops)))))
(car order)
(next-qualifier (cdr order) props)))))
-
- (let*
- ((q (font-qualifier node))
- (d (font-default node))
- (v (assoc-get q fprops d))
- (new-fprops (assoc-delete q fprops))
- (child (hashq-ref (slot-ref node 'children)
- v #f)))
+ (let* ((q (font-qualifier node))
+ (d (font-default node))
+ (v (assoc-get q fprops d))
+ (new-fprops (assoc-delete q fprops))
+ (child (hashq-ref (slot-ref node 'children)
+ v #f)))
(if (not child)
(define-method (g-lookup-font (node <Font-tree-node>) alist-chain)
- (let*
- ((qual (font-qualifier node))
- (def (font-default node))
- (val (chain-assoc-get qual alist-chain def))
- (desired-child (hashq-ref (font-children node) val)))
+ (let* ((qual (font-qualifier node))
+ (def (font-default node))
+ (val (chain-assoc-get qual alist-chain def))
+ (desired-child (hashq-ref (font-children node) val)))
(if desired-child
(g-lookup-font desired-child alist-chain)
`(
(fetaNumber 20
#(
- ,(delay (ly:font-load "feta-alphabet11"))
- ,(delay (ly:font-load "feta-alphabet13"))
- ,(delay (ly:font-load "feta-alphabet14"))
- ,(delay (ly:font-load "feta-alphabet16"))
- ,(delay (ly:font-load "feta-alphabet18"))
- ,(delay (ly:font-load "feta-alphabet20"))
- ,(delay (ly:font-load "feta-alphabet23"))
- ,(delay (ly:font-load "feta-alphabet26"))))
+ ,(delay (ly:font-load "feta-alphabet11"))
+ ,(delay (ly:font-load "feta-alphabet13"))
+ ,(delay (ly:font-load "feta-alphabet14"))
+ ,(delay (ly:font-load "feta-alphabet16"))
+ ,(delay (ly:font-load "feta-alphabet18"))
+ ,(delay (ly:font-load "feta-alphabet20"))
+ ,(delay (ly:font-load "feta-alphabet23"))
+ ,(delay (ly:font-load "feta-alphabet26"))))
(fetaDynamic 20.0 #(
- ,(delay (ly:font-load "feta-alphabet11"))
- ,(delay (ly:font-load "feta-alphabet13"))
- ,(delay (ly:font-load "feta-alphabet14"))
- ,(delay (ly:font-load "feta-alphabet16"))
- ,(delay (ly:font-load "feta-alphabet18"))
- ,(delay (ly:font-load "feta-alphabet20"))
- ,(delay (ly:font-load "feta-alphabet23"))
- ,(delay (ly:font-load "feta-alphabet26"))))
-
+ ,(delay (ly:font-load "feta-alphabet11"))
+ ,(delay (ly:font-load "feta-alphabet13"))
+ ,(delay (ly:font-load "feta-alphabet14"))
+ ,(delay (ly:font-load "feta-alphabet16"))
+ ,(delay (ly:font-load "feta-alphabet18"))
+ ,(delay (ly:font-load "feta-alphabet20"))
+ ,(delay (ly:font-load "feta-alphabet23"))
+ ,(delay (ly:font-load "feta-alphabet26"))))
+
(fetaMusic 20.0
#(
,(delay (ly:font-load "bigcheese11"))
,(delay (ly:font-load "bigcheese26"))))
(fetaBraces 100.0 #(,(delay
- (ly:font-load "aybabtu")))))))
+ (ly:font-load "aybabtu")))))))
(define-public (add-cmr-fonts node factor)
(add-font node '((font-encoding . TeX-math))
(define (debugf string . rest)
(if #f
(apply stderr (cons string rest))))
-
+
(define-class <gnome-outputter> ()
(name #:init-value "untitled" #:init-keyword #:name #:accessor name)
(if (not ifs)
(set! ifs " "))
ifs)
-
+
(define (spawn-editor location)
(let* ((file-name (car location))
(line (cadr location))
(let ((command-list (string-split command #\ )));; (get-ifs))))
(apply execlp command-list)
(primitive-exit)))))
-
+
(define location-callback spawn-editor)
(define (get-location grob)
(offset-add origin offset))))))
(define-method (save-tweaks (go <gnome-outputter>))
- (let*
- ((dumper (ly:make-dumper))
- (tweaks (ly:all-tweaks))
- (serialized-tweaks (map
- (lambda (tweak)
- (append
- (list
- (ly:dumper-key-serial dumper (car tweak))
- (list 'unquote (procedure-name (cadr tweak))))
- (cddr tweak)))
- tweaks)))
+ (let* ((dumper (ly:make-dumper))
+ (tweaks (ly:all-tweaks))
+ (serialized-tweaks (map
+ (lambda (tweak)
+ (append
+ (list
+ (ly:dumper-key-serial dumper (car tweak))
+ (list 'unquote (procedure-name (cadr tweak))))
+ (cddr tweak)))
+ tweaks)))
(if (not (null? serialized-tweaks))
(let ((file (open-file (string-append (name go) ".twy") "w")))
(begin
(stderr "CLICK WITH MODIFIERS: ~S\n"
(gdk-event-button:modifiers event))
-
+
;; some modifier, do jump to source
(and-let* ((grob (hashq-ref (item-grobs go) item #f))
(location (get-location grob)))
(location-callback location)))))
((= button 2)
- (and-let*
- ((grob (hashq-ref (item-grobs go) item #f)))
-
- (let ((properties (ly:grob-properties grob))
- (basic-properties (ly:grob-basic-properties grob))
- (x (inexact->exact (gdk-event-button:x-root event)))
- (y (inexact->exact (gdk-event-button:y-root event))))
-
- (debugf "GROB: ~S\n" grob)
- (debugf "PROPERTIES: ~S\n" properties)
- (debugf "BASIC PROPERTIES: ~S\n" basic-properties)
-
- ;; FIXME: dialog iso window?
- ;; http://www.gtk.org/tutorial/sec-textentries.html
- (let ((window (make <gtk-window>))
- (vbox (make <gtk-vbox>))
- (ok (make <gtk-button> #:label "Ok")))
-
- (add window vbox)
- (connect ok 'clicked (lambda (b) (destroy window)))
-
- (for-each
- (lambda (x)
- (let ((label (make <gtk-label>
- ;;#:label (symbol->string (car x))))
- #:label (format #f "~S" (car x))))
- ;;(symbol->string (car x))))
- (entry (make <gtk-entry>
- #:text (format #f "~S" (cdr x))))
- (hbox (make <gtk-hbox>)))
- (add hbox label)
- (add hbox entry)
- (set-size-request label 150 BUTTON-HEIGHT)
- (add vbox hbox)))
- (append properties basic-properties))
- (add vbox ok)
-
- (show-all window)
- (move window x y))))))))
+ (and-let* ((grob (hashq-ref (item-grobs go) item #f)))
+
+ (let ((properties (ly:grob-properties grob))
+ (basic-properties (ly:grob-basic-properties grob))
+ (x (inexact->exact (gdk-event-button:x-root event)))
+ (y (inexact->exact (gdk-event-button:y-root event))))
+
+ (debugf "GROB: ~S\n" grob)
+ (debugf "PROPERTIES: ~S\n" properties)
+ (debugf "BASIC PROPERTIES: ~S\n" basic-properties)
+
+ ;; FIXME: dialog iso window?
+ ;; http://www.gtk.org/tutorial/sec-textentries.html
+ (let ((window (make <gtk-window>))
+ (vbox (make <gtk-vbox>))
+ (ok (make <gtk-button> #:label "Ok")))
+
+ (add window vbox)
+ (connect ok 'clicked (lambda (b) (destroy window)))
+
+ (for-each
+ (lambda (x)
+ (let ((label (make <gtk-label>
+ ;;#:label (symbol->string (car x))))
+ #:label (format #f "~S" (car x))))
+ ;;(symbol->string (car x))))
+ (entry (make <gtk-entry>
+ #:text (format #f "~S" (cdr x))))
+ (hbox (make <gtk-hbox>)))
+ (add hbox label)
+ (add hbox entry)
+ (set-size-request label 150 BUTTON-HEIGHT)
+ (add vbox hbox)))
+ (append properties basic-properties))
+ (add vbox ok)
+
+ (show-all window)
+ (move window x y))))))))
((2button-press) (gobject-set-property item 'fill-color "green"))
((key-press)
(points (gobject-get-property x 'size-points)))
;;(gobject-set-property x 'scale pixels-per-unit)
(gobject-set-property x 'size-points (* points factor))))
- (text-items go)))
+ (text-items go)))
(define (key-press-event go item event)
(let ((keyval (gdk-event-key:keyval event))
(string-append
"magfont" (string-encode-integer (hashq name 1000000))
- "m" (string-encode-integer (inexact->exact (round (* 1000 magnify))))
- )))
+ "m" (string-encode-integer (inexact->exact (round (* 1000 magnify)))))))
(define (tex-font? fontname)
(or
(equal? (substring fontname 0 2) "ec")))
(define (ps-embed-cff body font-set-name version)
- (let*
- ((binary-data
- (string-append
- (format "/~a ~s StartData " font-set-name (string-length body))
- body)))
+ (let* ((binary-data
+ (string-append
+ (format "/~a ~s StartData " font-set-name (string-length body))
+ body)))
(string-append
(format
- "%!PS-Adobe-3.0 Resource-FontSet
+ "%!PS-Adobe-3.0 Resource-FontSet
%%DocumentNeededResources: ProcSet (FontSetInit)
%%EndComments
%%IncludeResource: ProcSet (FontSetInit)
/FontSetInit /ProcSet findresource begin
%%BeginData: ~s Binary Bytes
"
- font-set-name font-set-name version (string-length binary-data)
- )
- binary-data
- "\n%%EndData
+ font-set-name font-set-name version (string-length binary-data))
+ binary-data
+ "\n%%EndData
%%EndResource
%%EOF
-"
-
- )))
+")))
(define (load-fonts paper)
(let* ((fonts (ly:paper-fonts paper))
(all-font-names
- (map
- (lambda (font)
- (if (string? (ly:font-file-name font))
- (list (ly:font-file-name font))
- (ly:font-sub-fonts font)))
+ (map
+ (lambda (font)
+ (if (string? (ly:font-file-name font))
+ (list (ly:font-file-name font))
+ (ly:font-sub-fonts font)))
- fonts))
+ fonts))
(font-names
(uniq-list
(sort (apply append all-font-names) string<?)))
(define (standard-tex-font? x)
(or (equal? (substring x 0 2) "ms")
(equal? (substring x 0 2) "cm")))
-
+
(define (font-load-command font)
(let* ((specced-font-name (ly:font-name font))
(fontname (if specced-font-name
(number->string (ly:output-def-lookup layout 'outputscale))
" lily-output-units mul def \n"
(output-entry "page-height" 'vsize)
- (output-entry "page-width" 'hsize)
- ))
+ (output-entry "page-width" 'hsize)))
(define (dump-page outputter page page-number page-count landscape?)
(ly:outputter-dump-string outputter
- (string-append
- "%%Page: "
- (number->string page-number) " " (number->string page-count) "\n"
-
- "%%BeginPageSetup\n"
- (if landscape?
- "page-width output-scale mul 0 translate 90 rotate\n"
- "")
- "%%EndPageSetup\n"
-
- "start-system { "
- "set-ps-scale-to-lily-scale "
- "\n"))
+ (string-append
+ "%%Page: "
+ (number->string page-number) " " (number->string page-count) "\n"
+
+ "%%BeginPageSetup\n"
+ (if landscape?
+ "page-width output-scale mul 0 translate 90 rotate\n"
+ "")
+ "%%EndPageSetup\n"
+
+ "start-system { "
+ "set-ps-scale-to-lily-scale "
+ "\n"))
(ly:outputter-dump-stencil outputter page)
(ly:outputter-dump-string outputter "} stop-system \nshowpage\n"))
(page-number (1- (ly:output-def-lookup paper 'firstpagenumber)))
(page-count (length pages)))
- (for-each
- (lambda (x)
- (ly:outputter-dump-string outputter x))
- (cons
- (page-header paper page-count)
- (preamble paper)))
-
- (for-each
- (lambda (page)
- (set! page-number (1+ page-number))
- (dump-page outputter page page-number page-count landscape?))
- pages)
-
- (ly:outputter-dump-string outputter "%%Trailer\n%%EOF\n")))
+ (for-each
+ (lambda (x)
+ (ly:outputter-dump-string outputter x))
+ (cons
+ (page-header paper page-count)
+ (preamble paper)))
+
+ (for-each
+ (lambda (page)
+ (set! page-number (1+ page-number))
+ (dump-page outputter page page-number page-count landscape?))
+ pages)
+
+ (ly:outputter-dump-string outputter "%%Trailer\n%%EOF\n")))
(define-public (output-preview-framework outputter book scopes fields basename)
(let* ((paper (ly:paper-book-paper book))
(if (or (nan? x) (inf? x))
0.0 x))
(list (car xext) (car yext)
- (cdr xext) (cdr yext)))
- ))
+ (cdr xext) (cdr yext))) ))
- (for-each
- (lambda (x)
- (ly:outputter-dump-string outputter x))
- (cons
- (eps-header paper
- (map
- (lambda (x)
- (inexact->exact
- (round (* x scale mm-to-bigpoint))))
- bbox))
- (preamble paper)))
-
-
- (ly:outputter-dump-string outputter
- (string-append "start-system { "
- "set-ps-scale-to-lily-scale "
- "\n"))
-
- (ly:outputter-dump-stencil outputter dump-me)
- (ly:outputter-dump-string outputter "} stop-system\n%%Trailer\n%%EOF\n")))
+ (for-each
+ (lambda (x)
+ (ly:outputter-dump-string outputter x))
+ (cons
+ (eps-header paper
+ (map
+ (lambda (x)
+ (inexact->exact
+ (round (* x scale mm-to-bigpoint))))
+ bbox))
+ (preamble paper)))
+
+
+ (ly:outputter-dump-string outputter
+ (string-append "start-system { "
+ "set-ps-scale-to-lily-scale "
+ "\n"))
+
+ (ly:outputter-dump-stencil outputter dump-me)
+ (ly:outputter-dump-string outputter "} stop-system\n%%Trailer\n%%EOF\n")))
(define-public (convert-to-pdf book name)
(let* ((defs (ly:paper-book-paper book))
(ly:warn "Can't convert <stdout> to PDF")
(postscript->pdf (if (string? papersizename) papersizename "a4")
name))))
-
+
(define-public (convert-to-png book name)
(let* ((defs (ly:paper-book-paper book))
(resolution (ly:output-def-lookup defs 'pngresolution)))
;;;;
;;;; (c) 2004 Carl D. Sorensen <c_sorensen@byu.edu>
-
-
(define (fret-parse-marking-list marking-list fret-count)
(let* ((fret-range (list 1 fret-count))
(barre-list '())
(if (defined? 'set-debug-cell-accesses!)
(set-debug-cell-accesses! #f))
-;(set-debug-cell-accesses! 5000)
+;;(set-debug-cell-accesses! 5000)
(use-modules (ice-9 regex)
(ice-9 safe)
(srfi srfi-13)) ; strings
-; my display
-
+;; my display
(define-public (myd k v) (display k) (display ": ") (display v) (display ", "))
(define-public (print . args)
(apply format (cons (current-output-port) args)))
-
+
;;; General settings
;;; debugging evaluator is slower. This should
(map (lambda (x) (if (symbol? x)
(symbol->string x)
(number->string x)))
- (ly:version))
+ (ly:version))
"."))
(if (null? signature)
#t
(and (helper (car signature) (car arguments) count)
- (recursion-helper (cdr signature) (cdr arguments) (1+ count)))
- ))
+ (recursion-helper (cdr signature) (cdr arguments) (1+ count)))))
(recursion-helper signature arguments 1))
-
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; output
-
+
;;(define-public (output-framework) (write "hello\n"))
(define output-tex-module
text
white-dot
white-text
- zigzag-line
- ))
+ zigzag-line))
;; TODO:
;; - generate this list by registering the output-backend-commands
grob-cause
no-origin
placebox
- unknown
- ))
+ unknown))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; other files.
(for-each ly:load
- ;; load-from-path
- '("lily-library.scm"
- "define-music-types.scm"
- "output-lib.scm"
- "c++.scm"
- "chord-ignatzek-names.scm"
- "chord-entry.scm"
- "chord-generic-names.scm"
- "stencil.scm"
- "new-markup.scm"
- "bass-figure.scm"
- "music-functions.scm"
- "part-combiner.scm"
- "define-music-properties.scm"
- "auto-beam.scm"
- "chord-name.scm"
-
- "ly-from-scheme.scm"
-
- "define-context-properties.scm"
- "translation-functions.scm"
- "script.scm"
- "midi.scm"
- "beam.scm"
- "clef.scm"
- "slur.scm"
- "font.scm"
- "encoding.scm"
-
- "fret-diagrams.scm"
- "define-markup-commands.scm"
- "define-grob-properties.scm"
- "define-grobs.scm"
- "define-grob-interfaces.scm"
- "page-layout.scm"
- "titling.scm"
-
- "paper.scm"
-
- ; last:
- "safe-lily.scm"
- ))
+ ;; load-from-path
+ '("lily-library.scm"
+ "define-music-types.scm"
+ "output-lib.scm"
+ "c++.scm"
+ "chord-ignatzek-names.scm"
+ "chord-entry.scm"
+ "chord-generic-names.scm"
+ "stencil.scm"
+ "new-markup.scm"
+ "bass-figure.scm"
+ "music-functions.scm"
+ "part-combiner.scm"
+ "define-music-properties.scm"
+ "auto-beam.scm"
+ "chord-name.scm"
+
+ "ly-from-scheme.scm"
+
+ "define-context-properties.scm"
+ "translation-functions.scm"
+ "script.scm"
+ "midi.scm"
+ "beam.scm"
+ "clef.scm"
+ "slur.scm"
+ "font.scm"
+ "encoding.scm"
+
+ "fret-diagrams.scm"
+ "define-markup-commands.scm"
+ "define-grob-properties.scm"
+ "define-grobs.scm"
+ "define-grob-interfaces.scm"
+ "page-layout.scm"
+ "titling.scm"
+
+ "paper.scm"
+
+ ; last:
+ "safe-lily.scm"))
(set! type-p-name-alist
- `(
- (,boolean-or-symbol? . "boolean or symbol")
- (,boolean? . "boolean")
- (,char? . "char")
- (,grob-list? . "list of grobs")
- (,hash-table? . "hash table")
- (,input-port? . "input port")
- (,integer? . "integer")
- (,list? . "list")
- (,ly:context? . "context")
- (,ly:dimension? . "dimension, in staff space")
- (,ly:dir? . "direction")
- (,ly:duration? . "duration")
- (,ly:grob? . "layout object")
- (,ly:input-location? . "input location")
- (,ly:moment? . "moment")
- (,ly:music? . "music")
- (,ly:pitch? . "pitch")
- (,ly:translator? . "translator")
- (,ly:font-metric? . "font metric")
- (,markup-list? . "list of markups")
- (,markup? . "markup")
- (,ly:music-list? . "list of music")
- (,number-or-grob? . "number or grob")
- (,number-or-string? . "number or string")
- (,number-pair? . "pair of numbers")
- (,number? . "number")
- (,output-port? . "output port")
- (,pair? . "pair")
- (,procedure? . "procedure")
- (,scheme? . "any type")
- (,string? . "string")
- (,symbol? . "symbol")
- (,vector? . "vector")
- ))
+ `(
+ (,boolean-or-symbol? . "boolean or symbol")
+ (,boolean? . "boolean")
+ (,char? . "char")
+ (,grob-list? . "list of grobs")
+ (,hash-table? . "hash table")
+ (,input-port? . "input port")
+ (,integer? . "integer")
+ (,list? . "list")
+ (,ly:context? . "context")
+ (,ly:dimension? . "dimension, in staff space")
+ (,ly:dir? . "direction")
+ (,ly:duration? . "duration")
+ (,ly:grob? . "layout object")
+ (,ly:input-location? . "input location")
+ (,ly:moment? . "moment")
+ (,ly:music? . "music")
+ (,ly:pitch? . "pitch")
+ (,ly:translator? . "translator")
+ (,ly:font-metric? . "font metric")
+ (,markup-list? . "list of markups")
+ (,markup? . "markup")
+ (,ly:music-list? . "list of music")
+ (,number-or-grob? . "number or grob")
+ (,number-or-string? . "number or string")
+ (,number-pair? . "pair of numbers")
+ (,number? . "number")
+ (,output-port? . "output port")
+ (,pair? . "pair")
+ (,procedure? . "procedure")
+ (,scheme? . "any type")
+ (,string? . "string")
+ (,symbol? . "symbol")
+ (,vector? . "vector")))
;; debug mem leaks
(define gc-protect-stat-count 0)
(define-public (dump-gc-protects)
(set! gc-protect-stat-count (1+ gc-protect-stat-count) )
- (let*
- ((protects (sort
- (hash-table->alist (ly:protects))
- (lambda (a b)
- (< (object-address (car a))
- (object-address (car b))))))
- (out-file-name (string-append
- "gcstat-" (number->string gc-protect-stat-count)
- ".scm"))
- (outfile (open-file out-file-name "w")))
+ (let* ((protects (sort
+ (hash-table->alist (ly:protects))
+ (lambda (a b)
+ (< (object-address (car a))
+ (object-address (car b))))))
+ (out-file-name (string-append
+ "gcstat-" (number->string gc-protect-stat-count)
+ ".scm"))
+ (outfile (open-file out-file-name "w")))
(display "Dumping gc protected objs to ...\n")
(display
(filter
(lambda (x) (not (symbol? x)))
(map (lambda (y)
- (let
- ((x (car y))
- (c (cdr y)))
+ (let ((x (car y))
+ (c (cdr y)))
(string-append
(string-join
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (ly:system command)
- (let*
- ((status 0)
+ (let* ((status 0)
- (silenced
- (string-append command (if (ly:get-option 'verbose)
- ""
- " > /dev/null 2>&1 "))))
+ (silenced
+ (string-append command (if (ly:get-option 'verbose)
+ ""
+ " > /dev/null 2>&1 "))))
(if (ly:get-option 'verbose)
(format (current-error-port) (_ "Invoking `~a'...\n") command))
(string-append
"\""
(regexp-substitute/global #f "[^- 0-9,.a-zA-Z'\"\\]" str 'pre 'post)
- "\""))
+ "\""))
(define-public (postscript->pdf papersizename name)
(let* ((cmd (string-append "ps2pdf "
" -sPAPERSIZE="
(sanitize-command-option papersizename)
" "
- name)))
+ name)))
(pdf-name (string-append (basename name ".ps") ".pdf" )))
(if (access? pdf-name W_OK)
(ly:system cmd)))
(define-public (postscript->png resolution name)
- (let
- ((cmd (string-append
- "ps2png --resolution="
- (if (number? resolution)
- (number->string resolution)
- "90 ")
- (if (ly:get-option 'verbose)
- "--verbose "
- " ")
- name)))
+ (let ((cmd (string-append
+ "ps2png --resolution="
+ (if (number? resolution)
+ (number->string resolution)
+ "90 ")
+ (if (ly:get-option 'verbose)
+ "--verbose "
+ " ")
+ name)))
(ly:system cmd)))
(define-public (lilypond-main files)
(for-each
(lambda (f)
(catch 'ly-file-failed (lambda () (ly:parse-file f)) handler)
-; (dump-gc-protects)
- )
+ (if #f
+ (dump-gc-protects)))
files)
-
+
(if (pair? failed)
(begin
(newline (current-error-port))
(exit 1))
(exit 0))))
-
(define-public (tweak-grob-property grob sym val)
- (set! (ly:grob-property grob sym) val))
+ (set! (ly:grob-property grob sym) val))
music
(make-music 'Music))) ;must return music.
-
(define-public (display-music music)
"Display music, not done with music-map for clarity of presentation."
(display music)
(display " }\n")
music)
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (shift-one-duration-log music shift dot)
(define-public (shift-duration-log music shift dot)
(music-map (lambda (x) (shift-one-duration-log x shift dot))
music))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; clusters.
(if (equal? (ly:music-property music 'iterator-ctor)
Chord_tremolo_iterator::constructor)
- (let*
- ((seq-arg? (memq 'sequential-music
- (ly:music-property e 'types)))
- (count (ly:music-property music 'repeat-count))
- (dot-shift (if (= 0 (remainder count 3))
- -1 0))
- )
+ (let* ((seq-arg? (memq 'sequential-music
+ (ly:music-property e 'types)))
+ (count (ly:music-property music 'repeat-count))
+ (dot-shift (if (= 0 (remainder count 3))
+ -1 0)))
(if (= 0 -1)
(set! count (* 2 (quotient count 3))))
(ly:intlog2 count)) dot-shift)
(if seq-arg?
- (ly:music-compress e (ly:make-moment (length (ly:music-property e 'elements)) 1)))
- ))
+ (ly:music-compress e (ly:make-moment (length (ly:music-property e 'elements)) 1)))))
(set! (ly:music-property music 'length)
Repeated_music::unfolded_music_length)
(unfold-repeats e)))
music))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; property setting music objs.
'grob-property gprop))
(define direction-polyphonic-grobs
- '(Stem Tie Rest Slur Script TextScript Dots DotColumn Fingering
- ))
+ '(Stem Tie Rest Slur Script TextScript Dots DotColumn Fingering))
(define-public (make-voice-props-set n)
(make-sequential-music
direction-polyphonic-grobs)
(list
(make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2))
- (make-grob-property-set 'MultiMeasureRest 'staff-position (if (odd? n) -4 4))
-
- ))))
-
+ (make-grob-property-set 'MultiMeasureRest 'staff-position (if (odd? n) -4 4))))))
(define-public (make-voice-props-revert)
(make-sequential-music
(set! (ly:music-property cm 'context-id) id))
cm))
-
(define-public (descend-to-context m context)
"Like context-spec-music, but only descending. "
(let ((cm (context-spec-music m context)))
(define-public (make-non-relative-music mus)
(make-music 'UnrelativableMusic
- 'element mus
- ))
+ 'element mus))
(define-public (make-apply-context func)
(make-music 'ApplyContext
;;; splitting chords into voices.
(define (voicify-list lst number)
- "Make a list of Musics.
+ "Make a list of Musics.
voicify-list :: [ [Music ] ] -> number -> [Music]
LST is a list music-lists.
NUMBER is 0-base, i.e. Voice=1 (upstems) has number 0.
"
- (if (null? lst)
- '()
- (cons (context-spec-music
- (make-sequential-music
- (list (make-voice-props-set number)
- (make-simultaneous-music (car lst))))
- 'Voice (number->string (1+ number)))
- (voicify-list (cdr lst) (1+ number)))))
+ (if (null? lst)
+ '()
+ (cons (context-spec-music
+ (make-sequential-music
+ (list (make-voice-props-set number)
+ (make-simultaneous-music (car lst))))
+ 'Voice (number->string (1+ number)))
+ (voicify-list (cdr lst) (1+ number)))))
(define (voicify-chord ch)
"Split the parts of a chord into different Voices using separator"
(ly:export (make-music 'Music)))
;;;
-; Make a function that checks score element for being of a specific type.
+ ; Make a function that checks score element for being of a specific type.
(define-public (make-type-checker symbol)
(lambda (elt)
;;(display symbol)
(define-public ((set-output-property grob-name symbol val) grob grob-c context)
- "Usage:
+ "Usage:
\\applyoutput #(set-output-property 'Clef 'extra-offset '(0 . 1))
"
- (let ((meta (ly:grob-property grob 'meta)))
- (if (equal? (cdr (assoc 'name meta)) grob-name)
- (set! (ly:grob-property grob symbol) val))))
+ (let ((meta (ly:grob-property grob 'meta)))
+ (if (equal? (cdr (assoc 'name meta)) grob-name)
+ (set! (ly:grob-property grob symbol) val))))
;;
(if (ly:input-location? ip)
(ly:input-message ip msg)
(ly:warn msg))))
-
+
(define (check-start-chords music)
"Check music expression for a Simultaneous_music containing notes\n(ie. Request_chords),
without context specification. Called from parser."
(define (vector-extend v x)
"Make a new vector consisting of V, with X added to the end."
- (let*
- ((n (vector-length v))
- (nv (make-vector (+ n 1) '())))
+ (let* ((n (vector-length v))
+ (nv (make-vector (+ n 1) '())))
(vector-move-left! v 0 n nv 0)
(vector-set! nv n x)
nv))
"Must happen after quote-substitute."
(if (vector? (ly:music-property quote-music 'quoted-events))
- (let*
- ((dir (ly:music-property quote-music 'quoted-voice-direction))
- (main-voice (if (eq? 1 dir) 1 0))
- (cue-voice (if (eq? 1 dir) 0 1))
- (main-music (ly:music-property quote-music 'element))
- (return-value quote-music)
- )
+ (let* ((dir (ly:music-property quote-music 'quoted-voice-direction))
+ (main-voice (if (eq? 1 dir) 1 0))
+ (cue-voice (if (eq? 1 dir) 0 1))
+ (main-music (ly:music-property quote-music 'element))
+ (return-value quote-music))
(if (or (eq? 1 dir) (eq? -1 dir))
(list
(context-spec-music (make-voice-props-set cue-voice) 'Voice "cue")
quote-music
- (context-spec-music (make-voice-props-revert) 'Voice "cue"))
- ))
+ (context-spec-music (make-voice-props-revert) 'Voice "cue"))))
(set! main-music
(make-sequential-music
(list
(make-voice-props-set main-voice)
main-music
- (make-voice-props-revert)
- )))
- (set! (ly:music-property quote-music 'element) main-music)
- ))
+ (make-voice-props-revert))))
+ (set! (ly:music-property quote-music 'element) main-music)))
return-value)
quote-music))
(define-public ((quote-substitute quote-tab) music)
- (let*
- ((quoted-name (ly:music-property music 'quoted-music-name))
- (quoted-vector (if (string? quoted-name)
- (hash-ref quote-tab quoted-name #f)
- #f
- )))
+ (let* ((quoted-name (ly:music-property music 'quoted-music-name))
+ (quoted-vector (if (string? quoted-name)
+ (hash-ref quote-tab quoted-name #f)
+ #f)))
(if (string? quoted-name)
(if (vector? quoted-vector)
(ly:warn "Cannot find quoted music `~S'" quoted-name)))
music))
-
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; switch it on here, so parsing and init isn't checked (too slow!)
(music-map (quote-substitute (ly:parser-lookup parser 'musicQuotes)) music))
;; switch-on-debugging
- (lambda (x parser) (music-map cue-substitute x))
-
- ))
+ (lambda (x parser) (music-map cue-substitute x))))
;;;;;;;;;;;;;;;;;
;; lyrics
;;
(define-public ((add-balloon-text object-name text off) grob orig-context cur-context)
- "Usage: see input/regression/balloon.ly "
+ "Usage: see input/regression/balloon.ly "
(let* ((meta (ly:grob-property grob 'meta))
(nm (if (pair? meta) (cdr (assoc 'name meta)) "nonexistant"))
(cb (ly:grob-property grob 'print-function)))
(define-public (skip-of-length mus)
"Create a skip of exactly the same length as MUS."
- (let*
- ((skip
- (make-music
- 'SkipEvent
- 'duration (ly:make-duration 0 0))))
-
- (make-event-chord (list (ly:music-compress skip (ly:music-length mus))))
-))
+ (let* ((skip
+ (make-music
+ 'SkipEvent
+ 'duration (ly:make-duration 0 0))))
+ (make-event-chord (list (ly:music-compress skip (ly:music-length mus))))))
(define-public (mmrest-of-length mus)
"Create a mmrest of exactly the same length as MUS."
- (let*
- ((skip
- (make-multi-measure-rest
- (ly:make-duration 0 0) '() )))
- (ly:music-compress skip (ly:music-length mus))
- skip
-))
-
+ (let* ((skip
+ (make-multi-measure-rest
+ (ly:make-duration 0 0) '() )))
+ (ly:music-compress skip (ly:music-length mus))
+ skip))
(+ #x80 (modulo y #x40))))))
(else (begin (stderr "programming-error: utf-8 too big:~x\n" i)
(list (integer->char 32))))))
-
+
(define (integer->utf8-string integer)
(list->string (utf8 integer)))
(define (char->utf8-string char)
(list->string (utf8 (char->integer char))))
-
+
(define (string->utf8-string string)
(apply
string-append
bezier))
(define (square-beam width slope thick blot)
- (let*
- ((def (make <gnome-canvas-path-def>))
- (y (* (- width) slope))
- (props (make <gnome-canvas-bpath>
- #:parent (canvas-root)
- #:fill-color "black"
- #:outline-color "black"
- #:width-units 0.0)))
+ (let* ((def (make <gnome-canvas-path-def>))
+ (y (* (- width) slope))
+ (props (make <gnome-canvas-bpath>
+ #:parent (canvas-root)
+ #:fill-color "black"
+ #:outline-color "black"
+ #:width-units 0.0)))
(reset def)
(moveto def 0 0)
(closepath def)
(set-path-def props def)
props))
-
+
;; two beziers
(define (bezier-sandwich lst thick)
(let* ((def (make <gnome-canvas-path-def>))
;; cl cr r l 0 1 2 3
;; cr cl l r 4 5 6 7
- (moveto def (car (list-ref lst 3)) (- (cdr (list-ref lst 3))))
- (curveto def (car (list-ref lst 0)) (- (cdr (list-ref lst 0)))
+ (moveto def (car (list-ref lst 3)) (- (cdr (list-ref lst 3))))
+ (curveto def (car (list-ref lst 0)) (- (cdr (list-ref lst 0)))
(car (list-ref lst 1)) (- (cdr (list-ref lst 1)))
(car (list-ref lst 2)) (- (cdr (list-ref lst 2))))
- (lineto def (car (list-ref lst 7)) (- (cdr (list-ref lst 7))))
- (curveto def (car (list-ref lst 4)) (- (cdr (list-ref lst 4)))
+ (lineto def (car (list-ref lst 7)) (- (cdr (list-ref lst 7))))
+ (curveto def (car (list-ref lst 4)) (- (cdr (list-ref lst 4)))
(car (list-ref lst 5)) (- (cdr (list-ref lst 5)))
(car (list-ref lst 6)) (- (cdr (list-ref lst 6))))
- (lineto def (car (list-ref lst 3)) (- (cdr (list-ref lst 3))))
+ (lineto def (car (list-ref lst 3)) (- (cdr (list-ref lst 3))))
(closepath def)
(set-path-def bezier def)
#:fill-color "black"
#:outline-color "black"
#:join-style 'round)
- #:width-units blot-diameter)
+ #:width-units blot-diameter)
(points (ly:list->offsets '() coords))
(last-point (car (last-pair points))))
(closepath def)
(set-path-def props def)
props))
-
+
(define (round-filled-box breapth width depth height blot-diameter)
(let ((r (/ blot-diameter 2)))
(make <gnome-canvas-rect>
;;scaling:29.7046771653543
;;magnification:0.569055118110236
;;design:20.0
-
+
;; ugh, experimental sizing
;; where does factor ops come from?
;; Hmm, design size: 26/20
;;;; (c) 1998--2004 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
-; Tablature functions, by Jiba (jiba@tuxfamily.org)
+;;; Tablature functions, by Jiba (jiba@tuxfamily.org)
-; The TabNoteHead stem attachment function.
+;; The TabNoteHead stem attachment function.
(define (tablature-stem-attachment-function style duration)
(cons 0.0 0.5))
-
-; The TabNoteHead tablatureFormat callback.
-; Compute the text grob-property
+;; The TabNoteHead tablatureFormat callback.
+;; Compute the text grob-property
(define-public (fret-number-tablature-format string tuning pitch)
(number->string
(- (ly:pitch-semitones pitch)
(list-ref tuning
- (- string 1) ; remove 1 because list index starts at 0 and guitar string at 1.
- )
- )))
+ ;; remove 1 because list index starts at 0 and guitar string at 1.
+ (- string 1)))))
(define-public (hammer-print-function grob)
(let* ((note-collums (ly:grob-property grob 'note-columns))
(letter (cond
((< fret1 fret2) "H")
((> fret1 fret2) "P")
- (else "")))
-
- )
- (let* (
- (slur ; (Slur::print grob)
+ (else ""))))
+ (let* ((slur
+ ;; (Slur::print grob)
;;
;; FIXME: a hammer is not a slur.
layout
(ly:grob-alist-chain grob (ly:output-def-lookup layout 'text-font-defaults))
letter)))
-
+
(let ((x (/ (- (cdr (ly:stencil-extent slur 0))
- (/ (cdr (ly:stencil-extent text 0)) 2.0)
- )
+ (/ (cdr (ly:stencil-extent text 0)) 2.0))
-2.0)))
-
+
(ly:stencil-set-extent! text 0 (cons x x))
- (ly:stencil-align-to! text 0 1)
- )
+ (ly:stencil-align-to! text 0 1))) ) )
-; (ly:stencil-combine-at-edge slur 1 1 text -0.6)
- ) ) )
+ ; (ly:stencil-combine-at-edge slur 1 1 text -0.6)
(define-public guitar-tunings '(4 -1 -5 -10 -15 -20))
-; end of tablature functions
+ ; end of tablature functions
(define-public (make-stencil-boxer line-thick x-padding y-padding callback)
(y-ext (interval-widen (ly:stencil-extent mol 1) y-padding))
(x-rule (make-filled-box-stencil (interval-widen x-ext line-thick)
(cons 0 line-thick)))
- (y-rule (make-filled-box-stencil (cons 0 line-thick) y-ext))
- )
+ (y-rule (make-filled-box-stencil (cons 0 line-thick) y-ext)))
(set! mol (ly:stencil-combine-at-edge mol 0 1 y-rule x-padding))
(set! mol (ly:stencil-combine-at-edge mol 0 -1 y-rule x-padding))
(define (scm-scm action-name)
1)
-
;; silly, use alist?
(define-public (find-notehead-symbol duration style)
(case style
- ((xcircle) "2xcircle")
- ((harmonic) "0harmonic")
- ((baroque)
- ;; Oops, I actually would not call this "baroque", but, for
- ;; backwards compatibility to 1.4, this is supposed to take
- ;; brevis, longa and maxima from the neo-mensural font and all
- ;; other note heads from the default font. -- jr
- (if (< duration 0)
- (string-append (number->string duration) "neomensural")
- (number->string duration)))
- ((mensural)
- (string-append (number->string duration) (symbol->string style)))
- ((neomensural)
- (string-append (number->string duration) (symbol->string style)))
- ((default)
- ;; The default font in mf/feta-bolletjes.mf defines a brevis, but
- ;; neither a longa nor a maxima. Hence let us, for the moment,
- ;; take these from the neo-mensural font. TODO: mf/feta-bolletjes
- ;; should define at least a longa for the default font. The longa
- ;; should look exactly like the brevis of the default font, but
- ;; with a stem exactly like that of the quarter note. -- jr
- (if (< duration -1)
- (string-append (number->string duration) "neomensural")
- (number->string duration)))
- (else
- (if (string-match "vaticana*|hufnagel*|medicaea*" (symbol->string style))
- (symbol->string style)
- (string-append (number->string (max 0 duration))
- (symbol->string style))))))
-
+ ((xcircle) "2xcircle")
+ ((harmonic) "0harmonic")
+ ((baroque)
+ ;; Oops, I actually would not call this "baroque", but, for
+ ;; backwards compatibility to 1.4, this is supposed to take
+ ;; brevis, longa and maxima from the neo-mensural font and all
+ ;; other note heads from the default font. -- jr
+ (if (< duration 0)
+ (string-append (number->string duration) "neomensural")
+ (number->string duration)))
+ ((mensural)
+ (string-append (number->string duration) (symbol->string style)))
+ ((neomensural)
+ (string-append (number->string duration) (symbol->string style)))
+ ((default)
+ ;; The default font in mf/feta-bolletjes.mf defines a brevis, but
+ ;; neither a longa nor a maxima. Hence let us, for the moment,
+ ;; take these from the neo-mensural font. TODO: mf/feta-bolletjes
+ ;; should define at least a longa for the default font. The longa
+ ;; should look exactly like the brevis of the default font, but
+ ;; with a stem exactly like that of the quarter note. -- jr
+ (if (< duration -1)
+ (string-append (number->string duration) "neomensural")
+ (number->string duration)))
+ (else
+ (if (string-match "vaticana*|hufnagel*|medicaea*" (symbol->string style))
+ (symbol->string style)
+ (string-append (number->string (max 0 duration))
+ (symbol->string style))))))
;; TODO junk completely?
(define (note-head-style->attachment-coordinates grob axis)
bounding box, where to attach the stem. e.g.: X==0 means horizontally
centered, X==1 is at the right, X == -1 is at the left."
- '(1.0 . 0.0))
-
+ '(1.0 . 0.0))
(define-public (string-encode-integer i)
(cond
(make-string 1 (integer->char (+ 65 (modulo i 26))))
(string-encode-integer (quotient i 26))))))
-
(define-public ((every-nth-bar-number-visible n) barnum) (= 0 (modulo barnum n)))
(define-public ((modulo-bar-number-visible n m) barnum) (and (> barnum 1) (= m (modulo barnum n))))
(define-public ((set-bar-number-visibility n) tr)
(let* ((bn (ly:context-property tr 'currentBarNumber)))
- (ly:context-set-property! tr 'barNumberVisibility (modulo-bar-number-visible n (modulo bn n)))))
+ (ly:context-set-property! tr 'barNumberVisibility (modulo-bar-number-visible n (modulo bn n)))))
(define-public (default-bar-number-visibility barnum) (> barnum 1))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Bar lines.
-;
-; How should a bar line behave at a break?
-;
+;;
+;; How should a bar line behave at a break?
+;;
;; Why prepend `default-' to every scm identifier?
(define-public (default-break-barline glyph dir)
- (let ((result (assoc glyph
- '((":|:" . (":|" . "|:"))
- ("||:" . ("||" . "|:"))
- ("|" . ("|" . ()))
- ("||:" . ("||" . "|:"))
- ("|s" . (() . "|"))
- ("|:" . ("|" . "|:"))
- ("|." . ("|." . ()))
-
- ;; hmm... should we end with a bar line here?
- (".|" . ("|" . ".|"))
- (":|" . (":|" . ()))
- ("||" . ("||" . ()))
- (".|." . (".|." . ()))
- ("" . ("" . ""))
- (":" . (":" . ""))
- ("empty" . (() . ()))
- ("brace" . (() . "brace"))
- ("bracket" . (() . "bracket"))
- )
- )))
-
- (if (equal? result #f)
- (ly:warn "Unknown bar glyph: `~S'" glyph)
- (index-cell (cdr result) dir))
- ) )
-
-
+ (let ((result (assoc glyph
+ '((":|:" . (":|" . "|:"))
+ ("||:" . ("||" . "|:"))
+ ("|" . ("|" . ()))
+ ("||:" . ("||" . "|:"))
+ ("|s" . (() . "|"))
+ ("|:" . ("|" . "|:"))
+ ("|." . ("|." . ()))
+
+ ;; hmm... should we end with a bar line here?
+ (".|" . ("|" . ".|"))
+ (":|" . (":|" . ()))
+ ("||" . ("||" . ()))
+ (".|." . (".|." . ()))
+ ("" . ("" . ""))
+ (":" . (":" . ""))
+ ("empty" . (() . ()))
+ ("brace" . (() . "brace"))
+ ("bracket" . (() . "bracket")) ))))
+
+ (if (equal? result #f)
+ (ly:warn "Unknown bar glyph: `~S'" glyph)
+ (index-cell (cdr result) dir))) )
(define-public (shift-right-at-line-begin g)
"Shift an item to the right, but only at the start of the line."
(if (and (ly:item? g) (equal? (ly:item-break-dir g) RIGHT))
- (ly:grob-translate-axis! g 3.5 X)
- ))
+ (ly:grob-translate-axis! g 3.5 X)))
(define (unknown)
"%\n\\unknown\n")
-
(define (select-font name-mag-pair)
- (let*
- (
- (c (assoc name-mag-pair font-name-alist))
- )
+ (let* ((c (assoc name-mag-pair font-name-alist)))
(if (eq? c #f)
(begin
(display (object-type (caaar font-name-alist)))
(ly:warn "Programming error: No such font known ~S ~S"
- (car name-mag-pair)
- (ly:number->string (cdr name-mag-pair))
- )
+ (car name-mag-pair)
+ (ly:number->string (cdr name-mag-pair)))
"") ; issue no command
- (string-append "\\" (cddr c)))
-
-
- ))
+ (string-append "\\" (cddr c)))))
(define (beam width slope thick blot)
(embedded-pdf (list 'beam width slope thick blot)))
(define (header-to-file fn key val)
(set! key (symbol->string key))
(if (not (equal? "-" fn))
- (set! fn (string-append fn "." key))
- )
+ (set! fn (string-append fn "." key)))
(display
(format "writing header field `~a' to `~a'..."
key
- (if (equal? "-" fn) "<stdout>" fn)
- )
+ (if (equal? "-" fn) "<stdout>" fn))
(current-error-port))
(if (equal? fn "-")
(display val)
- (display val (open-file fn "w"))
- )
+ (display val (open-file fn "w")))
(display "\n" (current-error-port))
- ""
- )
+ "")
(define (embedded-pdf expr)
- (let
- ((os (open-output-string)))
+ (let ((os (open-output-string)))
(pdf-output-expression expr os)
(string-append "\\embeddedpdf{" (get-output-string os) "}")))
-
-
(define (experimental-on)
"")
(define (repeat-slash w a t)
(embedded-pdf (list 'repeat-slash w a t)))
-
(define (tex-encoded-fontswitch name-mag)
(let* ((iname-mag (car name-mag))
(ename-mag (cdr name-mag)))
(cons iname-mag
(cons ename-mag
(string-append "magfont"
- (string-encode-integer
- (hashq (car ename-mag) 1000000))
- "m"
- (string-encode-integer
- (inexact->exact (* 1000 (cdr ename-mag)))))))))
+ (string-encode-integer
+ (hashq (car ename-mag) 1000000))
+ "m"
+ (string-encode-integer
+ (inexact->exact (* 1000 (cdr ename-mag)))))))))
(define (define-fonts internal-external-name-mag-pairs)
(set! font-name-alist (map tex-encoded-fontswitch
internal-external-name-mag-pairs))
(font-load-command (car x) (cdr x)))
(map cdr font-name-alist))))
-
(define (font-switch i)
(string-append
"\\" (font i) "\n"))
(number->string (cond
((equal? (ly:unit) "mm") (/ 72.0 25.4))
((equal? (ly:unit) "pt") (/ 72.0 72.27))
- (else (error "unknown unit" (ly:unit)))
- ))
+ (else (error "unknown unit" (ly:unit)))))
"}%\n"
"\\ifx\\lilypondstart\\undefined\n"
" \\input lilyponddefs\n"
;; FIXME: explain ploblem: need to do something to make this really safe.
(define (output-tex-string s)
(if (ly:get-option 'safe)
- (regexp-substitute/global #f "\\\\"
- (regexp-substitute/global #f "\\([{}]\\)" s 'pre "\\1" 'post)
- 'pre "$\\backslash$" 'post)
-
+ (regexp-substitute/global
+ #f "\\\\"
+ (regexp-substitute/global #f "\\([{}]\\)" s 'pre "\\1" 'post)
+ 'pre "$\\backslash$" 'post)
s))
(define (lily-def key val)
(let ((tex-key
(regexp-substitute/global
- #f "_" (output-tex-string key) 'pre "X" 'post))
+ #f "_" (output-tex-string key) 'pre "X" 'post))
(tex-val (output-tex-string val)))
(if (equal? (sans-surrounding-whitespace tex-val) "")
(string-append "\\let\\" tex-key "\\undefined\n")
(string-append "\\special{src:\\string:"
(point-and-click line col file)
"}" )
- "")
- )
+ ""))
- ; no-origin not supported in PDFTeX
+;; no-origin not supported in PDFTeX
(define (no-origin) "")
-
-
-
(define-public (pdftex-output-expression expr port)
(display (eval expr this-module) port) )
;; JUNK this -- see lily.scm: ly:all-output-backend-commands
#:export (unknown
- blank
- dot
- white-dot
- beam
- bracket
- dashed-slur
- char
- named-glyph
- dashed-line
- zigzag-line
- ez-ball
- comment
- repeat-slash
- placebox
- bezier-sandwich
- horizontal-line
- embedded-ps
- filledbox
- round-filled-box
- text
- white-text
- polygon
- draw-line
- no-origin
- ))
+ blank
+ dot
+ white-dot
+ beam
+ bracket
+ dashed-slur
+ char
+ named-glyph
+ dashed-line
+ zigzag-line
+ ez-ball
+ comment
+ repeat-slash
+ placebox
+ bezier-sandwich
+ horizontal-line
+ embedded-ps
+ filledbox
+ round-filled-box
+ text
+ white-text
+ polygon
+ draw-line
+ no-origin))
(use-modules (guile)
(define (char font i)
(string-append
- (ps-font-command font) " setfont "
+ (ps-font-command font) " setfont "
"(\\" (ly:inexact->string i 8) ") show" ))
(define (named-glyph font glyph)
(string-append
- (ps-font-command font) " setfont "
+ (ps-font-command font) " setfont "
"/" glyph " glyphshow "))
(define (dashed-line thick on off dx dy)
(ly:number->string (* 10 thick))
" ] 0 draw_dashed_slur"))
-; todo: merge with tex-font-command?
+ ; todo: merge with tex-font-command?
(define (embedded-ps string)
string)
" draw_repeat_slash"))
(define (round-filled-box x y width height blotdiam)
- (string-append
- (ly:numbers->string
- (list x y width height blotdiam)) " draw_round_box"))
+ (string-append
+ (ly:numbers->string
+ (list x y width height blotdiam)) " draw_round_box"))
(define (old-text font s)
- (let*
-
- ;; ugh, we should find a better way to
- ;; extract the hsbw for /space from the font.
-
- ((space-length (cdar (ly:text-dimension font " ")))
- (commands '())
- (add-command (lambda (x) (set! commands (cons x commands)))) )
+ ;; ugh, we should find a better way to
+ ;; extract the hsbw for /space from the font.
+ (let* ((space-length (cdar (ly:text-dimension font " ")))
+ (commands '())
+ (add-command (lambda (x) (set! commands (cons x commands)))) )
(string-fold
(lambda (chr word)
(string-append
(ps-font-command font) " setfont "
- (string-join (reverse commands)))
- ))
+ (string-join (reverse commands)))))
(define (new-text font s)
- (let*
- ((space-length (cdar (ly:text-dimension font " ")))
- (space-move (string-append (number->string space-length) " 0.0 rmoveto "))
-
- (input-enc (assoc-get 'input-name
- (ly:font-encoding-alist font)
- 'latin1))
- (out-vec (decode-byte-string input-enc s)))
+ (let* ((space-length (cdar (ly:text-dimension font " ")))
+ (space-move (string-append (number->string space-length) " 0.0 rmoveto "))
+
+ (input-enc (assoc-get 'input-name
+ (ly:font-encoding-alist font)
+ 'latin1))
+ (out-vec (decode-byte-string input-enc s)))
(string-append
(if (eq? sym 'space)
space-move
(string-append "/" (symbol->string sym) " glyphshow")))
- out-vec)))
- )))
+ out-vec))))))
-;(define text old-text)
+ ;(define text old-text)
(define text new-text)
(define (white-text scale s)
- (let ((mystring (string-append "(" s ") " (number->string scale) " /Helvetica-Bold "
- " draw_white_text")))
- mystring))
+ (let ((mystring (string-append "(" s ") " (number->string scale) " /Helvetica-Bold "
+ " draw_white_text")))
+ mystring))
(define (unknown)
"\n unknown\n")
(define (zigzag-line centre? zzw zzh thick dx dy)
(string-append
- (if centre? "true" "false") " "
- (ly:number->string zzw) " "
- (ly:number->string zzh) " "
- (ly:number->string thick) " "
- "0 0 "
- (ly:number->string dx) " "
- (ly:number->string dy)
- " draw_zigzag_line"))
+ (if centre? "true" "false") " "
+ (ly:number->string zzw) " "
+ (ly:number->string zzh) " "
+ (ly:number->string thick) " "
+ "0 0 "
+ (ly:number->string dx) " "
+ (ly:number->string dy)
+ " draw_zigzag_line"))
(define (grob-cause grob)
;; JUNK this -- see lily.scm: ly:all-output-backend-commands
#:export (unknown
- blank
- dot
- white-dot
- beam
- bracket
- dashed-slur
- named-glyph
- dashed-line
- zigzag-line
- ez-ball
- comment
- repeat-slash
- placebox
- bezier-sandwich
- horizontal-line
- filledbox
- round-filled-box
- text
- white-text
- polygon
- draw-line
- no-origin
- grob-cause
- ))
+ blank
+ dot
+ white-dot
+ beam
+ bracket
+ dashed-slur
+ named-glyph
+ dashed-line
+ zigzag-line
+ ez-ball
+ comment
+ repeat-slash
+ placebox
+ bezier-sandwich
+ horizontal-line
+ filledbox
+ round-filled-box
+ text
+ white-text
+ polygon
+ draw-line
+ no-origin
+ grob-cause))
(use-modules (ice-9 regex)
(ice-9 string-fun)
(begin
(ly:warn "Can't find ~a in ~a" name font)
- ""))
- ))
+ ""))))
(define (dashed-line thick on off dx dy)
(embedded-ps (list 'dashed-line thick on off dx dy)))
(embedded-ps (list 'round-filled-box x y width height blotdiam)))
(define (text font s)
- (let*
- ((mapping #f) ;; (assoc-get 'char-mapping (ly:font-encoding-alist font))))
+ ;; (assoc-get 'char-mapping (ly:font-encoding-alist font))))
+ (let* ((mapping #f)
-
- ;; TODO: we'd better do this for PS only
- ;; LaTeX gets in the way, and we need to remap
- ;; nonprintable chars.
-
- (input-enc-name #f) ;; (assoc-get 'input-name (ly:font-encoding-alist font) ))
- )
+ ;; TODO: we'd better do this for PS only
+ ;; LaTeX gets in the way, and we need to remap
+ ;; nonprintable chars.
+
+ ;; (assoc-get 'input-name (ly:font-encoding-alist font)))
+
+ (input-enc-name #f))
(string-append "\\hbox{\\" (tex-font-command font)
(if (string? input-enc-name)
"}")))
(define (white-text scale s)
- (embedded-ps (list 'white-text scale s)))
-
+ (embedded-ps (list 'white-text scale s)))
+
(define (polygon points blotdiameter)
(embedded-ps (list 'polygon `(quote ,points) blotdiameter)))
(string-append "\\special{src:"
(apply point-and-click location) "}")
""))
- ""))
+ ""))
\ No newline at end of file
-;;; page-layout.scm -- page breaking and page layout
-;;;
+;;;; page-layout.scm -- page breaking and page layout
+;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
;;;; (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
(define TAGLINE
(string-append "Engraved by LilyPond (version " (lilypond-version) ")"))
-
+
(define (page-headfoot layout scopes number sym sepsym dir last?)
"Create a stencil including separating space."
- (let*
- ((header-proc (ly:output-def-lookup layout sym))
+ (let* ((header-proc (ly:output-def-lookup layout sym))
(sep (ly:output-def-lookup layout sepsym))
(stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
(head-stencil
(define-public (default-page-music-height layout scopes number last?)
"Printable area for music and titles; matches default-page-make-stencil."
- (let*
- ((h (- (ly:output-def-lookup layout 'vsize)
+ (let* ((h (- (ly:output-def-lookup layout 'vsize)
(ly:output-def-lookup layout 'topmargin)
(ly:output-def-lookup layout 'bottommargin)))
(head (page-headfoot layout scopes number 'make-header 'headsep UP last?))
(interval-length (ly:stencil-extent foot Y))
0))))
-; (display (list "\n available" available head foot))
+ ; (display (list "\n available" available head foot))
available))
(define-public (default-page-make-stencil
lines offsets layout scopes number last? )
"Construct a stencil representing the page from LINES. "
- (let*
- ((topmargin (ly:output-def-lookup layout 'topmargin))
-
- ;; TODO: naming vsize/hsize not analogous to TeX.
-
- (vsize (ly:output-def-lookup layout 'vsize))
- (hsize (ly:output-def-lookup layout 'hsize))
-
- (lmargin (ly:output-def-lookup layout 'leftmargin))
- (leftmargin (if lmargin
- lmargin
- (/ (- hsize
- (ly:output-def-lookup layout 'linewidth)) 2)))
-
- (rightmargin (ly:output-def-lookup layout 'rightmargin))
- (bottom-edge (- vsize
- (ly:output-def-lookup layout 'bottommargin)))
-
- (head (page-headfoot layout scopes number 'make-header 'headsep UP last?))
- (foot (page-headfoot layout scopes number 'make-footer 'footsep DOWN last?))
-
- (head-height (if (ly:stencil? head)
- (interval-length (ly:stencil-extent head Y))
- 0.0))
-
- (line-stencils (map ly:paper-system-stencil lines))
- (height-proc (ly:output-def-lookup layout 'page-music-height))
-
- (page-stencil (ly:make-stencil '()
- (cons leftmargin hsize)
- (cons (- topmargin) 0)))
- (was-title #t)
- (add-system (lambda (stencil-position)
- (set! page-stencil
- (ly:stencil-add
- (ly:stencil-translate-axis
- (car stencil-position)
- (- 0
- head-height
- (cadr stencil-position)
- topmargin)
- Y)
- page-stencil))))
- )
+ (let* ((topmargin (ly:output-def-lookup layout 'topmargin))
+
+ ;; TODO: naming vsize/hsize not analogous to TeX.
+
+ (vsize (ly:output-def-lookup layout 'vsize))
+ (hsize (ly:output-def-lookup layout 'hsize))
+
+ (lmargin (ly:output-def-lookup layout 'leftmargin))
+ (leftmargin (if lmargin
+ lmargin
+ (/ (- hsize
+ (ly:output-def-lookup layout 'linewidth)) 2)))
+
+ (rightmargin (ly:output-def-lookup layout 'rightmargin))
+ (bottom-edge (- vsize
+ (ly:output-def-lookup layout 'bottommargin)))
+
+ (head (page-headfoot layout scopes number 'make-header 'headsep UP last?))
+ (foot (page-headfoot layout scopes number 'make-footer 'footsep DOWN last?))
+
+ (head-height (if (ly:stencil? head)
+ (interval-length (ly:stencil-extent head Y))
+ 0.0))
+
+ (line-stencils (map ly:paper-system-stencil lines))
+ (height-proc (ly:output-def-lookup layout 'page-music-height))
+
+ (page-stencil (ly:make-stencil '()
+ (cons leftmargin hsize)
+ (cons (- topmargin) 0)))
+ (was-title #t)
+ (add-system (lambda (stencil-position)
+ (set! page-stencil
+ (ly:stencil-add
+ (ly:stencil-translate-axis
+ (car stencil-position)
+ (- 0
+ head-height
+ (cadr stencil-position)
+ topmargin)
+ Y)
+ page-stencil)))))
(if #f
(display (list
- "leftmargin" leftmargin "rightmargin" rightmargin
- )))
+ "leftmargin" leftmargin "rightmargin" rightmargin)))
(set! page-stencil (ly:stencil-combine-at-edge
- page-stencil Y DOWN head 0. 0.))
+ page-stencil Y DOWN head 0. 0.))
(map add-system (zip line-stencils offsets))
(if (ly:stencil? foot)
foot
(cons 0
(+ (- bottom-edge)
- (- (car (ly:stencil-extent foot Y)))))
- ))))
+ (- (car (ly:stencil-extent foot Y)))))))))
+
+ (ly:stencil-translate page-stencil (cons leftmargin 0))))
- (ly:stencil-translate page-stencil (cons leftmargin 0))
- ))
-
;;; This is not optimal page breaking, this is optimal distribution of
;;; lines over pages; line breaks are a given.
-; TODO:
-;
-; - density scoring
-; - separate function for word-wrap style breaking?
-; - raggedbottom? raggedlastbottom?
+ ; TODO:
+ ;
+ ; - density scoring
+ ; - separate function for word-wrap style breaking?
+ ; - raggedbottom? raggedlastbottom?
(define-public (ly:optimal-page-breaks
lines paper-book)
(define scopes (ly:paper-book-scopes paper-book))
(define (page-height page-number last?)
- (let
- ((p (ly:output-def-lookup paper 'page-music-height)))
+ (let ((p (ly:output-def-lookup paper 'page-music-height)))
(if (procedure? p)
(p paper scopes page-number last?)
done))
(define (combine-penalties force user best-paths)
- (let*
- ((prev-force (if (null? best-paths)
+ (let* ((prev-force (if (null? best-paths)
0.0
(node-force (car best-paths))))
(prev-penalty (if (null? best-paths)
(inter-system-space (ly:output-def-lookup paper 'betweensystemspace))
(force-equalization-factor 0.3)
(relative-force (/ force inter-system-space))
- (abs-relative-force (abs relative-force))
- )
-
-
- (+ (* abs-relative-force (+ abs-relative-force 1))
- prev-penalty
- (* force-equalization-factor (/ (abs (- prev-force force)) inter-system-space))
- user)))
+ (abs-relative-force (abs relative-force)))
+
+
+ (+ (* abs-relative-force (+ abs-relative-force 1))
+ prev-penalty
+ (* force-equalization-factor (/ (abs (- prev-force force)) inter-system-space))
+ user)))
(define (space-systems page-height lines ragged?)
- (let*
- ((inter-system-space
+ (let* ((inter-system-space
(ly:output-def-lookup paper 'betweensystemspace))
(system-vector (list->vector
- (append lines
- (if (= (length lines) 1)
- '(#f)
- '()))
- ))
+ (append lines
+ (if (= (length lines) 1)
+ '(#f)
+ '()))))
(staff-extents
(list->vector
lines)
(if (= (length lines) 1)
'((0 . 0))
- '()))
- ))
+ '())) ))
(real-extents
(list->vector
(append
(map
(lambda (sys) (ly:paper-system-extent sys Y)) lines)
- (if (= (length lines) 1)
- '((0 . 0))
- '())
- )))
+ (if (= (length lines) 1)
+ '((0 . 0))
+ '()) )))
(no-systems (vector-length real-extents))
(topskip (interval-end (vector-ref real-extents 0)))
(space-left (- page-height
- (apply + (map interval-length (vector->list real-extents)))
-
- ))
-
+ (apply + (map interval-length (vector->list real-extents)))))
+
(space (- page-height
topskip
- (- (interval-start (vector-ref real-extents (1- no-systems))))
- ))
+ (- (interval-start (vector-ref real-extents (1- no-systems))))))
(fixed-dist (ly:output-def-lookup paper 'betweensystempadding))
(calc-spring
(lambda (idx)
- (let*
- ((this-system-ext (vector-ref staff-extents idx))
+ (let* ((this-system-ext (vector-ref staff-extents idx))
(next-system-ext (vector-ref staff-extents (1+ idx)))
(fixed (max 0 (- (+ (interval-end next-system-ext)
fixed-dist)
(title1? (and (vector-ref system-vector idx)
(ly:paper-system-title? (vector-ref system-vector idx))))
(title2? (and
- (vector-ref system-vector (1+ idx))
- (ly:paper-system-title? (vector-ref system-vector (1+ idx)))))
+ (vector-ref system-vector (1+ idx))
+ (ly:paper-system-title? (vector-ref system-vector (1+ idx)))))
(ideal (+
(cond
((and title2? title1?)
(ly:output-def-lookup paper 'beforetitlespace))
(else inter-system-space))
fixed))
- (hooke (/ 1 (- ideal fixed)))
- )
- (list ideal hooke))
- ))
+ (hooke (/ 1 (- ideal fixed))))
+ (list ideal hooke))))
(springs (map calc-spring (iota (1- no-systems))))
(calc-rod
(lambda (idx)
- (let*
- ((this-system-ext (vector-ref real-extents idx))
+ (let* ((this-system-ext (vector-ref real-extents idx))
(next-system-ext (vector-ref real-extents (1+ idx)))
(distance (max (- (+ (interval-end next-system-ext)
- fixed-dist)
+ fixed-dist)
(interval-start this-system-ext)
) 0))
(entry (list idx (1+ idx) distance)))
(force (car result))
(positions
(map (lambda (y)
- (+ y topskip))
- (cdr result)))
- )
+ (+ y topskip))
+ (cdr result))))
(if #f ;; debug.
(begin
- (display (list "\n# systems: " no-systems
- "\nreal-ext" real-extents "\nstaff-ext" staff-extents
- "\ninterscore" inter-system-space
- "\nspace-letf" space-left
- "\nspring,rod" springs rods
- "\ntopskip " topskip
- " space " space
- "\npage-height" page-height
- "\nragged" ragged?
- "\nforce" force
- "\nres" (cdr result)
- "\npositions" positions "\n"))))
-
- (cons force positions)))
+ (display (list "\n# systems: " no-systems
+ "\nreal-ext" real-extents "\nstaff-ext" staff-extents
+ "\ninterscore" inter-system-space
+ "\nspace-letf" space-left
+ "\nspring,rod" springs rods
+ "\ntopskip " topskip
+ " space " space
+ "\npage-height" page-height
+ "\nragged" ragged?
+ "\nforce" force
+ "\nres" (cdr result)
+ "\npositions" positions "\n"))))
+
+ (cons force positions)))
(define (walk-paths done-lines best-paths current-lines last? current-best)
"Return the best optimal-page-break-node that contains
(user-penalty
(+
(max (ly:paper-system-break-before-penalty (car current-lines)) 0.0)
- user-nobreak-penalties))
+ user-nobreak-penalties))
(total-penalty (combine-penalties
force user-penalty
best-paths))
(new-best (if better?
(make <optimally-broken-page-node>
#:prev (if (null? best-paths)
- #f
- (car best-paths))
+ #f
+ (car best-paths))
#:lines current-lines
#:pageno this-page-num
#:force force
(last? (null? (cdr todo)))
(next (walk-paths done best-paths (list this-line) last? #f)))
-; (display "\n***************")
+ ; (display "\n***************")
(walk-lines (cons this-line done)
(cons next best-paths)
(cdr todo)))))
(begin
(display (list
"\nbreaks: " (map line-number break-nodes))
- "\nsystems " (map node-lines break-nodes)
- "\npenalties " (map node-penalty break-nodes)
- "\nconfigs " (map node-configuration break-nodes))))
+ "\nsystems " (map node-lines break-nodes)
+ "\npenalties " (map node-penalty break-nodes)
+ "\nconfigs " (map node-configuration break-nodes))))
- ; create stencils.
+ ; create stencils.
(map (lambda (node)
((ly:output-def-lookup paper 'page-make-stencil)
(define (interpret-in-page-env potential-markup)
(if (markup? potential-markup)
- (let*
- ((alists (map ly:module->alist scopes))
- (prefixed-alists
- (map (lambda (alist)
- (map (lambda (entry)
- (cons
- (string->symbol
- (string-append
- "header:"
- (symbol->string (car entry))))
- (cdr entry)
- ))
- alist))
- alists))
- (tagline (ly:modules-lookup scopes 'tagline))
+ (let* ((alists (map ly:module->alist scopes))
+ (prefixed-alists
+ (map (lambda (alist)
+ (map (lambda (entry)
+ (cons
+ (string->symbol
+ (string-append
+ "header:"
+ (symbol->string (car entry))))
+ (cdr entry)))
+ alist))
+ alists))
+ (tagline (ly:modules-lookup scopes 'tagline))
- (pgnum-alist
- (list
- (cons 'header:tagline (if (markup? tagline)
- tagline
- TAGLINE))
- (cons 'page:last? last?)
- (cons 'page:page-number-string
- (number->string page-number))
- (cons 'page:page-number page-number)))
- (props (append
- (list pgnum-alist)
- prefixed-alists
- (page-properties layout))))
+ (pgnum-alist
+ (list
+ (cons 'header:tagline (if (markup? tagline)
+ tagline
+ TAGLINE))
+ (cons 'page:last? last?)
+ (cons 'page:page-number-string
+ (number->string page-number))
+ (cons 'page:page-number page-number)))
+ (props (append
+ (list pgnum-alist)
+ prefixed-alists
+ (page-properties layout))))
(interpret-markup layout props potential-markup))
(let ((x (ly:modules-lookup scopes sym)))
(if (markup? x) x #f)))
- (let*
- ((alists (map ly:module->alist scopes))
- (prefixed-alist
- (map (lambda (alist)
- (map (lambda (entry)
- (cons
- (string->symbol
- (string-append
- "header:"
- (symbol->string (car entry))))
- (cdr entry)
- ))
- alist))
- alists))
- (props (append prefixed-alist
- (page-properties layout)))
+ (let* ((alists (map ly:module->alist scopes))
+ (prefixed-alist
+ (map (lambda (alist)
+ (map (lambda (entry)
+ (cons
+ (string->symbol
+ (string-append
+ "header:"
+ (symbol->string (car entry))))
+ (cdr entry)))
+ alist))
+ alists))
+ (props (append prefixed-alist
+ (page-properties layout)))
- (markup (ly:output-def-lookup layout what))
- )
+ (markup (ly:output-def-lookup layout what)))
(if (markup? markup)
(interpret-markup layout props markup)
- (ly:make-stencil '() '(1 . -1) '(1 . -1)))
- ))
-
+ (ly:make-stencil '() '(1 . -1) '(1 . -1)))))
(pitch . pitch)
(duration . duration)
(octave . octave)
- (step . step)
- ))
+ (step . step)))
(define (musicxml-node->string node)
(let ((xml-name (assoc-get (node-name node) node-names #f)))
- (string-append
- (if xml-name (open-tag xml-name '() '()) "")
- (if (equal? (node-value node) "")
- (string-append
- (if xml-name "\n" "")
- (apply string-append (map musicxml-node->string (node-children node))))
- (node-value node))
- (if xml-name (close-tag xml-name) "")
- (if xml-name "\n" ""))))
+ (string-append
+ (if xml-name (open-tag xml-name '() '()) "")
+ (if (equal? (node-value node) "")
+ (string-append
+ (if xml-name "\n" "")
+ (apply string-append (map musicxml-node->string (node-children node))))
+ (node-value node))
+ (if xml-name (close-tag xml-name) "")
+ (if xml-name "\n" ""))))
(define (xml-node->string node)
(string-append
#:attributes `((octave . ,(ly:pitch-octave p))
(notename . ,(ly:pitch-notename p))
(alteration . ,(ly:pitch-alteration p)))))
-
+
(define (music->xml-node music)
(let* ((name (ly:music-property music 'name))
(e (ly:music-property music 'element))
]>
"))
-
-
+
+
;; as computed from input/trip.ly, by
;; http://www.pault.com/pault/dtdgenerator/
(not (memq (car x) exceptions)))
(define (dump-attr sym-val)
- (let*
- (
- (sym (car sym-val))
- (val (cdr sym-val))
- )
+ (let* ((sym (car sym-val))
+ (val (cdr sym-val)))
- (string-append
- "\n "
- (symbol->string sym)
- "=\""
- (let ((s (call-with-output-string (lambda (port) (display val port)))))
- (re-sub-alist s xml-entities-alist))
- "\""
- )))
+ (string-append
+ "\n "
+ (symbol->string sym)
+ "=\""
+ (let ((s (call-with-output-string (lambda (port) (display val port)))))
+ (re-sub-alist s xml-entities-alist))
+ "\"")))
(string-append
"<" (symbol->string tag)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; tuplets.
+;;;; translation-functions.scm --
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 1998--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; Jan Nieuwenhuizen <janneke@gnu.org>
(define-public (denominator-tuplet-formatter mus)
(number->string (ly:music-property mus 'denominator)))
(string-append
(number->string (ly:music-property mus 'denominator))
":"
- (number->string (ly:music-property mus 'numerator))
- ))
-
+ (number->string (ly:music-property mus 'numerator))))
;; metronome marks
(define-public (format-metronome-markup event context)
- (let*
- ((dur (ly:music-property event 'tempo-unit))
+ (let* ((dur (ly:music-property event 'tempo-unit))
(count (ly:music-property event 'metronome-count))
(note-mark (make-smaller-markup
(make-note-by-number-markup (ly:duration-log dur)
(list
(make-general-align-markup Y DOWN note-mark)
(make-simple-markup "=")
- (make-simple-markup (number->string count))
-
- ))))
-
-
+ (make-simple-markup (number->string count))))))
(define-public (format-mark-letters mark context)
(make-bold-markup (make-markletter-markup (1- mark))))
projects / lilypond.git / commitdiff