+1.5.20.jcn1
+===========
+
+* 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.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
+======
+
1.5.19.jcn3
===========
- textrace:
wget http://www.inf.bme.hu/~pts/textrace-latest.tar.gz
tar xzf textrace-latest.tar.gz
-@@ -15,18 +17,23 @@
(cd autotrace-0.27ap; ./configure; make)
./traceall.sh feta20 feta20.pfb $HOME/usr/src/lilypond/mf/out
- - copy mf/out/feta20.* to sketch/Resources/Fontmetrics
+ - copy mf/out/feta20.* to sketch/Resources/Fontmetrics:
- append to sketch/Resources/Fontmetrics/std.sfd:
- echo 'TeX-feta20,feta20,Roman,-gnu-feta20-medium-r-normal,adobe-fontspec\ific,feta20' > $HOME/usr/src/sketch/sketch/Resources/Fontmetrics/std.sfd
+ echo 'TeX-feta20,feta20,Roman,-gnu-feta20-medium-r-normal,adobe-fontspecific,feta20' >> $HOME/usr/src/sketch/sketch/Resources/Fontmetrics/std.sfd
- Hmm, then find that
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.
./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
--- /dev/null
+
+
+
+\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
+}
+}
+
}
\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
+}
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)) ();
}
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 ();
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 *);
};
--- /dev/null
+/*
+stream.hh -- declare compatibility glue for gcc 3.
+
+source file of the GNU LilyPond music typesetter
+
+(c) 2001 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+ */
+
+#ifndef STREAM_HH
+#define STREAM_HH
+#include "string.hh"
+
+
+#include <iostream.h> /* 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 */
+
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)
SCM my_gh_symbol2scm (const char* x)
{
- return gh_symbol2scm (x);
+ return gh_symbol2scm ((char*)x);
}
{
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));
}
}
}
*/
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.
#include <iostream.h>
#include <assert.h>
#include <locale.h>
+#include <stdio.h>
#include "config.h"
"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;
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);
}
/**
}
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 ();
(c) 1997--2001 Jan Nieuwenhuizen <janneke@gnu.org>
*/
-#include <fstream.h>
-#include "paper-stream.hh"
+
+#include "stream.hh"
#include "string.hh"
#include "string-convert.hh"
#include "main.hh"
*/
#include <time.h>
-#include <fstream.h>
+
#include <math.h>
-#include <iostream.h>
+
#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"
/*
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);
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);
}
);
}
-
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
SCM k = ly_caar (s);
SCM v = ly_cdar (s);
String s = ly_symbol2string (k);
-
if (gh_string_p (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 ("<stdout>") : 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
{
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));
}
}
}
#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"
--- /dev/null
+#include "config.h"
+
+#include <stdlib.h>
+#include <errno.h>
+#include <sys/types.h>
+#if HAVE_SYS_STAT_H
+#include <sys/stat.h>
+#endif
+#include <iostream.h>
+#include <fstream.h>
+
+#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;
+}
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?
-(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
'(
(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))
(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)))
+ "")))
;;; General settings
+
+
+
(debug-enable 'backtrace)
(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"
(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 "")))
+
+
+
-(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) "")
+
+
--- /dev/null
+;;; pysk.scm -- implement Python output routines (for Sketch)
+;;;
+;;; source file of the GNU LilyPond music typesetter
+;;;
+;;; (c) 1998--2001 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+
+
+(define-module (scm pysk)
+ :export (pysk-output-expression)
+ :no-backtrace
+ )
+
+(use-modules (scm ps)
+ (ice-9 regex)
+ (ice-9 string-fun)
+ (guile-user)
+ (guile)
+ )
+
+(define this-module (current-module))
+(define (pysk-output-expression expr port)
+ (display (pythonify expr) port )
+ )
+
+(define (ly-warn s) (display s))
+
+(define (pythonify q)
+ (cond
+ ((string? q) (py-str q))
+ ((symbol? q) (py-str (symbol->string q)))
+ ((and (pair? q)
+ (not (pair? (cdr q)))
+ (not (eq? '() (cdr q)))
+ ) (py-tuple q))
+ ((pair? q) (py-listify q))
+ ((number? q) (number->string q))
+ ((eq? q '()) '())
+ (else (begin
+ (ly-warn "Unknown object to pythonify:")
+ (write q)
+ (newline)
+ )
+ )))
+
+(define (py-str s)
+ (string-append "'" s "'")
+ )
+
+(define (py-tuple q)
+ (string-append "(" (pythonify (car q)) "," (pythonify (cdr q)) ")")
+ )
+
+(define (reduce-list list between)
+ "Create new list, inserting BETWEEN between elements of LIST"
+ (if (null? list)
+ '()
+ (if (null? (cdr list))
+ list
+ (cons (car list)
+ (cons between (reduce-list (cdr list) between)))
+
+ )))
+
+(define (string-join str-list sep)
+ (apply string-append (reduce-list str-list sep))
+ )
+
+(define (my-map f l)
+ (if (null? l)
+ '()
+ (if (pair? (cdr l))
+ (cons (f (car l)) (my-map f (cdr l)))
+ (cons (f (car l)) (f (cdr l)))
+ )
+ ))
+
+(define (tuplify-list lst)
+ (if (null? lst)
+ '()
+ (if (pair? (cdr lst))
+ (cons (car lst) (tuplify-list (cdr lst)))
+ (if (eq? '() (cdr lst))
+ lst
+ (list (string-append "(" (car lst) ", " (cdr lst) ")" ))
+ ))
+ ))
+
+(define (py-listify q)
+ (string-append
+ "["
+ (string-join
+ (tuplify-list (my-map pythonify q)) ",")
+ "]\n"
+ ))
+
+
-
-
-(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))
- )
- )
-
-
;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
+(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 #<unspecified> --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) "<stdout>" 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 )
+ )
projects / lilypond.git / commitdiff