-;;;; stencil.scm --
+;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; source file of the GNU LilyPond music typesetter
-;;;;
-;;;; (c) 2003--2007 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2003--2009 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
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
(define-public (stack-stencils axis dir padding stils)
"Stack stencils STILS in direction AXIS, DIR, using PADDING."
(set! result (car p)))))
result)
-
-(define-public (bracketify-stencil stil axis thick protusion padding)
+
+(define-public (bracketify-stencil stil axis thick protrusion padding)
"Add brackets around STIL, producing a new stencil."
(let* ((ext (ly:stencil-extent stil axis))
- (lb (ly:bracket axis ext thick (- protusion)))
- (rb (ly:bracket axis ext thick protusion)))
+ (lb (ly:bracket axis ext thick protrusion))
+ (rb (ly:bracket axis ext thick (- protrusion))))
(set! stil
- (ly:stencil-combine-at-edge stil (other-axis axis) 1 lb padding))
+ (ly:stencil-combine-at-edge stil (other-axis axis) 1 rb padding))
(set! stil
- (ly:stencil-combine-at-edge stil (other-axis axis) -1 rb padding))
+ (ly:stencil-combine-at-edge lb (other-axis axis) 1 stil padding))
stil))
+(define-public (make-line-stencil width startx starty endx endy)
+ "Make a line stencil of given linewidth and set its extents accordingly"
+ (let ((xext (cons (min startx endx) (max startx endx)))
+ (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!
+ (interval-widen xext (/ width 2))
+ (interval-widen yext (/ width 2)))))
+
+
(define-public (make-filled-box-stencil xext yext)
"Make a filled box."
(define-public (make-circle-stencil radius thickness fill)
"Make a circle of radius @var{radius} and thickness @var{thickness}"
+ (let*
+ ((out-radius (+ radius (/ thickness 2.0))))
+
(ly:make-stencil
(list 'circle radius thickness fill)
- (cons (- radius) radius)
- (cons (- radius) radius)))
+ (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}."
+ (let*
+ ((x-out-radius (+ x-radius (/ thickness 2.0)))
+ (y-out-radius (+ y-radius (/ thickness 2.0))) )
+
+ (ly:make-stencil
+ (list 'ellipse x-radius y-radius thickness fill)
+ (cons (- x-out-radius) x-out-radius)
+ (cons (- y-out-radius) y-out-radius))))
(define-public (box-grob-stencil grob)
"Make a box of exactly the extents of the grob. The box precisely
"
(let* ((xext (ly:grob-extent grob grob 0))
(yext (ly:grob-extent grob grob 1))
- (thick 0.1))
-
+ (thick 0.01))
+
(ly:stencil-add
(make-filled-box-stencil xext (cons (- (car yext) thick) (car yext)))
(make-filled-box-stencil xext (cons (cdr yext) (+ (cdr yext) thick)))
(define-public (circle-stencil stencil thickness padding)
"Add a circle around STENCIL, producing a new stencil."
- (let* ((x-ext (ly:stencil-extent stencil 0))
- (y-ext (ly:stencil-extent stencil 1))
- (diameter (max (- (cdr x-ext) (car x-ext))
- (- (cdr y-ext) (car y-ext))))
+ (let* ((x-ext (ly:stencil-extent stencil X))
+ (y-ext (ly:stencil-extent stencil Y))
+ (diameter (max (interval-length x-ext)
+ (interval-length y-ext)))
(radius (+ (/ diameter 2) padding thickness))
(circle (make-circle-stencil radius thickness #f)))
(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."
+ (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))
+ ;(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))
+ (ellipse (make-ellipse-stencil x-radius y-radius thickness #f)))
+
+ (ly:stencil-add
+ stencil
+ (ly:stencil-translate ellipse
+ (cons
+ (interval-center x-ext)
+ (interval-center y-ext))))))
+
+(define-public (rounded-box-stencil stencil thickness padding blot)
+ "Add a rounded box around STENCIL, producing a new stencil."
+
+ (let* ((xext (interval-widen (ly:stencil-extent stencil 0) padding))
+ (yext (interval-widen (ly:stencil-extent stencil 1) padding))
+ (min-ext (min (-(cdr xext) (car xext)) (-(cdr yext) (car yext))))
+ (ideal-blot (min blot (/ min-ext 2)))
+ (ideal-thickness (min thickness (/ min-ext 2)))
+ (outer (ly:round-filled-box
+ (interval-widen xext ideal-thickness)
+ (interval-widen yext ideal-thickness)
+ ideal-blot))
+ (inner (ly:make-stencil (list 'color (x11-color 'white)
+ (ly:stencil-expr (ly:round-filled-box
+ xext yext (- ideal-blot ideal-thickness)))))))
+ (set! stencil (ly:stencil-add outer inner))
+ stencil))
+
(define-public (fontify-text font-metric text)
"Set TEXT with font FONT-METRIC, returning a 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))
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!)
+ (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"
(list-ref bbox 0)
BeginEPSF
~a dup scale
~a
+~a
%%BeginDocument: ~a
-" factor clip-rect-string
+" factor translate-string clip-rect-string
file-name
)
EndEPSF
grestore
"))
-
- (cons (list-ref scaled-bbox 0) (list-ref scaled-bbox 2))
- (cons (list-ref scaled-bbox 1) (list-ref scaled-bbox 3)))
+ ; 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))))
(ly:make-stencil "" '(0 . 0) '(0 . 0)))
))