X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-lib.scm;h=17bbea995b1f7c7bf03005b4ffffea2d6c9fd221;hb=92bfc879f666457f9dc51b190f4f605937035179;hp=9137d5be170845fd9e0d9cd498dc425c01575982;hpb=a969a9895dbb211cd0298f4f88c74c679b31a40d;p=lilypond.git

diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 9137d5be17..17bbea995b 100644
--- 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--2011 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
@@ -132,10 +132,43 @@
          (beg (ly:grob-pure-property grob 'stem-begin-position 0 1000)))
     (abs (- (ly:stem::pure-calc-stem-end-position grob 0 2147483646) beg))))
 
+(define (stem-stub::do-calculations grob)
+  (and (ly:grob-property (ly:grob-parent grob X) 'cross-staff)
+       (not (ly:grob-property (ly:grob-parent grob X) 'transparent))))
+
+(define-public (stem-stub::pure-height grob beg end)
+  (if (stem-stub::do-calculations grob)
+      '(0 . 0)
+      '(+inf.0 . -inf.0)))
+
+(define-public (stem-stub::width grob)
+  (if (stem-stub::do-calculations grob)
+      (grob::x-parent-width grob)
+      '(+inf.0 . -inf.0)))
+
+(define-public (stem-stub::extra-spacing-height grob)
+  (if (stem-stub::do-calculations grob)
+      (let* ((dad (ly:grob-parent grob X))
+             (refp (ly:grob-common-refpoint grob dad Y))
+             (stem_ph (ly:grob-pure-height dad refp 0 1000000))
+             (my_ph (ly:grob-pure-height grob refp 0 1000000))
+             ;; only account for distance if stem is on different staff than stub
+             (dist (if (grob::has-interface refp 'hara-kiri-group-spanner-interface)
+                       0
+                       (- (car my_ph) (car stem_ph)))))
+        (if (interval-empty? (interval-intersection stem_ph my_ph)) #f (coord-translate stem_ph dist)))
+      #f))
+
+;; FIXME: NEED TO FIND A BETTER WAY TO HANDLE KIEVAN NOTATION
 (define-public (note-head::calc-duration-log grob)
-  (min 2
-       (ly:duration-log
-	(ly:event-property (event-cause grob) 'duration))))
+  (let ((style (ly:grob-property grob 'style)))
+    (if (and (symbol? style) (string-match "kievan*" (symbol->string style)))
+      (min 3
+        (ly:duration-log
+	(ly:event-property (event-cause grob) 'duration)))
+      (min 2
+	(ly:duration-log
+	(ly:event-property (event-cause grob) 'duration))))))
 
 (define-public (dots::calc-dot-count grob)
   (ly:duration-dot-count
@@ -199,6 +232,8 @@ and duration-log @var{log}."
 	 (string-append (number->string log) "petrucci")))
     ((neomensural)
      (string-append (number->string log) (symbol->string style)))
+    ((kievan)
+     (string-append (number->string log) "kievan"))
     (else
      (if (string-match "vaticana*|hufnagel*|medicaea*" (symbol->string style))
 	 (symbol->string style)
@@ -206,9 +241,10 @@ and duration-log @var{log}."
 			(symbol->string style))))))
 
 (define-public (note-head::calc-glyph-name grob)
-  (let ((style (ly:grob-property grob 'style))
-	(log (min 2 (ly:grob-property grob 'duration-log))))
-
+  (let* ((style (ly:grob-property grob 'style))
+	 (log (if (string-match "kievan*" (symbol->string style))
+		  (min 3 (ly:grob-property grob 'duration-log))
+		  (min 2 (ly:grob-property grob 'duration-log)))))
     (select-head-glyph style log)))
 
 (define-public (note-head::brew-ez-stencil grob)
@@ -361,7 +397,10 @@ and duration-log @var{log}."
     ("S|:" . ("S" . "|:"))
     (".S|:" . ("|" . "S|:"))
     (":|S|:" . (":|" . "S|:"))
-    (":|S.|:" . (":|S" . "|:"))))
+    (":|S.|:" . (":|S" . "|:"))
+
+    ;; ancient bar lines
+    ("kievan" . ("kievan" . ""))))
 
 (define-public (bar-line::calc-glyph-name grob)
   (let* ((glyph (ly:grob-property grob 'glyph))
@@ -409,10 +448,10 @@ and duration-log @var{log}."
          (hsb (ly:grob-property grob 'has-span-bar))
          (ii (interval-intersection esh (cons -1.01 1.01))))
     (if (pair? hsb)
-        (cons (car (if (and (cdr hsb)
+        (cons (car (if (and (car hsb)
                        (ly:grob-property grob 'allow-span-bar))
                        esh ii))
-              (cdr (if (car hsb) esh ii)))
+              (cdr (if (cdr hsb) esh ii)))
         ii)))
 
 (define-public (pure-from-neighbor-interface::extra-spacing-height-including-staff grob)
@@ -651,6 +690,9 @@ and duration-log @var{log}."
     (0 . "accidentals.vaticana0")
     (1/2 . "accidentals.mensural1")))
 
+(define-public alteration-kievan-glyph-name-alist
+ '((-1/2 . "accidentals.kievanM1")
+   (1/2 . "accidentals.kievan1")))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; * Pitch Trill Heads
@@ -837,11 +879,6 @@ and duration-log @var{log}."
   (let* ((event (event-cause grob))
 	 (digit (ly:event-property event 'digit)))
 
-    (if (> digit 5)
-	(ly:input-message (ly:event-property event 'origin)
-			  "Warning: Fingering notation for finger number ~a"
-			  digit))
-
     (number->string digit 10)))
 
 (define-public (string-number::calc-text grob)