release: 1.3.106

[lilypond.git] / scm / lily.scm

diff --git a/scm/lily.scm b/scm/lily.scm
index a2834f250ec0ec2bc415daf3b4c3358f7a4b6b4e..6876a9cb6563701963920ccfe40e268c9616de0a 100644 (file)
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -1,16 +1,18 @@
-; lily.scm -- implement Scheme output routines for TeX and PostScript
-;
-;  source file of the GNU LilyPond music typesetter
-; 
-; (c) 1998 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; lily.scm -- implement Scheme output routines for TeX and PostScript
+;;;
+;;;  source file of the GNU LilyPond music typesetter
+;;; 
+;;; (c) 1998--2000 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
-;
-; This file contains various routines in Scheme that are easier to 
-; do here than in C++.  At present it is an unorganised mess. Sorry. 
-;
 
-; We should repartition the entire scm side of lily in a
-; more sane way, using namesspaces/modules?
+;;;
+;;; This file contains various routines in Scheme that are easier to 
+;;; do here than in C++.  At present it is an unorganised mess. Sorry. 
+
+
+;;; We should repartition the entire scm side of lily in a
+;;; more sane way, using namesspaces/modules?
 
 (debug-enable 'backtrace)
 
@@ -711,15 +713,10 @@
       (if (< x 0) -1 1)))
 
 (define (gulp-file name)
-  (let* ((port (open-file name "r"))
-        (content (let loop ((text ""))
-                      (let ((line (read-line port)))
-                           (if (or (eof-object? line)
-                                   (not line)) 
-                               text
-                               (loop (string-append text line "\n")))))))
-       (close port)
-       content))
+  (let* ((file (open-input-file name))
+        (text (read-delimited "" file)))
+    (close file)
+    text))
 
 ;; urg: Use when standalone, do:
 ;; (define ly-gulp-file scm-gulp-file)
@@ -761,10 +758,89 @@
 
 (begin
   (eval-string (ly-gulp-file "interface.scm"))
+  (eval-string (ly-gulp-file "beam.scm"))
   (eval-string (ly-gulp-file "slur.scm"))
-  (eval-string (ly-gulp-file "font.scm"))  
+  (eval-string (ly-gulp-file "font.scm"))
+  (eval-string (ly-gulp-file "auto-beam.scm"))  
   (eval-string (ly-gulp-file "generic-property.scm"))
   (eval-string (ly-gulp-file "basic-properties.scm"))
   (eval-string (ly-gulp-file "chord-names.scm"))
-  (eval-string (ly-gulp-file "element-descriptions.scm"))  
+  (eval-string (ly-gulp-file "element-descriptions.scm"))
  )
+
+
+;;
+;; (name . (glyph clef-position octavation))
+;; -- the name clefOctavation is misleading the value 7 is 1 octave not 7 Octaves.
+;;
+(define supported-clefs '(
+         ("treble" . ("clefs-G" -2 0))
+         ("violin" . ("clefs-G" -2 0))
+         ("G" . ("clefs-G" -2 0))
+         ("G2" . ("clefs-G" -2 0))
+         ("french" . ("clefs-G" -4  0))
+         ("soprano" . ("clefs-C" -4  0))
+         ("mezzosoprano" . ("clefs-C" -2  0))
+         ("alto" . ("clefs-C" 0  0))
+         ("tenor" . ("clefs-C" 2  0))
+         ("baritone" . ("clefs-C" 4  0))
+         ("varbaritone"  . ("clefs-F" 0 0))
+         ("bass" . ("clefs-F" 2  0))
+         ("F" . ( "clefs-F" 2 0))
+         ("subbass" . ("clefs-F" 4 0))
+
+         ;; should move mensural stuff to separate file? 
+         ("vaticana_do1" . ("clefs-vaticana_do" -1 0))
+         ("vaticana_do2" . ("clefs-vaticana_do" 1 0))
+         ("vaticana_do3" . ("clefs-vaticana_do" 3 0))
+         ("vaticana_fa1" . ("clefs-vaticana_fa" -1 0))
+         ("vaticana_fa2" . ("clefs-vaticana_fa" 1 0))
+         ("medicaea_do1" . ("clefs-medicaea_do" -1 0))
+         ("medicaea_do2" . ("clefs-medicaea_do" 1 0))
+         ("medicaea_do3" . ("clefs-medicaea_do" 3 0))
+         ("medicaea_fa1" . ("clefs-medicaea_fa" -1 0))
+         ("medicaea_fa2" . ("clefs-medicaea_fa" 1 0))
+         ("hufnagel_do1" . ("clefs-hufnagel_do" -1 0))
+         ("hufnagel_do2" . ("clefs-hufnagel_do" 1 0))
+         ("hufnagel_do3" . ("clefs-hufnagel_do" 3 0))
+         ("hufnagel_fa1" . ("clefs-hufnagel_fa" -1 0))
+         ("hufnagel_fa2" . ("clefs-hufnagel_fa" 1 0))
+         ("hufnagel" . ("clefs-hufnagel_do_fa" 4 0))
+         ("mensural1_c1" . ("clefs-mensural1_c" -4 0))
+         ("mensural1_c2" . ("clefs-mensural1_c" -2 0))
+         ("mensural1_c3" . ("clefs-mensural1_c" 0 0))
+         ("mensural1_c4" . ("clefs-mensural1_c" 2 0))
+         ("mensural2_c1" . ("clefs-mensural2_c" -4 0))
+         ("mensural2_c2" . ("clefs-mensural2_c" -2 0))
+         ("mensural2_c3" . ("clefs-mensural2_c" 0 0))
+         ("mensural2_c4" . ("clefs-mensural2_c" 2 0))
+         ("mensural2_c5" . ("clefs-mensural2_c" 4 0))
+         ("mensural3_c1" . ("clefs-mensural3_c" -2 0))
+         ("mensural3_c2" . ("clefs-mensural3_c" 0 0))
+         ("mensural3_c3" . ("clefs-mensural3_c" 2 0))
+         ("mensural3_c4" . ("clefs-mensural3_c" 4 0))
+         ("mensural_f" . ("clefs-mensural_f" 2 0))
+       )
+)
+
+(define (clef-name-to-properties cl)
+  (let ((e (assoc cl supported-clefs))
+       )
+    (if (pair? e)
+       `(((symbol . clefGlyph)
+          (type . property-set)
+          (value . ,(cadr e))
+          )
+         ((symbol . clefPosition)
+          (type . property-set)
+          (value . ,(caddr e))
+          )
+         ((symbol . clefOctavation)
+          (type . property-set)
+          (value . ,(caddr (cdr e)))
+         )
+         )
+       (begin
+         (ly-warn (string-append "Unknown clef type `" cl "'\nSee scm/lily.scm for supported clefs"))
+         '())
+    )))