Adds sane return value to stem::length after programming error.

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

diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 01953a941215f60b06c9a30797c5d2c5e8d551f0..0fbe9ee3c9ac086e682f3cc64c655d3ce5e00b33 100644 (file)
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -56,6 +56,15 @@
     (ly:text-interface::interpret-markup layout props text)))
 
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; cross-staff stuff
+
+(define-public (script-or-side-position-cross-staff g)
+  (or
+   (ly:script-interface::calc-cross-staff g)
+   (ly:side-position-interface::calc-cross-staff g)))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; note heads
 
@@ -63,6 +72,22 @@
   (ly:duration-log
    (ly:event-property (event-cause grob) 'duration)))
 
+(define-public (stem::length grob)
+  (let* ((ss (ly:staff-symbol-staff-space grob))
+         (beg (ly:grob-property grob 'stem-begin-position))
+         (beam (ly:grob-object grob 'beam)))
+    (if (null? beam)
+        (abs (- (ly:stem::calc-stem-end-position grob) beg))
+        (begin
+          (ly:programming-error
+            "stem::length called but will not be used for beamed stem.")
+          0.0))))
+
+(define-public (stem::pure-length grob beg end)
+  (let* ((ss (ly:staff-symbol-staff-space grob))
+         (beg (ly:grob-pure-property grob 'stem-begin-position 0 1000)))
+    (abs (- (ly:stem::pure-calc-stem-end-position grob 0 2147483646) beg))))
+
 (define-public (note-head::calc-duration-log grob)
   (min 2
        (ly:duration-log
@@ -333,7 +358,7 @@ and duration-log @var{log}."
 (define-public (tuplet-number::calc-fraction-text grob)
   (let ((ev (event-cause grob)))
 
-    (format "~a:~a"
+    (format #f "~a:~a"
            (ly:event-property ev 'denominator)
            (ly:event-property ev 'numerator))))
 
@@ -363,7 +388,7 @@ and duration-log @var{log}."
          (den (if denominator denominator (ly:event-property ev 'denominator)))
          (num (if numerator numerator (ly:event-property ev 'numerator))))
 
-    (format "~a:~a" den num)))
+    (format #f "~a:~a" den num)))
 
 ;; Print a tuplet fraction with note durations appended to the numerator and the
 ;; denominator
@@ -385,10 +410,10 @@ and duration-log @var{log}."
          (num (if numerator numerator (ly:event-property ev 'numerator))))
 
     (make-concat-markup (list
-                        (make-simple-markup (format "~a" den))
+                        (make-simple-markup (format #f "~a" den))
                         (markup #:fontsize -5 #:note denominatornote UP)
                         (make-simple-markup " : ")
-                        (make-simple-markup (format "~a" num))
+                        (make-simple-markup (format #f "~a" num))
                         (markup #:fontsize -5 #:note numeratornote UP)))))
 
 
@@ -467,6 +492,25 @@ and duration-log @var{log}."
        (+ c0 p))))
 
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; annotations
+
+(define-public (numbered-footnotes int)
+  (markup #:tiny (number->string (+ 1 int))))
+
+(define-public (symbol-footnotes int)
+  (define (helper symbols out idx n)
+    (if (< n 1)
+        out
+        (helper symbols
+                (string-append out (list-ref symbols idx))
+                idx
+                (- n 1))))
+  (markup #:tiny (helper '("*" "†" "‡" "§" "¶")
+                          ""
+                          (remainder int 5)
+                          (+ 1 (quotient int 5)))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; accidentals
 
@@ -792,40 +836,6 @@ between the two text elements."
     (ly:grob-property grob 'dot-placement-list))))
 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; glissando
-
-(define-public (glissando::make-simple-y grob)
- "Establishes the Y terminus points of the glissando based on the
-pre-broken positions of its left and right bounds."
- (let* ((siblings (ly:spanner-broken-into (ly:grob-original grob)))
-        (bound-details (ly:grob-property grob 'bound-details))
-        (extra-dy (ly:grob-property grob 'extra-dy 0.0)))
-
-   (and (pair? siblings)
-        (for-each (lambda (dir-sym)
-                    (let* ((details (assoc-get dir-sym bound-details))
-                           (dir (if (eq? dir-sym 'left) LEFT RIGHT))
-                           (good-grob (if (eq? dir-sym 'left)
-                                          (first siblings)
-                                          (last siblings)))
-                           (bound (ly:spanner-bound good-grob dir))
-                           (common-y (ly:grob-common-refpoint good-grob
-                                                              bound
-                                                              Y))
-                           (y (+ (interval-center (ly:grob-extent bound
-                                                                 common-y
-                                                                 Y))
-                                 (/ (* dir extra-dy)
-                                    2))))
-                      (if (not (assoc-get 'Y details))
-                          (set! bound-details (assoc-set! bound-details dir-sym
-                                                          (acons 'Y y details))))))
-                  '(left right))
-
-        (set! (ly:grob-property grob 'bound-details) bound-details))))
-
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; scripts