X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-lib.scm;h=b9f5e421e9103609a7f6fc0cfcf1d3824b3324ea;hb=b715af1d7ae27aa1c3cdca6b18cf17873ecdb6ba;hp=444f77df06965be181cb0f660dbef72cb85914b7;hpb=1efdabf3b2349ea7fa3183dca5bba5104c347c36;p=lilypond.git

diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 444f77df06..b9f5e421e9 100644
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -99,6 +99,11 @@
        (if (< log 0)
 	   (string-append (number->string log) "neomensural")
 	   (number->string log)))
+      ((altdefault)
+       ;; Like default, but brevis is drawn with double vertical lines
+       (if (= log -1)
+	   (string-append (number->string log) "double")
+	   (number->string log)))
       ((mensural)
        (string-append (number->string log) (symbol->string style)))
       ((petrucci)
@@ -135,18 +140,21 @@
 	 (letter (markup #:center-align #:vcenter pitch-string))
 	 (filled-circle (markup #:draw-circle radius 0 #t)))
 
-    (grob-interpret-markup
-     grob
-     (if (>= log 2)
-	 (make-combine-markup
-	  filled-circle
-	  (make-with-color-markup white letter))
-	 (make-combine-markup
+    (ly:stencil-translate-axis
+     (grob-interpret-markup
+      grob
+      (if (>= log 2)
 	  (make-combine-markup
 	   filled-circle
-	   (make-with-color-markup white (make-draw-circle-markup
-					  (- radius stem-thickness) 0 #t)))
-	  letter)))))
+	   (make-with-color-markup white letter))
+	  (make-combine-markup
+	   (make-combine-markup
+	    filled-circle
+	    (make-with-color-markup white (make-draw-circle-markup
+					   (- radius stem-thickness) 0 #t)))
+	   letter)))
+     radius X)))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; break visibility
@@ -197,21 +205,21 @@
 (define-public (bar-line::calc-glyph-name grob)
   (let* ((glyph (ly:grob-property grob 'glyph))
 	 (dir (ly:item-break-dir grob))
-	 (result (assoc glyph  bar-glyph-alist))
+	 (result (assoc-get glyph bar-glyph-alist))
 	 (glyph-name (if (= dir CENTER)
 			 glyph
 		         (if (and result
-				  (string? (index-cell (cdr result) dir)))
-			     (index-cell (cdr result) dir)
+				  (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 glyph bar-glyph-alist)))
+	 (result (assoc-get glyph bar-glyph-alist)))
 
     (if result
-	(vector (string? (cadr result)) #t (string? (cddr result)))
+	(vector (string? (car result)) #t (string? (cdr result)))
 	all-invisible)))
 
 (define-public (shift-right-at-line-begin g)
@@ -766,3 +774,38 @@
     (+
      (ly:self-alignment-interface::y-aligned-on-self grob)
      (interval-center extent))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ambitus
+
+(define-public (ambitus::print grob)
+  (let ((heads (ly:grob-object grob 'note-heads)))
+
+    (if (and (ly:grob-array? heads)
+	     (= (ly:grob-array-length heads) 2))
+	(let* ((common (ly:grob-common-refpoint-of-array grob heads Y))
+	       (head-down (ly:grob-array-ref heads 0))
+	       (head-up (ly:grob-array-ref heads 1))
+	       (gap (ly:grob-property grob 'gap 0.35))
+	       (point-min (+ (interval-end (ly:grob-extent head-down common Y))
+			     gap))
+	       (point-max (- (interval-start (ly:grob-extent head-up common Y))
+			     gap)))
+
+	  (if (< point-min point-max)
+	      (let* ((layout (ly:grob-layout grob))
+		     (line-thick (ly:output-def-lookup layout 'line-thickness))
+		     (blot (ly:output-def-lookup layout 'blot-diameter))
+		     (grob-thick (ly:grob-property grob 'thickness 2))
+		     (width (* line-thick grob-thick))
+		     (x-ext (symmetric-interval (/ width 2)))
+		     (y-ext (cons point-min point-max))
+		     (line (ly:round-filled-box x-ext y-ext blot))
+		     (y-coord (ly:grob-relative-coordinate grob common Y)))
+
+		(ly:stencil-translate-axis line (- y-coord) Y))
+	      empty-stencil))
+	(begin
+	  (ly:grob-suicide! grob)
+	  (list)))))