* The grand 2005-2006 replace.

[lilypond.git] / scm / lily-library.scm

diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index b9e326cae7167dd7de8ab359020c4d5c0f5a9070..52779ceef4feaa52c835f98bbea335783804feb2 100644 (file)
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -2,7 +2,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c) 1998--2005 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 1998--2006 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 
@@ -43,25 +43,25 @@
 
 ;; parser stuff.
 (define-public (print-music-as-book parser music)
-  (let* ((head (ly:parser-lookup parser '$globalheader))
-        (book (ly:make-book (ly:parser-lookup parser $defaultpaper)
-                            head score)))
-    (ly:parser-print-book parser book)))
+  (let* ((head (ly:parser-lookup parser '$defaultheader))
+        (book (ly:make-book (ly:parser-lookup parser '$defaultpaper)
+                            head (scorify-music music parser))))
+    (print-book-with-defaults parser book)))
 
 (define-public (print-score-as-book parser score)
-  (let* ((head (ly:parser-lookup parser '$globalheader))
-        (book (ly:make-book (ly:parser-lookup parser $defaultpaper)
+  (let* ((head (ly:parser-lookup parser '$defaultheader))
+        (book (ly:make-book (ly:parser-lookup parser '$defaultpaper)
                             head score)))
-    (ly:parser-print-book parser book)))
+    (print-book-with-defaults parser book)))
 
 (define-public (print-score parser score)
-  (let* ((head (ly:parser-lookup parser '$globalheader))
-        (book (ly:make-book (ly:parser-lookup parser $defaultpaper)
+  (let* ((head (ly:parser-lookup parser '$defaultheader))
+        (book (ly:make-book (ly:parser-lookup parser '$defaultpaper)
                             head score)))
     (ly:parser-print-score parser book)))
                
 (define-public (collect-scores-for-book parser score)
-  (ly:parser-define
+  (ly:parser-define!
    parser 'toplevel-scores
    (cons score (ly:parser-lookup parser 'toplevel-scores))))
 
@@ -72,16 +72,62 @@
              (set! music (func music parser)))
            toplevel-music-functions)
 
-;  (display-scheme-music  music)
   (ly:make-score music))
 
-
 (define-public (collect-music-for-book parser music)
   (collect-scores-for-book parser (scorify-music music parser)))
 
-  
+
+(define-public (print-book-with-defaults parser book)
+  (let*
+      ((paper (ly:parser-lookup parser '$defaultpaper))
+       (layout (ly:parser-lookup parser '$defaultlayout))
+       (count (ly:parser-lookup parser 'output-count))
+       (base (ly:parser-output-name parser)))
+
+    (if (not (integer? count))
+       (set! count 0))
+
+    (if (> count 0)
+       (set! base (format #f "~a-~a" base count)))
+
+    (ly:parser-define! parser 'output-count (1+ count))
+    (ly:book-process book paper layout base)
+    ))
+
+(define-public (print-score-with-defaults parser score)
+  (let*
+      ((paper (ly:parser-lookup parser '$defaultpaper))
+       (layout (ly:parser-lookup parser '$defaultlayout))
+       (header (ly:parser-lookup parser '$defaultheader))
+       (count (ly:parser-lookup parser 'output-count))
+       (base (ly:parser-output-name parser)))
+
+    (if (not (integer? count))
+       (set! count 0))
+
+    (if (> count 0)
+       (set! base (format #f "~a-~a" base count)))
+
+    (ly:parser-define! parser 'output-count (1+ count))
+    
+
+    (ly:score-process score header paper layout base)
+    ))
+
+
+(define-public (paper-system-title? system)
+  (equal? #t (ly:paper-system-property system 'is-title)
+         ))
+
+(define-public (paper-system-stencil system)
+  (ly:paper-system-property system 'stencil))
+
+(define-public (paper-system-extent system axis)
+  (ly:stencil-extent (paper-system-stencil system) axis))
+
 ;;;;;;;;;;;;;;;;
-; alist
+;; alist
 (define-public assoc-get ly:assoc-get)
 
 (define-public (uniqued-alist alist acc)
@@ -280,6 +326,16 @@ found."
 (define-public interval-start car)
 (define-public interval-end cdr)
 
+(define-public (interval-center x)
+  "Center the number-pair X, when an interval"
+  (/ (+ (car x) (cdr x)) 2))
+
+(define-public interval-start car)
+(define-public interval-end cdr)
+(define-public (interval-translate iv amount)
+  (cons (+ amount (car iv))
+       (+ amount (cdr iv))))
+
 (define (other-axis a)
   (remainder (+ a 1) 2))
 
@@ -287,6 +343,10 @@ found."
    (cons (- (car iv) amount)
          (+ (cdr iv) amount)))
 
+
+(define-public (interval-empty? iv)
+   (> (car iv) (cdr iv)))
+
 (define-public (interval-union i1 i2)
    (cons (min (car i1) (car i2))
         (max (cdr i1) (cdr i2))))
@@ -325,7 +385,6 @@ possibly turned off."
 (define-public (string-regexp-substitute a b str)
   (regexp-substitute/global #f a str 'pre b 'post)) 
 
-
 (define (regexp-split str regex)
   (define matches '())
   (define end-of-prev-match 0)
@@ -355,6 +414,9 @@ possibly turned off."
 (define-public (symbol<? lst r)
   (string<? (symbol->string lst) (symbol->string r)))
 
+(define-public (symbol-key<? lst r)
+  (string<? (symbol->string (car lst)) (symbol->string (car r))))
+
 ;;
 ;; don't confuse users with #<procedure .. > syntax. 
 ;;