Fix some bugs in the dynamic engraver and PostScript backend

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

diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 7eeefa3bad4adf6a2cb56f898d32d08e0e6e3141..bf98dbab41487de60be66c96050353531f7e01cc 100644 (file)
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -6,26 +6,7 @@
 ;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 
-
-(define-public (event-cause grob)
-  (let*
-      ((cause (ly:grob-property  grob 'cause)))
-    
-    (cond
-     ((ly:stream-event? cause) cause)
-     ((ly:grob? cause) (event-cause cause))
-     (else #f))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; note heads
-
-(define-public (note-head::calc-duration-log grob)
-  (ly:duration-log
-   (ly:event-property (event-cause grob) 'duration)))
-
-(define-public (dots::calc-dot-count grob)
-  (ly:duration-dot-count
-   (ly:event-property (event-cause grob) 'duration)))
+;;; Tablature functions, by Jiba (jiba@tuxfamily.org)
 
 ;; The TabNoteHead stem attachment function.
 (define (note-head::calc-tablature-stem-attachment grob)
@@ -102,6 +83,33 @@
                  layout props (make-circle-markup text))))
     circle))
 
+
+;;(define (mm-to-pt x)
+;;  (* (/ 72.27 25.40) x))
+
+;; do nothing in .scm output
+
+(define-public (ly:numbers->string lst)
+  (string-join (map ly:number->string lst) " "))
+
+(define (number->octal-string x)
+  (let* ((n (inexact->exact x))
+         (n64 (quotient n 64))
+         (n8 (quotient (- n (* n64 64)) 8)))
+    (string-append
+     (number->string n64)
+     (number->string n8)
+     (number->string (remainder (- n (+ (* n64 64) (* n8 8))) 8)))))
+
+(define-public (ly:inexact->string x radix)
+  (let ((n (inexact->exact x)))
+    (number->string n radix)))
+
+(define-public (ly:number-pair->string c)
+  (string-append (ly:number->string (car c)) " "
+                (ly:number->string (cdr c))))
+
+
 ;; silly, use alist? 
 (define-public (note-head::calc-glyph-name grob)
   (let*
@@ -198,7 +206,6 @@ centered, X==1 is at the right, X == -1 is at the left."
         (result (assoc glyph 
                       '((":|:" . (":|" . "|:"))
                         ("||:" . ("||" . "|:"))
-                        ("dashed" . ("dashed" . '())) 
                         ("|" . ("|" . ()))
                         ("||:" . ("||" . "|:"))
                         ("|s" . (() . "|"))
@@ -236,23 +243,6 @@ centered, X==1 is at the right, X == -1 is at the left."
       (ly:grob-translate-axis! g 3.5 X)))
 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Tuplets
-
-(define-public (tuplet-number::calc-denominator-text grob)
-  (let*
-      ((ev (ly:grob-property grob 'cause)))
-    
-    (number->string (ly:event-property ev 'denominator))))
-
-
-(define-public (tuplet-number::calc-fraction-text grob)
-  (let*
-      ((ev (ly:grob-property grob 'cause)))
-    (format "~a:~a" 
-      (ly:event-property ev 'denominator)
-      (ly:event-property ev 'numerator))))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Color
 
@@ -282,7 +272,8 @@ centered, X==1 is at the right, X == -1 is at the left."
 
 (define (parenthesize-elements grob . rest)
   (let*
-      ((refp (if (null? rest)
+      (
+       (refp (if (null? rest)
                 grob
                 (car rest)))
        (elts (ly:grob-object grob 'elements))
@@ -292,7 +283,7 @@ centered, X==1 is at the right, X == -1 is at the left."
        (lp (ly:font-get-glyph font "accidentals.leftparen"))
        (rp (ly:font-get-glyph font "accidentals.rightparen"))
        (padding (ly:grob-property grob 'padding 0.1)))
-    
+
     (ly:stencil-add
      (ly:stencil-translate-axis lp (- (car x-ext) padding) X)
      (ly:stencil-translate-axis rp (+ (cdr x-ext) padding) X))
@@ -332,90 +323,3 @@ centered, X==1 is at the right, X == -1 is at the left."
 
   value)
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; falls
-
-(define-public (fall::print spanner)
-  (let*
-      ((delta-y (* 0.5 (ly:grob-property spanner 'delta-position)))
-       (left-span (ly:spanner-bound spanner LEFT))
-       (right-span (ly:spanner-bound spanner RIGHT))
-       (thickness (* (ly:grob-property spanner 'thickness)
-                    (ly:output-def-lookup (ly:grob-layout spanner)
-                                          'line-thickness)))
-       (padding (ly:grob-property spanner 'padding 0.5))
-       (common (ly:grob-common-refpoint right-span
-                                       (ly:grob-common-refpoint spanner
-                                               left-span X)
-                                       X))
-       (left-x (+ padding  (interval-end  (ly:grob-robust-relative-extent left-span common X))))
-       (right-x (- (interval-start  (ly:grob-robust-relative-extent right-span common X)) padding))
-       (self-x (ly:grob-relative-coordinate spanner common X))
-       (dx (- right-x left-x))
-       (exp (list 'path thickness 
-                 `(quote
-                   (rmoveto
-                    ,(- left-x self-x) 0
-
-                    rcurveto                
-                    ,(/ dx 3)
-                    0
-                    ,dx ,(* 0.66 delta-y)
-                    ,dx ,delta-y
-                    ))))
-       )
-
-    (ly:make-stencil
-     exp
-     (cons 0 dx)
-     (cons (min 0 delta-y)
-          (max 0 delta-y)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; grace spacing
-
-
-(define-public (grace-spacing::calc-shortest-duration grob)
-  (let*
-     ((cols (ly:grob-object grob 'columns))
-      (get-difference
-       (lambda (idx)
-        (ly:moment-sub (ly:grob-property (ly:grob-array-ref cols (1+ idx)) 'when)
-                       (ly:grob-property (ly:grob-array-ref cols idx) 'when))))
-      
-      (moment-min (lambda (x y)
-                   (cond
-                    ((and x y)
-                     (if (ly:moment<? x y)
-                           x
-                           y))
-                    (x x)
-                    (y y)))))
-                    
-    (fold moment-min #f (map get-difference
-                            (iota (1- (ly:grob-array-length cols)))))))
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; fingering
-
-(define-public (fingering::calc-text grob)
-  (let*
-      ((event (ly:grob-property grob 'cause))
-       (digit (ly:event-property event 'digit)))
-    
-    (if (> digit 5)
-       (ly:input-message (ly:music-property event 'origin)
-                         "Music for the martians"))
-
-    (number->string digit 10)
-  ))
-
-(define-public (string-number::calc-text grob)
-  (let*
-      ((event (ly:grob-property grob 'cause))
-       (digit (ly:event-property event 'string-number)))
-    
-    (number->string digit 10)
-  ))