X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily-library.scm;h=0746876ca3d6625d9c678c857618fe38f8ebf00a;hb=53beda01ed73495a40ccb0caab9abd60b2c536cf;hp=cb240332ca0bab1aaf547ba141c6d67229fea44e;hpb=7a3c3526e082ada6fefbe564315046a14ecf609c;p=lilypond.git

diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index cb240332ca..0746876ca3 100644
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -49,44 +49,28 @@
 (define-public (moment-min a b)
   (if (ly:moment<? a b) a b))
 
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; arithmetic
 (define-public (average x . lst)
   (/ (+ x (apply + lst)) (1+ (length lst))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; lily specific variables.
-
-(define-public default-script-alist '())
-
-
-;; parser stuff.
-(define-public (print-music-as-book parser music)
-  (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 '$defaultheader))
-	 (book (ly:make-book (ly:parser-lookup parser '$defaultpaper)
-			     head score)))
-    (print-book-with-defaults parser book)))
+;; parser <-> output hooks.
 
-(define-public (print-score parser score)
-  (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!
    parser 'toplevel-scores
    (cons score (ly:parser-lookup parser 'toplevel-scores))))
 
+(define-public (collect-music-for-book parser music)
+  ;; discard music if its 'void property is true.
+  (let ((void-music (ly:music-property music 'void)))
+    (if (or (null? void-music) (not void-music))
+        (collect-scores-for-book parser (scorify-music music parser)))))
 
 (define-public (scorify-music music parser)
+  "Preprocess MUSIC."
   
   (for-each (lambda (func)
 	      (set! music (func music parser)))
@@ -94,38 +78,15 @@
 
   (ly:make-score music))
 
-(define-public (collect-music-for-book parser music)
-  ;; discard music if its 'void property is true.
-  (let ((void-music (ly:music-property music 'void)))
-    (if (or (null? void-music) (not void-music))
-        (collect-scores-for-book parser (scorify-music music parser)))))
-
-
-(define-public (print-book-with-defaults parser book)
+(define (print-book-with parser book process-procedure)
   (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)))
 
+    ;; must be careful: output-count is under user control.
     (if (not (integer? count))
 	(set! count 0))
 
@@ -133,9 +94,14 @@
 	(set! base (format #f "~a-~a" base count)))
 
     (ly:parser-define! parser 'output-count (1+ count))
-    (ly:score-process score header paper layout base)
+    (process-procedure book paper layout base)
     ))
 
+(define-public (print-book-with-defaults parser book)
+  (print-book-with parser book ly:book-process))
+
+(define-public (print-book-with-defaults-as-systems parser book)
+  (print-book-with parser book ly:book-process-to-systems))
 
 ;;;;;;;;;;;;;;;;
 ;; alist
@@ -222,24 +188,9 @@ found."
 ;;;;;;;;;;;;;;;;
 ;; hash
 
-(if (not (defined? 'hash-table?)) ;; guile 1.6 compat
-    (begin
-      (define hash-table? vector?)
-      (define-public (hash-for-each proc tab)
-	(hash-fold (lambda (k v prior)
-		     (proc k v)
-		     #f)
-		   #f
-		   tab))
-      (define-public (hash-table->alist t)
-	"Convert table t to list"
-	(apply append (vector->list t))))
-
-    ;; native hashtabs.
-    (begin
-      (define-public (hash-table->alist t)
-	(hash-fold (lambda (k v acc) (acons  k v  acc))
-		   '() t))))
+(define-public (hash-table->alist t)
+  (hash-fold (lambda (k v acc) (acons  k v  acc))
+	     '() t))
 
 ;; todo: code dup with C++. 
 (define-safe-public (alist->hash-table lst)
@@ -429,6 +380,9 @@ found."
 
 (define-public interval-end cdr)
 
+(define-public (interval-bound interval dir)
+  ((if (= dir RIGHT) cdr car) interval))
+
 (define-public (interval-index interval dir)
   "Interpolate INTERVAL between between left (DIR=-1) and right (DIR=+1)"
   
@@ -472,9 +426,16 @@ found."
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-
-
+;; string
+
+(define-public (string-endswith s suffix)
+  (equal? suffix (substring s
+			    (max 0 (- (string-length s) (string-length suffix)))
+			    (string-length s))))
+	     
+(define-public (string-startswith s prefix)
+  (equal? prefix (substring s 0 (min (string-length s) (string-length prefix)))))
+	     
 (define-public (string-encode-integer i)
   (cond
    ((= i  0) "o")
@@ -565,6 +526,12 @@ possibly turned off."
       0
       (if (< x 0) -1 1)))
 
+(define-public (round2 num)
+  (/ (round (* 100 num)) 100))
+
+(define-public (round4 num)
+  (/ (round (* 10000 num)) 10000))
+
 (define-public (car< a b) (< (car a) (car b)))
 
 (define-public (symbol<? lst r)
@@ -620,14 +587,16 @@ possibly turned off."
 
 (define-public (version-not-seen-message input-file-name)
   (ly:message
-   (string-append
-    input-file-name ": 0: " (_ "warning: ")
-   (format #f
-	   (_ "no \\version statement found, please add~afor future compatibility")
-	   (format #f "\n\n\\version ~s\n\n" (lilypond-version))))))
+   "~a:0: ~a: ~a" 
+    input-file-name
+    (_ "warning: ")
+    (format #f
+	    (_ "no \\version statement found, please add~afor future compatibility")
+	    (format #f "\n\n\\version ~s\n\n" (lilypond-version)))))
 
 (define-public (old-relative-not-used-message input-file-name)
   (ly:message
-   (string-append
-    input-file-name ": 0: " (_ "warning: ")
-    (_ "old relative compatibility not used"))))
+   "~a:0: ~a: ~a" 
+    input-file-name
+    (_ "warning: ")
+    (_ "old relative compatibility not used")))