;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 2003--2014 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2003--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
((eq? head 'curveto) 6)
(else 0)))
(coordinates-raw (take rest arity))
- (absolute? (if (memq head-raw
+ (is-absolute (if (memq head-raw
'(rmoveto m rlineto l rcurveto c)) #f #t))
- (coordinates (if absolute?
+ (coordinates (if is-absolute
coordinates-raw
;; convert relative coordinates to absolute by
;; adding them to previous point values
(set! stencil (ly:stencil-add outer inner))
stencil))
+(define-public (flip-stencil axis stil)
+ "Flip stencil @var{stil} in the direction of @var{axis}.
+Value @code{X} (or @code{0}) for @var{axis} flips it horizontally.
+Value @code{Y} (or @code{1}) flips it vertically. @var{stil} is
+flipped in place; its position, the coordinates of its bounding
+box, remains the same."
+ (let* (
+ ;; scale stencil using -1 to flip it and
+ ;; then restore it to its original position
+ (xy (if (= axis X) '(-1 . 1) '(1 . -1)))
+ (flipped-stil (ly:stencil-scale stil (car xy) (cdr xy)))
+ (flipped-ext (ly:stencil-extent flipped-stil axis))
+ (original-ext (ly:stencil-extent stil axis))
+ (offset (- (car original-ext) (car flipped-ext)))
+ (replaced-stil (ly:stencil-translate-axis flipped-stil offset axis)))
+ replaced-stil))
+
(define-public (stencil-with-color stencil color)
(ly:make-stencil
(list 'color color (ly:stencil-expr stencil))
(ly:stencil-extent stencil X)
(ly:stencil-extent stencil Y)))
-(define-public (stencil-whiteout stencil)
+(define*-public (stencil-whiteout
+ stil #:optional (thickness 0.3) (color white)
+ (angle-increments 16) (radial-increments 1))
+ "This function works by creating a series of white or @var{color}
+stencils radially offset from the original stencil with angles from
+0 to 2*pi, at an increment of @code{angle-inc}, and with radii
+from @code{radial-inc} to @var{thickness}. @var{thickness} is how big
+the white outline is in staff-spaces. @var{radial-increments} is how
+many copies of the white stencil we make on our way out to thickness.
+@var{angle-increments} is how many copies of the white stencil
+we make between 0 and 2*pi."
+ (if (or (not (positive? angle-increments))
+ (not (positive? radial-increments)))
+ (begin
+ (ly:warning "Both angle-increments and radial-increments must be positive numbers.")
+ stil)
+ (let* ((2pi 6.283185307)
+ (angle-inc (/ 2pi angle-increments))
+ (radial-inc (/ thickness radial-increments)))
+
+ (define (circle-plot ang dec radius original-stil new-stil)
+ ;; ang (angle) and dec (decrement) are in radians, not degrees
+ (if (<= ang 0)
+ new-stil
+ (circle-plot (- ang dec) dec radius original-stil
+ (ly:stencil-add
+ new-stil
+ (ly:stencil-translate original-stil
+ (cons
+ (* radius (cos ang))
+ (* radius (sin ang))))))))
+
+ (define (radial-plot radius original-stil new-stil)
+ (if (<= radius 0)
+ new-stil
+ (ly:stencil-add new-stil
+ (radial-plot
+ (- radius radial-inc)
+ original-stil
+ (circle-plot 2pi angle-inc
+ radius original-stil empty-stencil)))))
+
+ (let ((whiteout-expr
+ (ly:stencil-expr
+ (stencil-with-color
+ (radial-plot thickness stil empty-stencil)
+ color))))
+ (ly:stencil-add
+ (ly:make-stencil
+ `(delay-stencil-evaluation ,(delay whiteout-expr)))
+ stil)))))
+
+(define-public (stencil-whiteout-box stencil)
(let*
((x-ext (ly:stencil-extent stencil X))
- (y-ext (ly:stencil-extent stencil Y))
-
- )
+ (y-ext (ly:stencil-extent stencil Y)))
(ly:stencil-add
(stencil-with-color (ly:round-filled-box x-ext y-ext 0.0)
white)
- stencil)
- ))
+ stencil)))
(define-public (arrow-stencil-maker start? end?)
"Return a function drawing a line from current point to @code{destination},
(make-simple-markup (simple-format #f "~a: NaN/inf" name))))
(let ((text-stencil (interpret-markup
layout text-props
- (markup #:whiteout #:simple name)))
+ (markup #:whiteout-box #:simple name)))
(dim-stencil (interpret-markup
layout text-props
- (markup #:whiteout
+ (markup #:whiteout-box
#:simple (cond
((interval-empty? extent)
"empty")