;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
-;;;; (c) 2003--2007 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; (c) 2003--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
(define-public (stack-stencils axis dir padding stils)
"Stack stencils STILS in direction AXIS, DIR, using PADDING."
(interval-widen xext (/ width 2))
(interval-widen yext (/ width 2)))))
+
(define-public (make-filled-box-stencil xext yext)
"Make a filled box."
(cons (- out-radius) out-radius)
(cons (- out-radius) out-radius))))
+(define-public (make-oval-stencil x-radius y-radius thickness fill)
+ "Make an oval from two Bezier curves, of x radius @var{x-radius},
+ y radius @code{y-radius},
+ and thickness @var{thickness} with fill defined by @code{fill}."
+ (let*
+ ((x-out-radius (+ x-radius (/ thickness 2.0)))
+ (y-out-radius (+ y-radius (/ thickness 2.0))) )
+
+ (ly:make-stencil
+ (list 'oval x-radius y-radius thickness fill)
+ (cons (- x-out-radius) x-out-radius)
+ (cons (- y-out-radius) y-out-radius))))
+
(define-public (make-ellipse-stencil x-radius y-radius thickness fill)
"Make an ellipse of x radius @var{x-radius}, y radius @code{y-radius},
and thickness @var{thickness} with fill defined by @code{fill}."
(interval-center x-ext)
(interval-center y-ext))))))
+(define-public (oval-stencil stencil thickness x-padding y-padding)
+ "Add an oval around @code{stencil}, padded by the padding pair,
+ producing a new stencil."
+ (let* ((x-ext (ly:stencil-extent stencil X))
+ (y-ext (ly:stencil-extent stencil Y))
+ (x-length (+ (interval-length x-ext) x-padding thickness))
+ (y-length (+ (interval-length y-ext) y-padding thickness))
+ (x-radius (* 0.707 x-length) )
+ (y-radius (* 0.707 y-length) )
+ (oval (make-oval-stencil x-radius y-radius thickness #f)))
+
+ (ly:stencil-add
+ stencil
+ (ly:stencil-translate oval
+ (cons
+ (interval-center x-ext)
+ (interval-center y-ext))))))
+
(define-public (ellipse-stencil stencil thickness x-padding y-padding)
"Add an ellipse around STENCIL, padded by the padding pair,
producing a new stencil."
stencil)
))
-(define-public (dimension-arrows destination)
+(define-public (dimension-arrows destination max-size)
"Draw twosided arrow from here to @var{destination}"
(let*
((e_x 1+0i)
(e_y 0+1i)
+ (distance (sqrt (+ (* (car destination) (car destination))
+ (* (cdr destination) (cdr destination)))))
+ (size (min max-size (/ distance 3)))
(rotate (lambda (z ang)
(* (make-polar 1 ang)
z)))
(z-dest (+ (* e_x (car destination)) (* e_y (cdr destination))))
(e_z (/ z-dest (magnitude z-dest)))
- (triangle-points '(-1+0.25i
- 0
- -1-0.25i))
+ (triangle-points (list
+ (* size -1+0.25i)
+ 0
+ (* size -1-0.25i)))
(p1s (map (lambda (z)
(+ z-dest (rotate z (angle z-dest))))
triangle-points))
`(polygon (quote ,(concatenate (map complex-to-offset p2s)))
0.0
#t) null null ) )
- (thickness 0.1)
- (shorten-line 0.5)
+ (thickness (min (/ distance 12) 0.1))
+ (shorten-line (min (/ distance 3) 0.5))
(start (complex-to-offset (/ (* e_z shorten-line) 2)))
(end (complex-to-offset (- z-dest (/ (* e_z shorten-line) 2))))
(ly:format "(~$,~$)"
(car extent) (cdr extent)))))))
(arrows (ly:stencil-translate-axis
- (dimension-arrows (cons 0 (interval-length extent)))
+ (dimension-arrows (cons 0 (interval-length extent)) 1.0)
(interval-start extent) Y)))
(set! annotation
(center-stencil-on-extent text-stencil))
annotation))
+(define*-public (annotate-spacing-spec layout spacing-spec start-Y-offset prev-system-end
+ #:key (base-color blue))
+ (let* ((get-spacing-var (lambda (sym) (assoc-get sym spacing-spec 0.0)))
+ (space (get-spacing-var 'space))
+ (padding (get-spacing-var 'padding))
+ (min-dist (get-spacing-var 'minimum-distance))
+ (contrast-color (append (cdr base-color) (list (car base-color)))))
+ (stack-stencils X RIGHT 0.0
+ (list
+ (annotate-y-interval layout
+ "space"
+ (cons (- start-Y-offset space) start-Y-offset)
+ #t
+ #:color (map (lambda (x) (* x 0.25)) base-color))
+ (annotate-y-interval layout
+ "min-dist"
+ (cons (- start-Y-offset min-dist) start-Y-offset)
+ #t
+ #:color (map (lambda (x) (* x 0.5)) base-color))
+ (ly:stencil-add
+ (annotate-y-interval layout
+ "bottom-of-extent"
+ (cons prev-system-end start-Y-offset)
+ #t
+ #:color base-color)
+ (annotate-y-interval layout
+ "padding"
+ (cons (- prev-system-end padding) prev-system-end)
+ #t
+ #:color contrast-color))))))
+
+
(define-public (eps-file->stencil axis size file-name)
(let*
((contents (ly:gulp-file file-name))