X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-lib.scm;h=3cfefc8f3e58f53aac4f323105d7f769fb32d3ef;hb=264d51268e3ba26d6fb8cff9e5ba3d7e08f9de77;hp=37f965d94ff7e877827df9520987c04778ae4d52;hpb=763d936b0b9e93244fe34bd2a0354ea03657339f;p=lilypond.git

diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 37f965d94f..3cfefc8f3e 100644
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -26,22 +26,9 @@
   (lambda (grob) (circle-stencil (callback grob) thickness padding)))
 
 (define-public (print-circled-text-callback grob)
-  (let* ((text (ly:grob-property grob 'text))
-	 
-	 (layout (ly:grob-layout grob))
-	 (defs (ly:output-def-lookup layout 'text-font-defaults))
-	 (props (ly:grob-alist-chain grob defs))
-	 (circle (ly:text-interface::interpret-markup
-		  layout props (make-circle-markup text))))
-    circle))
-
-(define-public (music-cause grob)
-  (let*
-      ((event (event-cause grob)))
-
-    (if (ly:stream-event? event)
-	(ly:event-property event 'music-cause)
-	#f)))
+  (grob-interpret-markup grob (make-circle-markup
+		   (ly:grob-property grob 'text))
+	     ))
 
 (define-public (event-cause grob)
   (let*
@@ -135,6 +122,21 @@
   (ly:duration-dot-count
    (ly:event-property (event-cause grob) 'duration)))
 
+(define-public (dots::calc-staff-position grob)
+  (let*
+      ((head (ly:grob-parent grob Y))
+       (log (ly:grob-property head 'duration-log)))
+
+    (cond
+     ((or (not (grob::has-interface head 'rest-interface))
+	 (not (integer? log))) 0)
+     ((= log 7) 4)
+     ((> log 4) 3)
+     ((= log 0) -1)
+     ((= log 1) 1)
+     ((= log -1) 1)
+     (else 0))))
+
 (define (note-head::calc-tablature-stem-attachment grob)
   (cons 0.0 1.35))
 
@@ -153,6 +155,9 @@
       ;; statement.  -- jr
       ((xcircle) "2xcircle")
       ((harmonic) "0harmonic")
+      ((harmonic-black) "2harmonic")
+      ((harmonic-mixed) (if (<= log 1) "0harmonic"
+                                       "2harmonic"))
       ((baroque) 
        ;; Oops, I actually would not call this "baroque", but, for
        ;; backwards compatibility to 1.4, this is supposed to take
@@ -303,21 +308,125 @@ centered, X==1 is at the right, X == -1 is at the left."
 (define-public darkmagenta '(0.5 0.0 0.5))
 (define-public darkyellow  '(0.5 0.5 0.0))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; accidentals
+
+(define-public (accidental-interface::calc-alteration grob)
+  (ly:pitch-alteration  (ly:event-property (event-cause grob) 'pitch)))
+
+
+(define-public cancellation-glyph-name-alist
+  '((0 . "accidentals.natural")))
+
+(define-public standard-alteration-glyph-name-alist
+     '(
+       ;; ordered for optimal performance.
+       (0 . "accidentals.natural")
+       (-1/2 . "accidentals.flat")
+       (1/2 . "accidentals.sharp")
+
+       (1 . "accidentals.doublesharp")
+       (-1 . "accidentals.flatflat")
+       
+       (3/4 . "accidentals.sharp.slashslash.stemstemstem")
+       (1/4 . "accidentals.sharp.slashslash.stem")
+       (-1/4 . "accidentals.mirroredflat")
+       (-3/4 . "accidentals.mirroredflat.flat")
+       ))
+
+(define-public makam-alteration-glyph-name-alist
+     '((1 . "accidentals.doublesharp")
+       (8/9 . "accidentals.sharp.slashslashslash.stemstem")
+       (5/9 . "accidentals.sharp.slashslashslash.stem")
+       (4/9 . "accidentals.sharp")
+       (1/9 . "accidentals.sharp.slashslash.stem")
+       (0 . "accidentals.natural")
+       (-1/9 . "accidentals.mirroredflat")
+       (-4/9 . "accidentals.flat.slash")
+       (-5/9 . "accidentals.flat")
+       (-8/9 . "accidentals.flat.slashslash")
+       (-1 . "accidentals.flatflat")
+       ))
+  
+(define-public alteration-hufnagel-glyph-name-alist
+   '((1/2 . "accidentals.hufnagel-1")
+     (0 . "accidentals.vaticana0")
+     (-1/2 . "accidentals.mensural1")))
+
+(define-public alteration-medicaea-glyph-name-alist
+   '((1/2 . "accidentals.medicaea-1")
+     (0 . "accidentals.vaticana0")
+     (-1/2 . "accidentals.mensural1")))
+
+(define-public alteration-vaticana-glyph-name-alist
+   '((1/2 . "accidentals.vaticana-1")
+     (0 . "accidentals.vaticana0")
+     (-1/2 . "accidentals.mensural1")))
+
+(define-public alteration-mensural-glyph-name-alist
+   '((1/2 . "accidentals.mensural-1")
+     (0 . "accidentals.vaticana0")
+     (-1/2 . "accidentals.mensural1")))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; * Pitch Trill Heads
 ;; * Parentheses
 
 (define-public (parentheses-item::calc-parenthesis-stencils grob)
-  (let* (
-	 (font (ly:grob-default-font grob))
+  (let* ((font (ly:grob-default-font grob))
 	 (lp (ly:font-get-glyph font "accidentals.leftparen"))
-	 (rp (ly:font-get-glyph font "accidentals.rightparen"))
-	 )
+	 (rp (ly:font-get-glyph font "accidentals.rightparen")))
 
     (list lp rp)))
 
 
-(define (grob-text grob text)
+(define-public (grob-interpret-markup grob text)
   (let*
       ((layout (ly:grob-layout grob))
        (defs (ly:output-def-lookup layout 'text-font-defaults))
@@ -329,9 +438,9 @@ centered, X==1 is at the right, X == -1 is at the left."
 (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))
+	 (lp (ly:stencil-aligned-to (ly:stencil-aligned-to (grob-interpret-markup 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))
+	 (rp (ly:stencil-aligned-to (ly:stencil-aligned-to (grob-interpret-markup grob (ly:wide-char->utf-8 #x232A))
 							   Y CENTER) X LEFT))
 	 )
 
@@ -520,16 +629,12 @@ centered, X==1 is at the right, X == -1 is at the left."
   "Allow interpretation of tildes as lyric tieing marks."
   
   (let*
-      ((text (ly:grob-property grob 'text))
-       (layout (ly:grob-layout grob))
-       (defs (ly:output-def-lookup layout 'text-font-defaults))
-       (props (ly:grob-alist-chain grob defs)))
+      ((text (ly:grob-property grob 'text)))
 
-    (ly:text-interface::interpret-markup layout
-					 props
-					 (if (string? text)
-					     (make-tied-lyric-markup text)
-					     text))))
+    (grob-interpret-markup grob 
+	       (if (string? text)
+		   (make-tied-lyric-markup text)
+		   text))))
 
 (define-public ((grob::calc-property-by-copy prop) grob)
   (ly:event-property (event-cause grob) prop))
@@ -566,10 +671,8 @@ centered, X==1 is at the right, X == -1 is at the left."
 
 (define-public (fret-board::calc-stencil grob)
   (let* ((string-frets (ly:grob-property grob 'string-fret-finger-combinations))
-	 (string-count (ly:grob-property grob 'string-count))
-	 (layout (ly:grob-layout grob))
-	 (defs (ly:output-def-lookup layout 'text-font-defaults))
-	 (props (ly:grob-alist-chain grob defs)))
-
-    (make-fret-diagram layout props
-		       (string-frets->description string-frets 6))))
+	 (string-count (ly:grob-property grob 'string-count)))
+    
+    (grob-interpret-markup grob
+			   (make-fret-diagram-verbose-markup
+			    (string-frets->description string-frets string-count)))))