X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-lib.scm;h=01e429cd195594cae2e3fcd202f3148bffdc7364;hb=d8d7985d6027b374744a7c88250b856c4ef7e619;hp=70e3ba3eeb07885ff46475ec6f20b2a841dd01f8;hpb=6465274e66a851cccd4cd32a521abc853f3e79dd;p=lilypond.git

diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 70e3ba3eeb..01e429cd19 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
@@ -26,6 +26,9 @@
 (define-public (grob::is-live? grob)
   (pair? (ly:grob-basic-properties grob)))
 
+(define-public (grob::x-parent-width grob)
+  (ly:grob-property (ly:grob-parent grob X) 'X-extent))
+
 (define-public (make-stencil-boxer thickness padding callback)
   "Return function that adds a box around the grob passed as argument."
   (lambda (grob)
@@ -55,6 +58,47 @@
 
     (ly:text-interface::interpret-markup layout props text)))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; beam slope
+
+;; calculates each slope of a broken beam individually
+(define-public (beam::place-broken-parts-individually grob)
+  (ly:beam::quanting grob '(+inf.0 . -inf.0) #f))
+
+;; calculates the slope of a beam as a single unit,
+;; even if it is broken.  this assures that the beam
+;; will pick up where it left off after a line break
+(define-public (beam::align-with-broken-parts grob)
+  (ly:beam::quanting grob '(+inf.0 . -inf.0) #t))
+
+;; uses the broken beam style from edition peters combines the
+;; values of place-broken-parts-individually and align-with-broken-parts above,
+;; favoring place-broken-parts-individually when the beam naturally has a steeper
+;; incline and align-with-broken-parts when the beam is flat
+(define-public (beam::slope-like-broken-parts grob)
+  (define (slope y x)
+    (/ (- (cdr y) (car y)) (- (cdr x) (car x))))
+  (let* ((quant1 (ly:beam::quanting grob '(+inf.0 . -inf.0) #t))
+         (original (ly:grob-original grob))
+         (siblings (if (ly:grob? original)
+                       (ly:spanner-broken-into original)
+                       '())))
+    (if (null? siblings)
+        quant1
+        (let* ((quant2 (ly:beam::quanting grob '(+inf.0 . -inf.0) #f))
+               (x-span (ly:grob-property grob 'X-positions))
+               (slope1 (slope quant1 x-span))
+               (slope2 (slope quant2 x-span))
+               (quant2 (if (not (= (sign slope1) (sign slope2)))
+                           '(0 . 0)
+                           quant2))
+               (factor (/ (atan (abs slope1)) PI-OVER-TWO))
+               (base (cons-map
+                       (lambda (x)
+                         (+ (* (x quant1) (- 1 factor))
+                            (* (x quant2) factor)))
+                       (cons car cdr))))
+          (ly:beam::quanting grob base #f)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; cross-staff stuff
@@ -73,24 +117,58 @@
    (ly:event-property (event-cause grob) 'duration)))
 
 (define-public (stem::length grob)
-  (let* ((d (ly:grob-property grob 'direction))
-         (ss (ly:staff-symbol-staff-space 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))
-        (ly:grob-property grob 'length))))
+        (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* ((d (ly:grob-property grob 'direction))
-         (ss (ly:staff-symbol-staff-space grob))
+  (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 (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
@@ -154,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)
@@ -161,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)
@@ -235,7 +316,7 @@ and duration-log @var{log}."
 (define-public (rhythmic-location<=? a b)
   (not (rhythmic-location<? b a)))
 (define-public (rhythmic-location>=? a b)
-  (rhythmic-location<? a b))
+  (not (rhythmic-location<? a b)))
 (define-public (rhythmic-location>? a b)
   (rhythmic-location<? b a))
 
@@ -288,7 +369,6 @@ and duration-log @var{log}."
     ("||:" . ("||" . "|:"))
     ("dashed" . ("dashed" . '()))
     ("|" . ("|" . ()))
-    ("||:" . ("||" . "|:"))
     ("|s" . (() . "|"))
     ("|:" . ("|" . "|:"))
     ("|." . ("|." . ()))
@@ -316,7 +396,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))
@@ -344,6 +427,41 @@ and duration-log @var{log}."
 	   (equal? (ly:item-break-dir g) RIGHT))
       (ly:grob-translate-axis! g 3.5 X)))
 
+(define-public (pure-from-neighbor-interface::extra-spacing-height-at-beginning-of-line grob)
+  (if (= 1 (ly:item-break-dir grob))
+      (pure-from-neighbor-interface::extra-spacing-height grob)
+      (cons -0.1 0.1)))
+
+(define-public (pure-from-neighbor-interface::extra-spacing-height grob)
+  (let* ((height (ly:grob-pure-height grob grob 0 10000000))
+         (from-neighbors (interval-union
+                            height
+                            (ly:axis-group-interface::pure-height
+                              grob
+                              0
+                              10000000))))
+    (coord-operation - from-neighbors height)))
+
+(define-public (pure-from-neighbor-interface::account-for-span-bar grob)
+  (let* ((esh (pure-from-neighbor-interface::extra-spacing-height grob))
+         (hsb (ly:grob-property grob 'has-span-bar))
+         (ii (interval-intersection esh (cons -1.01 1.01))))
+    (if (pair? hsb)
+        (cons (car (if (and (car hsb)
+                       (ly:grob-property grob 'allow-span-bar))
+                       esh ii))
+              (cdr (if (cdr hsb) esh ii)))
+        ii)))
+
+(define-public (pure-from-neighbor-interface::extra-spacing-height-including-staff grob)
+  (let ((esh (pure-from-neighbor-interface::extra-spacing-height grob))
+        (to-staff (coord-operation -
+                                   (interval-widen
+                                     '(0 . 0)
+                                     (ly:staff-symbol-staff-radius grob))
+                                   (ly:grob::stencil-height grob))))
+    (interval-union esh to-staff)))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Tuplets
@@ -571,6 +689,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
@@ -757,11 +878,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)
@@ -783,7 +899,7 @@ and duration-log @var{log}."
 ;; dynamics
 
 (define-public (hairpin::calc-grow-direction grob)
-  (if (eq? (ly:event-property (event-cause grob) 'class) 'decrescendo-event)
+  (if (ly:in-event-class? (event-cause grob) 'decrescendo-event)
       START
       STOP))