(define-public (stack-stencils axis dir padding stils)
"Stack stencils @var{stils} in direction @var{axis}, @var{dir}, using
@var{padding}."
- (cond
- ((null? stils) empty-stencil)
- ((null? (cdr stils)) (car stils))
- (else (ly:stencil-combine-at-edge
- (car stils) axis dir (stack-stencils axis dir padding (cdr stils))
- padding))))
-
-(define-public (stack-stencils-padding-list axis dir padding stils)
+ (reduce
+ (lambda (next front)
+ (ly:stencil-stack front axis dir next padding))
+ empty-stencil
+ stils))
+
+(define-public (stack-stencils-padding-list axis dir paddings stils)
"Stack stencils @var{stils} in direction @var{axis}, @var{dir}, using
-a list of @var{padding}."
- (cond
- ((null? stils) empty-stencil)
- ((null? (cdr stils)) (car stils))
- (else (ly:stencil-combine-at-edge
- (car stils)
- axis dir
- (stack-stencils-padding-list axis dir (cdr padding) (cdr stils))
- (car padding)))))
+a list of @var{paddings}."
+ (if (null? stils)
+ empty-stencil
+ (fold
+ (lambda (next padding front)
+ (ly:stencil-stack front axis dir next padding))
+ (car stils)
+ (cdr stils)
+ paddings)))
(define-public (centered-stencil stencil)
"Center stencil @var{stencil} in both the X and Y directions."
(define-public (stack-lines dir padding baseline stils)
"Stack vertically with a baseline skip."
- (define result empty-stencil)
- (define last-y #f)
- (do
- ((last-stencil #f (car p))
- (p stils (cdr p)))
-
- ((null? p))
-
- (if (number? last-y)
- (begin
- (let* ((dy (max (+ (* dir (interval-bound (ly:stencil-extent last-stencil Y) dir))
- padding
- (* (- dir) (interval-bound (ly:stencil-extent (car p) Y) (- dir))))
- baseline))
- (y (+ last-y (* dir dy))))
-
-
-
- (set! result
- (ly:stencil-add result (ly:stencil-translate-axis (car p) y Y)))
- (set! last-y y)))
- (begin
- (set! last-y 0)
- (set! result (car p)))))
-
- result)
-
+ (reduce-right
+ (lambda (next back) (ly:stencil-stack next Y dir back padding baseline))
+ empty-stencil
+ (map
+ (lambda (s)
+ ;; X-empty stencils may add vertical space. A stencil that is
+ ;; merely Y-empty counts as horizontal spacing. Since we want
+ ;; those to register as lines of their own (is this a good
+ ;; idea?), we make them a separately visible line.
+ (if (and (ly:stencil-empty? s Y)
+ (not (ly:stencil-empty? s X)))
+ (ly:make-stencil (ly:stencil-expr s) (ly:stencil-extent s X) '(0 . 0))
+ s))
+ stils)))
(define-public (bracketify-stencil stil axis thick protrusion padding)
"Add brackets around @var{stil}, producing a new stencil."
(set! stil
(ly:stencil-combine-at-edge stil (other-axis axis) 1 rb padding))
(set! stil
- (ly:stencil-combine-at-edge lb (other-axis axis) 1 stil padding))
+ (ly:stencil-combine-at-edge stil (other-axis axis) -1 lb padding))
stil))
(define (make-parenthesis-stencil
y-extent half-thickness (- width) angularity))
(rp (make-parenthesis-stencil
y-extent half-thickness width angularity)))
- (set! stencil (ly:stencil-combine-at-edge lp X RIGHT stencil padding))
+ (set! stencil (ly:stencil-combine-at-edge stencil X LEFT lp padding))
(set! stencil (ly:stencil-combine-at-edge stencil X RIGHT rp padding))
stencil))
(yext (cons (min starty endy) (max starty endy))))
(ly:make-stencil
(list 'draw-line width startx starty endx endy)
- ; Since the line has rounded edges, we have to / can safely add half the
- ; width to all coordinates!
+ ;; Since the line has rounded edges, we have to / can safely add half the
+ ;; width to all coordinates!
(interval-widen xext (/ width 2))
(interval-widen yext (/ width 2)))))
(define-public
(make-partial-ellipse-stencil
x-radius y-radius start-angle end-angle thick connect fill)
-
+ "Create an elliptical arc
+@var{x-radius} is the X radius of the arc.
+@var{y-radius} is the Y radius of the arc.
+@var{start-angle} is the starting angle of the arc in degrees.
+@var{end-angle} is the ending angle of the arc in degrees.
+@var{thick} is the thickness of the line.
+@var{connect} is a boolean flag indicating if the end should
+be connected to the start by a line.
+@var{fill} is a boolean flag indicating if the shape should be filled."
(define (make-radius-list x-radius y-radius)
+ "Makes a list of angle/radius pairs at intervals of PI/2 for
+the partial ellipse until 7*PI/2. For example, in pseudo-code:
+> (make-radius-list 2 3)
+((0.0 . 2) (PI/2 . 3) (PI . -2) (3*PI/2 . -3)
+(2*PI . 2) (5*PI/2 . 3) (3*PI . -2) (7*PI/2 . -3))
+"
(apply append
(map (lambda (adder)
(map (lambda (quadrant)
(define
(insert-in-ordered-list ordering-function value inlist cutl? cutr?)
+ "Insert @var{value} in ordered list @var{inlist}. If @var{cutl?}, we
+cut away any parts of @var{inlist} before @var{value}. @var{cutr?} works
+the same way but for the right side. For example:
+> (insert-in-ordered-list < 4 '(1 2 3 6 7) #f #f)
+'(1 2 3 4 6 7)
+> (insert-in-ordered-list < 4 '(1 2 3 6 7) #t #f)
+'(4 6 7)
+> (insert-in-ordered-list < 4 '(1 2 3 6 7) #f #t)
+'(1 2 3 4)
+"
(define
(helper ordering-function value left-list right-list cutl? cutr?)
(if (null? right-list)
(define (ordering-function-2 a b) (car<= a b))
(define (min-max-crawler min-max side l)
+ "Apply function @var{side} to each member of list and
+then reduce using @var{min-max}:
+> (min-max-crawler min car '((0 . 3) (-1 . 4) (1 . 2)))
+-1
+> (min-max-crawler min cdr '((0 . 3) (-1 . 4) (1 . 2)))
+2
+"
(reduce min-max
(if (eq? min-max min) 100000 -100000)
(map (lambda (x) (side x)) l)))
(let*
- ((x-out-radius (+ x-radius (/ thick 2.0)))
+ (;; the outside limit of the x-radius
+ (x-out-radius (+ x-radius (/ thick 2.0)))
+ ;; the outside limit of the y-radius
(y-out-radius (+ y-radius (/ thick 2.0)))
+ ;; end angle to radians
(new-end-angle (angle-0-2pi (degrees->radians end-angle)))
+ ;; length of the radius at the end angle
(end-radius (ellipse-radius x-out-radius y-out-radius new-end-angle))
+ ;; start angle to radians
(new-start-angle (angle-0-2pi (degrees->radians start-angle)))
+ ;; length of the radius at the start angle
(start-radius (ellipse-radius x-out-radius y-out-radius new-start-angle))
+ ;; points that the arc passes through at 90 degree intervals
(radius-list (make-radius-list x-out-radius y-out-radius))
+ ;; rectangular coordinates of arc endpoint
(rectangular-end-radius (polar->rectangular end-radius end-angle))
+ ;; rectangular coordinates of arc begin point
(rectangular-start-radius (polar->rectangular start-radius start-angle))
+ ;; we want the end angle to always be bigger than the start angle
+ ;; so we redefine it here just in case it is less
(new-end-angle
(if (<= new-end-angle new-start-angle)
(+ TWO-PI new-end-angle)
new-end-angle))
+ ;; all the points that may be extrema of the arc
+ ;; this is the 90 degree points plus the beginning and end points
+ ;; we use this to calculate extents
(possible-extrema
(insert-in-ordered-list
ordering-function-2
thick
connect
fill)
+ ;; we know the extrema points by crawling through the
+ ;; list of possible extrema and finding the min and max
+ ;; for x and y
(cons (min-max-crawler min cadr possible-extrema)
(min-max-crawler max cadr possible-extrema))
(cons (min-max-crawler min cddr possible-extrema)
(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))
- ;(aspect-ratio (/ x-length y-length))
+ ;; (aspect-ratio (/ x-length y-length))
(x-radius (* 0.707 x-length) )
(y-radius (* 0.707 y-length) )
- ;(diameter (max (- (cdr x-ext) (car x-ext))
- ; (- (cdr y-ext) (car y-ext))))
- ;(radius (+ (/ diameter 2) padding thickness))
+ ;; (diameter (max (- (cdr x-ext) (car x-ext))
+ ;; (- (cdr y-ext) (car y-ext))))
+ ;; radius (+ (/ diameter 2) padding thickness))
(ellipse (make-ellipse-stencil x-radius y-radius thickness #f)))
(ly:stencil-add
0))
(scaled-bbox
(map (lambda (x) (* factor x)) bbox))
- ; We need to shift the whole eps to (0,0), otherwise it will appear
- ; displaced in lilypond (displacement will depend on the scaling!)
+ ;; We need to shift the whole eps to (0,0), otherwise it will appear
+ ;; displaced in lilypond (displacement will depend on the scaling!)
(translate-string (ly:format "~a ~a translate" (- (list-ref bbox 0)) (- (list-ref bbox 1))))
(clip-rect-string (ly:format
"~a ~a ~a ~a rectclip"
EndEPSF
grestore
"))
- ; Stencil starts at (0,0), since we have shifted the eps, and its
- ; size is exactly the size of the scaled bounding box
+ ;; Stencil starts at (0,0), since we have shifted the eps, and its
+ ;; size is exactly the size of the scaled bounding box
(cons 0 (- (list-ref scaled-bbox 2) (list-ref scaled-bbox 0)))
(cons 0 (- (list-ref scaled-bbox 3) (list-ref scaled-bbox 1))))
projects / lilypond.git / blobdiff