;; 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
(yextent (ly:stencil-extent stil Y))
(old-expr (ly:stencil-expr stil))
(url-expr (list 'url-link url `(quote ,xextent) `(quote ,yextent))))
+
(ly:stencil-add (ly:make-stencil url-expr xextent yextent) stil)))
;(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 ""))
(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?)
(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:
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?)
(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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;