Merge branch 'master' of git://git.sv.gnu.org/lilypond

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

diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index 3575e13264db2bfe53a05633b45d05a501d523fe..1e8fe97e477809c669338cb9072e8594a31adb16 100644 (file)
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -6,6 +6,8 @@
 ;;;; (c) 1998--2006 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; constants.
 
 (define-public X 0)
 (define-public Y 1)
@@ -17,22 +19,39 @@
 (define-public DOWN -1)
 (define-public CENTER 0)
 
-(define-safe-public DOUBLE-FLAT -4)
-(define-safe-public THREE-Q-FLAT -3)
-(define-safe-public FLAT -2)
-(define-safe-public SEMI-FLAT -1)
+(define-safe-public DOUBLE-FLAT-QTS -4)
+(define-safe-public THREE-Q-FLAT-QTS -3)
+(define-safe-public FLAT-QTS -2)
+(define-safe-public SEMI-FLAT-QTS -1)
+(define-safe-public NATURAL-QTS 0)
+(define-safe-public SEMI-SHARP-QTS 1)
+(define-safe-public SHARP-QTS 2)
+(define-safe-public THREE-Q-SHARP-QTS 3)
+(define-safe-public DOUBLE-SHARP-QTS 4)
+(define-safe-public SEMI-TONE-QTS 2)
+
+(define-safe-public DOUBLE-FLAT  -1)
+(define-safe-public THREE-Q-FLAT -3/4)
+(define-safe-public FLAT -1/2)
+(define-safe-public SEMI-FLAT -1/4)
 (define-safe-public NATURAL 0)
-(define-safe-public SEMI-SHARP 1)
-(define-safe-public SHARP 2)
-(define-safe-public THREE-Q-SHARP 3)
-(define-safe-public DOUBLE-SHARP 4)
-(define-safe-public SEMI-TONE 2)
+(define-safe-public SEMI-SHARP 1/4)
+(define-safe-public SHARP 1/2)
+(define-safe-public THREE-Q-SHARP 3/4)
+(define-safe-public DOUBLE-SHARP 1)
+(define-safe-public SEMI-TONE 1/2)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; moments
 
 (define-public ZERO-MOMENT (ly:make-moment 0 1)) 
 
 (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))))
 
@@ -42,6 +61,9 @@
 (define-public default-script-alist '())
 
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; parser <-> output hooks.
+
 ;; parser stuff.
 (define-public (print-music-as-book parser music)
   (let* ((head (ly:parser-lookup parser '$defaultheader))
@@ -66,7 +88,6 @@
    parser 'toplevel-scores
    (cons score (ly:parser-lookup parser 'toplevel-scores))))
 
-
 (define-public (scorify-music music parser)
   
   (for-each (lambda (func)
@@ -102,8 +123,6 @@
 (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)))
 
@@ -114,12 +133,40 @@
        (set! base (format #f "~a-~a" base count)))
 
     (ly:parser-define! parser 'output-count (1+ count))
-    (ly:score-process score header paper layout base)
-    ))
+
+    (if (not (ly:score-error? score))
+       (let*
+           ((header (ly:score-header score))
+            (output-defs (ly:score-output-defs score))
+            (layout-defs (filter  (lambda (d) (eq? #t (ly:output-def-lookup d 'is-layout)))
+                                 output-defs))
+            (midi-defs (filter (lambda (d)  (eq? #t (ly:output-def-lookup d 'is-midi)))
+                               output-defs))
+            (music (ly:score-music score))
+            (layout-def (if (null? layout-defs)
+                            (ly:parser-lookup parser '$defaultlayout)
+                            (car layout-defs))))
+
+         (if (not (module? header))
+             (set! header (ly:parser-lookup parser '$defaultheader)))
+            
+         (ly:render-music-as-systems
+          music layout-def paper header base)
+
+         (if (pair? midi-defs)
+             (ly:performance-write (ly:format-output (ly:run-translator music (car midi-defs)))
+                                   (format #f "~a.midi" base)
+                                   ))
+             
+    ))))
+
+
+
 
 
 ;;;;;;;;;;;;;;;;
 ;; alist
+
 (define-public assoc-get ly:assoc-get)
 
 (define-public (uniqued-alist alist acc)
@@ -192,6 +239,7 @@ found."
 
 ;;;;;;;;;;;;;;;;
 ;; vector
+
 (define-public (vector-for-each proc vec)
   (do
       ((i 0 (1+ i)))
@@ -230,6 +278,18 @@ found."
 ;;;;;;;;;;;;;;;;
 ;; list
 
+(define (functional-or . rest)
+  (if (pair? rest)
+      (or (car rest)
+          (apply functional-and (cdr rest)))
+      #f))
+
+(define (functional-and . rest)
+  (if (pair? rest)
+      (and (car rest)
+          (apply functional-and (cdr rest)))
+      #t))
+
 (define (split-list lst n)
   "Split LST in N equal sized parts"
   
@@ -257,6 +317,7 @@ found."
 
 (define-public (count-list lst)
   "Given lst (E1 E2 .. ) return ((E1 . 1) (E2 . 2) ... )  "
+
   (define (helper l acc count)
     (if (pair? l)
        (helper (cdr l) (cons (cons (car l) count) acc) (1+ count))
@@ -293,19 +354,17 @@ found."
   "Return list of elements in A that are not in B."
   (lset-difference eq? a b))
 
-;; TODO: use the srfi-1 partition function.
 (define-public (uniq-list lst)
-  
   "Uniq LST, assuming that it is sorted"
-  (define (helper acc lst) 
-    (if (null? lst)
-       acc
-       (if (null? (cdr lst))
-           (cons (car lst) acc)
-           (if (equal? (car lst) (cadr lst))
-               (helper acc (cdr lst))
-               (helper (cons (car lst) acc)  (cdr lst))))))
-  (reverse! (helper '() lst) '()))
+
+  (reverse! 
+   (fold (lambda (x acc)
+          (if (null? acc)
+              (list x)
+              (if (eq? x (car acc))
+                  acc
+                  (cons x acc))))
+        '() lst) '()))
 
 (define (split-at-predicate predicate lst)
  "Split LST = (a_1 a_2 ... a_k b_1 ... b_k)
@@ -314,6 +373,7 @@ found."
   L1 is copied, L2 not.
 
   (split-at-predicate (lambda (x y) (= (- y x) 2)) '(1 3 5 9 11) (cons '() '()))"
+ 
  ;; " Emacs is broken
 
  (define (inner-split predicate lst acc)