Scheme nitpicks.

[lilypond.git] / scm / define-markup-commands.scm

diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index 25ced26a9b2bb54edde73d952ed08d70ced42f8e..10d48d5e8a5173640482824f981ee0ffc0a14a32 100644 (file)
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -127,17 +127,7 @@ circle of diameter 0 (ie sharp corners)."
 
 (define-markup-command (whiteout layout props arg) (markup?)
   "Provide a white underground for @var{arg}"
-  (let* ((stil (interpret-markup layout props arg))
-        (white
-         (interpret-markup layout props
-                           (make-with-color-markup
-                            white
-                            (make-filled-box-markup
-                             (ly:stencil-extent stil X)
-                             (ly:stencil-extent stil Y)
-                             0.0)))))
-
-    (ly:stencil-add white stil)))
+  (stencil-whiteout (interpret-markup layout props arg)))
 
 (define-markup-command (pad-markup layout props padding arg) (number? markup?)
   "Add space around a markup object."
@@ -1042,39 +1032,40 @@ recommend font for this is bold and italic"
 (define-markup-command (doublesharp layout props) ()
   "Draw a double sharp symbol."
 
-  (interpret-markup layout props (markup #:musicglyph "accidentals.4")))
+  (interpret-markup layout props (markup #:musicglyph (assoc-get 1 standard-alteration-glyph-name-alist ""))))
 
 (define-markup-command (sesquisharp layout props) ()
   "Draw a 3/2 sharp symbol."
-  (interpret-markup layout props (markup #:musicglyph "accidentals.3")))
+  (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist ""))))
+                                        
 
 (define-markup-command (sharp layout props) ()
   "Draw a sharp symbol."
-  (interpret-markup layout props (markup #:musicglyph "accidentals.2")))
+  (interpret-markup layout props (markup #:musicglyph (assoc-get 1/2 standard-alteration-glyph-name-alist ""))))
 
 (define-markup-command (semisharp layout props) ()
   "Draw a semi sharp symbol."
-  (interpret-markup layout props (markup #:musicglyph "accidentals.1")))
+  (interpret-markup layout props (markup #:musicglyph (assoc-get 1/4 standard-alteration-glyph-name-alist ""))))
 
 (define-markup-command (natural layout props) ()
   "Draw a natural symbol."
-  (interpret-markup layout props (markup #:musicglyph "accidentals.0")))
+  (interpret-markup layout props (markup #:musicglyph (assoc-get 0 standard-alteration-glyph-name-alist ""))))
 
 (define-markup-command (semiflat layout props) ()
   "Draw a semiflat."
-  (interpret-markup layout props (markup #:musicglyph "accidentals.M1")))
+  (interpret-markup layout props (markup #:musicglyph (assoc-get -1/4 standard-alteration-glyph-name-alist ""))))
 
 (define-markup-command (flat layout props) ()
   "Draw a flat symbol."
-  (interpret-markup layout props (markup #:musicglyph "accidentals.M2")))
+  (interpret-markup layout props (markup #:musicglyph (assoc-get -1/2 standard-alteration-glyph-name-alist ""))))
 
 (define-markup-command (sesquiflat layout props) ()
   "Draw a 3/2 flat symbol."
-  (interpret-markup layout props (markup #:musicglyph "accidentals.M3")))
+  (interpret-markup layout props (markup #:musicglyph (assoc-get -3/4 standard-alteration-glyph-name-alist ""))))
 
 (define-markup-command (doubleflat layout props) ()
   "Draw a double flat symbol."
-  (interpret-markup layout props (markup #:musicglyph "accidentals.M4")))
+  (interpret-markup layout props (markup #:musicglyph (assoc-get -1 standard-alteration-glyph-name-alist ""))))
 
 (define-markup-command (with-color layout props color arg) (color? markup?)
   "Draw @var{arg} in color specified by @var{color}"
@@ -1108,7 +1099,7 @@ recommend font for this is bold and italic"
 
 (define-markup-command (musicglyph layout props glyph-name) (string?)
   "This is converted to a musical symbol, e.g. @code{\\musicglyph
-#\"accidentals.0\"} will select the natural sign from the music font.
+#\"accidentals.natural\"} will select the natural sign from the music font.
 See @usermanref{The Feta font} for  a complete listing of the possible glyphs."
   (ly:font-get-glyph
    (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
@@ -1177,30 +1168,42 @@ figured bass notation"
        (num-x (interval-widen (ly:stencil-extent number-stencil X)
                              (* mag 0.2)))
        (num-y (ly:stencil-extent number-stencil Y))
-       (slash-stencil 
-       (ly:make-stencil
-        `(draw-line
-          ,thickness
-          ,(car num-x) ,(- (interval-center num-y) dy)
-          ,(cdr num-x) ,(+ (interval-center num-y) dy))
-        num-x num-y
-        )))
-
-    (ly:stencil-add number-stencil
-                   (cond
-                    ((= num 5) (ly:stencil-translate slash-stencil
-                                                     ;;(cons (* mag -0.05) (* mag 0.42))
-                                                     (cons (* mag -0.00) (* mag -0.07))
-
-                                                     ))
-                    ((= num 7) (ly:stencil-translate slash-stencil
-                                                     ;;(cons (* mag -0.05) (* mag 0.42))
-                                                     (cons (* mag -0.00) (* mag -0.15))
-
-                                                     ))
-                    
-                    (else slash-stencil)))
-    ))
+       (is-sane (and (interval-sane? num-x) (interval-sane? num-y)))
+       
+       (slash-stencil
+       (if is-sane
+           (ly:make-stencil
+            `(draw-line
+              ,thickness
+              ,(car num-x) ,(- (interval-center num-y) dy)
+              ,(cdr num-x) ,(+ (interval-center num-y) dy))
+            num-x num-y)
+           #f)))
+
+    (set! slash-stencil
+         (cond
+          ((not (ly:stencil? slash-stencil)) #f)
+          ((= num 5) (ly:stencil-translate slash-stencil
+                                           ;;(cons (* mag -0.05) (* mag 0.42))
+                                           (cons (* mag -0.00) (* mag -0.07))
+
+                                           ))
+          ((= num 7) (ly:stencil-translate slash-stencil
+                                           ;;(cons (* mag -0.05) (* mag 0.42))
+                                           (cons (* mag -0.00) (* mag -0.15))
+
+                                           ))
+          
+          (else slash-stencil)))
+
+    (if slash-stencil
+       (set! number-stencil
+             (ly:stencil-add number-stencil slash-stencil))
+       
+       (ly:warning "invalid number for slashed digit ~a" num))
+
+
+    number-stencil))
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; the note command.