From 5f68ba5ca0edd64f0f6723e65c27993c2dfb1e96 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sun, 4 Nov 2001 20:54:52 +0100 Subject: [PATCH] release: 1.5.21 =========== * Fixed direct PostScript output, and changed default fonts. * Bugfix: automaticMelismata in refman (huh, or should lily be changed?) * pktrace: cp mf/out/feta20.* $HOME/usr/src/sketch-0.7.8/Resources/Fontmetrics echo 'TeX-feta20,feta20,Roman,-gnu-feta20-medium-r-normal,adobe-fontspec\ific,feta20' >> $HOME/usr/src/sketch-0.7.8/Resources/Fontmetrics/std.sfd 1.5.3.l --- CHANGES | 25 +- Documentation/topdocs/INSTALL.texi | 27 +- Documentation/topdocs/README.texi | 2 +- Documentation/user/latex-example.latex | 33 +- INSTALL.txt | 26 +- README.txt | 2 +- VERSION | 4 +- aclocal.m4 | 2 + configure | 190 +++++---- input/bugs/RondoAllaTurca.ly | 225 ----------- input/bugs/clefsp.ly | 20 + input/test/sketch.ly | 5 +- lily/global-ctor.cc | 2 +- lily/gourlay-breaking.cc | 62 +-- lily/include/lily-guile.hh | 10 +- lily/include/paper-outputter.hh | 9 +- lily/include/paper-stream.hh | 46 --- lily/include/stream.hh | 28 ++ lily/lily-guile.cc | 13 +- lily/line-of-score.cc | 12 +- lily/main.cc | 25 +- lily/midi-def.cc | 16 +- lily/midi-stream.cc | 4 +- lily/paper-outputter.cc | 124 ++---- lily/paper-score.cc | 1 - lily/paper-stream.cc | 149 ------- lily/repeat-acknowledge-engraver.cc | 17 +- lily/streams.cc | 53 +++ lily/unfolded-repeat-iterator.cc | 2 +- make/lilypond-vars.make | 7 +- make/lilypond.mandrake.spec.in | 3 + make/lilypond.redhat.spec.in | 3 + make/out/lilypond.lsm | 8 +- make/out/lilypond.mandrake.spec | 5 +- make/out/lilypond.redhat.spec | 7 +- make/out/lilypond.suse.spec | 4 +- mf/GNUmakefile | 9 +- scm/ascii-script.scm | 407 +++++++++---------- scm/lily.scm | 51 ++- scm/output-lib.scm | 31 +- scm/ps.scm | 464 +++++++++++----------- scm/sketch.scm | 318 --------------- scm/tex.scm | 504 ++++++++++++------------ scripts/abc2ly.py | 23 +- scripts/etf2ly.py | 10 +- stepmake/stepmake/metafont-rules.make | 7 + stepmake/stepmake/metafont-targets.make | 3 + 47 files changed, 1217 insertions(+), 1781 deletions(-) delete mode 100644 input/bugs/RondoAllaTurca.ly create mode 100644 input/bugs/clefsp.ly delete mode 100644 lily/include/paper-stream.hh create mode 100644 lily/include/stream.hh delete mode 100644 lily/paper-stream.cc create mode 100644 lily/streams.cc diff --git a/CHANGES b/CHANGES index 62de546a46..8ad23847a9 100644 --- a/CHANGES +++ b/CHANGES @@ -8,9 +8,32 @@ * pktrace: cp mf/out/feta20.* $HOME/usr/src/sketch-0.7.8/Resources/Fontmetrics - echo 'TeX-feta20,feta20,Roman,-gnu-feta20-medium-r-normal,adobe-fontspecific,feta20' >> $HOME/usr/src/sketch-0.7.8/Resources/Fontmetrics/std.sfd + echo 'TeX-feta20,feta20,Roman,-gnu-feta20-medium-r-normal,adobe-fontspec\ific,feta20' >> $HOME/usr/src/sketch-0.7.8/Resources/Fontmetrics/std.sfd +1.5.3.lec1 +========== +abc2ly fixes: + + fix to Q: support + partial fix for tuplet parsing + fix for blank first T: line + escape "'s in header lines + fix for dotted breve in whole note duration + M:none no longer attempts to insert "\time none" + + +1.5.20.uu1 +========== + +* etf2ly robustness fixes + +* Rewrote outputting backend. Now uses GUILE modules. + +* Line breaking bugfix. + +* Bugfix: Unfolded_repeat_iterator::add_repeat_command(). + 1.5.20 ====== diff --git a/Documentation/topdocs/INSTALL.texi b/Documentation/topdocs/INSTALL.texi index 24442f34b1..dd4b50599a 100644 --- a/Documentation/topdocs/INSTALL.texi +++ b/Documentation/topdocs/INSTALL.texi @@ -155,14 +155,6 @@ It is available at FTP directory for @code{geometry}}. This package is normally included with the @TeX{} distribution. -@item MetaPost, needed for generating PostScript fonts. Please -note that tetex-0.4pl8 (included with Red Hat 5.x) does not include -@file{mfplain.mp}, which is needed for producing the scalable font -files. - -If you don't have MetaPost and don't want to use PostScript output, then -edit @file{mf/GNUmakefile}, removing the line saying @code{PFA_FILES=}. - @item kpathsea, a library for searching (@TeX{}) files. @code{kpathsea} is usually included with your installation of @TeX{}. You may need to install a tetex-devel or tetex-dev package too. @@ -177,6 +169,25 @@ configure something like: ./configure --without-kpathsea --enable-tfm-path=/usr/share/texmf/fonts/tfm/public/cm/:/usr/share/texmf/fonts/tfm/ams/symbols @end example + +@item pktrace, [OPTIONAL], needed for generating PostScript Type1 +fonts. Get it from + @uref{http://www.cs.uu.nl/~hanwen/public/software/pktrace-0.1.tar.gz} + +@item autotrace-0.27a, [OPTIONAL], needed for generating PostScript Type1 +fonts. You must apply the patch included pktrace-0.1 first. +@uref{http://autotrace.sourceforge.net}. + +@item MetaPost [OPTIONAL] needed for generating PostScript Type3 fonts. Please +note that tetex-0.4pl8 (included with Red Hat 5.x) does not include +@file{mfplain.mp}, which is needed for producing the scalable font +files. + +If you don't have MetaPost and don't want to use PostScript output, then +edit @file{mf/GNUmakefile}, removing the line saying @code{PFA_FILES=}. + + + @end itemize @subsection Running requirements diff --git a/Documentation/topdocs/README.texi b/Documentation/topdocs/README.texi index dbd1ffa511..5ac05c3342 100644 --- a/Documentation/topdocs/README.texi +++ b/Documentation/topdocs/README.texi @@ -108,7 +108,7 @@ files, eg., rm `find /var/lib/texmf/fonts -name 'feta*'` @end example -a script to do this for you is in @file{buildscripts/clean-fonts.sh} +a script to do this for you is in @file{buildscripts/out/clean-fonts} @section Bugs diff --git a/Documentation/user/latex-example.latex b/Documentation/user/latex-example.latex index 68a861072a..fa675e55e8 100644 --- a/Documentation/user/latex-example.latex +++ b/Documentation/user/latex-example.latex @@ -6,40 +6,25 @@ %\def\postLilypondExample{} +\usepackage{graphics} +\def\postLilypondExample{} +\def\preLilypondExample{} \begin{document} -\begin{lilypond} -\score { - \notes\relative c' { c d e f g a b c } -} -\end{lilypond} +\preLilypondExample \input lily-464146743.tex \postLilypondExample -\begin[fragment]{lilypond} -c d e -\end{lilypond} + +\preLilypondExample \input lily-940223662.tex \postLilypondExample + % generate standard lilypond titles \input titledefs.tex \def\preLilypondExample{\def\mustmakelilypondtitle{}} -\begin{lilypond} -\header { - title = "Title" - subtitle = "Subtitle" - subsubtitle = "Subsubtitle" - opus = "Opus 1" - piece = "Piece" - composer = "Composer" - enteredby = "JCN" - instrument = "instrument" -} -\paper { linewidth = -1. } -\score { - \notes \relative c'' { a b c d } -} -\end{lilypond} +\preLilypondExample \input lily-615430739.tex \postLilypondExample + \begin{enumerate} \item Vers one. aaa aaa aaa aaa aaa aaa aaa aaa aaa aaa diff --git a/INSTALL.txt b/INSTALL.txt index 4c8da9fa63..7fa5e4fe7c 100644 --- a/INSTALL.txt +++ b/INSTALL.txt @@ -160,15 +160,6 @@ Compilation (ftp://ftp.ctan.org/tex-archive/macros/latex/contrib/supported/geometry). This package is normally included with the TeX distribution. - * MetaPost, needed for generating PostScript fonts. Please note that - tetex-0.4pl8 (included with Red Hat 5.x) does not include - `mfplain.mp', which is needed for producing the scalable font - files. - - If you don't have MetaPost and don't want to use PostScript - output, then edit `mf/GNUmakefile', removing the line saying - `PFA_FILES='. - * kpathsea, a library for searching (TeX) files. `kpathsea' is usually included with your installation of TeX. You may need to install a tetex-devel or tetex-dev package too. @@ -181,6 +172,23 @@ Compilation ./configure --without-kpathsea --enable-tfm-path=/usr/share/texmf/fonts/tfm/public/cm/:/usr/share/texmf/fonts/tfm/ams/symbols + * pktrace, [OPTIONAL], needed for generating PostScript Type1 fonts. + Get it from + `http://www.cs.uu.nl/~hanwen/public/software/pktrace-0.1.tar.gz' + + * autotrace-0.27a, [OPTIONAL], needed for generating PostScript Type1 + fonts. You must apply the patch included pktrace-0.1 first. + `http://autotrace.sourceforge.net'. + + * MetaPost [OPTIONAL] needed for generating PostScript Type3 fonts. + Please note that tetex-0.4pl8 (included with Red Hat 5.x) does not + include `mfplain.mp', which is needed for producing the scalable + font files. + + If you don't have MetaPost and don't want to use PostScript + output, then edit `mf/GNUmakefile', removing the line saying + `PFA_FILES='. + Running requirements -------------------- diff --git a/README.txt b/README.txt index b044f51b8f..6ee2dd7535 100644 --- a/README.txt +++ b/README.txt @@ -86,7 +86,7 @@ Caveats files, eg., rm `find /var/lib/texmf/fonts -name 'feta*'` - a script to do this for you is in `buildscripts/clean-fonts.sh' + a script to do this for you is in `buildscripts/out/clean-fonts' Bugs ==== diff --git a/VERSION b/VERSION index aa11a5ea61..08539f2bab 100644 --- a/VERSION +++ b/VERSION @@ -1,8 +1,8 @@ PACKAGE_NAME=LilyPond MAJOR_VERSION=1 MINOR_VERSION=5 -PATCH_LEVEL=20 -MY_PATCH_LEVEL=jcn1 +PATCH_LEVEL=21 +MY_PATCH_LEVEL= # use the above to send patches: MY_PATCH_LEVEL is always empty for a # released version. diff --git a/aclocal.m4 b/aclocal.m4 index 3003cbd938..082312d741 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1,3 +1,5 @@ +dnl WARNING WARNING WARNING WARNING +dnl do not edit! this is aclocal.m4, generated from stepmake/aclocal.m4 dnl aclocal.m4 -*-shell-script-*- dnl StepMake subroutines for configure.in diff --git a/configure b/configure index a46decc286..f08e503965 100755 --- a/configure +++ b/configure @@ -1889,20 +1889,71 @@ else fi fi +for ac_declaration in \ + ''\ + '#include ' \ + 'extern "C" void std::exit (int) throw (); using std::exit;' \ + 'extern "C" void std::exit (int); using std::exit;' \ + 'extern "C" void exit (int) throw ();' \ + 'extern "C" void exit (int);' \ + 'void exit (int);' +do + cat > conftest.$ac_ext < +$ac_declaration +int main() { +exit (42); +; return 0; } +EOF +if { (eval echo configure:1911: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + : +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + continue +fi +rm -f conftest* + cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + break +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 +fi +rm -f conftest* +done +if test -n "$ac_declaration"; then + echo '#ifdef __cplusplus' >>confdefs.h + echo $ac_declaration >>confdefs.h + echo '#endif' >>confdefs.h +fi + + ac_safe=`echo "FlexLexer.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for FlexLexer.h""... $ac_c" 1>&6 -echo "configure:1896: checking for FlexLexer.h" >&5 +echo "configure:1947: checking for FlexLexer.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1906: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:1957: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -1939,7 +1990,7 @@ fi echo $ac_n "checking "g++ version"""... $ac_c" 1>&6 -echo "configure:1943: checking "g++ version"" >&5 +echo "configure:1994: checking "g++ version"" >&5 cxx_version=`$CXX --version` echo "$ac_t"""$cxx_version"" 1>&6 # urg, egcs: how to check for egcs >= 1.1? @@ -1957,12 +2008,12 @@ echo "configure:1943: checking "g++ version"" >&5 echo $ac_n "checking whether explicit instantiation is needed""... $ac_c" 1>&6 -echo "configure:1961: checking whether explicit instantiation is needed" >&5 +echo "configure:2012: checking whether explicit instantiation is needed" >&5 if eval "test \"`echo '$''{'lily_cv_need_explicit_instantiation'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < struct foo { static int baz; }; @@ -1972,7 +2023,7 @@ int main() { return foo::baz; ; return 0; } EOF -if { (eval echo configure:1976: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:2027: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* lily_cv_need_explicit_instantiation=no else @@ -1999,7 +2050,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2003: checking for $ac_word" >&5 +echo "configure:2054: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_YACC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2042,7 +2093,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2046: checking for $ac_word" >&5 +echo "configure:2097: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_BISON'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2077,7 +2128,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2081: checking for $ac_word" >&5 +echo "configure:2132: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_FLEX'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2145,7 +2196,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2149: checking for $ac_word" >&5 +echo "configure:2200: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_AR'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2178,7 +2229,7 @@ test -n "$AR" || AR="error" # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2182: checking for $ac_word" >&5 +echo "configure:2233: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2233,7 +2284,7 @@ fi echo $ac_n "checking language""... $ac_c" 1>&6 -echo "configure:2237: checking language" >&5 +echo "configure:2288: checking language" >&5 case "$language" in En* | en* | Am* | am* | US* | us*) lang=English;; @@ -2269,7 +2320,7 @@ EOF echo $ac_n "checking for gettext in -lintl""... $ac_c" 1>&6 -echo "configure:2273: checking for gettext in -lintl" >&5 +echo "configure:2324: checking for gettext in -lintl" >&5 ac_lib_var=`echo intl'_'gettext | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -2277,7 +2328,7 @@ else ac_save_LIBS="$LIBS" LIBS="-lintl $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:2346: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -2321,12 +2372,12 @@ fi for ac_func in gettext do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:2325: checking for $ac_func" >&5 +echo "configure:2376: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:2407: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -2384,7 +2435,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2388: checking for $ac_word" >&5 +echo "configure:2439: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_MSGFMT'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2415,7 +2466,7 @@ done test -n "$MSGFMT" || MSGFMT="\$(SHELL) \$(step-bindir)/fake-msgfmt.sh " echo $ac_n "checking whether msgfmt accepts -o""... $ac_c" 1>&6 -echo "configure:2419: checking whether msgfmt accepts -o" >&5 +echo "configure:2470: checking whether msgfmt accepts -o" >&5 msgfmt_output="`msgfmt -o bla 2>&1 | grep usage`" if test "$msgfmt_output" = ""; then echo "$ac_t""yes" 1>&6 @@ -2443,7 +2494,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2447: checking for $ac_word" >&5 +echo "configure:2498: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_METAFONT'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2479,7 +2530,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2483: checking for $ac_word" >&5 +echo "configure:2534: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_MFONT'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2517,7 +2568,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2521: checking for $ac_word" >&5 +echo "configure:2572: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_METAPOST'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2553,7 +2604,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2557: checking for $ac_word" >&5 +echo "configure:2608: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_MPOST'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2592,7 +2643,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2596: checking for $ac_word" >&5 +echo "configure:2647: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_INIMETAFONT'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2628,7 +2679,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2632: checking for $ac_word" >&5 +echo "configure:2683: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_INIMFONT'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2666,7 +2717,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2670: checking for $ac_word" >&5 +echo "configure:2721: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_INIMETAPOST'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2702,7 +2753,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2706: checking for $ac_word" >&5 +echo "configure:2757: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_INIMPOST'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2736,7 +2787,7 @@ test -n "$INIMPOST" || INIMPOST="-echo no inimp or inimpost" fi echo $ac_n "checking for working metafont mode""... $ac_c" 1>&6 -echo "configure:2740: checking for working metafont mode" >&5 +echo "configure:2791: checking for working metafont mode" >&5 modelist='ljfour lj4 lj3 lj2 ljet laserjet' for MFMODE in $modelist; do $METAFONT "\mode:=$MFMODE; mode_setup; end." > /dev/null 2>&1 @@ -2747,7 +2798,7 @@ echo "configure:2740: checking for working metafont mode" >&5 echo "$ac_t""$MFMODE" 1>&6 echo $ac_n "checking for mfplain.mp""... $ac_c" 1>&6 -echo "configure:2751: checking for mfplain.mp" >&5 +echo "configure:2802: checking for mfplain.mp" >&5 # # For now let people define these in their environments # @@ -2755,7 +2806,7 @@ echo "configure:2751: checking for mfplain.mp" >&5 echo "$ac_t""$MFPLAIN_MP" 1>&6 echo $ac_n "checking for inimetapost flags""... $ac_c" 1>&6 -echo "configure:2759: checking for inimetapost flags" >&5 +echo "configure:2810: checking for inimetapost flags" >&5 if test ${INIMETAPOST} = "inimp" ; then : ${INIMETAPOST_FLAGS=''} else @@ -2788,7 +2839,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2792: checking for $ac_word" >&5 +echo "configure:2843: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_KPSEWHICH'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2819,7 +2870,7 @@ done test -n "$KPSEWHICH" || KPSEWHICH="no" echo $ac_n "checking for tfm path""... $ac_c" 1>&6 -echo "configure:2823: checking for tfm path" >&5 +echo "configure:2874: checking for tfm path" >&5 TFM_FONTS="cmr msam" @@ -2847,13 +2898,13 @@ echo "configure:2823: checking for tfm path" >&5 ## First, let's just see if we can find Guile at all. echo $ac_n "checking "for guile-config"""... $ac_c" 1>&6 -echo "configure:2851: checking "for guile-config"" >&5 +echo "configure:2902: checking "for guile-config"" >&5 for guile_config in guile-config $target-guile-config $build-guile-config; do echo "$ac_t"""$guile_config"" 1>&6 if ! $guile_config --version > /dev/null 2>&1 ; then echo "configure: warning: "cannot execute $guile_config"" 1>&2 echo $ac_n "checking "if we are cross compiling"""... $ac_c" 1>&6 -echo "configure:2857: checking "if we are cross compiling"" >&5 +echo "configure:2908: checking "if we are cross compiling"" >&5 guile_config=error else break @@ -2864,7 +2915,7 @@ echo "configure:2857: checking "if we are cross compiling"" >&5 exit 1 fi echo $ac_n "checking "Guile version"""... $ac_c" 1>&6 -echo "configure:2868: checking "Guile version"" >&5 +echo "configure:2919: checking "Guile version"" >&5 need_guile_version="1.3.4" need_guile_version_numeric=100304 guile_version=`$guile_config --version 2>&1 | awk '{print $NF}'` @@ -2885,7 +2936,7 @@ else {last =0}} ## The GUILE_FLAGS macro. echo $ac_n "checking for Guile""... $ac_c" 1>&6 -echo "configure:2889: checking for Guile" >&5 +echo "configure:2940: checking for Guile" >&5 if ! $guile_config link > /dev/null ; then echo "$ac_t"""cannot execute $guile_config"" 1>&6 { echo "configure: error: "cannot find guile-config; is Guile installed?"" 1>&2; exit 1; } @@ -2900,7 +2951,7 @@ echo "configure:2889: checking for Guile" >&5 # Extract the first word of "guile", so it can be a program name with args. set dummy guile; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2904: checking for $ac_word" >&5 +echo "configure:2955: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_path_GUILE'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -2961,17 +3012,17 @@ fi do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:2965: checking for $ac_hdr" >&5 +echo "configure:3016: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2975: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:3026: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -2998,7 +3049,7 @@ fi done echo $ac_n "checking for kpse_find_file in -lkpathsea""... $ac_c" 1>&6 -echo "configure:3002: checking for kpse_find_file in -lkpathsea" >&5 +echo "configure:3053: checking for kpse_find_file in -lkpathsea" >&5 ac_lib_var=`echo kpathsea'_'kpse_find_file | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -3006,7 +3057,7 @@ else ac_save_LIBS="$LIBS" LIBS="-lkpathsea $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3075: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -3050,12 +3101,12 @@ fi for ac_func in kpse_find_file do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:3054: checking for $ac_func" >&5 +echo "configure:3105: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3136: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -3108,7 +3159,7 @@ done fi echo $ac_n "checking whether to use kpathsea""... $ac_c" 1>&6 -echo "configure:3112: checking whether to use kpathsea" >&5 +echo "configure:3163: checking whether to use kpathsea" >&5 if test "$kpathsea_b" != no; then echo "$ac_t""yes" 1>&6 KPATHSEA=1 @@ -3129,7 +3180,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:3133: checking for $ac_word" >&5 +echo "configure:3184: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_BIBTEX2HTML'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -3180,7 +3231,7 @@ fi echo $ac_n "checking for 8-bit clean memcmp""... $ac_c" 1>&6 -echo "configure:3184: checking for 8-bit clean memcmp" >&5 +echo "configure:3235: checking for 8-bit clean memcmp" >&5 if eval "test \"`echo '$''{'ac_cv_func_memcmp_clean'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -3188,11 +3239,8 @@ else ac_cv_func_memcmp_clean=no else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:3253: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then ac_cv_func_memcmp_clean=yes else @@ -3219,12 +3267,12 @@ echo "$ac_t""$ac_cv_func_memcmp_clean" 1>&6 test $ac_cv_func_memcmp_clean = no && LIBOBJS="$LIBOBJS memcmp.${ac_objext}" echo $ac_n "checking for vprintf""... $ac_c" 1>&6 -echo "configure:3223: checking for vprintf" >&5 +echo "configure:3271: checking for vprintf" >&5 if eval "test \"`echo '$''{'ac_cv_func_vprintf'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3302: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_vprintf=yes" else @@ -3274,12 +3322,12 @@ fi if test "$ac_cv_func_vprintf" != yes; then echo $ac_n "checking for _doprnt""... $ac_c" 1>&6 -echo "configure:3278: checking for _doprnt" >&5 +echo "configure:3326: checking for _doprnt" >&5 if eval "test \"`echo '$''{'ac_cv_func__doprnt'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3357: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func__doprnt=yes" else @@ -3332,12 +3380,12 @@ fi for ac_func in memmem snprintf vsnprintf gettext isinf do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:3336: checking for $ac_func" >&5 +echo "configure:3384: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3415: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -3403,7 +3451,7 @@ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:3407: checking for $ac_word" >&5 +echo "configure:3455: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_MAKEINFO'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -3435,7 +3483,7 @@ test -n "$MAKEINFO" || MAKEINFO="error" if test "$MAKEINFO" != "error"; then echo $ac_n "checking whether makeinfo can split html by @node""... $ac_c" 1>&6 -echo "configure:3439: checking whether makeinfo can split html by @node" >&5 +echo "configure:3487: checking whether makeinfo can split html by @node" >&5 mkdir -p out makeinfo --html --output=out/split <&6 -echo "configure:3467: checking for $ac_word" >&5 +echo "configure:3515: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_path_PERL'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -3501,17 +3549,17 @@ for ac_hdr in python2.1/Python.h python2.0/Python.h python2/Python.h python/Pyth do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:3505: checking for $ac_hdr" >&5 +echo "configure:3553: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3515: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:3563: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* diff --git a/input/bugs/RondoAllaTurca.ly b/input/bugs/RondoAllaTurca.ly deleted file mode 100644 index 2e0299e49d..0000000000 --- a/input/bugs/RondoAllaTurca.ly +++ /dev/null @@ -1,225 +0,0 @@ -\include "paper20.ly" -\version "1.4.7" -\header { - title = "Rondo Alla Turca" - subtitle = "Turkish March" - composer = "W. A. Mozart" - piece = "\\quad \\quad \\quad \\quad \\quad Allegretto" - mutopiatitle = "Rondo Alla Turca" - mutopiacomposer = "W. A. Mozart (1756-1791)" - mutopiainstrument = "Piano" - style = "classical" - copyright = "Public Domain" - maintainer = "Rune Zedeler" - maintainerEmail = "rz@daimi.au.dk" - lastupdated = "2001/sep/15" - tagline = "\\parbox{\hsize}{\\thefooter\\quad\\small \\\\This music is part of the Mutopia project, \\texttt{http://www.mutopiaproject.org/}\\\\It has been typeset and placed in the public domain by " + \maintainer + " (" + \maintainerEmail + ").\\\\Unrestricted modification and redistribution is permitted and encouraged---copy this music and share it!}" -} - -volta = "volta" - -\include "deutsch.ly"; - -#(define (remove-scripts music) - (let* ((es (ly-get-mus-property music 'elements)) - (e (ly-get-mus-property music 'element)) - (body (ly-get-mus-property music 'body)) - (alts (ly-get-mus-property music 'alternatives))) - - (if (pair? es) - (begin - (ly-set-mus-property - music 'elements - (map (lambda (x) (remove-scripts x)) es)) - (let recurse ((elts (ly-get-mus-property music 'elements))) - (if (and (pair? elts) (pair? (cdr elts))) - (let ((name (ly-music-name (cadr elts)))) - (if (or (equal? name "Articulation_req") (equal? name "Text_script_req")) - (begin - (set-cdr! elts (cddr elts)) - (recurse elts)) - (recurse (cdr elts)))))))) - - (if (music? alts) - (ly-set-mus-property - music 'alternatives - (remove-scripts alts))) - - (if (music? body) - (ly-set-mus-property - music 'body - (remove-scripts body))) - - (if (music? e) - (ly-set-mus-property - music 'element - (remove-scripts e))) - music)) - -righta = \notes \transpose c''' { - \scriptUp - \property Staff.Fingering \override #'direction = #1 - \partial 4 h,16-4-\p( a, gis, a,-1 | )c8-3 r d16-4( c h, c-1 | )e8-3 r f16-4( e dis e-1 | h-4 a gis a h a gis a | )c'4-\accent - a8-.-3 c'-.-5 | \grace {[g!32( )a]} h8-.-5-\sfz | \grace {[g32( )a]} h8-.-\sfz | \grace {[g32( )a]} h8-.-\sfz e4-- -} -rightaa = \notes \transpose c''' { - \partial 4 h,16-4-\p( a, gis, a,-1 | )c8-3 r d16-4( c h, c-1 | )e8-3 r f16-4( e dis e-1 | h-4 a gis a h \< a gis a | \! )c'4-\accent - a8-.-3 h-. | c'-.-\accent \> h-. a-.-1 \! gis-.-2 a-. e-. f-.-4 d-.-2 | c4-- h,8.-2-\trill( a,32 h, | )a,4-- -} - -rightb = \notes \transpose c''' { - [ ] | a16-4( g f )e | \stemUp \stemBoth - | a16-4( g f )e | - | f16-4( e d )c | \stemUp \stemBoth - | f16( e d )c | -} - -rightca = \notes \context Voice = voicea \relative c''' { a8-.-\f h-. | cis4-\accent a8-. h-. cis-.-\accent h-. a-. gis-. | fis-. gis-. a-. h-. gis-4( )e-. -a8-. h-. | cis4-\accent a8-. h cis-.-\accent h-. a-. gis-. | fis-. h-. gis-. e-. a4 -} -rightc = \notes < \apply #remove-scripts \rightca \transpose c \rightca > -rightco = \notes \relative c'' -{ \stemDown - a16-\f( a' h, h' | cis,-\accent )cis' r8 a,16( a' h, h' cis, cis' h, h' a, a' gis, )gis' | fis,( fis' gis, gis' a, a' h, h' gis, gis' e, )e' - a,16( a' h, h' | cis,-\accent )cis' r8 a,16( a' h, h' cis, cis' h, h' a, a' gis, )gis' | fis,( fis' h, h' gis, gis' e, e' -} -rightcoa = \notes \context Voice < )a'4 a'' > - -rightd = \notes \relative c''' { - cis16-3-\p( d cis h a h a gis-3 fis-2 a gis fis | eis fis gis eis cis-2 dis eis cis-1 | fis-4 eis-1 fis gis a gis a-1 h | cis his cis his - cis d cis )h | a( h a gis-3 fis a gis fis | e fis gis e cis-2 dis e cis | dis-3 e fis dis his-1 cis dis his | )cis4 -} -righte = \notes \relative c''' { - e,16-5(-\f d! cis h! | a h cis d-1 e fis gis a | )a-\accent-4( gis fis )e e-5( d cis h | )a-1( h cis d-1 e fis gis a ais8-\accent-3 )h-.-4 - e,16-5( d cis h | a h cis d-1 e fis gis a | )a-\accent-4( gis fis )e e-5( d cis h | cis-3 e a,-1 cis-4 h d gis,-2 h | )a4-- - cis'16-3-\p( d cis h a h a gis-3 fis-2 a gis fis | eis fis gis eis cis-2 dis eis )cis-1 | fis-4( \< eis-1 fis gis a gis a-1 \! h | cis his cis his - cis his cis ais-2 | )d-4( \> cis d cis d cis d cis | d cis h a gis-2 a h \! gis | a-\p h cis fis,-2 eis fis gis eis )fis4-- -} - -strum = \notes \transpose c' { < - \context Voice = strumUp {\stemUp cis'2-\arpeggio-\accent} - \context Voice = strumDown {\stemDown < cis4-\arpeggio e a> } -> -\stemBoth -} - -rightf = \notes \transpose c''' { - < {\stemUp cis'8. cis'16} \context Voice = another {\stemDown cis4} > - \strum \strum d'16-4( )cis'-. h-. cis'-. d'( )cis'-. h-. cis' - \repeat unfold 4 { \grace{d'8( } < )cis'8-. a e> } | < {\stemUp \slurUp h4.-3()e'8-. \stemBoth} \context Voice = another > - \strum \strum d'16-4( )cis'-. h-. cis'-. d'( )cis'-. h-. cis' \grace{d'8( } < )cis'2-. a e> - \repeat unfold 4 { \grace{cis'8( } < )h8-. gis e> } - - a4-\p-- \grace {[e32()a]} cis'8.-.-4 cis'16 \repeat unfold 2 { \grace {[e32()a]} cis'2-\accent } | - d'16-4( )cis'-. h-. cis'-. d'( )cis'-. h-. cis' | d'2-\accent | \repeat unfold 4 { \grace{d'8( } ) cis'8-. } h4.-2()e'8-. - <\strum s2-\f> \strum d'16-4( )cis'-. h-. cis'-. d'( )cis'-. h-. cis' \grace{d'8( } < )cis'2-. a e> - \repeat unfold 4 { \grace{cis'8( } < )h8-. gis e> } - - <) a,4-. cis e a-. > r4 -} - - -lefta = \notes { - \partial 4 r4 | a8-5( <)c' e'-.> | a8( <)c' e'-.> | a8-. a8-. | a8( <)c' e'-.> | - e-. | e-. | e-. h, h | e4-- -} -leftaa = \notes { \partial 4 - r4 | a8-5( <)c' e'-.> | a8( <)c' e'-.> | a8-. a8-. | f8( <)a dis'-.> | - e-. d!-. c-. d-. -} -leftb = \notes { \partial 4 - \repeat unfold 2 {r4 | c8-. c'-. e-. e'-. | g4 } - \repeat unfold 2 {r4 | a,8-. a-. c-. c'-. | e4 } -} - -stra = \notes { \grace {[a,32( cis )e]} a8-. a-. } -strd = \notes { \grace {[d,32( fis, )a,]} d8-. d-. } -strdis = \notes { \grace {[dis,32( fis, )a,]} dis8-. dis-. } -stre = \notes { \grace {[e,32( gis, )h,]} e8-. e-. } -stral = \notes { \stra a8-. a-. } -strdl = \notes { \strd d8-. d-. } -strel = \notes { \stre e8-. e-. } - -leftc = \notes { \partial 4 - r4 \stral \stral \strd \strdis \strel \stral \stral \strd \stre -} - -leftd = \notes \relative c { \partial 4 - r4 | fis8-5( <)a cis-.> | - gis8-4( <)h cis-.> | - fis8( <)a cis-.> | - eis8( <)gis cis-.> | - fis8( <)a cis-.> | - gis8( <)cis e-.> | - gis8( <)dis' fis-.> | - -} - -lefte = \notes \relative c' { \partial 4 - r4 | a8( <)cis e-.> | - h-. gis,-. | - a8( <)cis e-.> | - e,8( <)gis d'-.> | - a8( <)cis e-.> | - h-. gis,-. | - a-. fis-. d-. e-. a,-. a'-. r4 | - - fis8( <)a cis-.> | - gis8( <)h cis-.> | - fis8( <)a cis-.> | - cis,( <)gis' cis-.> | - h,8( <)fis' h-.> | - h,8( <)gis'! h-.> | - cis,-. cis-. -} - -leftf = \notes { - a8-. a8-. \stral \stral \stral \strdl \stral \strel \stral \stral \stral \strdl \stral \strel - a16( e' cis' e' a e' cis' )e' \repeat unfold 6 { a16 e' cis' e' } \repeat unfold 2 { a16 fis' d' fis' } \repeat unfold 2 { a16 e' cis' e' } \repeat unfold 2 { e16 e' gis e' } - \stral \stral \stral \strdl \stral \strel \stral \stral \stral \stra \stra a,4-. < )a, cis e a-. > r4 -} - -global = \notes {\time 2/4 } - -right = \notes { - \global \clef G \repeat \volta 2 \righta \repeat \volta 2 {\rightb \rightaa } \key a \major \repeat \volta 2 \rightc - \repeat \volta 2 \rightd \repeat \volta 2 \righte \repeat \volta 2 \rightc - \key a \minor \repeat \volta 2 \righta \repeat \volta 2 {\rightb \rightaa } \key a \major \repeat \volta 2 \rightco \alternative { \rightcoa {\partial 4 \rightcoa } } - \rightf \bar "|." -} - -left = \notes { - \global \clef F \repeat \volta 2 \lefta \repeat \volta 2 { \leftb \leftaa } \key a \major \repeat \volta 2 { \leftc a,4 } - \repeat \volta 2 \leftd \repeat \volta 2 \lefte \repeat \volta 2 { \leftc a,4 } - \key a \minor \repeat \volta 2 \lefta \repeat \volta 2 { \leftb \leftaa } \key a \major \repeat \volta 2 \leftc \alternative { a,4 {\partial 2 \stra} } - \leftf \bar "|." -} - - -\score { \notes - \context GrandStaff < - \property GrandStaff.connectArpeggios = ##t - \context Staff = up { - \right - } - \context Staff = down { - \property Staff.VoltaBracket = \turnOff - \left - } - > - \paper { - \translator { - \GraceContext - Slur \override #'direction = #-1 - } - \translator { - \ScoreContext - SpacingSpanner \override #'arithmetic-basicspace = #1.8 - GraceAlignment \override #'horizontal-space = #-0.4 - PaperColumn \override #'before-grace-spacing-factor = #1.0 - - } - interscoreline = 6.0 \pt - - } -} diff --git a/input/bugs/clefsp.ly b/input/bugs/clefsp.ly new file mode 100644 index 0000000000..91f8fe49f6 --- /dev/null +++ b/input/bugs/clefsp.ly @@ -0,0 +1,20 @@ + + + +\score{< + \notes \relative c'' \context Staff=violin{ + \time 3/4 +s2. + \grace a b4 + } + \notes \relative c'' \context Staff=violoncello{ + \time 3/4 + \clef tenor +s2. \clef bass b4 + } +> +\paper{ + linewidth=-1 +} +} + diff --git a/input/test/sketch.ly b/input/test/sketch.ly index 22594c583e..fefc6d0f34 100644 --- a/input/test/sketch.ly +++ b/input/test/sketch.ly @@ -3,10 +3,11 @@ texidoc="sketch output supported features" } \score { \notes\relative c''' { - a4( a a a )a + + \time 3/4 a4( a a a )a \stemDown a,8( b c )d \stemUp \slurDown d16( c b )a } -} \ No newline at end of file +} diff --git a/lily/global-ctor.cc b/lily/global-ctor.cc index 5fa1db034d..27ab068d09 100644 --- a/lily/global-ctor.cc +++ b/lily/global-ctor.cc @@ -23,5 +23,5 @@ void call_constructors () { for (int i=0; i < ctor_global_static_arr_p_->size (); i++) - (ctor_global_static_arr_p_->elem (i)) (); + (ctor_global_static_arr_p_->elem (i)) (); } diff --git a/lily/gourlay-breaking.cc b/lily/gourlay-breaking.cc index 78e5c2fa04..86914fcd0e 100644 --- a/lily/gourlay-breaking.cc +++ b/lily/gourlay-breaking.cc @@ -59,16 +59,12 @@ Gourlay_breaking::do_solve () const Array breaks = find_break_indices (); - optimal_paths.set_size (breaks.size ()); - Break_node first_node ; - - optimal_paths[0] = first_node; - int break_idx=1; + optimal_paths.push (first_node); Real worst_force = 0.0; - for (; break_idx< breaks.size (); break_idx++) + for ( int break_idx=1; break_idx< breaks.size (); break_idx++) { /* start with a short line, add measures. At some point @@ -96,24 +92,15 @@ Gourlay_breaking::do_solve () const sp->solve (&cp); delete sp; - if (cp.force_f_ > worst_force) - worst_force = cp.force_f_; + if (fabs (cp.force_f_) > worst_force) + worst_force = fabs (cp.force_f_); /* We remember this solution as a "should always work solution", in case everything fucks up. */ if (start_idx == break_idx - 1) backup_sol = cp; - if (!cp.satisfies_constraints_b_) - { - /* - If it doesn't satisfy constraints, we make this one - really unattractive. - */ - cp.force_f_ += worst_force; - cp.force_f_ *= 10; - } - + Real this_demerits; if (optimal_paths[start_idx].demerits_f_ >= infinity_f) @@ -137,28 +124,30 @@ Gourlay_breaking::do_solve () const break ; } - int prev =break_idx - 1; + + Break_node bnod; if (minimal_start_idx < 0) { - optimal_paths[break_idx].demerits_f_ = infinity_f; - optimal_paths[break_idx].line_config_ = backup_sol; + bnod.demerits_f_ = infinity_f; + bnod.line_config_ = backup_sol; + bnod.prev_break_i_ = break_idx - 1; } else { - prev = minimal_start_idx; - optimal_paths[break_idx].line_config_ = minimal_sol; - optimal_paths[break_idx].demerits_f_ = minimal_demerits; + bnod.prev_break_i_ = minimal_start_idx; + bnod.demerits_f_ = minimal_demerits; + bnod.line_config_ = minimal_sol; } - optimal_paths[break_idx].prev_break_i_ = prev; - optimal_paths[break_idx].line_i_ = optimal_paths[prev].line_i_ + 1; - + bnod.line_i_ = optimal_paths[bnod.prev_break_i_].line_i_ + 1; + optimal_paths.push (bnod); + if (! (break_idx % HAPPY_DOTS_I)) progress_indication (String ("[") + to_str (break_idx) + "]"); } /* do the last one */ - if (break_idx % HAPPY_DOTS_I) - progress_indication (String ("[") + to_str (break_idx) + "]"); + if (breaks.size () % HAPPY_DOTS_I) + progress_indication (String ("[") + to_str (breaks.size()) + "]"); progress_indication ("\n"); @@ -214,7 +203,20 @@ Gourlay_breaking::combine_demerits (Column_x_positions const &prev, } } - return abs (this_one.force_f_) + abs (prev.force_f_ - this_one.force_f_) + Real demerit = abs (this_one.force_f_) + abs (prev.force_f_ - this_one.force_f_) + break_penalties; + + + if (!this_one.satisfies_constraints_b_) + { + /* + If it doesn't satisfy constraints, we make this one + really unattractive. + */ + demerit += 10; + demerit *= 100; + } + + return demerit; } diff --git a/lily/include/lily-guile.hh b/lily/include/lily-guile.hh index e67293e06f..e2a74c779f 100644 --- a/lily/include/lily-guile.hh +++ b/lily/include/lily-guile.hh @@ -91,6 +91,12 @@ SCM ly_truncate_list (int k, SCM l ); #define CACHE_SYMBOLS #ifdef CACHE_SYMBOLS + +/* + We don't use gh_symbol2scm directly, since it has const-correctness + problems in GUILE 1.3.4 + + */ SCM my_gh_symbol2scm (const char* x); // #warning: CACHE_SYMBOLS @@ -108,12 +114,12 @@ SCM my_gh_symbol2scm (const char* x); SCM value = cached; /* We store this one locally, since G++ -O2 fucks up else */ \ if ( __builtin_constant_p ((x)))\ { if (!cached)\ - value = cached = scm_gc_protect_object (my_gh_symbol2scm((char*) (x)));\ + value = cached = scm_gc_protect_object (my_gh_symbol2scm((x)));\ } else\ value = gh_symbol2scm ((char*) (x)); \ value; }) #else -inline SCM ly_symbol2scm(char const* x) { return gh_symbol2scm((char*)x); } +inline SCM ly_symbol2scm(char const* x) { return gh_symbol2scm((x)); } #endif diff --git a/lily/include/paper-outputter.hh b/lily/include/paper-outputter.hh index 48d78a529a..97f8fc2cab 100644 --- a/lily/include/paper-outputter.hh +++ b/lily/include/paper-outputter.hh @@ -27,8 +27,13 @@ class Paper_outputter { bool verbatim_scheme_b_; - Paper_stream * stream_p_; + + public: + + SCM output_func_ ; + Protected_scm file_; + String basename_; Paper_outputter (String nm); ~Paper_outputter (); @@ -47,7 +52,7 @@ public: void output_string (SCM s); void output_scheme (SCM scm); - static void write_header_field_to_file (String filename, String key, String value); + void write_header_field_to_file (String filename, SCM, SCM); void write_header_fields_to_file (Scope *); }; diff --git a/lily/include/paper-stream.hh b/lily/include/paper-stream.hh deleted file mode 100644 index 0864b408dd..0000000000 --- a/lily/include/paper-stream.hh +++ /dev/null @@ -1,46 +0,0 @@ -#ifndef PAPER_STREAM_HH -#define PAPER_STREAM_HH - -#include "string.hh" - -/** Paper output - Baseclass for writing to a PostScript or TeX file. - It counts braces to prevent nesting errors, and - it will add a comment sign before each newline. - */ - -class Paper_stream -{ -public: - String basename_; - bool outputting_comment_b_; - ostream *os_; - int nest_level; - /// to check linelen in output. TeX has limits. - int line_len_i_; - - /// open a file for writing - Paper_stream (String filename); - - /// delegate conversion to scalar class - Paper_stream &operator << (String); - - /// close the file - ~Paper_stream (); - -private: - Paper_stream (Paper_stream const&); - void break_line (); -}; - -#include /* gcc 3.0 */ -#if __GNUC__ > 2 -ostream *open_file_stream (String filename, - std::ios_base::openmode mode=std::ios::out); -#else -ostream *open_file_stream (String filename, int mode=ios::out); -#endif -void close_file_stream (ostream *os); - - -#endif // PAPER_STREAM_HH diff --git a/lily/include/stream.hh b/lily/include/stream.hh new file mode 100644 index 0000000000..ad747a0760 --- /dev/null +++ b/lily/include/stream.hh @@ -0,0 +1,28 @@ +/* +stream.hh -- declare compatibility glue for gcc 3. + +source file of the GNU LilyPond music typesetter + +(c) 2001 Han-Wen Nienhuys + + */ + +#ifndef STREAM_HH +#define STREAM_HH +#include "string.hh" + + +#include /* gcc 3.0 */ +#if __GNUC__ > 2 +ostream *open_file_stream (String filename, + std::ios_base::openmode mode=std::ios::out); +#else +ostream *open_file_stream (String filename, int mode=ios::out); +#endif +void close_file_stream (ostream *os); + + + + +#endif /* STREAM_HH */ + diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc index ccca4cee06..4446fdda1d 100644 --- a/lily/lily-guile.cc +++ b/lily/lily-guile.cc @@ -245,14 +245,23 @@ void add_scm_init_func (void (*f) ()) scm_init_funcs_->push (f); } + extern void init_cxx_function_smobs (); void init_lily_guile () { + SCM last_mod = scm_current_module (); + scm_set_current_module (scm_c_resolve_module ("guile")); + init_cxx_function_smobs (); for (int i=scm_init_funcs_->size () ; i--;) - (scm_init_funcs_->elem (i)) (); + (scm_init_funcs_->elem (i)) (); + + if (verbose_global_b) + progress_indication ("\n"); + read_lily_scm_file ("lily.scm"); + scm_set_current_module (last_mod); } unsigned int ly_scm_hash (SCM s) @@ -545,5 +554,5 @@ ly_truncate_list (int k, SCM l ) SCM my_gh_symbol2scm (const char* x) { - return gh_symbol2scm (x); + return gh_symbol2scm ((char*)x); } diff --git a/lily/line-of-score.cc b/lily/line-of-score.cc index e82b544481..464cd4e6ab 100644 --- a/lily/line-of-score.cc +++ b/lily/line-of-score.cc @@ -114,10 +114,14 @@ Line_of_score::output_lines () { SCM lastcol = ly_car (line_l->get_grob_property ("columns")); Grob* e = unsmob_grob (lastcol); - SCM inter = e->get_grob_property ("between-system-string"); + + SCM between = ly_symbol2scm ("between-system-string"); + SCM inter = e->internal_get_grob_property (between); if (gh_string_p (inter)) { - pscore_l_->outputter_l_->output_string (inter); + pscore_l_->outputter_l_ + ->output_scheme (scm_list_n (between, + inter, SCM_UNDEFINED)); } } } @@ -371,8 +375,8 @@ Line_of_score::post_processing (bool last_line) */ SCM font_names = ly_quote_scm (paper_l ()->font_descriptions ()); output_scheme (scm_list_n (ly_symbol2scm ("define-fonts"), - font_names, - SCM_UNDEFINED)); + font_names, + SCM_UNDEFINED)); /* line preamble. diff --git a/lily/main.cc b/lily/main.cc index 50725df2cb..f4ccf040d0 100644 --- a/lily/main.cc +++ b/lily/main.cc @@ -10,6 +10,7 @@ #include #include #include +#include #include "config.h" @@ -211,12 +212,14 @@ notice () "USA.\n"); } +String prefix_directory; + void setup_paths () { // facilitate binary distributions char const *env_lily = getenv ("LILYPONDPREFIX"); - String prefix_directory; + if (env_lily) prefix_directory = env_lily; @@ -266,6 +269,21 @@ setup_paths () i++; #endif } + + char const * glp = getenv ("GUILE_LOAD_PATH"); + + String new_glp (glp? glp : "") ; + if (glp) + new_glp = ":" + new_glp; + new_glp = prefix_directory + new_glp; + + /* + Yes , so setenv is not posix. + + I say, fuckem'all. + */ + + setenv ("GUILE_LOAD_PATH", new_glp.ch_C(), 1); } /** @@ -309,15 +327,12 @@ format_to_ext (String format) } void -main_prog (void * closure, int, char**) +main_prog (void * , int, char**) { /* need to do this first. Engravers use lily.scm contents. */ init_lily_guile (); - if (verbose_global_b) - progress_indication ("\n"); - read_lily_scm_file ("lily.scm"); cout << endl; call_constructors (); diff --git a/lily/midi-def.cc b/lily/midi-def.cc index 40a2d065b3..a0599d107f 100644 --- a/lily/midi-def.cc +++ b/lily/midi-def.cc @@ -22,8 +22,20 @@ Midi_def::Midi_def () int Midi_def::get_tempo_i (Moment one_beat_mom) { - Moment w = *unsmob_moment (scope_p_->scm_elem ("whole-in-seconds")); - Moment wholes_per_min = Moment (60) /w; + SCM wis = ly_symbol2scm ("whole-in-seconds"); + Moment *w = unsmob_moment (scope_p_->scm_elem (wis)); + + Moment wholes_per_min = Moment (60); + if (!w) + { + programming_error ("wholes-in-seconds not set."); + wholes_per_min /= 4; + } + else + { + wholes_per_min /= *w; + } + int beats_per_min = int ((wholes_per_min / one_beat_mom).main_part_); return int (beats_per_min); } diff --git a/lily/midi-stream.cc b/lily/midi-stream.cc index b353f92dc7..9b3365753c 100644 --- a/lily/midi-stream.cc +++ b/lily/midi-stream.cc @@ -6,8 +6,8 @@ (c) 1997--2001 Jan Nieuwenhuizen */ -#include -#include "paper-stream.hh" + +#include "stream.hh" #include "string.hh" #include "string-convert.hh" #include "main.hh" diff --git a/lily/paper-outputter.cc b/lily/paper-outputter.cc index 4c1f865fd2..abfed82563 100644 --- a/lily/paper-outputter.cc +++ b/lily/paper-outputter.cc @@ -8,14 +8,13 @@ */ #include -#include + #include -#include + #include "dimensions.hh" #include "virtual-methods.hh" #include "paper-outputter.hh" -#include "paper-stream.hh" #include "molecule.hh" #include "array.hh" #include "string-convert.hh" @@ -32,56 +31,32 @@ /* Ugh, this is messy. */ - Paper_outputter::Paper_outputter (String name) { - stream_p_ = new Paper_stream (name); - - /* - lilypond -f scm x.ly - guile -s x.scm - */ - verbatim_scheme_b_ = output_format_global == "scm"; - - if (verbatim_scheme_b_) + if (safe_global_b) { - *stream_p_ << "" - ";;; Usage: guile -s x.scm > x.tex\n" - " (primitive-load-path 'standalone.scm)\n" - "; (scm-tex-output)\n" - " (scm-ps-output)\n" - " (map (lambda (x) (display (ly-eval x))) ' (\n" - ; + gh_define ("security-paranoia", SCM_BOOL_T); } + + file_ = scm_open_file (ly_str02scm (name.ch_C()), + ly_str02scm ("w")); + + SCM exp = scm_list_n (ly_symbol2scm ("find-dumper"), + ly_str02scm (output_format_global.ch_C()), + SCM_UNDEFINED); + output_func_ = scm_primitive_eval (exp); } Paper_outputter::~Paper_outputter () { - if (verbatim_scheme_b_) - { - *stream_p_ << "))"; - } - delete stream_p_; + } void Paper_outputter::output_header () { - if (safe_global_b) - { - gh_define ("security-paranoia", SCM_BOOL_T); - } - - SCM exp = scm_list_n (ly_symbol2scm ((output_format_global + "-scm").ch_C ()), - ly_quote_scm (ly_symbol2scm ("all-definitions")), - SCM_UNDEFINED); - exp = scm_primitive_eval (exp); - scm_primitive_eval (exp); - - String creator = gnu_lilypond_version_str (); - String generate = _ (", at "); time_t t (time (0)); generate += ctime (&t); @@ -91,13 +66,14 @@ Paper_outputter::output_header () Make fixed length time stamps */ generate = generate + to_str (' ' * (120 - generate.length_i ())>? 0) ; + String creator = "lelie"; - SCM args_scm = - scm_list_n (ly_str02scm (creator.ch_l ()), - ly_str02scm (generate.ch_l ()), SCM_UNDEFINED); + SCM args_scm = scm_list_n (ly_str02scm (creator.ch_C ()), + ly_str02scm (generate.ch_C ()), SCM_UNDEFINED); SCM scm = gh_cons (ly_symbol2scm ("header"), args_scm); + output_scheme (scm); } @@ -112,49 +88,10 @@ Paper_outputter::output_comment (String str) ); } - void Paper_outputter::output_scheme (SCM scm) { - /* - we don't rename dump_scheme, because we might in the future want - to remember Scheme. We don't now, because it sucks up a lot of memory. - */ - dump_scheme (scm); -} - -void flatten_write (SCM x, Paper_stream*ps) -{ - if (ly_pair_p (x)) - { - flatten_write (ly_car (x),ps); - flatten_write (ly_cdr (x),ps); - } - else if (gh_string_p (x)) - { - *ps << String ( SCM_STRING_CHARS(x)) ; - } -} - - -/* - UGH. - - Should probably change interface to do less eval (symbol), and more - apply (procedure, args) - */ -void -Paper_outputter::dump_scheme (SCM s) -{ - if (verbatim_scheme_b_) - { - *stream_p_ << ly_scm2string (ly_write2scm (s)); - } - else - { - SCM result = scm_primitive_eval (s); - flatten_write (result, stream_p_); - } + scm_apply_2 (output_func_, scm, file_, SCM_EOL); } void @@ -166,7 +103,6 @@ Paper_outputter::output_scope (Scope *scope, String prefix) SCM k = ly_caar (s); SCM v = ly_cdar (s); String s = ly_symbol2string (k); - if (gh_string_p (v)) { @@ -229,24 +165,12 @@ Paper_outputter::output_int_def (String k, int v) } void -Paper_outputter::output_string (SCM str) -{ - *stream_p_ << ly_scm2string (str); -} - -void -Paper_outputter::write_header_field_to_file (String filename, String key, String value) +Paper_outputter::write_header_field_to_file (String filename, SCM key, SCM value) { - if (filename != "-") - filename += String (".") + key; - progress_indication (_f ("writing header field `%s' to `%s'...", - key, - filename == "-" ? String ("") : filename)); - - ostream *os = open_file_stream (filename); - *os << value; - close_file_stream (os); - progress_indication ("\n"); + output_scheme (scm_list_n (ly_symbol2scm ("header-to-file"), + ly_str02scm (filename.ch_C()), + ly_quote_scm (key), value, + SCM_UNDEFINED)); } void @@ -265,7 +189,7 @@ Paper_outputter::write_header_fields_to_file (Scope * header) { s = ly_scm2string (ly_cdr (val)); /* Always write header field file, even if string is empty ... */ - write_header_field_to_file (basename_, key, s); + write_header_field_to_file (basename_ , ly_car (val), ly_cdr (val)); } } } diff --git a/lily/paper-score.cc b/lily/paper-score.cc index 5605668c1c..73a3c2ee16 100644 --- a/lily/paper-score.cc +++ b/lily/paper-score.cc @@ -17,7 +17,6 @@ #include "paper-column.hh" #include "scope.hh" #include "gourlay-breaking.hh" -#include "paper-stream.hh" #include "paper-outputter.hh" #include "file-results.hh" #include "misc.hh" diff --git a/lily/paper-stream.cc b/lily/paper-stream.cc deleted file mode 100644 index d2bbeb3f9c..0000000000 --- a/lily/paper-stream.cc +++ /dev/null @@ -1,149 +0,0 @@ -/* - paper-stream.cc -- implement Paper_stream - - source file of the GNU LilyPond music typesetter - - (c) 1997--2001 Han-Wen Nienhuys -*/ - -#include -#include -#include - -#include "config.h" -#if HAVE_SYS_STAT_H -#include -#endif - -#include "main.hh" -#include "paper-stream.hh" -#include "file-path.hh" -#include "debug.hh" - -const int MAXLINELEN = 200; - -#if __GNUC__ > 2 -ostream * -open_file_stream (String filename, std::ios_base::openmode mode) -#else -ostream * -open_file_stream (String filename, int mode) -#endif -{ - ostream *os; - if ((filename == "-")) - os = &cout; - else - { - Path p = split_path (filename); - if (!p.dir.empty_b ()) - if (mkdir (p.dir.ch_C (), 0777) == -1 && errno != EEXIST) - error (_f ("can't create directory: `%s'", p.dir)); - os = new ofstream (filename.ch_C (), mode); - } - if (!*os) - error (_f ("can't open file: `%s'", filename)); - return os; -} - -void -close_file_stream (ostream *os) -{ - *os << flush; - if (!*os) - { - warning (_ ("Error syncing file (disk full?)")); - exit_status_global = 1; - } - if (os != &cout) - delete os; - os = 0; -} - -Paper_stream::Paper_stream (String filename) -{ - os_ = open_file_stream (filename); - nest_level = 0; - line_len_i_ = 0; - outputting_comment_b_=false; -} - -Paper_stream::~Paper_stream () -{ - close_file_stream (os_); - if (nest_level != 0) - programming_error ("Brace nesting in paper output doesn't match"); -} - -// print string. don't forget indent. -Paper_stream& -Paper_stream::operator << (String s) -{ - for (char const *cp = s.ch_C (); *cp; cp++) - { - if (outputting_comment_b_) - { - *os_ << *cp; - if (*cp == '\n') - { - outputting_comment_b_=false; - line_len_i_ =0; - } - continue; - } - line_len_i_ ++; - switch (*cp) - { - case '%': - outputting_comment_b_ = true; - *os_ << *cp; - break; - case '{': - nest_level++; - *os_ << *cp; - break; - case '}': - nest_level--; - *os_ << *cp; - - if (nest_level < 0) - { - delete os_; // we want to see the remains. - assert (nest_level>=0); - } - - /* don't break line if not nested; very ugly for ps */ - if (nest_level == 0) - break; - - *os_ << '%'; - break_line (); - break; - case '\n': - break_line (); - break; - case ' ': - *os_ << ' '; - if (line_len_i_ > MAXLINELEN) - break_line (); - - break; - default: - *os_ << *cp; - break; - } - } - //urg, for debugging only!! - *os_ << flush; - return *this; -} - -void -Paper_stream::break_line () -{ - *os_ << '\n'; - *os_ << to_str (' ', nest_level); - outputting_comment_b_ = false; - line_len_i_ = 0; -} - diff --git a/lily/repeat-acknowledge-engraver.cc b/lily/repeat-acknowledge-engraver.cc index 24f8d723d4..4f75dade55 100644 --- a/lily/repeat-acknowledge-engraver.cc +++ b/lily/repeat-acknowledge-engraver.cc @@ -92,15 +92,24 @@ Repeat_acknowledge_engraver::process_music () s = ":|"; /* - TODO: line breaks might be allowed if we set whichBar to "". + TODO: line breaks might be allowed if we set whichBar to "". */ - if (s != "" || (volta_found && !gh_string_p (get_property ("whichBar")))) + + /* + We only set the barline if we wouldn't overwrite a previously set + barline. + */ + SCM wb = get_property ("whichBar"); + SCM db = get_property ("defaultBarType"); + if (!gh_string_p (wb) || gh_equal_p (db, wb)) { - daddy_trans_l_->set_property ("whichBar", ly_str02scm (s.ch_C ())); + if (s != "" || (volta_found && !gh_string_p (wb))) + { + daddy_trans_l_->set_property ("whichBar", ly_str02scm (s.ch_C ())); + } } } - ENTER_DESCRIPTION(Repeat_acknowledge_engraver, /* descr */ "Acknowledge repeated music, and convert the contents of repeatCommands ainto an appropriate setting for whichBar", diff --git a/lily/streams.cc b/lily/streams.cc new file mode 100644 index 0000000000..06a74a23cb --- /dev/null +++ b/lily/streams.cc @@ -0,0 +1,53 @@ +#include "config.h" + +#include +#include +#include +#if HAVE_SYS_STAT_H +#include +#endif +#include +#include + +#include "stream.hh" +#include "file-path.hh" +#include "warn.hh" +#include "main.hh" + +#if __GNUC__ > 2 +ostream * +open_file_stream (String filename, std::ios_base::openmode mode) +#else +ostream * +open_file_stream (String filename, int mode) +#endif +{ + ostream *os; + if ((filename == "-")) + os = &cout; + else + { + Path p = split_path (filename); + if (!p.dir.empty_b ()) + if (mkdir (p.dir.ch_C (), 0777) == -1 && errno != EEXIST) + error (_f ("can't create directory: `%s'", p.dir)); + os = new ofstream (filename.ch_C (), mode); + } + if (!*os) + error (_f ("can't open file: `%s'", filename)); + return os; +} + +void +close_file_stream (ostream *os) +{ + *os << flush; + if (!*os) + { + warning (_ ("Error syncing file (disk full?)")); + exit_status_global = 1; + } + if (os != &cout) + delete os; + os = 0; +} diff --git a/lily/unfolded-repeat-iterator.cc b/lily/unfolded-repeat-iterator.cc index 7dd93bd1dc..7e8b12fbcd 100644 --- a/lily/unfolded-repeat-iterator.cc +++ b/lily/unfolded-repeat-iterator.cc @@ -289,7 +289,7 @@ void Unfolded_repeat_iterator::add_repeat_command (SCM what) { SCM reps = ly_symbol2scm ("repeatCommands"); - SCM current_reps = report_to_l ()->get_property (reps); + SCM current_reps = report_to_l ()->internal_get_property (reps); Translator_group * where = report_to_l ()->where_defined (reps); if (where diff --git a/make/lilypond-vars.make b/make/lilypond-vars.make index be760f25ae..0eff08a3db 100644 --- a/make/lilypond-vars.make +++ b/make/lilypond-vars.make @@ -15,7 +15,12 @@ export MT_DESTROOT := $(topdir)/mf/out export DVIPSMAKEPK := mktexpk --destdir $(topdir)/mf/out endif -export LILYPONDPREFIX:=$(depth)/ +# don't change to "depth". It makes the GUILE barf. +# +# LilyPond is often run from within $(outdir), making a relative +# PREFIX incorrect. +export LILYPONDPREFIX:=$(shell cd $(depth)/ ; pwd) + export PYTHONPATH:=$(topdir)/python:$(PYTHONPATH) # guile load path? diff --git a/make/lilypond.mandrake.spec.in b/make/lilypond.mandrake.spec.in index 6765e199b9..073071203e 100644 --- a/make/lilypond.mandrake.spec.in +++ b/make/lilypond.mandrake.spec.in @@ -101,6 +101,9 @@ rm `find /var/lib/texmf -name 'feta*pk -print' -or -name 'feta*tfm -print'` /tmp %_install_info lilypond.info %_install_info lilypond-internals.info +echo 'Please logout first before using LilyPond.' + + %preun %_remove_install_info lilypond.info %_remove_install_info lilypond-internals.info diff --git a/make/lilypond.redhat.spec.in b/make/lilypond.redhat.spec.in index 7f047cda27..1489a8cc53 100644 --- a/make/lilypond.redhat.spec.in +++ b/make/lilypond.redhat.spec.in @@ -86,6 +86,9 @@ rm `find /var/lib/texmf -name 'feta*pk -print' -or -name 'feta*tfm -print'` /tmp /sbin/install-info %{_prefix}/info/lilypond.info.gz %{_prefix}/info/dir %endif + +echo 'Please logout first before using LilyPond.' + %preun %if info=="yes" diff --git a/make/out/lilypond.lsm b/make/out/lilypond.lsm index 5125d402ad..17bd53526c 100644 --- a/make/out/lilypond.lsm +++ b/make/out/lilypond.lsm @@ -1,15 +1,15 @@ Begin3 Title: LilyPond -Version: 1.5.20 -Entered-date: 29OKT01 +Version: 1.5.21 +Entered-date: 04NOV01 Description: @BLURB@ Keywords: music notation typesetting midi fonts engraving Author: hanwen@cs.uu.nl (Han-Wen Nienhuys) janneke@gnu.org (Jan Nieuwenhuizen) Maintained-by: hanwen@stack.nl (Han-Wen Nienhuys) Primary-site: sunsite.unc.edu /pub/Linux/apps/sound/convert - 1000k lilypond-1.5.20.tar.gz + 1000k lilypond-1.5.21.tar.gz Original-site: ftp.cs.uu.nl /pub/GNU/LilyPond/development/ - 1000k lilypond-1.5.20.tar.gz + 1000k lilypond-1.5.21.tar.gz Copying-policy: GPL End diff --git a/make/out/lilypond.mandrake.spec b/make/out/lilypond.mandrake.spec index 753566a11e..b97f5a1f9c 100644 --- a/make/out/lilypond.mandrake.spec +++ b/make/out/lilypond.mandrake.spec @@ -1,5 +1,5 @@ %define name lilypond -%define version 1.5.20 +%define version 1.5.21 %define release 1mdk Name: %{name} @@ -101,6 +101,9 @@ rm `find /var/lib/texmf -name 'feta*pk -print' -or -name 'feta*tfm -print'` /tmp %_install_info lilypond.info %_install_info lilypond-internals.info +echo 'Please logout first before using LilyPond.' + + %preun %_remove_install_info lilypond.info %_remove_install_info lilypond-internals.info diff --git a/make/out/lilypond.redhat.spec b/make/out/lilypond.redhat.spec index baf0a5dabf..4ca31c7eec 100644 --- a/make/out/lilypond.redhat.spec +++ b/make/out/lilypond.redhat.spec @@ -1,11 +1,11 @@ %define info yes Name: lilypond -Version: 1.5.20 +Version: 1.5.21 Release: 1 License: GPL Group: Applications/Publishing -Source0: ftp.cs.uu.nl:/pub/GNU/LilyPond/development/lilypond-1.5.20.tar.gz +Source0: ftp.cs.uu.nl:/pub/GNU/LilyPond/development/lilypond-1.5.21.tar.gz Summary: Create and print music notation URL: http://www.lilypond.org/ BuildRoot: /tmp/lilypond-install @@ -86,6 +86,9 @@ rm `find /var/lib/texmf -name 'feta*pk -print' -or -name 'feta*tfm -print'` /tmp /sbin/install-info %{_prefix}/info/lilypond.info.gz %{_prefix}/info/dir %endif + +echo 'Please logout first before using LilyPond.' + %preun %if info=="yes" diff --git a/make/out/lilypond.suse.spec b/make/out/lilypond.suse.spec index 3173831f5e..9dcf102f44 100644 --- a/make/out/lilypond.suse.spec +++ b/make/out/lilypond.suse.spec @@ -14,11 +14,11 @@ Distribution: SuSE Linux 7.0 (i386) Name: lilypond -Version: 1.5.20 +Version: 1.5.21 Release: 2 Copyright: GPL Group: Applications/Publishing -Source0: ftp.cs.uu.nl:/pub/GNU/LilyPond/development/lilypond-1.5.20.tar.gz +Source0: ftp.cs.uu.nl:/pub/GNU/LilyPond/development/lilypond-1.5.21.tar.gz # music notation software for.. ? Summary: A program for printing sheet music. URL: http://www.lilypond.org/ diff --git a/mf/GNUmakefile b/mf/GNUmakefile index 12ce227e8a..9b2ae77de2 100644 --- a/mf/GNUmakefile +++ b/mf/GNUmakefile @@ -2,6 +2,8 @@ depth = .. STEPMAKE_TEMPLATES=metafont metapost install install-out LOCALSTEPMAKE_TEMPLATES=asciifont + + include $(depth)/make/stepmake.make AF_FILES = $(wildcard *.af) @@ -24,7 +26,10 @@ LOG_FILES = $(addprefix $(outdir)/, $(FET_FILES:.mf=.log)) TEXTABLES = $(addprefix $(outdir)/, $(FET_FILES:.mf=.tex)) AFM_FILES = $(addprefix $(outdir)/, $(FET_FILES:.mf=.afm) $(AF_FILES:.af=.afm) $(addsuffix .afm, $(CM_AFM_FILES))) TFM_FILES = $(addprefix $(outdir)/, $(FONT_FILES:.mf=.tfm)) -PFA_FILES = $(addprefix $(outdir)/, $(FONT_FILES:.mf=.pfa)) +PFA_FILES = $(addprefix $(outdir)/, $(FONT_FILES:.mf=.pfa)) +PFB_FILES = $(addprefix $(outdir)/, $(FONT_FILES:.mf=.pfb)) + +pfb: $(PFB_FILES) # Make tfm files first, log files last, # so that normally log files aren't made twice @@ -52,7 +57,7 @@ INSTALLATION_OUT_FILES4=$(PFA_FILES) export MFINPUTS:=.:$(MFINPUTS) -default: $(ALL_GEN_FILES) +default: $(PFA_FILES) $(ALL_GEN_FILES) ## ## todo: this also depends on .tfm, FIXME. diff --git a/scm/ascii-script.scm b/scm/ascii-script.scm index b899092088..b3138812f3 100644 --- a/scm/ascii-script.scm +++ b/scm/ascii-script.scm @@ -1,26 +1,40 @@ -(debug-enable 'backtrace) +(define-module (scm ascii-script) + :export (as-output-expression) + :no-backtrace + ) + +(define this-module (current-module)) + +(define (as-output-expression expr port) + (display (eval expr this-module) port) + ) -; (define cmr-alist -; '(("bold" . "as-dummy") -; ("brace" . "as-braces") -; ("dynamic" . "as-dummy") -; ("default" . "as-dummy") -; ("feta" . "feta") -; ("feta-1" . "feta") -; ("feta-2" . "feta") -; ("finger" . "as-number") -; ("typewriter" . "as-dummy") -; ("italic" . "as-dummy") -; ("roman" . "as-dummy") -; ("script" . "as-dummy") -; ("large" . "as-dummy") -; ("Large" . "as-dummy") -; ("mark" . "as-number") -; ("number" . "as-number") -; ("timesig" . "as-number") -; ("volta" . "as-number")) -; ) +(debug-enable 'backtrace) +(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))))))))) + +(define (fontify name-mag-pair exp) + (string-append (select-font name-mag-pair) + exp)) + + +(define (define-fonts internal-external-name-mag-pairs) + (set! font-name-alist (map tex-encoded-fontswitch + internal-external-name-mag-pairs)) + (apply string-append + (map (lambda (x) + (font-load-command (car x) (cdr x))) + (map cdr font-name-alist)))) (define as-font-alist-alist '( @@ -46,8 +60,8 @@ (cmr8 . as-dummy) (cmr10 . as-dummy) (cmr12 . as-dummy) - )) - )) + )) + )) (define (as-properties-to-font-name size fonts properties-alist-list) (let* ((feta-name (properties-to-font-name fonts properties-alist-list)) @@ -71,202 +85,153 @@ (lambda (x y) (as-properties-to-font-name size x y))) sheet)) -;;;; AsciiScript as -- ascii art output -(define (as-scm action-name) - - (define (beam width slope thick) - (string-append - (func "set-line-char" "#") - (func "rline-to" width (* width slope)) - )) - - ; simple flat slurs - (define (bezier-sandwich l thick) - (let ( - (c0 (cadddr l)) - (c1 (cadr l)) - (c3 (caddr l))) - (let* ((x (car c0)) - (dx (- (car c3) x)) - (dy (- (cdr c3) (cdr c0))) - (rc (/ dy dx)) - (c1-dx (- (car c1) x)) - (c1-line-y (+ (cdr c0) (* c1-dx rc))) - (dir (if (< c1-line-y (cdr c1)) 1 -1)) - (y (+ -1 (* dir (max (* dir (cdr c0)) (* dir (cdr c3))))))) - (string-append - (func "rmove-to" x y) - (func "put" (if (< 0 dir) "/" "\\\\")) - (func "rmove-to" 1 (if (< 0 dir) 1 0)) - (func "set-line-char" "_") - (func "h-line" (- dx 1)) - (func "rmove-to" (- dx 1) (if (< 0 dir) -1 0)) - (func "put" (if (< 0 dir) "\\\\" "/")))))) - - - (define (bracket arch_angle arch_width arch_height height arch_thick thick) - ;; width now fixed? - (let ((width 1)) - (string-append - (func "rmove-to" (+ width 1) (- (/ height -2) 1)) - (func "put" "\\\\") - (func "set-line-char" "|") - (func "rmove-to" 0 1) - (func "v-line" (+ height 1)) - (func "rmove-to" 0 (+ height 1)) - (func "put" "/") - ))) - - (define (char i) - (func "char" i)) - - (define (define-origin a b c ) "") - - (define (end-output) - (func "end-output")) - - (define (experimental-on) - "") - - (define (filledbox breapth width depth height) - (let ((dx (+ width breapth)) - (dy (+ depth height))) - (string-append - (func "rmove-to" (* -1 breapth) (* -1 depth)) - (if (< dx dy) - (string-append - (func "set-line-char" - (if (<= dx 1) "|" "#")) - (func "v-line" dy)) - (string-append - (func "set-line-char" - (if (<= dy 1) "-" "=")) - (func "h-line" dx)))))) - - (define (font-load-command name-mag command) - ;; (display "name-mag: ") - ;; (write name-mag) - ;; (display "command: ") - ;; (write command) - (func "load-font" (car name-mag) (cdr name-mag))) - - (define (header creator generate) - (func "header" creator generate)) - - (define (header-end) - (func "header-end")) - - ;; urg: this is good for half of as2text's execution time - (define (xlily-def key val) - (string-append "(define " key " " (arg->string val) ")\n")) - - (define (lily-def key val) - (if - ;; let's not have all bloody definitions - (or (equal? key "lilypondpaperlinewidth") - (equal? key "lilypondpaperstaffheight") - (equal? key "lilypondpaperoutputscale")) - (string-append "(define " key " " (arg->string val) ")\n") - "")) - - (define (no-origin) "") - - (define (placebox x y s) - (let ((ey (inexact->exact y))) - (string-append "(move-to " (number->string (inexact->exact x)) " " - (if (= 0.5 (- (abs y) (abs ey))) - (number->string y) - (number->string ey)) - ")\n" s))) - - (define (select-font name-mag-pair) - (let* ((c (assoc name-mag-pair font-name-alist))) - (if (eq? c #f) - (begin - (ly-warn - (string-append - "Programming error: No such font known " - (car name-mag-pair)))) - "") ; issue no command - (func "select-font" (car name-mag-pair)))) - - (define (start-line height) - (func "start-line" height)) - - (define (stop-line) - (func "stop-line")) - - (define (text s) - (func "text" s)) - - (define (tuplet ht gap dx dy thick dir) "") - - (define (volta h w thick vert-start vert-end) - ;; urg - (string-append - (func "set-line-char" "|") - (func "rmove-to" 0 -4) - ;; definition strange-way around - (if (= 0 vert-start) - (func "v-line" h) - "") - (func "rmove-to" 1 h) - (func "set-line-char" "_") - (func "h-line" (- w 1)) - (func "set-line-char" "|") - (if (= 0 vert-end) - (string-append - (func "rmove-to" (- w 1) (* -1 h)) - (func "v-line" (* -1 h))) - ""))) - -(cond ((eq? action-name 'all-definitions) - `(begin - (define beam ,beam) - (define bracket ,bracket) - (define char ,char) - (define define-origin ,define-origin) - ;;(define crescendo ,crescendo) - (define bezier-sandwich ,bezier-sandwich) - ;;(define dashed-slur ,dashed-slur) - ;;(define decrescendo ,decrescendo) - (define end-output ,end-output) - (define experimental-on ,experimental-on) - (define filledbox ,filledbox) - ;;(define font-def ,font-def) - (define font-load-command ,font-load-command) - ;;(define font-switch ,font-switch) - (define header ,header) - (define header-end ,header-end) - (define lily-def ,lily-def) - ;;(define invoke-char ,invoke-char) - ;;(define invoke-dim1 ,invoke-dim1) - (define no-origin ,no-origin) - (define placebox ,placebox) - (define select-font ,select-font) - (define start-line ,start-line) - ;;(define stem ,stem) - (define stop-line ,stop-line) - (define stop-last-line ,stop-line) - (define text ,text) - (define tuplet ,tuplet) - (define volta ,volta) - )) - ((eq? action-name 'tuplet) tuplet) - ;;((eq? action-name 'beam) beam) - ;;((eq? action-name 'bezier-sandwich) bezier-sandwich) - ;;((eq? action-name 'bracket) bracket) - ((eq? action-name 'char) char) - ;;((eq? action-name 'crescendo) crescendo) - ;;((eq? action-name 'dashed-slur) dashed-slur) - ;;((eq? action-name 'decrescendo) decrescendo) - ;;((eq? action-name 'experimental-on) experimental-on) - ((eq? action-name 'filledbox) filledbox) - ((eq? action-name 'select-font) select-font) - ;;((eq? action-name 'volta) volta) - (else (error "unknown tag -- MUSA-SCM " action-name)) - ) - ) -(define (scm-as-output) - (primitive-eval (as-scm 'all-definitions))) +(define (beam width slope thick) + (string-append + (func "set-line-char" "#") + (func "rline-to" width (* width slope)) + )) + + ; simple flat slurs +(define (bezier-sandwich l thick) + (let ( + (c0 (cadddr l)) + (c1 (cadr l)) + (c3 (caddr l))) + (let* ((x (car c0)) + (dx (- (car c3) x)) + (dy (- (cdr c3) (cdr c0))) + (rc (/ dy dx)) + (c1-dx (- (car c1) x)) + (c1-line-y (+ (cdr c0) (* c1-dx rc))) + (dir (if (< c1-line-y (cdr c1)) 1 -1)) + (y (+ -1 (* dir (max (* dir (cdr c0)) (* dir (cdr c3))))))) + (string-append + (func "rmove-to" x y) + (func "put" (if (< 0 dir) "/" "\\\\")) + (func "rmove-to" 1 (if (< 0 dir) 1 0)) + (func "set-line-char" "_") + (func "h-line" (- dx 1)) + (func "rmove-to" (- dx 1) (if (< 0 dir) -1 0)) + (func "put" (if (< 0 dir) "\\\\" "/")))))) + + +(define (bracket arch_angle arch_width arch_height height arch_thick thick) + ;; width now fixed? + (let ((width 1)) + (string-append + (func "rmove-to" (+ width 1) (- (/ height -2) 1)) + (func "put" "\\\\") + (func "set-line-char" "|") + (func "rmove-to" 0 1) + (func "v-line" (+ height 1)) + (func "rmove-to" 0 (+ height 1)) + (func "put" "/") + ))) + +(define (char i) + (func "char" i)) + +(define (define-origin a b c ) "") + +(define (end-output) + (func "end-output")) + +(define (experimental-on) + "") + +(define (filledbox breapth width depth height) + (let ((dx (+ width breapth)) + (dy (+ depth height))) + (string-append + (func "rmove-to" (* -1 breapth) (* -1 depth)) + (if (< dx dy) + (string-append + (func "set-line-char" + (if (<= dx 1) "|" "#")) + (func "v-line" dy)) + (string-append + (func "set-line-char" + (if (<= dy 1) "-" "=")) + (func "h-line" dx)))))) + +(define (font-load-command name-mag command) + ;; (display "name-mag: ") + ;; (write name-mag) + ;; (display "command: ") + ;; (write command) + (func "load-font" (car name-mag) (cdr name-mag))) + +(define (header creator generate) + (func "header" creator generate)) + +(define (header-end) + (func "header-end")) + +;; urg: this is good for half of as2text's execution time +(define (xlily-def key val) + (string-append "(define " key " " (arg->string val) ")\n")) + +(define (lily-def key val) + (if + ;; let's not have all bloody definitions + (or (equal? key "lilypondpaperlinewidth") + (equal? key "lilypondpaperstaffheight") + (equal? key "lilypondpaperoutputscale")) + (string-append "(define " key " " (arg->string val) ")\n") + "")) + +(define (no-origin) "") + +(define (placebox x y s) + (let ((ey (inexact->exact y))) + (string-append "(move-to " (number->string (inexact->exact x)) " " + (if (= 0.5 (- (abs y) (abs ey))) + (number->string y) + (number->string ey)) + ")\n" s))) + +(define (select-font name-mag-pair) + (let* ((c (assoc name-mag-pair font-name-alist))) + (if (eq? c #f) + (begin + (ly-warn + (string-append + "Programming error: No such font known " + (car name-mag-pair)))) + "") ; issue no command + (func "select-font" (car name-mag-pair)))) + +(define (start-line height) + (func "start-line" height)) + +(define (stop-line) + (func "stop-line")) + +(define (stop-last-line) + (func "stop-line")) + + +(define (text s) + (func "text" s)) + +(define (tuplet ht gap dx dy thick dir) "") + +(define (volta h w thick vert-start vert-end) + ;; urg + (string-append + (func "set-line-char" "|") + (func "rmove-to" 0 -4) + ;; definition strange-way around + (if (= 0 vert-start) + (func "v-line" h) + "") + (func "rmove-to" 1 h) + (func "set-line-char" "_") + (func "h-line" (- w 1)) + (func "set-line-char" "|") + (if (= 0 vert-end) + (string-append + (func "rmove-to" (- w 1) (* -1 h)) + (func "v-line" (* -1 h))) + ""))) diff --git a/scm/lily.scm b/scm/lily.scm index c3ae34acf2..8679e958cc 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -13,6 +13,9 @@ ;;; General settings + + + (debug-enable 'backtrace) @@ -110,25 +113,49 @@ (symbol->string (car y)))) -(map (lambda (x) (eval-string (ly-gulp-file x))) - '("output-lib.scm" - "tex.scm" - "ps.scm" - "sketch.scm" - "pdf.scm" - "pdftex.scm" - "ascii-script.scm" - )) +(define (ly-load x) (eval-string (ly-gulp-file x))) -(define ctor list) +(ly-load "output-lib.scm") -(define (ly-load x) (eval-string (ly-gulp-file x))) + +(use-modules (scm tex) + (scm ps) + (scm pysk) + (scm ascii-script) + ) + +(define output-alist + `( + ("tex" . ,tex-output-expression) + ("ps" . ,ps-output-expression) + ("scm" . ,write) + ("as" . ,as-output-expression) + ("pysk" . ,pysk-output-expression) +)) + + + + +(define (find-dumper format ) + (let* + ((d (assoc format output-alist))) + + (if (pair? d) + (cdr d) + scm-output-expression) + )) + (if (not standalone) (map ly-load ; load-from-path - '("c++.scm" + '("output-lib.scm" + "sketch.scm" + "pdf.scm" + "pdftex.scm" + "ascii-script.scm" + "c++.scm" "grob-property-description.scm" "translator-property-description.scm" "context-description.scm" diff --git a/scm/output-lib.scm b/scm/output-lib.scm index 039121f527..d9123c436e 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -101,31 +101,6 @@ centered, X==1 is at the right, X == -1 is at the left." (string-encode-integer (quotient i 26)))))) -(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))))))))) - -(define (define-fonts internal-external-name-mag-pairs) - (set! font-name-alist (map tex-encoded-fontswitch - internal-external-name-mag-pairs)) - (apply string-append - (map (lambda (x) - (font-load-command (car x) (cdr x))) - (map cdr font-name-alist)))) - -;; urg, how can exp be #unspecified? -- in sketch output -(define (xfontify name-mag-pair exp) - (string-append (select-font name-mag-pair) - exp)) - -(define (fontify name-mag-pair exp) - (string-append (select-font name-mag-pair) - (if (string? exp) exp ""))) + + + diff --git a/scm/ps.scm b/scm/ps.scm index ac32281bb2..f469ec7ac9 100644 --- a/scm/ps.scm +++ b/scm/ps.scm @@ -7,256 +7,244 @@ -(define (ps-scm action-name) +(define-module (scm ps) + :export (ps-output-expression) + :no-backtrace + ) - ;; alist containing fontname -> fontcommand assoc (both strings) - (define font-alist '()) - (define font-count 0) - (define current-font "") +(define this-module (current-module)) - - (define (cached-fontname i) - (string-append - "lilyfont" - (make-string 1 (integer->char (+ 65 i))))) - - - (define (select-font name-mag-pair) - (let* - ( - (c (assoc name-mag-pair font-name-alist)) - ) - - (if (eq? c #f) - (begin - (display "FAILED\n") - (display (object-type (car name-mag-pair))) - (display (object-type (caaar font-name-alist))) - - (ly-warn (string-append - "Programming error: No such font known " - (car name-mag-pair) " " - (ly-number->string (cdr name-mag-pair)) - )) - - "") ; issue no command - (string-append " " (cddr c) " ")) - )) - - (define (font-load-command name-mag command) - (string-append - "/" command - " { /" - (car name-mag) - " findfont " - "12 " (ly-number->string (cdr name-mag)) " mul " - "lilypondpaperoutputscale div scalefont setfont } bind def " - "\n")) - - (define (beam width slope thick) - (string-append - (numbers->string (list slope width thick)) " draw_beam" )) - - (define (comment s) - (string-append "% " s)) - - (define (bracket arch_angle arch_width arch_height height arch_thick thick) - (string-append - (numbers->string (list arch_angle arch_width arch_height height arch_thick thick)) " draw_bracket" )) - - (define (char i) - (invoke-char " show" i)) - - - (define (hairpin thick width starth endh ) - (string-append - (numbers->string (list width starth endh thick)) - " draw_hairpin")) - - ;; what the heck is this interface ? - (define (dashed-slur thick dash l) - (string-append - (apply string-append (map control->string l)) - (ly-number->string thick) - " [ " - (ly-number->string dash) - " " - (ly-number->string (* 10 thick)) ;UGH. 10 ? - " ] 0 draw_dashed_slur")) - - (define (dashed-line thick on off dx dy) - (string-append - (ly-number->string dx) - " " - (ly-number->string dy) - " " - (ly-number->string thick) - " [ " - (ly-number->string on) - " " - (ly-number->string off) - " ] 0 draw_dashed_line")) - - (define (repeat-slash wid slope thick) - (string-append (numbers->string (list wid slope thick)) - " draw_repeat_slash")) - - (define (end-output) - "\nend-lilypond-output\n") - - (define (experimental-on) "") - - (define (filledbox breapth width depth height) - (string-append (numbers->string (list breapth width depth height)) - " draw_box" )) - - ;; obsolete? - (define (font-def i s) - (string-append - "\n/" (font i) " {/" - (substring s 0 (- (string-length s) 4)) - " findfont 12 scalefont setfont} bind def \n")) - - (define (font-switch i) - (string-append (font i) " ")) - - (define (header-end) - (string-append - ;; URG: now we can't use scm output without Lily - (ly-gulp-file "lilyponddefs.ps") - " {exch pop //systemdict /run get exec} " - (ly-gulp-file "music-drawing-routines.ps") - "{ exch pop //systemdict /run get exec } " - (if (defined? 'ps-testing) "\n /testing true def" "") +(define (ps-output-expression expr port) + (display (eval expr this-module) port) + ) + + +(use-modules + (guile) + (guile-user)) + + + +;;;;;;;; +;;;;;;;; DOCUMENT ME! +;;;;;;;; +(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))))))))) + +(define (fontify name-mag-pair exp) + (string-append (select-font name-mag-pair) + exp)) + + +(define (define-fonts internal-external-name-mag-pairs) + (set! font-name-alist (map tex-encoded-fontswitch + internal-external-name-mag-pairs)) + (apply string-append + (map (lambda (x) + (font-load-command (car x) (cdr x))) + (map cdr font-name-alist)))) + + + +;; alist containing fontname -> fontcommand assoc (both strings) +(define font-alist '()) +(define font-count 0) +(define current-font "") + +(define (select-font name-mag-pair) + (let* + ( + (c (assoc name-mag-pair font-name-alist)) + ) + + (if (eq? c #f) + (begin + (display "FAILED\n") + (display (object-type (car name-mag-pair))) + (display (object-type (caaar font-name-alist))) + + (ly-warn (string-append + "Programming error: No such font known " + (car name-mag-pair) " " + (ly-number->string (cdr name-mag-pair)) + )) + + "") ; issue no command + (string-append " " (cddr c) " ")) )) - - (define (lily-def key val) - - (if (string=? (substring key 0 (min (string-length "lilypondpaper") (string-length key))) "lilypondpaper") - (string-append "/" key " {" val "} bind def\n") - (string-append "/" key " (" val ") def\n") - ) - ) - - (define (header creator generate) - (string-append - "%!PS-Adobe-3.0\n" - "%%Creator: " creator generate "\n")) - - (define (invoke-char s i) - (string-append - "(\\" (inexact->string i 8) ") " s " " )) - - (define (invoke-dim1 s d) - (string-append - (ly-number->string (* d (/ 72.27 72))) " " s )) - - (define (placebox x y s) - (string-append - (ly-number->string x) " " (ly-number->string y) " {" s "} place-box\n")) - - (define (bezier-sandwich l thick) - (string-append - (apply string-append (map control->string l)) - (ly-number->string thick) - " draw_bezier_sandwich")) - -; TODO: use HEIGHT argument - (define (start-line height) - (string-append - "\n" - (ly-number->string height) - " start-line { + +(define (font-load-command name-mag command) + (string-append + "/" command + " { /" + (car name-mag) + " findfont " + "12 " (ly-number->string (cdr name-mag)) " mul " + "lilypondpaperoutputscale div scalefont setfont } bind def " + "\n")) + +(define (beam width slope thick) + (string-append + (numbers->string (list slope width thick)) " draw_beam" )) + +(define (comment s) + (string-append "% " s "\n")) + +(define (bracket arch_angle arch_width arch_height height arch_thick thick) + (string-append + (numbers->string (list arch_angle arch_width arch_height height arch_thick thick)) " draw_bracket" )) + +(define (char i) + (invoke-char " show" i)) + + +(define (hairpin thick width starth endh ) + (string-append + (numbers->string (list width starth endh thick)) + " draw_hairpin")) + +;; what the heck is this interface ? +(define (dashed-slur thick dash l) + (string-append + (apply string-append (map control->string l)) + (ly-number->string thick) + " [ " + (ly-number->string dash) + " " + (ly-number->string (* 10 thick)) ;UGH. 10 ? + " ] 0 draw_dashed_slur")) + +(define (dashed-line thick on off dx dy) + (string-append + (ly-number->string dx) + " " + (ly-number->string dy) + " " + (ly-number->string thick) + " [ " + (ly-number->string on) + " " + (ly-number->string off) + " ] 0 draw_dashed_line")) + +(define (repeat-slash wid slope thick) + (string-append (numbers->string (list wid slope thick)) + " draw_repeat_slash")) + +(define (end-output) + "\nend-lilypond-output\n") + +(define (experimental-on) "") + +(define (filledbox breapth width depth height) + (string-append (numbers->string (list breapth width depth height)) + " draw_box" )) + +;; obsolete? +(define (font-def i s) + (string-append + "\n/" (font i) " {/" + (substring s 0 (- (string-length s) 4)) + " findfont 12 scalefont setfont} bind def \n")) + +(define (font-switch i) + (string-append (font i) " ")) + +(define (header-end) + (string-append + ;; URG: now we can't use scm output without Lily + (ly-gulp-file "lilyponddefs.ps") + " {exch pop //systemdict /run get exec} " + (ly-gulp-file "music-drawing-routines.ps") + "{ exch pop //systemdict /run get exec } " + (if (defined? 'ps-testing) "\n /testing true def" "") + )) + +(define (lily-def key val) + + (if (string=? (substring key 0 (min (string-length "lilypondpaper") (string-length key))) "lilypondpaper") + (string-append "/" key " {" val "} bind def\n") + (string-append "/" key " (" val ") def\n") + ) + ) + +(define (header creator generate) + (string-append + "%!PS-Adobe-3.0\n" + "%%Creator: " creator generate "\n")) + +(define (invoke-char s i) + (string-append + "(\\" (inexact->string i 8) ") " s " " )) + +(define (invoke-dim1 s d) + (string-append + (ly-number->string (* d (/ 72.27 72))) " " s )) + +(define (placebox x y s) + (string-append + (ly-number->string x) " " (ly-number->string y) " {" s "} place-box\n")) + +(define (bezier-sandwich l thick) + (string-append + (apply string-append (map control->string l)) + (ly-number->string thick) + " draw_bezier_sandwich")) + + ; TODO: use HEIGHT argument +(define (start-line height) + (string-append + "\n" + (ly-number->string height) + " start-line { lilypondpaperoutputscale lilypondpaperoutputscale scale ")) - - (define (stem breapth width depth height) - (string-append (numbers->string (list breapth width depth height)) - " draw_box" )) - (define (stop-line) - "}\nstop-line\n") +(define (stem breapth width depth height) + (string-append (numbers->string (list breapth width depth height)) + " draw_box" )) - (define (text s) - (string-append "(" s ") show ")) +(define (stop-line) + "}\nstop-line\n") +(define (stop-last-line) + "}\nstop-line\n") - (define (volta h w thick vert_start vert_end) - (string-append - (numbers->string (list h w thick (inexact->exact vert_start) (inexact->exact vert_end))) - " draw_volta")) +(define (text s) + (string-append "(" s ") show ")) - (define (tuplet ht gap dx dy thick dir) - (string-append - (numbers->string (list ht gap dx dy thick (inexact->exact dir))) - " draw_tuplet")) +(define (volta h w thick vert_start vert_end) + (string-append + (numbers->string (list h w thick (inexact->exact vert_start) (inexact->exact vert_end))) + " draw_volta")) - (define (unknown) - "\n unknown\n") +(define (tuplet ht gap dx dy thick dir) + (string-append + (numbers->string (list ht gap dx dy thick (inexact->exact dir))) + " draw_tuplet")) - (define (ez-ball ch letter-col ball-col) - (string-append - " (" ch ") " - (numbers->string (list letter-col ball-col)) - " /Helvetica-Bold " ;; ugh - " draw_ez_ball")) - (define (define-origin a b c ) "") - (define (no-origin) "") - - ;; PS - (cond ((eq? action-name 'all-definitions) - `(begin - (define beam ,beam) - (define tuplet ,tuplet) - (define bracket ,bracket) - (define char ,char) - (define hairpin ,hairpin) - (define volta ,volta) - (define bezier-sandwich ,bezier-sandwich) - (define dashed-line ,dashed-line) - (define dashed-slur ,dashed-slur) - (define end-output ,end-output) - (define experimental-on ,experimental-on) - (define filledbox ,filledbox) - (define font-def ,font-def) - (define font-switch ,font-switch) - (define header-end ,header-end) - (define lily-def ,lily-def) - (define font-load-command ,font-load-command) - (define header ,header) - (define invoke-char ,invoke-char) - (define invoke-dim1 ,invoke-dim1) - (define placebox ,placebox) - (define select-font ,select-font) - (define start-line ,start-line) - (define stem ,stem) - (define stop-line ,stop-line) - (define stop-last-line ,stop-line) - (define repeat-slash ,repeat-slash) - (define text ,text) - (define no-origin ,no-origin) - (define define-origin ,define-origin) - (define ez-ball ,ez-ball) - )) - ((eq? action-name 'repeat-slash) repeat-slash) - ((eq? action-name 'tuplet) tuplet) - ((eq? action-name 'beam) beam) - ((eq? action-name 'bezier-sandwich) bezier-sandwich) - ((eq? action-name 'bracket) bracket) - ((eq? action-name 'char) char) - ((eq? action-name 'dashed-line) dashed-line) - ((eq? action-name 'dashed-slur) dashed-slur) - ((eq? action-name 'hairpin) hairpin) - ((eq? action-name 'experimental-on) experimental-on) - ((eq? action-name 'filledbox) filledbox) - ((eq? action-name 'ez-ball) ez-ball) - ((eq? action-name 'select-font) select-font) - ((eq? action-name 'volta) volta) - (else (error "unknown tag -- PS-SCM " action-name)) - ) - ) +(define (unknown) + "\n unknown\n") + +(define (ez-ball ch letter-col ball-col) + (string-append + " (" ch ") " + (numbers->string (list letter-col ball-col)) + " /Helvetica-Bold " ;; ugh + " draw_ez_ball")) -(define (scm-ps-output) - (primitive-eval (ps-scm 'all-definitions))) +(define (define-origin a b c ) "") +(define (no-origin) "") + + diff --git a/scm/sketch.scm b/scm/sketch.scm index 58fe938749..8b13789179 100644 --- a/scm/sketch.scm +++ b/scm/sketch.scm @@ -1,319 +1 @@ - - -(use-modules (ice-9 format)) - -(define (ascii->string i) (make-string 1 (integer->char i))) - -(define (control->list c) - (list (+ global-x (car c)) (+ global-y (cdr c)))) - -(define (control-flip-y c) - (cons (car c) (* -1 (cdr c)))) - -;;; urg. -(define (sk-numbers->string l) - (string-append - (number->string (car l)) - (if (null? (cdr l)) - "" - (string-append "," (sk-numbers->string (cdr l)))))) - -(define global-x 0.0) -(define global-y 0.0) -(define global-list '()) -(define global-font "") -(define global-s "") -(define global-scale 1.0) -(define (global-mul-scale x) (* global-scale x)) - -;; hmm, global is global -(define (global-filledbox width dy dx height x y) - (string-append - "fp((0,0,0))\n" - "lw(0.1)\n" - "r(" - (sk-numbers->string - (map global-mul-scale (list width dy dx height x y))) - ")\n")) - -(define (global-bezier l) - (let* ((c0 (car (list-tail l 3))) - (c123 (list-head l 3)) - (start (control->list c0)) - (control (apply append (map control->list c123)))) - (string-append - "bs(" (sk-numbers->string (map global-mul-scale start)) ",0)\n" - "bc(" (sk-numbers->string (map global-mul-scale control)) ",2)\n"))) - - -(define (global-beziers l thick) - (let* (;;(burp (set! global-y (+ global-y (* 2 (cdar l))))) - (first - (list-tail l 4)) - (second - (list-head l 4)) - ) - (string-append - "fp((0,0,0))\n" - "lw(0.1)\n" - "b()\n" - (global-bezier first) - (global-bezier second) - ;;"b_()\n" - ))) - - -(define (sketch-scm action-name) - - ;; alist containing fontname -> fontcommand assoc (both strings) - (define font-alist '()) - (define font-count 0) - (define current-font "") - - (define (font-def x) - "") - - (define (cached-fontname i) - "") - - (define (select-font name-mag-pair) - (set! global-font (car name-mag-pair)) - "") - - (define (font-load-command name-mag command) - "") - - (define (beam width slope thick) - (let ((s (list - 'global-filledbox - width - (* slope width) - 0 - thick - 'global-x - 'global-y))) - (set! global-s s)) - "\n") - - (define (comment s) - (string-append "% " s)) - - (define (bracket arch_angle arch_width arch_height height arch_thick thick) - (string-append - (numbers->string (list arch_angle arch_width arch_height height arch_thick thick)) " draw_bracket" )) - - (define (char i) - (set! global-s -;; `(string-append "txt(" ,(number->string i) ",(" -;; (sk-numbers->string (list global-x global-y)) - `(string-append - "fp((0,0,0))\n" - "le()\n" - "lw(0.1)\n" -;; "Fn('" global-font "')\n" -;; "Fn('Times-Roman')\n" - "Fn('TeX-feta20')\n" - "Fs(20)\n" - ;; chars > 128 don't work yet - "txt('" ,(ascii->string (modulo i 128)) "',(" -;; "char(" ,(number->string i) ",(" - (sk-numbers->string (list (* global-scale global-x) - (* global-scale global-y))) - "))\n"))) - - (define (hairpin thick width starth endh ) - (string-append - (numbers->string (list width starth endh thick)) - " draw_hairpin")) - - ;; what the heck is this interface ? - (define (dashed-slur thick dash l) - (string-append - (apply string-append (map control->string l)) - (ly-number->string thick) - " [ " - (ly-number->string dash) - " " - (ly-number->string (* 10 thick)) ;UGH. 10 ? - " ] 0 draw_dashed_slur")) - - (define (dashed-line thick on off dx dy) - (string-append - (ly-number->string dx) - " " - (ly-number->string dy) - " " - (ly-number->string thick) - " [ " - (ly-number->string on) - " " - (ly-number->string off) - " ] 0 draw_dashed_line")) - - (define (repeat-slash wid slope thick) - (string-append (numbers->string (list wid slope thick)) - " draw_repeat_slash")) - - (define (end-output) - "guidelayer('Guide Lines',1,0,0,1,(0,0,1)) -grid((0,0,20,20),0,(0,0,1),'Grid')\n") - - (define (experimental-on) "") - - (define (font-switch i) - "") - - (define (header-end) - "") - - (define (lily-def key val) - (if (equal? key "lilypondpaperoutputscale") - (set! global-scale (string->number val))) - "") - - - (define (header creator generate) - (string-append - "##Sketch 1 2 -document() -layout('A4',0) -layer('Layer 1',1,1,0,0,(0,0,0)) -")) - - (define (invoke-char s i) - "") - - (define (invoke-dim1 s d) - (string-append - (ly-number->string (* d (/ 72.27 72))) " " s )) - - ;; urg - (define (placebox x y s) -;; (format (current-error-port) "placebox: ~S, ~S, ~S\n" x y s) - (set! global-x (+ x 0)) - (set! global-y (+ y 100)) - (let ((s (primitive-eval global-s))) - (set! global-s "\n") - s)) - - (define (bezier-sandwich l thick) - (let ((s (list - 'global-beziers - 'global-list - thick))) - (set! global-s s) - (set! global-list l)) - "\n") - -; TODO: use HEIGHT argument - (define (start-line height) - "G()\n" - ) - - ;; r((520.305,0,0,98.0075,51.8863,10.089)) - ;; width, 0, 0, height, x, y - (define (filledbox breapth width depth height) - (let ((s (list - 'global-filledbox - (+ breapth width) - 0 0 - (+ depth height) - `(- global-x ,breapth) - `(- global-y ,depth)))) -;; (format (current-error-port) "filledbox: ~S\n" s) - (set! global-s s)) - "\n") - - (define (stem x y z w) (filledbox x y z w)) - - - (define (stop-line) - "G_()\n") - - (define (text s) - (set! global-s - `(string-append "txt('" ,s "',(" - (sk-numbers->string (list global-x global-y)) - "))\n"))) - - - (define (volta h w thick vert_start vert_end) - (string-append - (numbers->string (list h w thick (inexact->exact vert_start) (inexact->exact vert_end))) - " draw_volta")) - - (define (tuplet ht gap dx dy thick dir) - (string-append - (numbers->string (list ht gap dx dy thick (inexact->exact dir))) - " draw_tuplet")) - - - (define (unknown) - "\n unknown\n") - - (define (ez-ball ch letter-col ball-col) - (string-append - " (" ch ") " - (numbers->string (list letter-col ball-col)) - " /Helvetica-Bold " ;; ugh - " draw_ez_ball")) - - (define (define-origin a b c ) "") - (define (no-origin) "") - - ;; PS - (cond ((eq? action-name 'all-definitions) - `(begin - (define beam ,beam) - (define tuplet ,tuplet) - (define bracket ,bracket) - (define char ,char) - (define hairpin ,hairpin) - (define volta ,volta) - (define bezier-sandwich ,bezier-sandwich) - (define dashed-line ,dashed-line) - (define dashed-slur ,dashed-slur) - (define end-output ,end-output) - (define experimental-on ,experimental-on) - (define filledbox ,filledbox) - (define stem ,stem) - (define font-def ,font-def) - (define font-switch ,font-switch) - (define header-end ,header-end) - (define lily-def ,lily-def) - (define font-load-command ,font-load-command) - (define header ,header) - (define invoke-char ,invoke-char) - (define invoke-dim1 ,invoke-dim1) - (define placebox ,placebox) - (define select-font ,select-font) - (define start-line ,start-line) - (define stem ,stem) - (define stop-line ,stop-line) - (define stop-last-line ,stop-line) - (define repeat-slash ,repeat-slash) - (define text ,text) - (define no-origin ,no-origin) - (define define-origin ,define-origin) - (define ez-ball ,ez-ball) - )) - ((eq? action-name 'repeat-slash) repeat-slash) - ((eq? action-name 'tuplet) tuplet) - ((eq? action-name 'beam) beam) - ((eq? action-name 'bezier-sandwich) bezier-sandwich) - ((eq? action-name 'bracket) bracket) - ((eq? action-name 'char) char) - ((eq? action-name 'dashed-line) dashed-line) - ((eq? action-name 'dashed-slur) dashed-slur) - ((eq? action-name 'hairpin) hairpin) - ((eq? action-name 'experimental-on) experimental-on) - ((eq? action-name 'filledbox) filledbox) - ((eq? action-name 'ez-ball) ez-ball) - ((eq? action-name 'select-font) select-font) - ((eq? action-name 'volta) volta) - (else (error "unknown tag -- SKETCH-SCM " action-name)) - ) - ) - - diff --git a/scm/tex.scm b/scm/tex.scm index 1a1ec47cf6..01880f90f6 100644 --- a/scm/tex.scm +++ b/scm/tex.scm @@ -6,259 +6,267 @@ ;;; Han-Wen Nienhuys +(define-module (scm tex) + :export (tex-output-expression) + :no-backtrace + ) + +(use-modules (scm ps) + (ice-9 regex) + (ice-9 string-fun) + (ice-9 format) + (guile-user) + (guile) + ) + +(define this-module (current-module)) + +;;;;;;;; +;;;;;;;; DOCUMENT ME! +;;;;;;;; +(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))))))))) + +(define (define-fonts internal-external-name-mag-pairs) + (set! font-name-alist (map tex-encoded-fontswitch + internal-external-name-mag-pairs)) + (apply string-append + (map (lambda (x) + (font-load-command (car x) (cdr x))) + (map cdr font-name-alist)))) + + +;; urg, how can exp be #unspecified? -- in sketch output ;; -;; todo: this dispatch is totally LAME - -(define (tex-scm action-name) - (define (unknown) - "%\n\\unknown%\n") - - - (define (select-font name-mag-pair) - (let* - ( - (c (assoc name-mag-pair font-name-alist)) - ) - - (if (eq? c #f) - (begin - (display "FAILED\n") - (display (object-type (car name-mag-pair))) - (display (object-type (caaar font-name-alist))) - - (ly-warn (string-append - "Programming error: No such font known " - (car name-mag-pair) " " - (ly-number->string (cdr name-mag-pair)) - )) - "") ; issue no command - (string-append "\\" (cddr c))) - - - )) - - (define (beam width slope thick) - (embedded-ps ((ps-scm 'beam) width slope thick))) - - (define (bracket arch_angle arch_width arch_height height arch_thick thick) - (embedded-ps ((ps-scm 'bracket) arch_angle arch_width arch_height height arch_thick thick))) - - (define (dashed-slur thick dash l) - (embedded-ps ((ps-scm 'dashed-slur) thick dash l))) - - (define (hairpin thick w sh eh) - (embedded-ps ((ps-scm 'hairpin) thick w sh eh))) - - (define (char i) - (string-append "\\char" (inexact->string i 10) " ")) - - (define (dashed-line thick on off dx dy) - (embedded-ps ((ps-scm 'dashed-line) thick on off dx dy))) - - (define (font-load-command name-mag command) - (string-append - "\\font\\" command "=" - (car name-mag) - " scaled " - (ly-number->string (inexact->exact (* 1000 (cdr name-mag)))) - "\n")) - - (define (ez-ball c l b) - (embedded-ps ((ps-scm 'ez-ball) c l b))) - (define (embedded-ps s) - (string-append "\\embeddedps{" s "}")) - - (define (comment s) - (string-append "% " s)) - - (define (end-output) +;; set! returns # --hwn +(define (fontify name-mag-pair exp) + (string-append (select-font name-mag-pair) + exp)) + + +(define (unknown) + "%\n\\unknown%\n") + +(define (select-font name-mag-pair) + (let* + ( + (c (assoc name-mag-pair font-name-alist)) + ) + + (if (eq? c #f) (begin -; uncomment for some stats about lily memory -; (display (gc-stats)) + (display "FAILED\n") + (display (object-type (car name-mag-pair))) + (display (object-type (caaar font-name-alist))) + + (ly-warn (string-append + "Programming error: No such font known " + (car name-mag-pair) " " + (ly-number->string (cdr name-mag-pair)) + )) + "") ; issue no command + (string-append "\\" (cddr c))) + + + )) + +(define (beam width slope thick) + (embedded-ps (list 'beam width slope thick))) + +(define (bracket arch_angle arch_width arch_height height arch_thick thick) + (embedded-ps (list 'bracket arch_angle arch_width arch_height height arch_thick thick))) + +(define (dashed-slur thick dash l) + (embedded-ps (list 'dashed-slur thick dash l))) + +(define (hairpin thick w sh eh) + (embedded-ps (list 'hairpin thick w sh eh)) +) + +(define (char i) + (string-append "\\char" (inexact->string i 10) " ")) + +(define (dashed-line thick on off dx dy) + (embedded-ps (list 'dashed-line thick on off dx dy))) + +(define (font-load-command name-mag command) + (string-append + "\\font\\" command "=" + (car name-mag) + " scaled " + (ly-number->string (inexact->exact (* 1000 (cdr name-mag)))) + "\n")) + +(define (ez-ball c l b) + (embedded-ps (list 'ez-ball c l b))) + +(define (header-to-file fn key val) + (set! key (symbol->string key)) + (if (not (equal? "-" fn)) + (set! fn (string-append fn "." key)) + ) + (display + (format "writing header field `~a' to `~a'..." + key + (if (equal? "-" fn) "" fn) + ) + (current-error-port)) + (if (equal? fn "-") + (display val) + (display val (open-file fn "w")) + ) + (display "\n" (current-error-port)) + "" + ) + + +(define (embedded-ps expr) + (let + ((os (open-output-string))) + (ps-output-expression expr os) + (string-append "\\embeddedps{" (get-output-string os) "}") + )) + +(define (comment s) + (string-append "% " s "\n")) + +(define (end-output) + (begin + ; uncomment for some stats about lily memory + ; (display (gc-stats)) (string-append "\n\\EndLilyPondOutput" - ; Put GC stats here. + ; Put GC stats here. ))) - - (define (experimental-on) - "") - - (define (repeat-slash w a t) - (embedded-ps ((ps-scm 'repeat-slash) w a t))) - - (define (font-switch i) - (string-append - "\\" (font i) "\n")) - - (define (font-def i s) - (string-append - "\\font" (font-switch i) "=" s "\n")) - - (define (header-end) - (string-append - "\\special{\\string! " - - ;; URG: ly-gulp-file: now we can't use scm output without Lily - (if use-regex - ;; fixed in 1.3.4 for powerpc -- broken on Windows - (regexp-substitute/global #f "\n" - (ly-gulp-file "music-drawing-routines.ps") 'pre " %\n" 'post) - (ly-gulp-file "music-drawing-routines.ps")) - (if (defined? 'ps-testing) "/testing true def%\n" "") - "}" - "\\input lilyponddefs \\outputscale=\\lilypondpaperoutputscale pt\\turnOnPostScript")) - - ;; Note: this string must match the string in ly2dvi.py!!! - (define (header creator generate) - (string-append - "% Generated automatically by: " creator generate "\n")) - - (define (invoke-char s i) - (string-append - "\n\\" s "{" (inexact->string i 10) "}" )) - - (define (invoke-dim1 s d) - (string-append - "\n\\" s "{" (number->dim d) "}")) - (define (pt->sp x) - (* 65536 x)) - - ;; - ;; need to do something to make this really safe. - ;; - (define (output-tex-string s) - (if security-paranoia - (if use-regex - (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post) - (begin (display "warning: not paranoid") (newline) s)) - s)) - - (define (lily-def key val) - (let ((tex-key - (if use-regex - ;; fixed in 1.3.4 for powerpc -- broken on Windows - (regexp-substitute/global - #f "_" (output-tex-string key) 'pre "X" 'post) - (output-tex-string key))) - (tex-val (output-tex-string val))) - (if (equal? (sans-surrounding-whitespace tex-val) "") - (string-append "\\let\\" tex-key "\\undefined\n") - (string-append "\\def\\" tex-key "{" tex-val "}\n")))) - - (define (number->dim x) - (string-append - ;;ugh ly-* in backend needs compatibility func for standalone output - (ly-number->string x) " \\outputscale ")) - - (define (placebox x y s) - (string-append - "\\placebox{" - (number->dim y) "}{" (number->dim x) "}{" s "}\n")) - - (define (bezier-sandwich l thick) - (embedded-ps ((ps-scm 'bezier-sandwich) l thick))) - - (define (start-line ht) - (string-append"\\vbox to " (number->dim ht) "{\\hbox{%\n")) - - (define (stop-line) - "}\\vss}\\interscoreline\n") - (define (stop-last-line) - "}\\vss}") - - (define (filledbox breapth width depth height) - (if (defined? 'ps-testing) - (embedded-ps - (string-append (numbers->string (list breapth width depth height)) - " draw_box" )) - (string-append - "\\kern" (number->dim (- breapth)) - "\\vrule width " (number->dim (+ breapth width)) - "depth " (number->dim depth) - "height " (number->dim height) " "))) - - (define (text s) - (string-append "\\hbox{" (output-tex-string s) "}")) - - (define (tuplet ht gapx dx dy thick dir) - (embedded-ps ((ps-scm 'tuplet) ht gapx dx dy thick dir))) - - (define (volta h w thick vert_start vert_end) - (embedded-ps ((ps-scm 'volta) h w thick vert_start vert_end))) - - (define (define-origin file line col) - (if (procedure? point-and-click) - (string-append "\\special{src\\string:" - (point-and-click line col file) - "}" ) - "") - ) - ; no-origin not yet supported by Xdvi - (define (no-origin) "") - - ;; TeX - ;; The procedures listed below form the public interface of TeX-scm. - ;; (should merge the 2 lists) - (cond ((eq? action-name 'all-definitions) - `(begin - (define font-load-command ,font-load-command) - (define beam ,beam) - (define bezier-sandwich ,bezier-sandwich) - (define bracket ,bracket) - (define char ,char) - (define dashed-line ,dashed-line) - (define dashed-slur ,dashed-slur) - (define hairpin ,hairpin) - (define end-output ,end-output) - (define experimental-on ,experimental-on) - (define filledbox ,filledbox) - (define font-def ,font-def) - (define font-switch ,font-switch) - (define header-end ,header-end) - (define lily-def ,lily-def) - (define ez-ball ,ez-ball) - (define header ,header) - (define invoke-char ,invoke-char) - (define invoke-dim1 ,invoke-dim1) - (define placebox ,placebox) - (define select-font ,select-font) - (define start-line ,start-line) - (define stop-line ,stop-line) - (define stop-last-line ,stop-last-line) - (define text ,text) - (define tuplet ,tuplet) - (define volta ,volta) - (define define-origin ,define-origin) - (define no-origin ,no-origin) - (define repeat-slash ,repeat-slash) - )) - - ((eq? action-name 'beam) beam) - ((eq? action-name 'tuplet) tuplet) - ((eq? action-name 'bracket) bracket) - ((eq? action-name 'hairpin) hairpin) - ((eq? action-name 'dashed-line) dashed-line) - ((eq? action-name 'dashed-slur) dashed-slur) - ((eq? action-name 'end-output) end-output) - ((eq? action-name 'experimental-on) experimental-on) - ((eq? action-name 'font-def) font-def) - ((eq? action-name 'font-switch) font-switch) - ((eq? action-name 'header-end) header-end) - ((eq? action-name 'lily-def) lily-def) - ((eq? action-name 'header) header) - ((eq? action-name 'invoke-char) invoke-char) - ((eq? action-name 'invoke-dim1) invoke-dim1) - ((eq? action-name 'placebox) placebox) - ((eq? action-name 'bezier-sandwich) bezier-sandwich) - ((eq? action-name 'start-line) start-line) - ((eq? action-name 'stem) stem) - ((eq? action-name 'stop-line) stop-line) - ((eq? action-name 'stop-last-line) stop-last-line) - ((eq? action-name 'volta) volta) - (else (error "unknown tag -- PS-TEX " action-name)) - ) +(define (experimental-on) + "") + +(define (repeat-slash w a t) + (embedded-ps (list 'repeat-slash w a t))) + +(define (font-switch i) + (string-append + "\\" (font i) "\n")) + +(define (font-def i s) + (string-append + "\\font" (font-switch i) "=" s "\n")) + +(define (header-end) + (string-append + "\\special{\\string! " + + ;; URG: ly-gulp-file: now we can't use scm output without Lily + (if use-regex + ;; fixed in 1.3.4 for powerpc -- broken on Windows + (regexp-substitute/global #f "\n" + (ly-gulp-file "music-drawing-routines.ps") 'pre " %\n" 'post) + (ly-gulp-file "music-drawing-routines.ps")) + (if (defined? 'ps-testing) "/testing true def%\n" "") + "}" + "\\input lilyponddefs \\outputscale=\\lilypondpaperoutputscale pt\\turnOnPostScript")) + +;; Note: this string must match the string in ly2dvi.py!!! +(define (header creator generate) + (string-append + "% Generated automatically by: " creator generate "\n")) + +(define (invoke-char s i) + (string-append + "\n\\" s "{" (inexact->string i 10) "}" )) + +(define (invoke-dim1 s d) + (string-append + "\n\\" s "{" (number->dim d) "}")) +(define (pt->sp x) + (* 65536 x)) + +;; +;; need to do something to make this really safe. +;; +(define (output-tex-string s) + (if security-paranoia + (if use-regex + (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post) + (begin (display "warning: not paranoid") (newline) s)) + s)) + +(define (lily-def key val) + (let ((tex-key + (if use-regex + ;; fixed in 1.3.4 for powerpc -- broken on Windows + (regexp-substitute/global + #f "_" (output-tex-string key) 'pre "X" 'post) + (output-tex-string key))) + (tex-val (output-tex-string val))) + (if (equal? (sans-surrounding-whitespace tex-val) "") + (string-append "\\let\\" tex-key "\\undefined\n") + (string-append "\\def\\" tex-key "{" tex-val "}\n")))) + +(define (number->dim x) + (string-append + ;;ugh ly-* in backend needs compatibility func for standalone output + (ly-number->string x) " \\outputscale ")) + +(define (placebox x y s) + (string-append + "\\placebox{" + (number->dim y) "}{" (number->dim x) "}{" s "}%\n")) + +(define (bezier-sandwich l thick) + (embedded-ps (list 'bezier-sandwich `(quote ,l) thick))) + +(define (start-line ht) + (string-append"\\vbox to " (number->dim ht) "{\\hbox{%\n")) + +(define (stop-line) + "}\\vss}\\interscoreline\n") +(define (stop-last-line) + "}\\vss}") + +(define (filledbox breapth width depth height) + (if (defined? 'ps-testing) + (embedded-ps + (string-append (numbers->string (list breapth width depth height)) + " draw_box" )) + (string-append + "\\kern" (number->dim (- breapth)) + "\\vrule width " (number->dim (+ breapth width)) + "depth " (number->dim depth) + "height " (number->dim height) " "))) + +(define (text s) + (string-append "\\hbox{" (output-tex-string s) "}")) + +(define (tuplet ht gapx dx dy thick dir) + (embedded-ps (list 'tuplet ht gapx dx dy thick dir))) + +(define (volta h w thick vert_start vert_end) + (embedded-ps (list 'volta h w thick vert_start vert_end))) +(define (between-system-string string) + string ) +(define (define-origin file line col) + (if (procedure? point-and-click) + (string-append "\\special{src\\string:" + (point-and-click line col file) + "}" ) + "") + ) + + ; no-origin not yet supported by Xdvi +(define (no-origin) "") -(define (scm-tex-output) - (primitive-eval (tex-scm 'all-definitions))) +(define (tex-output-expression expr port) + (display (eval expr this-module) port ) + ) diff --git a/scripts/abc2ly.py b/scripts/abc2ly.py index 6428e0f105..23aa46d397 100644 --- a/scripts/abc2ly.py +++ b/scripts/abc2ly.py @@ -32,7 +32,8 @@ # the default placement for text in abc is above the staff. # %%LY now supported. # \breve and \longa supported. - +# M:none doesn't crash lily. + # Limitations # # Multiple tunes in single file not supported @@ -163,6 +164,7 @@ def dump_header (outf,hdr): ks = hdr.keys () ks.sort () for k in ks: + hdr[k] = re.sub('"', '\\"', hdr[k]) outf.write ('\t%s = "%s"\n'% (k,hdr[k])) outf.write ('}') @@ -225,7 +227,7 @@ def try_parse_q(a): array2=string.split(array[1],'=') denominator=array2[0] perminute=array2[1] - duration=str(string.atof(denominator)/string.atoi(numerator)) + duration=str(string.atoi(denominator)/string.atoi(numerator)) midi_specs=string.join(["\\tempo", duration, "=", perminute]) else: sys.stderr.write("abc2ly: Warning, unable to parse Q specification: %s\n" % a) @@ -489,8 +491,10 @@ def try_parse_tuplet_begin (str, state): if re.match ('\([2-9]', str): dig = str[1] str = str[2:] - state.parsing_tuplet = string.atoi (dig[0]) - + prev_tuplet_state = state.parsing_tuplet + state.parsing_tuplet = string.atoi (dig[0]) + if prev_tuplet_state: + voices_append ("}") voices_append ("\\times %s {" % tup_lookup[dig]) return str @@ -585,7 +589,10 @@ def try_parse_header_line (ln, state): a = re.sub('[ \t]*$','', a) #strip trailing blanks if header.has_key('title'): if a: - header['title'] = header['title'] + '\\\\\\\\' + a + if len(header['title']): + header['title'] = header['title'] + '\\\\\\\\' + a + else: + header['subtitle'] = a else: header['title'] = a if g == 'M': # Meter @@ -603,7 +610,8 @@ def try_parse_header_line (ln, state): set_default_len_from_time_sig (a) else: length_specified = 0 - voices_append ('\\time %s' % a) + if not a == 'none': + voices_append ('\\time %s' % a) state.next_bar = '' if g == 'K': # KEY a = check_clef(a) @@ -712,6 +720,9 @@ def duration_to_lilypond_duration (multiply_tup, defaultlen, dots): if base == 1: if (multiply_tup[0] / multiply_tup[1]) == 2: base = '\\breve' + if (multiply_tup[0] / multiply_tup[1]) == 3: + base = '\\breve' + dots = 1 if (multiply_tup[0] / multiply_tup[1]) == 4: base = '\longa' return '%s%s' % ( base, '.'* dots) diff --git a/scripts/etf2ly.py b/scripts/etf2ly.py index 7b902765f2..f80334bc14 100644 --- a/scripts/etf2ly.py +++ b/scripts/etf2ly.py @@ -256,7 +256,8 @@ class Global_measure: def set_timesig (self, finale): (beats, fdur) = finale (log, dots) = EDU_to_duration (fdur) - assert dots == 0 + if dots <> 0: + sys.stderr.write ("\nHuh? Beat duration has a dot? (EDU Duration = %d)" % fdur) self.timesig = (beats, log) def length (self): @@ -992,8 +993,11 @@ class Etf_file: frame_obj_list = [None] for frno in m.frames: - fr = self.frames[frno] - frame_obj_list.append (fr) + try: + fr = self.frames[frno] + frame_obj_list.append (fr) + except IndexError: + sys.stderr.write ("\nNon-existent frame %d" % frno) m.frames = frame_obj_list for fr in frame_obj_list[1:]: diff --git a/stepmake/stepmake/metafont-rules.make b/stepmake/stepmake/metafont-rules.make index 01feec1d1b..b8d78cf76f 100644 --- a/stepmake/stepmake/metafont-rules.make +++ b/stepmake/stepmake/metafont-rules.make @@ -26,6 +26,13 @@ $(outdir)/%.$(XPM_RESOLUTION)gf: %.mf $(outdir)/%.$(XPM_RESOLUTION)pk: $(outdir)/%.$(XPM_RESOLUTION)gf gftopk $< $@ + +$(outdir)/%.pfb: + pktrace $(basename $(@F)) + mv $(basename $(@F)).pfb $(outdir) + + + #%.afm: # $(SHELL) $(depth)/buildscripts/tfmtoafm.sh $(shell basename $@ .afm) # mv $@ $@.in diff --git a/stepmake/stepmake/metafont-targets.make b/stepmake/stepmake/metafont-targets.make index eac21cf496..616e5868a7 100644 --- a/stepmake/stepmake/metafont-targets.make +++ b/stepmake/stepmake/metafont-targets.make @@ -7,3 +7,6 @@ pks: $(addprefix $(outdir)/, $(XPM_FONTS:%=%.$(XPM_RESOLUTION)pk)) xpms: $(addprefix $(outdir)/, $(XPM_FONTS:%=%.afm)) pks $(foreach i, $(XPM_FONTS), $(SHELL) $(depth)/buildscripts/mf-to-xpms.sh $(i) && ) true + +pfb: $(PFB_FILES) + -- 2.39.2