;;;; 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
upper-end-point
;; Step 1: move to lower end point.
lower-end-point)
- line-width
+ (* 2 half-thickness)
(interval-widen x-extent (/ line-width 2))
(interval-widen y-extent (/ line-width 2)))))
((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))
;; TODO: figure out how to annotate padding nicely
;; TODO: emphasize either padding or min-dist depending on which constraint was active
-(define*-public (annotate-spacing-spec layout spacing-spec start-Y-offset next-staff-Y
+(define*-public (annotate-spacing-spec layout name spacing-spec
+ start-Y-offset next-staff-Y
#:key (base-color blue))
(let* ((get-spacing-var (lambda (sym) (assoc-get sym spacing-spec 0.0)))
(space (get-spacing-var 'basic-distance))
(contrast-color (append (cdr base-color) (list (car base-color))))
(min-dist-blocks (<= (- start-Y-offset min-dist) next-staff-Y))
(min-dist-color (if min-dist-blocks contrast-color base-color))
- (basic-annotation (annotate-y-interval layout
- "basic-dist"
- (cons (- start-Y-offset space) start-Y-offset)
- #t
- #:color (map (lambda (x) (* x 0.25)) base-color)))
- (min-annotation (annotate-y-interval layout
- "min-dist"
- (cons (- start-Y-offset min-dist) start-Y-offset)
- #t
- #:color min-dist-color))
- (extra-annotation (annotate-y-interval layout
- "extra dist"
- (cons next-staff-Y (- start-Y-offset min-dist))
- #t
- #:color (map (lambda (x) (* x 0.5)) min-dist-color))))
+ (name-string (if (string-null? name)
+ ""
+ (simple-format #f " (~a)" name)))
+ (basic-annotation
+ (annotate-y-interval layout
+ (simple-format #f "basic-dist~a" name-string)
+ (cons (- start-Y-offset space) start-Y-offset)
+ #t
+ #:color (map (lambda (x) (* x 0.25)) base-color)))
+ (min-annotation
+ (annotate-y-interval layout
+ (simple-format #f "min-dist~a" name-string)
+ (cons (- start-Y-offset min-dist) start-Y-offset)
+ #t
+ #:color min-dist-color))
+ (extra-annotation
+ (annotate-y-interval layout
+ (simple-format #f "extra dist~a" name-string)
+ (cons next-staff-Y (- start-Y-offset min-dist))
+ #t
+ #:color (map (lambda (x) (* x 0.5)) min-dist-color))))
(stack-stencils X RIGHT 0.0
(list