X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fstencil.scm;h=8513c6389a3bd95499315bf6ea54e743719e1485;hb=a9d9433bc7b95cb2d4b3d96eefce7a8437c0d44e;hp=536425b9c680ce5a44b0c7bcbe9f8924d94142fd;hpb=5b6e9e92849785962a1b1831eeef20e12af5d2d5;p=lilypond.git diff --git a/scm/stencil.scm b/scm/stencil.scm index 536425b9c6..8513c6389a 100644 --- a/scm/stencil.scm +++ b/scm/stencil.scm @@ -2,7 +2,14 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 2003--2007 Han-Wen Nienhuys +;;;; (c) 2003--2009 Han-Wen Nienhuys + +(define-public (translate-stencil stencil coordinate-pair) + "Translate @code{stencil} by the distances specified in +@code{coordinate-pair}." + (ly:stencil-translate-axis + (ly:stencil-translate-axis stencil (cdr coordinate-pair) Y) + (car coordinate-pair) X)) (define-public (stack-stencils axis dir padding stils) "Stack stencils STILS in direction AXIS, DIR, using PADDING." @@ -70,6 +77,25 @@ (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-round-filled-box-stencil xext yext blot-diameter) + "Make a filled rounded box." + + (ly:make-stencil + (list 'round-filled-box (- (car xext)) (cdr xext) + (- (car yext)) (cdr yext) blot-diameter) + xext yext)) + (define-public (make-filled-box-stencil xext yext) "Make a filled box." @@ -80,10 +106,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 +145,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 +169,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 +183,46 @@ 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."