]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/output-lib.scm
Merge branch 'jneeman' of git+ssh://jneem@git.sv.gnu.org/srv/git/lilypond into jneeman
[lilypond.git] / scm / output-lib.scm
index 2978f3b198e567adde40f529536590cde4684235..f15fb8ca257f3e9c8892293ff71c2078fa41f712 100644 (file)
@@ -10,6 +10,8 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; general
+(define-public (grob::has-interface grob iface)
+  (memq iface (ly:grob-interfaces grob)))
 
 (define-public (make-stencil-boxer thickness padding callback)
 
 
 ;; The TabNoteHead tablatureFormat callback.
 ;; Compute the text grob-property
-(define-public (fret-number-tablature-format string tuning pitch)
-  (make-whiteout-markup
-   (make-vcenter-markup  
-    (number->string
-     (- (ly:pitch-semitones pitch)
-       (list-ref tuning
-                 ;; remove 1 because list index starts at 0 and guitar string at 1. 
-                 (- string 1)))))))
+(define-public (fret-number-tablature-format string
+                                            context event)
+  (let*
+      ((tuning (ly:context-property context 'stringTunings))
+       (pitch (ly:event-property event 'pitch))
+       (is-harmonic (apply
+                    functional-or
+                    (map
+                     (lambda (ev)
+                       (eq? 'harmonic-event (ly:event-property ev 'class)))
+                     (ly:event-property event 'articulations)))))
+
+    
+    (make-whiteout-markup
+     (make-vcenter-markup
+      (format
+       "~a"
+       (- (ly:pitch-semitones pitch)
+         (list-ref tuning
+                   ;; remove 1 because list index starts at 0 and guitar string at 1. 
+                   (- string 1))))))
+    ))
 
 ;; The 5-string banjo has got a extra string, the fifth (duh), wich
 ;; starts at the fifth fret on the neck. Frets on the fifth string
 ;;   the "first fret" on the fifth string is really the sixth fret
 ;;   on the banjo neck.
 ;; We solve this by defining a new fret-number-tablature function:
-(define-public (fret-number-tablature-format-banjo string tuning pitch)
+(define-public (fret-number-tablature-format-banjo string 
+                                            context event)
+  (let*
+      ((tuning (ly:context-property context 'stringTunings))
+       (pitch (ly:event-property event 'pitch))
+       )
   (make-whiteout-markup
    (make-vcenter-markup  
     (let ((fret (- (ly:pitch-semitones pitch) (list-ref tuning (- string 1)))))
       (number->string (cond
                       ((and (> fret 0) (= string 5))
                        (+ fret 5))
-                      (else fret)))))))
+                      (else fret))))))
+  ))
 
 
 ; default tunings for common string instruments
@@ -285,6 +307,37 @@ centered, X==1 is at the right, X == -1 is at the left."
 ;; * Pitch Trill Heads
 ;; * Parentheses
 
+(define-public (parentheses-item::calc-parenthesis-stencils grob)
+  (let* (
+        (font (ly:grob-default-font grob))
+        (lp (ly:font-get-glyph font "accidentals.leftparen"))
+        (rp (ly:font-get-glyph font "accidentals.rightparen"))
+        )
+
+    (list lp rp)))
+
+
+(define (grob-text grob text)
+  (let*
+      ((layout (ly:grob-layout grob))
+       (defs (ly:output-def-lookup layout 'text-font-defaults))
+       (props (ly:grob-alist-chain grob defs)))
+
+    (ly:text-interface::interpret-markup
+     layout props text)))
+
+(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-text grob (ly:wide-char->utf-8 #x2329))
+                                                          Y CENTER)  X RIGHT))
+        (rp (ly:stencil-aligned-to (ly:stencil-aligned-to (grob-text grob (ly:wide-char->utf-8 #x232A))
+                                                          Y CENTER) X LEFT))
+        )
+
+    (list (stencil-whiteout lp)
+         (stencil-whiteout rp))))
+
 (define (parenthesize-elements grob . rest)
   (let*
       ((refp (if (null? rest)
@@ -292,10 +345,9 @@ centered, X==1 is at the right, X == -1 is at the left."
                 (car rest)))
        (elts (ly:grob-object grob 'elements))
        (x-ext (ly:relative-group-extent elts refp X))
-
-       (font (ly:grob-default-font grob))
-       (lp (ly:font-get-glyph font "accidentals.leftparen"))
-       (rp (ly:font-get-glyph font "accidentals.rightparen"))
+       (stencils (ly:grob-property grob 'stencils))
+       (lp (car stencils))
+       (rp (cadr stencils))
        (padding (ly:grob-property grob 'padding 0.1)))
     
     (ly:stencil-add
@@ -324,6 +376,7 @@ centered, X==1 is at the right, X == -1 is at the left."
     ))
 
 
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; 
 
@@ -336,12 +389,19 @@ centered, X==1 is at the right, X == -1 is at the left."
   value)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; falls
+;; falls/doits
 
-(define-public (fall::print spanner)
+(define-public (bend::print spanner)
+  (define (close  a b)
+    (< (abs (- a b)) 0.01))
+  
   (let*
       ((delta-y (* 0.5 (ly:grob-property spanner 'delta-position)))
        (left-span (ly:spanner-bound spanner LEFT))
+       (dots (if (and (grob::has-interface left-span 'note-head-interface)
+                     (ly:grob? (ly:grob-object left-span 'dot)))
+                (ly:grob-object left-span 'dot) #f))
+                
        (right-span (ly:spanner-bound spanner RIGHT))
        (thickness (* (ly:grob-property spanner 'thickness)
                     (ly:output-def-lookup (ly:grob-layout spanner)
@@ -351,9 +411,19 @@ centered, X==1 is at the right, X == -1 is at the left."
                                        (ly:grob-common-refpoint spanner
                                                                 left-span X)
                                        X))
+       (common-y (ly:grob-common-refpoint spanner left-span Y))
        (left-x (+ padding
-                 (interval-end  (ly:grob-robust-relative-extent
-                                 left-span common X))))
+                 (max (interval-end (ly:grob-robust-relative-extent
+                                     left-span common X))
+                       (if (and
+                            dots
+                            (close (ly:grob-relative-coordinate dots common-y Y)
+                                       (ly:grob-relative-coordinate spanner common-y Y)))
+                           (interval-end (ly:grob-robust-relative-extent dots common X))
+                           -10000) ;; TODO: use real infinity constant.
+                       )))
+       (x (display (grob::has-interface left-span 'note-head-interface)))
+
        (right-x (- (interval-start
                    (ly:grob-robust-relative-extent right-span common X))
                   padding))
@@ -372,9 +442,10 @@ centered, X==1 is at the right, X == -1 is at the left."
                     ))))
        )
 
+    (display left-span)
     (ly:make-stencil
      exp
-     (cons 0 dx)
+     (cons (- left-x self-x) (- right-x self-x))
      (cons (min 0 delta-y)
           (max 0 delta-y)))))
 
@@ -416,7 +487,7 @@ centered, X==1 is at the right, X == -1 is at the left."
     
     (if (> digit 5)
        (ly:input-message (ly:event-property event 'origin)
-                         "Music for the martians"))
+                         "Warning: Fingering notation for finger number ~a" digit))
 
     (number->string digit 10)
   ))