(let* ((m1 (interpret-markup layout props arg1))
(m2 (interpret-markup layout props arg2)))
- (ly:stencil-combine-at-edge m1 axis dir m2 0.0 0.0)
+ (ly:stencil-combine-at-edge m1 axis dir m2 0.0)
))
(define-builtin-markup-command (transparent layout props arg) (markup?)
(define-builtin-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-builtin-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-builtin-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-builtin-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-builtin-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-builtin-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-builtin-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-builtin-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-builtin-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-builtin-markup-command (with-color layout props color arg) (color? markup?)
"Draw @var{arg} in color specified by @var{color}"
(define-builtin-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))
(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.
(apply ly:stencil-add
(map (lambda (x)
(ly:stencil-translate-axis
- dot (* (+ 1 (* 2 x)) dotwid) X))
- (iota dot-count 1)))))
+ dot (* 2 x dotwid) X))
+ (iota dot-count)))))
(flaggl (and (> log 2)
(ly:stencil-translate
(ly:font-get-glyph font
(if (> dir 0) "u" "d")
(number->string log)))
(cons (+ (car attach-off) (/ stem-thickness 2)) stemy)))))
+
+ (if (and dots flaggl (> dir 0))
+ (set! dots (ly:stencil-translate-axis dots 0.35 X)))
(if flaggl
(set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
(if (ly:stencil? stem-glyph)
(ly:stencil-add
(ly:stencil-translate-axis
dots
- (+ (if (and (> dir 0) (> log 2))
- (* 1.5 dotwid)
- 0)
- ;; huh ? why not necessary?
- ;;(cdr (ly:stencil-extent head-glyph X))
- dotwid)
+ (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
X)
stem-glyph)))
stem-glyph))
(let ((th 0.1) ;; todo: take from GROB.
(m (interpret-markup layout props arg)))
(bracketify-stencil m Y th (* 2.5 th) th)))
-
-(define-builtin-markup-command (bracketed-y-column layout props indices args)
- (list? markup-list?)
- "Make a column of the markups in @var{args}, putting brackets around
-the elements marked in @var{indices}, which is a list of numbers.
-
-"
-;;
-;; DROPME? This command is a relic from the old figured bass implementation.
-;;
-
- (define (sublist lst start stop)
- (take (drop lst start) (- (1+ stop) start)))
-
- (define (stencil-list-extent ss axis)
- (cons
- (apply min (map (lambda (x) (car (ly:stencil-extent x axis))) ss))
- (apply max (map (lambda (x) (cdr (ly:stencil-extent x axis))) ss))))
-
-
- (define (stack-stencils-vertically stencils bskip last-stencil)
- (cond
- ((null? stencils) '())
- ((not (ly:stencil? last-stencil))
- (cons (car stencils)
- (stack-stencils-vertically (cdr stencils) bskip (car stencils))))
- (else
- (let* ((orig (car stencils))
- (dir (chain-assoc-get 'direction props DOWN))
- (new (ly:stencil-moved-to-edge last-stencil Y dir
- orig
- 0.1 bskip)))
-
- (cons new (stack-stencils-vertically (cdr stencils) bskip new))))))
-
- (define (make-brackets stencils indices acc)
- (if (and stencils
- (pair? indices)
- (pair? (cdr indices)))
- (let* ((encl (sublist stencils (car indices) (cadr indices)))
- (x-ext (stencil-list-extent encl X))
- (y-ext (stencil-list-extent encl Y))
- (thick 0.10)
- (pad 0.35)
- (protusion (* 2.5 thick))
- (lb
- (ly:stencil-translate-axis
- (ly:bracket Y y-ext thick protusion)
- (- (car x-ext) pad) X))
- (rb (ly:stencil-translate-axis
- (ly:bracket Y y-ext thick (- protusion))
- (+ (cdr x-ext) pad) X)))
-
- (make-brackets
- stencils (cddr indices)
- (append
- (list lb rb)
- acc)))
- acc))
-
- (let* ((stencils
- (map (lambda (x)
- (interpret-markup
- layout
- props
- x)) args))
- (leading
- (chain-assoc-get 'baseline-skip props))
- (stacked (stack-stencils-vertically
- (remove ly:stencil-empty? stencils) 1.25 #f))
- (brackets (make-brackets stacked indices '())))
-
- (apply ly:stencil-add
- (append stacked brackets))))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
projects / lilypond.git / blobdiff