Fix regressions in page breaking.

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

diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 8c34f01371e555bfbd16ac6278080ad07e05fb1d..409e8c1f8816f6f82dc8a777b1cb917cbfa66e45 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--2009 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2010 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
@@ -140,7 +140,8 @@ and duration-log @var{log}."
         (pitch (ly:event-property (event-cause grob) 'pitch))
         (pitch-index (ly:pitch-notename pitch))
         (note-names (ly:grob-property grob 'note-names))
-        (pitch-string (if (vector? note-names)
+        (pitch-string (if (and (vector? note-names)
+                               (> (vector-length note-names) pitch-index))
                           (vector-ref note-names pitch-index)
                           (string
                            (integer->char
@@ -217,7 +218,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))
@@ -317,7 +329,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
@@ -458,22 +475,40 @@ and duration-log @var{log}."
     (list lp rp)))
 
 (define-public (parentheses-item::calc-angled-bracket-stencils grob)
-  (let* ((font (ly:grob-default-font grob))
-        (lp (ly:stencil-aligned-to (ly:stencil-aligned-to
-                                    (grob-interpret-markup
-                                     grob
-                                     (ly:wide-char->utf-8 #x2329))
-                                    Y CENTER)
-                                   X RIGHT))
-        (rp (ly:stencil-aligned-to (ly:stencil-aligned-to
-                                    (grob-interpret-markup
-                                     grob
-                                     (ly:wide-char->utf-8 #x232A))
-                                    Y CENTER)
-                                   X LEFT)))
-
+  (let* ((parent (ly:grob-parent grob Y))
+         (y-extent (ly:grob-extent parent parent Y))
+         (half-thickness 0.05) ; should it be a property?
+         (width 0.5) ; should it be a property?
+         (angularity 1.5)  ; makes angle brackets
+         (white-padding 0.1) ; should it be a property?
+        (lp (ly:stencil-aligned-to
+                 (ly:stencil-aligned-to
+                   (make-parenthesis-stencil y-extent
+                                             half-thickness
+                                             (- width)
+                                             angularity)
+                   Y CENTER)
+                 X RIGHT))
+         (lp-x-extent
+           (interval-widen (ly:stencil-extent lp X) white-padding))
+        (rp (ly:stencil-aligned-to
+                 (ly:stencil-aligned-to
+                   (make-parenthesis-stencil y-extent
+                                             half-thickness
+                                             width
+                                             angularity)
+                   Y CENTER)
+                 X LEFT))
+          (rp-x-extent
+            (interval-widen (ly:stencil-extent rp X) white-padding)))
+    (set! lp (ly:make-stencil (ly:stencil-expr lp)
+                              lp-x-extent
+                              (ly:stencil-extent lp Y)))
+    (set! rp (ly:make-stencil (ly:stencil-expr rp)
+                              rp-x-extent
+                              (ly:stencil-extent rp Y)))
     (list (stencil-whiteout lp)
-         (stencil-whiteout rp))))
+          (stencil-whiteout rp))))
 
 (define (parenthesize-elements grob . rest)
   (let* ((refp (if (null? rest)
@@ -643,6 +678,27 @@ and duration-log @var{log}."
       START
       STOP))
 
+(define-public (dynamic-text-spanner::before-line-breaking grob)
+  "Monitor left bound of @code{DynamicTextSpanner} for absolute dynamics.
+If found, ensure @code{DynamicText} does not collide with spanner text by
+changing @code{'attach-dir} and @code{'padding}.  Reads the
+@code{'right-padding} property of @code{DynamicText} to fine tune space
+between the two text elements."
+  (let ((left-bound (ly:spanner-bound grob LEFT)))
+    (if (grob::has-interface left-bound 'dynamic-text-interface)
+       (let* ((details (ly:grob-property grob 'bound-details))
+              (left-details (ly:assoc-get 'left details))
+              (my-padding (ly:assoc-get 'padding left-details))
+              (script-padding (ly:grob-property left-bound 'right-padding 0)))
+
+         (and (number? my-padding)
+              (ly:grob-set-nested-property! grob
+                                            '(bound-details left attach-dir)
+                                            RIGHT)
+              (ly:grob-set-nested-property! grob
+                                            '(bound-details left padding)
+                                            (+ my-padding script-padding)))))))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; lyrics
@@ -826,3 +882,12 @@ and duration-log @var{log}."
        (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))
+