X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-markup-commands.scm;h=a2e128d5f0b0d966ab605dfc922d192ade1e3011;hb=73f6abcd0aa9a2b6f64269b1a82625d39036f3d7;hp=436d2c23781b33ab1133e3f9a0f1d77cdf159ca0;hpb=1cdd20054babbf7ce6eb6a135854abc2d8f00f8f;p=lilypond.git diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm index 436d2c2378..a2e128d5f0 100644 --- a/scm/define-markup-commands.scm +++ b/scm/define-markup-commands.scm @@ -24,6 +24,23 @@ ;; geometric shapes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-builtin-markup-command (draw-line layout props dest) + (number-pair?) + "A simple line. Uses the @code{thickness} property. " + (let* + ((th (chain-assoc-get 'thickness props 0.1)) + (x (car dest)) + (y (cdr dest))) + + (ly:make-stencil + `(draw-line + ,th + 0 0 + ,x ,y) + + (cons (min x 0) (min y 0)) + (cons (max x 0) (max y 0))))) + (define-builtin-markup-command (draw-circle layout props radius thickness fill) (number? number? boolean?) "A circle of radius @var{radius}, thickness @var{thickness} and @@ -292,11 +309,6 @@ grestore ;(map (lambda (s) (interpret-markup layout props s)) parts)) (interpret-markup layout props str))) - -;; TODO: use font recoding. -;; (make-line-markup -;; (map make-word-markup (string-tokenize str))))) - (define-public empty-markup (make-simple-markup "")) @@ -716,7 +728,7 @@ alignment accordingly." (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?) @@ -848,10 +860,7 @@ any sort of property supported by @internalsref{font-interface} and (cons 'font-size (+ fs increment ))))) (interpret-markup layout (cons entries props) arg))) - - -;; FIXME -> should convert to font-size. (define-builtin-markup-command (magnify layout props sz arg) (number? markup?) "Set the font magnification for the its argument. In the following example, the middle A will be 10% larger: @@ -863,7 +872,7 @@ Note: magnification only works if a font-name is explicitly selected. Use @code{\\fontsize} otherwise." (interpret-markup layout - (prepend-alist-chain 'font-magnification sz props) + (prepend-alist-chain 'font-size (magnification->font-size sz) props) arg)) (define-builtin-markup-command (bold layout props arg) (markup?) @@ -1263,8 +1272,8 @@ figured bass notation" (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 @@ -1272,6 +1281,9 @@ figured bass notation" (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) @@ -1282,12 +1294,7 @@ figured bass notation" (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)) @@ -1467,80 +1474,6 @@ that. (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)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;