From 942bdd57fcdd0c87e42c2a50852597817ae69232 Mon Sep 17 00:00:00 2001 From: Carl Sorensen Date: Fri, 22 Aug 2008 20:36:23 -0600 Subject: [PATCH] Change harp pedal outlines to ellipses Add ellipse drawing routines to ps and svg output Add ellipse stencil Add ellipse-stencil routine to center stencil in ellipse Modify scm/harp-pedals.scm to use ellipse routine Reformat code to avoid long lines --- ps/music-drawing-routines.ps | 15 +++++++++++- scm/define-stencil-commands.scm | 1 + scm/harp-pedals.scm | 19 ++++++++++----- scm/output-ps.scm | 9 ++++++++ scm/output-svg.scm | 11 +++++++++ scm/stencil.scm | 41 +++++++++++++++++++++++++++++---- 6 files changed, 85 insertions(+), 11 deletions(-) diff --git a/ps/music-drawing-routines.ps b/ps/music-drawing-routines.ps index 713d997f37..aa8cfa6527 100644 --- a/ps/music-drawing-routines.ps +++ b/ps/music-drawing-routines.ps @@ -128,7 +128,7 @@ bind def closepath fill } bind def -% this is for drawing slurs. +% this is for drawing slurs and barre-indicators. /draw_bezier_sandwich % thickness controls { gsave @@ -165,6 +165,19 @@ bind def ifelse } bind def +/draw_ellipse % filled? x-radius y-radius thickness draw_ellipse +{ + setlinewidth % f? x-r y-r + /savematrix matrix currentmatrix def + scale % f? + currentpoint + 1 0 rmoveto + 1 0 360 arc closepath + savematrix setmatrix + { stroke_and_fill} + { stroke } + ifelse +} bind def /draw_line % dx dy x1 y1 thickness draw_line { diff --git a/scm/define-stencil-commands.scm b/scm/define-stencil-commands.scm index fac14b3d6b..9a5bed1a9e 100644 --- a/scm/define-stencil-commands.scm +++ b/scm/define-stencil-commands.scm @@ -17,6 +17,7 @@ dashed-slur dot draw-line + ellipse embedded-ps glyph-string named-glyph diff --git a/scm/harp-pedals.scm b/scm/harp-pedals.scm index 8f7756acba..9fd4c84c9a 100644 --- a/scm/harp-pedals.scm +++ b/scm/harp-pedals.scm @@ -150,20 +150,27 @@ divider) and @code{space-after-divider} (box spacing after the divider). (stencil (make-filled-box-stencil (box-x-dimensions prev-x p space) (box-y-dimensions prev-x p space))) - ;(circle-stencil (if circled (rounded-box-stencil stencil 0.05 0.3 0.1 ) stencil)) - (circle-stencil (if circled (circle-stencil stencil 0.05 0.2 ) stencil)) + (pedal-stencil + (if circled + (ellipse-stencil stencil 0.05 0.1 ) + stencil)) (new-prev-x (+ prev-x space box-width))) - (process-pedal (cdr remaining) new-prev-x (cons circle-stencil stencils) #f space))) + (process-pedal (cdr remaining) new-prev-x + (cons pedal-stencil stencils) #f space))) ((#\|) ; Divider line (let* ((xpos (+ prev-x space)) (stencil (divider-stencil xpos)) (new-prev-x (+ prev-x space))) - (process-pedal (cdr remaining) new-prev-x (cons stencil stencils) circled spaceafterdivider))) + (process-pedal (cdr remaining) new-prev-x + (cons stencil stencils) + circled spaceafterdivider))) ((#\o) ; Next pedal should be circled (process-pedal (cdr remaining) prev-x stencils #t space)) (else - (ly:warning "Unhandled entry in harp-pedal: ~a" (car remaining)) - (process-pedal (cdr remaining) prev-x stencils circled space)))))) + (ly:warning "Unhandled entry in harp-pedal: ~a" + (car remaining)) + (process-pedal (cdr remaining) + prev-x stencils circled space)))))) (final-x (car result)) (stencils (cdr result))) ; Add the horizontal line and combine all stencils: diff --git a/scm/output-ps.scm b/scm/output-ps.scm index 5b5217868c..aef4802eb7 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -26,6 +26,7 @@ dashed-slur dot draw-line + ellipse embedded-ps named-glyph no-origin @@ -116,6 +117,14 @@ (- x2 x1) (- y2 y1) x1 y1 thick)) +(define (ellipse x-radius y-radius thick fill) + (ly:format + "~a ~4f ~4f ~4f draw_ellipse" + (if fill + "true" + "false") + x-radius y-radius thick)) + (define (embedded-ps string) string) diff --git a/scm/output-svg.scm b/scm/output-svg.scm index 8a8960e6d3..93b27a68b1 100644 --- a/scm/output-svg.scm +++ b/scm/output-svg.scm @@ -336,6 +336,17 @@ `(stroke-width . ,thick) `(r . ,radius))) +(define (ellipse x-radius y-radius thick is-filled) + (entity + 'ellipse "" + '(stroke-linejoin . "round") + '(stroke-linecap . "round") + `(fill . ,(if is-filled "currentColor" "none")) + `(stroke . "currentColor") + `(stroke-width . ,thick) + `(rx . ,x-radius) + `(ry . ,y-radius))) + (define (text font string) (dispatch `(fontify ,font ,(entity 'tspan (string->entities string))))) diff --git a/scm/stencil.scm b/scm/stencil.scm index 19303ae691..8ae5ffab06 100644 --- a/scm/stencil.scm +++ b/scm/stencil.scm @@ -99,6 +99,18 @@ (cons (- out-radius) out-radius) (cons (- out-radius) 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 encloses the contents. @@ -129,10 +141,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))) @@ -143,6 +155,27 @@ encloses the contents. (interval-center x-ext) (interval-center y-ext)))))) +(define-public (ellipse-stencil stencil thickness padding) + "Add an ellipse around STENCIL, 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) padding thickness)) + (y-length (+ (interval-length y-ext) 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." -- 2.39.5