From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Fri, 23 Oct 1998 13:51:54 +0000 (+0200)
Subject: partial: 1.1.0.jcn
X-Git-Tag: release/1.1.0~1
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=7fa94555679e3197028b1ab3fea02c374cd855da;p=lilypond.git

partial: 1.1.0.jcn
---

diff --git a/init/scm.ly b/init/scm.ly
new file mode 100644
index 0000000000..bd27dec6f4
--- /dev/null
+++ b/init/scm.ly
@@ -0,0 +1,341 @@
+% 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\")
+
+";
+
+
diff --git a/lily/include/graphical-lisp-element.hh b/lily/include/graphical-lisp-element.hh
new file mode 100644
index 0000000000..531322bf72
--- /dev/null
+++ b/lily/include/graphical-lisp-element.hh
@@ -0,0 +1,39 @@
+/*
+  graphical-lisp-element.hh -- declare Graphical_lisp_element
+
+  source file of the GNU LilyPond music typesetter
+
+  (c) 1998 Jan Nieuwenhuizen <janneke@gnu.org>
+*/
+
+
+#ifndef GRAPHICAL_LISP_ELEMENT_HH
+#define GRAPHICAL_LISP_ELEMENT_HH
+#error
+#include "lily-guile.hh"
+#include "lily-proto.hh"
+#include "string.hh"
+
+#define virtual
+#define static
+#include "virtual-methods.hh"
+
+class Graphical_lisp_element 
+{
+public:
+  DECLARE_MY_RUNTIME_TYPEINFO;
+
+  Graphical_lisp_element (String);
+
+  void* access (String);
+  void call (String, void*);
+
+private:
+  String type_str_;
+};
+
+#undef virtual
+#undef static
+
+#endif // GRAPHICAL_LISP_ELEMENT_HH
+
diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc
new file mode 100644
index 0000000000..daa7588554
--- /dev/null
+++ b/lily/lily-guile.cc
@@ -0,0 +1,99 @@
+/*
+  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;
+}
+