Fix excessive memory usage.

[lilypond.git] / scm / output-lib.scm

diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 8e17401477a79435adc2c47ead1db86c86faf8fc..400506a8a5f119d84abdeacab8efd7abd876c1e4 100644 (file)
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 1998--2010 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
@@ -173,6 +173,55 @@ and duration-log @var{log}."
           letter)))
      radius X)))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; clipping
+
+(define-public (make-rhythmic-location bar-num num den)
+  (cons
+   bar-num (ly:make-moment num den)))
+
+(define-public (rhythmic-location? a)
+  (and (pair? a)
+       (integer? (car a))
+       (ly:moment? (cdr a))))
+
+(define-public (make-graceless-rhythmic-location loc)
+  (make-rhythmic-location
+   (car loc)
+   (ly:moment-main-numerator (rhythmic-location-measure-position loc))
+   (ly:moment-main-denominator (rhythmic-location-measure-position loc))))
+
+(define-public rhythmic-location-measure-position cdr)
+(define-public rhythmic-location-bar-number car)
+
+(define-public (rhythmic-location<? a b)
+  (cond
+   ((< (car a) (car b)) #t)
+   ((> (car a) (car b)) #f)
+   (else
+    (ly:moment<? (cdr a) (cdr b)))))
+
+(define-public (rhythmic-location<=? a b)
+  (not (rhythmic-location<? b a)))
+(define-public (rhythmic-location>=? a b)
+  (rhythmic-location<? a b))
+(define-public (rhythmic-location>? a b)
+  (rhythmic-location<? b a))
+
+(define-public (rhythmic-location=? a b)
+  (and (rhythmic-location<=? a b)
+       (rhythmic-location<=? b a)))
+
+(define-public (rhythmic-location->file-string a)
+  (ly:format "~a.~a.~a"
+            (car a)
+            (ly:moment-main-numerator (cdr a))
+            (ly:moment-main-denominator (cdr a))))
+
+(define-public (rhythmic-location->string a)
+  (ly:format "bar ~a ~a"
+            (car a)
+            (ly:moment->string (cdr a))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; break visibility
@@ -185,6 +234,10 @@ and duration-log @var{log}."
 (define-public center-visible          #(#f #t #f))
 (define-public end-of-line-visible     #(#t #f #f))
 (define-public all-invisible           #(#f #f #f))
+(define-public (inherit-x-parent-visibility grob)
+  (let ((parent (ly:grob-parent grob X)))
+    (ly:grob-property parent 'break-visibility all-invisible)))
+
 
 (define-public spanbar-begin-of-line-invisible #(#t #f #f))
 
@@ -218,7 +271,18 @@ and duration-log @var{log}."
     ("'" . ("'" . ()))
     ("empty" . (() . ()))
     ("brace" . (() . "brace"))
-    ("bracket" . (() . "bracket"))))
+    ("bracket" . (() . "bracket"))
+
+    ;; segno bar lines
+    ("S" . ("||" . "S"))
+    ("|S" . ("|" . "S"))
+    ("S|" . ("S" . ()))
+    (":|S" . (":|" . "S"))
+    (":|S." . (":|S" . ()))
+    ("S|:" . ("S" . "|:"))
+    (".S|:" . ("|" . "S|:"))
+    (":|S|:" . (":|" . "S|:"))
+    (":|S.|:" . (":|S" . "|:"))))
 
 (define-public (bar-line::calc-glyph-name grob)
   (let* ((glyph (ly:grob-property grob 'glyph))
@@ -318,7 +382,12 @@ and duration-log @var{log}."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Color
 
-(define-public color? list?)
+(define-public (color? x)
+  (and (list? x)
+       (= 3 (length x))
+       (apply eq? #t (map number? x))
+       (apply eq? #t (map (lambda (y) (<= 0 y 1)) x))))
+
 (define-public (rgb-color r g b) (list r g b))
 
 ; predefined colors
@@ -794,18 +863,10 @@ between the two text elements."
 (define-public (system-start-text::calc-y-offset grob)
 
   (define (live-elements-list me)
-    (let* ((elements (ly:grob-object me 'elements))
-          (elts-length (ly:grob-array-length elements))
-          (live-elements '()))
-
-      (let get-live ((len elts-length))
-       (if (> len 0)
-           (let ((elt (ly:grob-array-ref elements (1- len))))
+    (let ((elements (ly:grob-object me 'elements)))
 
-             (if (grob::is-live? elt)
-                 (set! live-elements (cons elt live-elements)))
-             (get-live (1- len)))))
-      live-elements))
+      (filter! grob::is-live?
+               (ly:grob-array->list elements))))
 
   (let* ((left-bound (ly:spanner-bound grob LEFT))
         (live-elts (live-elements-list grob))
@@ -866,3 +927,12 @@ between the two text elements."
        (begin
          (ly:grob-suicide! grob)
          (list)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  laissez-vibrer tie
+;;
+;;  needed so we can make laissez-vibrer a pure print
+;;
+(define-public (laissez-vibrer::print grob)
+ (ly:tie::print grob))
+