--- /dev/null
+% scm.ly -- implement Scheme output routines for TeX and PostScript
+%
+% source file of the GNU LilyPond music typesetter
+%
+% (c) 1998 Jan Nieuwenhuizen <janneke@gnu.org>
+
+\scm "
+
+;;; graphical lisp element
+(define (add-column p) (display \"adding column (in guile): \") (display p) (newline))
+
+;;; library funtions
+(define
+ (numbers->string l)
+ (apply string-append
+ (map (lambda (n) (string-append (number->string n) \" \")) l)))
+
+(define (number->octal-string x)
+ (let* ((n (inexact->exact x))
+ (n64 (quotient n 64))
+ (n8 (quotient (- n (* n64 64)) 8)))
+ (string-append
+ (number->string n64)
+ (number->string n8)
+ (number->string (remainder (- n (+ (* n64 64) (* n8 8))) 8)))))
+
+(define (inexact->string x radix)
+ (let ((n (inexact->exact x)))
+ (number->string n radix)))
+
+(define
+ (number->dim-tex x)
+ (string-append
+ (number->string x) \"pt \"))
+
+(define
+ (control->string c)
+ (string-append
+ (string-append (number->string (car c)) \" \")
+ (string-append (number->string (cadr c)) \" \")))
+
+(define
+ (invoke-output o s)
+ (eval-string (string-append s \"-\" o)))
+
+;;; output definitions
+(define
+ (char o n)
+ ((invoke-output o \"char\") n))
+
+(define
+ (char-ps n)
+ (string-append
+ \"(\\\\\" (inexact->string n 8) \") show\"))
+
+(define
+ (char-tex n)
+ (string-append
+ \"\\\\char\" (inexact->string n 10)))
+
+(define
+ (dashed-slur o thick dash l)
+ ((invoke-output o \"dashed-slur\") thick dash l))
+
+(define
+ (dashed-slur-ps thick dash l)
+ (string-append
+ (apply string-append (map control->string l))
+ (number->string thick)
+ \" [ \"
+ (if (> 1 dash) (number->string (- (* thick dash) thick)) \"0\") \" \"
+ (number->string (* 2 thick))
+ \" ] 0 draw_dashed_slur\"))
+
+(define
+ (dashed-slur-tex thick dash l)
+ (string-append
+ \"\\\\embeddedps{\"
+ (dashed-slur-ps thick dash l)
+ \"}\"))
+
+(define
+ (empty o)
+ ((invoke-output o \"empty\")))
+
+(define
+ (empty-ps)
+ \"\n empty\n\")
+
+(define
+ (empty-tex)
+ \"%\n\\\\empty%\n\")
+
+(define
+ (end-output o)
+ ((invoke-output o \"end-output\")))
+
+(define
+ (end-output-ps)
+ \"\nshowpage\n\")
+
+(define
+ (end-output-tex)
+ \"\n\\\\EndLilyPondOutput\")
+
+(define
+ (experimental-on o)
+ ((invoke-output o \"experimental-on\")))
+
+(define
+ (experimental-on-ps) \"\")
+
+(define
+ (experimental-on-tex) \"\\\\turnOnExperimentalFeatures\")
+
+(define
+ (finishbar o h) (empty o))
+
+(define
+ (font i)
+ (string-append
+ \"font\"
+ (make-string 1 (integer->char (+ (char->integer #\\A) i)))
+ ))
+
+(define
+ (font-def o i s)
+ (empty o))
+; ((invoke-output o \"font-def\") i s))
+
+(define
+ (font-def-ps i s)
+ (string-append
+ \"\n/\" (font i) \" {/\"
+ (substring s 0 (- (string-length s) 3))
+ \" findfont 12 scalefont setfont} bind def\n\"))
+
+(define
+ (font-def-tex i s)
+ (string-append
+ \"\\\\font\" (font-switch-tex i) \"=\" s \"\n\"))
+
+(define
+ (font-switch o i)
+ ((invoke-output o \"font-switch\") i))
+
+(define
+ (font-switch-ps i)
+ (string-append (font i) \" \"))
+
+(define
+ (font-switch-tex i)
+ (string-append
+ \"\\\\\" (font i) \"\n\"))
+
+(define
+ (generalmeter o num den)
+ ((invoke-output o \"generalmeter\") num den))
+
+(define
+ (generalmeter-ps num den)
+ (string-append num \" \" den \" generalmeter \"))
+
+(define
+ (generalmeter-tex num den)
+ (string-append
+ \"\\\\generalmeter{\" num \"}{\" den \"}\"))
+
+(define
+ (header o creator generate)
+ ((invoke-output o \"header\") creator generate))
+
+(define
+ (header-ps creator generate)
+ (string-append
+ \"%!PS-Adobe-3.0\n\"
+ \"%%Creator: \" creator generate \"\n\"))
+
+(define
+ (header-tex creator generate)
+ (string-append
+ \"%created by: \" creator generate \"\n\"))
+
+(define
+ (header-end o)
+ ((invoke-output o \"header-end\")))
+
+(define
+ (header-end-ps) \"\")
+
+(define
+ (header-end-tex) \"\\\\turnOnPostScript\")
+
+(define
+ (lily-def o key val)
+ ((invoke-output o \"lily-def\") key val))
+
+(define
+ (lily-def-ps key val)
+ (string-append
+ \"/\" key \" {\" val \"} bind def\n\"))
+
+(define
+ (lily-def-tex key val)
+ (string-append
+ \"\\\\def\\\\\" key \"{\" val \"}\n\"))
+
+(define
+ (maatstreep o h)
+ ((invoke-output o \"maatstreep\") h))
+
+(define
+ (maatstreep-ps h)
+ (string-append
+ (number->string h) \" maatstreep \" ))
+
+(define
+ (maatstreep-tex h)
+ (string-append
+ \"\n\\\\maatstreep{\" (number->dim-tex h) \"}\"))
+
+(define
+ (pianobrace o h) (empty o))
+
+(define
+ (placebox o x y b)
+ ((invoke-output o \"placebox\") x y (b o)))
+
+(define
+ (placebox-ps x y s)
+ (string-append
+ (number->string x) \" \" (number->string y) \" {\" s \"} placebox \"))
+
+(define
+ (placebox-tex x y s)
+ (string-append
+ \"\\\\placebox{\"
+ (number->dim-tex y) \"}{\" (number->dim-tex x) \"}{\" s \"}\"))
+
+(define
+ (repeatbar o h) (empty o))
+
+(define
+ (rulesym o x y)
+ ((invoke-output o \"rulesym\") x y))
+
+(define
+ (rulesym-ps x y)
+ (string-append
+ (number->string x) \" \"
+ (number->string y) \" \"
+ \"rulesym\"))
+
+(define
+ (rulesym-tex x y)
+ (string-append
+ \"\\\\rulesym{\" (number->dim-tex x) \"}{\" (number->dim-tex y) \"}\"))
+
+(define
+ (setitalic o s) (empty o))
+
+(define
+ (settext o s) (empty o))
+
+(define
+ (slur o l)
+ ((invoke-output o \"slur\") l))
+
+(define
+ (slur-ps l)
+ (string-append
+ (apply string-append (map control->string l))
+ \" draw_slur\"))
+
+(define
+ (slur-tex l)
+ (string-append
+ \"\\\\embeddedps{\"
+ (slur-ps l)
+ \"}\"))
+
+(define
+ (stem o kern width height depth)
+ ((invoke-output o \"stem\") kern width height depth))
+
+(define
+ (stem-ps kern width height depth)
+ (string-append (numbers->string (list kern width height depth))
+ \"draw_stem\" ))
+
+(define
+ (stem-tex kern width height depth)
+ (string-append
+ \"\\\\kern\" (number->dim-tex kern)
+ \"\\\\vrule width \" (number->dim-tex width)
+ \"depth \" (number->dim-tex depth)
+ \"height \" (number->dim-tex height) \" \"))
+
+(define
+ (start-line o)
+ ((invoke-output o \"start-line\")))
+
+(define
+ (start-line-ps)
+ (string-append
+ (urg-fix-font-ps)
+ \"\nstart_line {\n\"))
+
+(define
+ (start-line-tex)
+ (string-append
+ (urg-fix-font-tex)
+ \"\\\\hbox{%\n\"))
+
+(define
+ (stop-line o)
+ ((invoke-output o \"stop-line\")))
+
+(define
+ (stop-line-ps)
+ \"}\nstop_line\n\")
+
+(define
+ (stop-line-tex)
+ \"}\\\\interscoreline\")
+
+(define
+ (urg-fix-font-ps)
+ \"/fontA { /feta20 findfont 12 scalefont setfont} bind def fontA\n\")
+
+(define
+ (urg-fix-font-tex)
+ \"\\\\font\\\\fontA=feta20.afm\\\\fontA\n\")
+
+(define
+ (urg-font-switch-ps i)
+ \"\n/feta20 findfont 12 scalefont setfont \n\")
+
+";
+
+
--- /dev/null
+/*
+ lily-guile.cc -- implement assorted guile functions
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 1998 Jan Nieuwenhuizen <janneke@gnu.org>
+*/
+
+#include <stdio.h>
+#include "libc-extension.hh"
+#include "lily-guile.hh"
+#include "main.hh"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+SCM
+ly_append (SCM a, SCM b)
+{
+ return gh_call2 (gh_eval_str ("append"), a, b);
+}
+
+SCM
+ly_list1 (SCM a)
+{
+ return gh_call1 (gh_eval_str ("list"), a);
+}
+
+SCM
+ly_list2(SCM a, SCM b)
+{
+ return gh_call2 (gh_eval_str ("list"), a, b);
+}
+
+SCM
+ly_quote ()
+{
+ return gh_eval_str ("'quote");
+}
+
+SCM
+ly_eval (SCM a)
+{
+ return gh_call1 (gh_eval_str ("eval"), a);
+}
+
+SCM
+ly_lambda_o ()
+{
+ return gh_eval_str ("'(lambda (o))");
+}
+
+SCM
+ly_func_o (char const* name)
+{
+ char buf[200];
+ snprintf (buf, 200, "'(%s o)", name);
+ return gh_eval_str (buf);
+}
+
+#ifdef __cplusplus
+}
+#endif
+
+SCM
+lambda_scm (String str, Array<Scalar> args_arr)
+{
+ if (str.empty_b ())
+ {
+ str = "empty";
+ args_arr.clear ();
+ }
+ SCM args_scm = SCM_EOL;
+ for (int i = args_arr.size () - 1; i >= 0; i--)
+ args_scm = gh_cons (gh_str02scm (args_arr[i].ch_l ()), args_scm);
+ SCM scm =
+ ly_append (ly_lambda_o (),
+ ly_list1 (ly_append (ly_func_o (str.ch_l ()), args_scm)));
+ return scm;
+}
+
+SCM
+lambda_scm (String str, Array<Real> args_arr)
+{
+ if (str.empty_b ())
+ {
+ str = "empty";
+ args_arr.clear ();
+ }
+ SCM args_scm = SCM_EOL;
+ for (int i = args_arr.size () - 1; i >= 0; i--)
+ args_scm = gh_cons (gh_double2scm (args_arr[i]), args_scm);
+ SCM scm =
+ ly_append (ly_lambda_o (),
+ ly_list1 (ly_append (ly_func_o (str.ch_l ()), args_scm)));
+ return scm;
+}
+