;;;; 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)))))
(define-public (make-path-stencil path thickness x-scale y-scale fill)
"Make a stencil based on the path described by the list @var{path},
with thickness @var{thickness}, and scaled by @var{x-scale} in the X
-direction and @var{y-scale} in the Y direction. @var{fill} is a boolean
-argument that specifies if the path should be filled. Valid path
+direction and @var{y-scale} in the Y direction. @var{fill} is a boolean
+argument that specifies if the path should be filled. Valid path
commands are: moveto rmoveto lineto rlineto curveto rcurveto closepath,
and their standard SVG single letter equivalents: M m L l C c Z z."
(define (convert-path path origin previous-point)
"Recursive function to standardize command names and
convert any relative path expressions (in @var{path}) to absolute
-values. Returns a list of lists. @var{origin} is a pair of x and y
+values. Returns a list of lists. @var{origin} is a pair of x and y
coordinates for the origin point of the path (used for closepath and
-reset by moveto commands). @var{previous-point} is a pair of x and y
+reset by moveto commands). @var{previous-point} is a pair of x and y
coordinates for the previous point in the path."
(if (pair? path)
(let*
(define-public (make-connected-path-stencil pointlist thickness
x-scale y-scale connect fill)
- "Make a connected path described by the list @var{pointlist}, with
-thickness @var{thickness}, and scaled by @var{x-scale} in the X direction
-and @var{y-scale} in the Y direction. @var{connect} and @var{fill} are
-boolean arguments that specify if the path should be connected or filled,
-respectively."
+ "Make a connected path described by the list @var{pointlist}, beginning
+at point '(0 . 0), with thickness @var{thickness}, and scaled by
+@var{x-scale} in the X direction and @var{y-scale} in the Y direction.
+@var{connect} and @var{fill} are boolean arguments that specify if the
+path should be connected or filled, respectively."
(make-path-stencil
(concatenate
(append
((2) (append (list 'lineto) path-unit))
((6) (append (list 'curveto) path-unit))))
pointlist)
- (if connect (list (list 'closepath)) '())))
+ ;; if this path is connected, add closepath to the end
+ (if connect (list '(closepath)) '())))
thickness x-scale y-scale fill))
(define-public (make-ellipse-stencil x-radius y-radius thickness fill)
;; 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
projects / lilypond.git / blobdiff