X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fstencil.scm;h=94332b31b4895d22257022c3b79f000568b8b443;hb=b3f0c2f6c352a850f03dc44a947776199eb3fa0b;hp=e4c15978b4fb6288b589a96f5648a8fa9a42637d;hpb=77cc001961a4931c002128b34638f69c082b9102;p=lilypond.git diff --git a/scm/stencil.scm b/scm/stencil.scm index e4c15978b4..94332b31b4 100644 --- a/scm/stencil.scm +++ b/scm/stencil.scm @@ -2,7 +2,7 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 2003--2007 Han-Wen Nienhuys +;;;; (c) 2003--2009 Han-Wen Nienhuys (define-public (stack-stencils axis dir padding stils) "Stack stencils STILS in direction AXIS, DIR, using PADDING." @@ -70,6 +70,18 @@ (ly:stencil-combine-at-edge stil (other-axis axis) -1 rb 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." @@ -80,10 +92,38 @@ (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 @@ -91,8 +131,8 @@ encloses the contents. " (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))) @@ -115,10 +155,10 @@ encloses the contents. (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))) @@ -129,6 +169,64 @@ encloses the contents. (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." @@ -163,12 +261,15 @@ encloses the contents. 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))) @@ -177,9 +278,10 @@ encloses the contents. (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)) @@ -197,8 +299,8 @@ encloses the contents. `(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)))) @@ -254,7 +356,7 @@ encloses the contents. (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)) @@ -271,6 +373,38 @@ encloses the contents. 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)) @@ -284,6 +418,9 @@ encloses the contents. 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) @@ -304,8 +441,9 @@ currentpoint translate BeginEPSF ~a dup scale ~a +~a %%BeginDocument: ~a -" factor clip-rect-string +" factor translate-string clip-rect-string file-name ) @@ -314,9 +452,10 @@ BeginEPSF 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))) ))