X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-lib.scm;h=4533cf2a965a8c95eb22b3dcf84d21dc2e5ad8f7;hb=785441aeb8cc557217d1b0658ef88d058f58eeb4;hp=33a2df36a70afcec5747ebaca2363028786e26a8;hpb=98afde57a6d72294c6fdedad4e1ff093b9bf5706;p=lilypond.git

diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 33a2df36a7..4533cf2a96 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,170 @@
 
     (ly:text-interface::interpret-markup layout props text)))
 
+(define-public (grob::unpure-Y-extent-from-stencil pure-function)
+  "The unpure height will come from a stencil whereas the pure
+   height will come from @code{pure-function}."
+  (ly:make-unpure-pure-container ly:grob::stencil-height pure-function))
+
+(define-public grob::unpure-horizontal-skylines-from-stencil
+  (ly:make-unpure-pure-container
+    ly:grob::horizontal-skylines-from-stencil
+    ly:grob::pure-simple-horizontal-skylines-from-extents))
+
+(define-public grob::always-horizontal-skylines-from-stencil
+  (ly:make-unpure-pure-container
+    ly:grob::horizontal-skylines-from-stencil))
+
+(define-public grob::unpure-vertical-skylines-from-stencil
+  (ly:make-unpure-pure-container
+    ly:grob::vertical-skylines-from-stencil
+    ly:grob::pure-simple-vertical-skylines-from-extents))
+
+(define-public grob::always-vertical-skylines-from-stencil
+  (ly:make-unpure-pure-container
+    ly:grob::vertical-skylines-from-stencil))
+
+(define-public grob::always-vertical-skylines-from-element-stencils
+  (ly:make-unpure-pure-container
+    ly:grob::vertical-skylines-from-element-stencils
+    ly:grob::pure-vertical-skylines-from-element-stencils))
+
+(define-public grob::always-horizontal-skylines-from-element-stencils
+  (ly:make-unpure-pure-container
+    ly:grob::horizontal-skylines-from-element-stencils
+    ly:grob::pure-horizontal-skylines-from-element-stencils))
+
+;; Using this as a callback for a grob's Y-extent promises
+;; that the grob's stencil does not depend on line-spacing.
+;; We use this promise to figure the space required by Clefs
+;; and such at the note-spacing stage.
+
+(define-public grob::always-Y-extent-from-stencil
+  (ly:make-unpure-pure-container ly:grob::stencil-height))
+
+(define-public (layout-line-thickness grob)
+  "Get the line thickness of the @var{grob}'s corresponding layout."
+  (let* ((layout (ly:grob-layout grob))
+         (line-thickness (ly:output-def-lookup layout 'line-thickness)))
+
+        line-thickness))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; beam slope
+
+;; even though kievan noteheads do not have stems, their
+;; invisible stems help with beam placement
+;; this assures that invisible stems for kievan notes are aligned
+;; to the center of kievan noteheads. that is thus where the beams'
+;; x extrema will fall
+(define-public (stem::kievan-offset-callback grob)
+  (let* ((note-heads (ly:grob-object grob 'note-heads))
+         (note-heads-grobs (if (not (null? note-heads))
+                               (ly:grob-array->list note-heads)
+                               '()))
+         (first-note-head (if (not (null? note-heads-grobs))
+                              (car note-heads-grobs)
+                              '()))
+         (note-head-w (if (not (null? first-note-head))
+                          (ly:grob-extent first-note-head first-note-head X)
+                          '(0 . 0))))
+    (interval-center note-head-w)))
+
+
+;; sets position of beams for Kievan notation
+(define-public (beam::get-kievan-positions grob)
+  (let* ((stems (ly:grob-object grob 'stems))
+         (stems-grobs (if (not (null? stems))
+                          (ly:grob-array->list stems)
+                          '()))
+         (first-stem (if (not (null? stems-grobs))
+                         (car stems-grobs)
+                         '()))
+         (note-heads (if (not (null? first-stem))
+                         (ly:grob-object first-stem 'note-heads)
+                         '()))
+         (note-heads-grobs (if (not (null? note-heads))
+                               (ly:grob-array->list note-heads)
+                               '()))
+         (first-note-head (if (not (null? note-heads-grobs))
+                              (car note-heads-grobs)
+                              '()))
+         (next-stem (if (not (null? stems))
+                        (cadr stems-grobs)
+                        '()))
+         (next-note-heads (if (not (null? next-stem))
+                              (ly:grob-object next-stem 'note-heads)
+                              '()))
+         (next-note-heads-grobs (if (not (null? next-note-heads))
+                                    (ly:grob-array->list next-note-heads)
+                                    '()))
+         (next-note-head (if (not (null? next-note-heads-grobs))
+                             (car next-note-heads-grobs)
+                             '()))
+         (left-pos (ly:grob-property first-note-head 'Y-offset))
+         (right-pos (ly:grob-property next-note-head 'Y-offset))
+         (direction (ly:grob-property grob 'direction))
+         (first-nh-height (ly:grob::stencil-height first-note-head))
+         (next-nh-height (ly:grob::stencil-height next-note-head))
+         (left-height (if (= direction DOWN)
+                          (+ (car first-nh-height) 0.75)
+                          (- (cdr first-nh-height) 0.75)))
+         (right-height (if (= direction DOWN)
+                           (+ (car next-nh-height) 0.75)
+                           (- (cdr next-nh-height) 0.75))))
+    (cons (+ left-pos left-height) (+ right-pos right-height))))
+
+(define-public (beam::get-kievan-quantized-positions grob)
+  (let* ((pos (ly:grob-property grob 'positions))
+         (stems (ly:grob-object grob 'stems))
+         (stems-grobs (if (not (null? stems))
+                          (ly:grob-array->list stems)
+                          '())))
+    (for-each
+      (lambda (g)
+        (ly:grob-set-property! g 'stem-begin-position 0)
+        (ly:grob-set-property! g 'length 0))
+      stems-grobs)
+    pos))
+
+;; 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
@@ -65,6 +232,32 @@
    (ly:side-position-interface::calc-cross-staff g)))
 
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; side-position stuff
+
+(define-public (only-if-beamed g)
+  (any (lambda (x) (ly:grob? (ly:grob-object x 'beam)))
+       (ly:grob-array->list (ly:grob-object g 'side-support-elements))))
+
+(define-public side-position-interface::y-aligned-side
+  (ly:make-unpure-pure-container
+    ly:side-position-interface::y-aligned-side
+    ly:side-position-interface::pure-y-aligned-side))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; self-alignment stuff
+
+(define-public self-alignment-interface::y-aligned-on-self
+  (ly:make-unpure-pure-container
+    ly:self-alignment-interface::y-aligned-on-self
+    ly:self-alignment-interface::pure-y-aligned-on-self))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; staff symbol
+
+(define staff-symbol-referencer::callback
+  (ly:make-unpure-pure-container ly:staff-symbol-referencer::callback))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; note heads
 
@@ -72,24 +265,42 @@
   (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))
-        (ly:programming-error
-          "stem::length called but will not be used for beamed stem."))))
-
-(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 (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 INFINITY-INT))
+             (my_ph (ly:grob-pure-height grob refp 0 INFINITY-INT))
+             ;; 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))
+
+(define-public (note-head::calc-kievan-duration-log grob)
+  (min 3
+       (ly:duration-log
+         (ly:event-property (event-cause grob) 'duration))))
 
 (define-public (note-head::calc-duration-log grob)
   (min 2
        (ly:duration-log
-	(ly:event-property (event-cause grob) 'duration))))
+         (ly:event-property (event-cause grob) 'duration))))
 
 (define-public (dots::calc-dot-count grob)
   (ly:duration-dot-count
@@ -153,6 +364,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)
@@ -160,9 +373,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)
@@ -234,7 +448,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))
 
@@ -276,66 +490,8 @@ and duration-log @var{log}."
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Bar lines.
+;; neighbor-interface routines
 
-;;
-;; How should a  bar line behave at a break?
-(define bar-glyph-alist
-  '((":|:" . (":|" . "|:"))
-    (":|.|:" . (":|" . "|:"))
-    (":|.:" . (":|" . "|:"))
-    ("||:" . ("||" . "|:"))
-    ("dashed" . ("dashed" . '()))
-    ("|" . ("|" . ()))
-    ("||:" . ("||" . "|:"))
-    ("|s" . (() . "|"))
-    ("|:" . ("|" . "|:"))
-    ("|." . ("|." . ()))
-
-    ;; hmm... should we end with a bar line here?
-    (".|" . ("|" . ".|"))
-    (":|" . (":|" . ()))
-    ("||" . ("||" . ()))
-    (".|." . (".|." . ()))
-    ("|.|" . ("|.|" . ()))
-    ("" . ("" . ""))
-    (":" . (":" . ""))
-    ("." . ("." . ()))
-    ("'" . ("'" . ()))
-    ("empty" . (() . ()))
-    ("brace" . (() . "brace"))
-    ("bracket" . (() . "bracket"))
-
-    ;; segno bar lines
-    ("S" . ("||" . "S"))
-    ("|S" . ("|" . "S"))
-    ("S|" . ("S" . ()))
-    (":|S" . (":|" . "S"))
-    (":|S." . (":|S" . ()))
-    ("S|:" . ("S" . "|:"))
-    (".S|:" . ("|" . "S|:"))
-    (":|S|:" . (":|" . "S|:"))
-    (":|S.|:" . (":|S" . "|:"))))
-
-(define-public (bar-line::calc-glyph-name grob)
-  (let* ((glyph (ly:grob-property grob 'glyph))
-	 (dir (ly:item-break-dir grob))
-	 (result (assoc-get glyph bar-glyph-alist))
-	 (glyph-name (if (= dir CENTER)
-			 glyph
-		         (if (and result
-				  (string? (index-cell result dir)))
-			     (index-cell result dir)
-			     #f))))
-    glyph-name))
-
-(define-public (bar-line::calc-break-visibility grob)
-  (let* ((glyph (ly:grob-property grob 'glyph))
-	 (result (assoc-get glyph bar-glyph-alist)))
-
-    (if result
-	(vector (string? (car result)) #t (string? (cdr result)))
-	all-invisible)))
 
 (define-public (shift-right-at-line-begin g)
   "Shift an item to the right, but only at the start of the line."
@@ -343,6 +499,62 @@ 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 INFINITY-INT))
+         (from-neighbors (interval-union
+                            height
+                            (ly:axis-group-interface::pure-height
+                              grob
+                              0
+                              INFINITY-INT))))
+    (coord-operation - from-neighbors height)))
+
+;; If there are neighbors, we place the height at their midpoint
+;; to avoid protrusion of this pure height out of the vertical
+;; axis group on either side.  This will minimize the impact of the
+;; grob on pure minimum translations.
+
+;; TODO - there is a double call to axis-group-interface::pure-height
+;; here and then in the extra-spacing-height function above. Can/should this
+;; be rolled into one?
+(define-public (pure-from-neighbor-interface::pure-height grob beg end)
+  (let* ((height (ly:axis-group-interface::pure-height
+                  grob
+                  0
+                  INFINITY-INT))
+         (c (interval-center height)))
+    (if (interval-empty? height) empty-interval (cons c c))))
+
+;; Minimizes the impact of the height on vertical spacing while allowing
+;; it to appear in horizontal skylines of paper columns if necessary.
+(define-public pure-from-neighbor-interface::height-if-pure
+  (ly:make-unpure-pure-container #f pure-from-neighbor-interface::pure-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
@@ -448,47 +660,31 @@ and duration-log @var{log}."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; key signature
 
-(define-public (key-signature-interface::alteration-position step alter
-							     c0-position)
-  ;; TODO: memoize - this is mostly constant.
-
-  ;; fes, ges, as and bes typeset in lower octave
-  (define FLAT_TOP_PITCH 2)
-
-  ;; ais and bis typeset in lower octave
-  (define SHARP_TOP_PITCH 4)
-
-  (if (pair? step)
-      (+ (cdr step) (* (car step) 7) c0-position)
-      (let* ((from-bottom-pos (modulo (+ 4 49 c0-position) 7))
-	     (p step)
-	     (c0 (- from-bottom-pos 4)))
-
-	(if
-	 (or (and (< alter 0)
-		  (or (> p FLAT_TOP_PITCH) (> (+ p c0) 4)) (> (+ p c0) 1))
-	     (and (> alter 0)
-		  (or (> p SHARP_TOP_PITCH) (> (+ p c0) 5)) (> (+ p c0) 2)))
-
-	 ;; Typeset below c_position
-	 (set! p (- p 7)))
-
-	;; Provide for the four cases in which there's a glitch
-	;; it's a hack, but probably not worth
-	;; the effort of finding a nicer solution.
-	;; --dl.
-	(cond
-	 ((and (= c0 2) (= p 3) (> alter 0))
-	  (set! p (- p 7)))
-	 ((and (= c0 -3) (= p -1) (> alter 0))
-	  (set! p (+ p 7)))
-	 ((and (= c0 -4) (= p -1) (< alter 0))
-	  (set! p (+ p 7)))
-	 ((and (= c0 -2) (= p -3) (< alter 0))
-	  (set! p (+ p 7))))
-
-	(+ c0 p))))
-
+(define-public (key-signature-interface::alteration-positions
+		entry c0-position grob)
+  (let ((step (car entry))
+	(alter (cdr entry)))
+    (if (pair? step)
+	(list (+ (cdr step) (* (car step) 7) c0-position))
+	(let* ((c-position (modulo c0-position 7))
+	       (positions
+		(if (< alter 0)
+		    ;; See (flat|sharp)-positions in define-grob-properties.scm
+		    (ly:grob-property grob 'flat-positions '(3))
+		    (ly:grob-property grob 'sharp-positions '(3))))
+	       (p (list-ref positions
+			    (if (< c-position (length positions))
+				c-position 0)))
+	       (max-position (if (pair? p) (cdr p) p))
+	       (min-position (if (pair? p) (car p) (- max-position 6)))
+	       (first-position (+ (modulo (- (+ c-position step)
+					     min-position)
+					  7)
+				  min-position)))
+	  (define (prepend x l) (if (> x max-position)
+				    l
+				    (prepend (+ x 7) (cons x l))))
+	  (prepend first-position '())))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; annotations
@@ -515,6 +711,15 @@ and duration-log @var{log}."
 (define-public (accidental-interface::calc-alteration grob)
   (ly:pitch-alteration (ly:event-property (event-cause grob) 'pitch)))
 
+(define-public (accidental-interface::glyph-name grob)
+  (assoc-get (ly:grob-property grob 'alteration)
+             standard-alteration-glyph-name-alist))
+
+(define-public accidental-interface::height
+  (ly:make-unpure-pure-container
+    ly:accidental-interface::height
+    ly:accidental-interface::pure-height))
+
 (define-public cancellation-glyph-name-alist
   '((0 . "accidentals.natural")))
 
@@ -570,6 +775,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
@@ -649,6 +857,15 @@ and duration-log @var{log}."
       (- y-center (ly:grob-relative-coordinate me y-ref Y))))))
 
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; offset callbacks
+
+(define-public (pure-chain-offset-callback grob start end prev-offset)
+  "Sometimes, a chained offset callback is unpure and there is
+   no way to write a pure function that estimates its behavior.
+   In this case, we use a pure equivalent that will simply pass
+   the previous calculated offset value."
+  prev-offset)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -698,8 +915,7 @@ and duration-log @var{log}."
 			    (ly:grob-relative-coordinate spanner common-y Y)))
 		      (interval-end
 		       (ly:grob-robust-relative-extent dots common X))
-		      ;; TODO: use real infinity constant.
-		      -10000))))
+		      (- INFINITY-INT)))))
 	 (right-x (max (- (interval-start
 			   (ly:grob-robust-relative-extent right-span common X))
 			  padding)
@@ -753,36 +969,28 @@ and duration-log @var{log}."
 ;; fingering
 
 (define-public (fingering::calc-text grob)
-  (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)))
+  (let ((event (event-cause grob)))
+    (or (ly:event-property event 'text #f)
+        (number->string (ly:event-property event 'digit) 10))))
 
 (define-public (string-number::calc-text grob)
-  (let ((digit (ly:event-property (event-cause grob) 'string-number)))
-
-    (number->string digit 10)))
+  (let ((event (event-cause grob)))
+    (or (ly:event-property event 'text #f)
+        (number->string (ly:event-property event 'string-number) 10))))
 
 (define-public (stroke-finger::calc-text grob)
-  (let* ((digit (ly:event-property (event-cause grob) 'digit))
-	 (text (ly:event-property (event-cause grob) 'text)))
-
-    (if (string? text)
-	text
+  (let ((event (event-cause grob)))
+    (or (ly:event-property event 'text #f)
 	(vector-ref (ly:grob-property grob 'digit-names)
-		    (1- (max (min 5 digit) 1))))))
+		    (1- (max 1
+                             (min 5 (ly:event-property event 'digit))))))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; 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))
 
@@ -807,6 +1015,71 @@ between the two text elements."
 					     '(bound-details left padding)
 					     (+ my-padding script-padding)))))))
 
+(define-public ((elbowed-hairpin coords mirrored?) grob)
+  "Create hairpin based on a list of @var{coords} in @code{(cons x y)}
+form.  @code{x} is the portion of the width consumed for a given line
+and @code{y} is the portion of the height.  For example,
+@code{'((0.3 . 0.7) (0.8 . 0.9) (1.0 . 1.0))} means that at the point
+where the hairpin has consumed 30% of its width, it must
+be at 70% of its height.  Once it is to 80% width, it
+must be at 90% height.  It finishes at
+100% width and 100% height.  @var{mirrored?} indicates if the hairpin
+is mirrored over the Y-axis or if just the upper part is drawn.
+Returns a function that accepts a hairpin grob as an argument
+and draws the stencil based on its coordinates.
+@lilypond[verbatim,quote]
+#(define simple-hairpin
+  (elbowed-hairpin '((1.0 . 1.0)) #t))
+
+\\relative c' {
+  \\override Hairpin #'stencil = #simple-hairpin
+  a\\p\\< a a a\\f
+}
+@end lilypond
+"
+  (define (pair-to-list pair)
+    (list (car pair) (cdr pair)))
+  (define (normalize-coords goods x y)
+    (map
+      (lambda (coord)
+        (cons (* x (car coord)) (* y (cdr coord))))
+      goods))
+  (define (my-c-p-s points thick decresc?)
+    (make-connected-path-stencil
+      points
+      thick
+      (if decresc? -1.0 1.0)
+      1.0
+      #f
+      #f))
+  ; outer let to trigger suicide
+  (let ((sten (ly:hairpin::print grob)))
+    (if (grob::is-live? grob)
+      (let* ((decresc? (eq? (ly:grob-property grob 'grow-direction) LEFT))
+             (thick (ly:grob-property grob 'thickness 0.1))
+             (thick (* thick (layout-line-thickness grob)))
+             (xex (ly:stencil-extent sten X))
+             (lenx (interval-length xex))
+             (yex (ly:stencil-extent sten Y))
+             (leny (interval-length yex))
+             (xtrans (+ (car xex) (if decresc? lenx 0)))
+             (ytrans (car yex))
+             (uplist (map pair-to-list
+                          (normalize-coords coords lenx (/ leny 2))))
+             (downlist (map pair-to-list
+                            (normalize-coords coords lenx (/ leny -2)))))
+      (ly:stencil-translate
+        (ly:stencil-add
+          (my-c-p-s uplist thick decresc?)
+          (if mirrored? (my-c-p-s downlist thick decresc?) empty-stencil))
+        (cons xtrans ytrans)))
+      '())))
+
+(define-public flared-hairpin
+  (elbowed-hairpin '((0.95 . 0.4) (1.0 . 1.0)) #t))
+
+(define-public constante-hairpin
+  (elbowed-hairpin '((1.0 . 0.0) (1.0 . 1.0)) #f))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; lyrics
@@ -823,6 +1096,9 @@ between the two text elements."
 (define-public ((grob::calc-property-by-copy prop) grob)
   (ly:event-property (event-cause grob) prop))
 
+(define-public ((grob::calc-property-by-non-event-cause prop) grob)
+  (ly:grob-property (non-event-cause grob) prop))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; fret boards
@@ -834,6 +1110,14 @@ between the two text elements."
     (ly:grob-property grob 'dot-placement-list))))
 
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; slurs
+
+(define-public slur::height
+  (ly:make-unpure-pure-container
+    ly:slur::height
+    ly:slur::pure-height))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; scripts
 
@@ -949,6 +1233,14 @@ between the two text elements."
      (interval-center extent))))
 
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; axis group interface
+
+(define-public axis-group-interface::height
+  (ly:make-unpure-pure-container
+    ly:axis-group-interface::height
+    ly:axis-group-interface::pure-height))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; ambitus
 
@@ -991,3 +1283,13 @@ between the two text elements."
 (define-public (laissez-vibrer::print grob)
  (ly:tie::print grob))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; volta-bracket
+
+(define-public (volta-bracket-interface::pure-height grob start end)
+  (let ((edge-height (ly:grob-property grob 'edge-height)))
+    (if (number-pair? edge-height)
+	(let ((smaller (min (car edge-height) (cdr edge-height)))
+	      (larger (max (car edge-height) (cdr edge-height))))
+	  (interval-union '(0 . 0) (cons smaller larger)))
+	'(0 . 0))))