From 4e34058754b48872b6dc751d833c38da4e6706c6 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Wed, 13 Jul 2005 14:13:23 +0000 Subject: [PATCH] * scm/output-gnome.scm: remove beam routine. * scm/output-ps.scm (scm): idem. * scm/output-svg.scm: remove beam. * ps/music-drawing-routines.ps: remove draw_beam. * lily/lookup.cc (beam): use round_filled_polygon() for beam. --- ChangeLog | 15 +++++ lily/include/lookup.hh | 2 +- lily/lookup.cc | 115 +++++++++++++++++++------------- ps/music-drawing-routines.ps | 27 -------- scm/define-music-properties.scm | 1 + scm/output-gnome.scm | 48 ------------- scm/output-ps.scm | 6 -- scm/output-socket.scm | 44 ++++++++---- scm/output-svg.scm | 59 +--------------- scm/output-tex.scm | 4 -- 10 files changed, 115 insertions(+), 206 deletions(-) diff --git a/ChangeLog b/ChangeLog index 03677cc680..6254b6bf4e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,18 @@ +2005-07-13 Han-Wen Nienhuys + + * scm/output-gnome.scm: remove beam routine. + + * scm/output-ps.scm (scm): idem. + + * scm/output-svg.scm: remove beam. + + * ps/music-drawing-routines.ps: remove draw_beam. + + * lily/lookup.cc (beam): use round_filled_polygon() for beam. + + * flower/include/guile-compatibility.hh (scm_from_locale_string): + add scm_from_locale_string compatibility glue. + 2005-07-13 Yoshinobu Isizaki * scripts/lilypond-book.py: Prevent occuring error when diff --git a/lily/include/lookup.hh b/lily/include/lookup.hh index b4aab56817..2e22a50787 100644 --- a/lily/include/lookup.hh +++ b/lily/include/lookup.hh @@ -17,7 +17,7 @@ struct Lookup static Stencil dot (Offset p, Real radius); static Stencil bracket (Axis a, Interval iv, Real thick, Real protude, Real blot); static Stencil accordion (SCM arg, Real interline_f, Font_metric *fm); - static Stencil round_filled_polygon (Array points, Real blotdiameter); + static Stencil round_filled_polygon (Array const &points, Real blotdiameter); static Stencil frame (Box b, Real thick, Real blot); static Stencil slur (Bezier controls, Real cthick, Real thick); static Stencil bezier_sandwich (Bezier top_curve, Bezier bottom_curve); diff --git a/lily/lookup.cc b/lily/lookup.cc index cab5cc8441..10e8bb7d5b 100644 --- a/lily/lookup.cc +++ b/lily/lookup.cc @@ -37,40 +37,57 @@ Lookup::dot (Offset p, Real radius) return Stencil (box, at); } -/* - * Horizontal Slope: - * - * /| ^ - * / | | - * / | | height - * / | | - * / | v - * | / - * | / - * (0, 0)x /slope = dy/dx - * | / - * |/ - * - * <-----> - * width - */ Stencil Lookup::beam (Real slope, Real width, Real thick, Real blot) { - Real height = slope * width; - Real min_y = min (0., height) - thick / 2; - Real max_y = max (0., height) + thick / 2; - - Box b (Interval (0, width), - Interval (min_y, max_y)); - - SCM at = scm_list_n (ly_symbol2scm ("beam"), - scm_make_real (width), - scm_make_real (slope), - scm_make_real (thick), - scm_make_real (blot), - SCM_UNDEFINED); - return Stencil (b, at); + Box b; + + Offset p; + + p = Offset (0, thick/2); + b.add_point (p); + p += Offset (1,-1) * (blot/2); + + SCM points = SCM_EOL; + + points = scm_cons (scm_from_double (p[X_AXIS]), + scm_cons (scm_from_double (p[Y_AXIS]), + points)); + + + p = Offset (0, -thick/2); + b.add_point (p); + p += Offset (1,1) * (blot/2); + + points = scm_cons (scm_from_double (p[X_AXIS]), + scm_cons (scm_from_double (p[Y_AXIS]), + points)); + + + p = Offset (width, width * slope - thick/2); + b.add_point (p); + p += Offset (-1, 1) * (blot/2); + + points = scm_cons (scm_from_double (p[X_AXIS]), + scm_cons (scm_from_double (p[Y_AXIS]), + points)); + + + p = Offset (width, width * slope + thick/2); + b.add_point (p); + p += Offset (-1, -1) * (blot/2); + + points = scm_cons (scm_from_double (p[X_AXIS]), + scm_cons (scm_from_double (p[Y_AXIS]), + points)); + + SCM expr = scm_list_n (ly_symbol2scm ("polygon"), + ly_quote_scm (points), + scm_make_real (blot), + SCM_BOOL_T, + SCM_UNDEFINED); + + return Stencil (b, expr); } Stencil @@ -218,24 +235,26 @@ Lookup::round_filled_box (Box b, Real blotdiameter) * shrinked polygon). --jr */ Stencil -Lookup::round_filled_polygon (Array points, Real blotdiameter) +Lookup::round_filled_polygon (Array const &points, + Real blotdiameter) { /* TODO: Maybe print a warning if one of the above limitations applies to the given polygon. However, this is quite complicated to check. */ - /* remove consecutive duplicate points */ const Real epsilon = 0.01; - for (int i = 0; i < points.size ();) + +#ifndef NDEBUG + /* remove consecutive duplicate points */ + for (int i = 0; i < points.size (); i++) { int next_i = (i + 1) % points.size (); Real d = (points[i] - points[next_i]).length (); if (d < epsilon) - points.del (next_i); - else - i++; + programming_error ("Polygon should not have duplicate points"); } - +#endif + /* special cases: degenerated polygons */ if (points.size () == 0) return Stencil (); @@ -245,8 +264,8 @@ Lookup::round_filled_polygon (Array points, Real blotdiameter) return Line_interface::make_line (blotdiameter, points[0], points[1]); /* shrink polygon in size by 0.5 * blotdiameter */ - Array shrinked_points; - shrinked_points.set_size (points.size ()); + Array shrunk_points; + shrunk_points.set_size (points.size ()); bool ccw = 1; // true, if three adjacent points are counterclockwise ordered for (int i = 0; i < points.size (); i++) { @@ -287,27 +306,27 @@ Lookup::round_filled_polygon (Array points, Real blotdiameter) } else p13 = (0.5 * blotdiameter / d) * p13n; - shrinked_points[i1] = p1 + ((ccw) ? p13 : -p13); + shrunk_points[i1] = p1 + ((ccw) ? p13 : -p13); } /* build scm expression and bounding box */ - SCM shrinked_points_scm = SCM_EOL; + SCM shrunk_points_scm = SCM_EOL; Box box; - for (int i = 0; i < shrinked_points.size (); i++) + for (int i = 0; i < shrunk_points.size (); i++) { - SCM x = scm_make_real (shrinked_points[i][X_AXIS]); - SCM y = scm_make_real (shrinked_points[i][Y_AXIS]); - shrinked_points_scm = scm_cons (x, scm_cons (y, shrinked_points_scm)); + SCM x = scm_make_real (shrunk_points[i][X_AXIS]); + SCM y = scm_make_real (shrunk_points[i][Y_AXIS]); + shrunk_points_scm = scm_cons (x, scm_cons (y, shrunk_points_scm)); box.add_point (points[i]); } SCM polygon_scm = scm_list_n (ly_symbol2scm ("polygon"), - ly_quote_scm (shrinked_points_scm), + ly_quote_scm (shrunk_points_scm), scm_make_real (blotdiameter), SCM_BOOL_T, SCM_UNDEFINED); Stencil polygon = Stencil (box, polygon_scm); - shrinked_points.clear (); + shrunk_points.clear (); return polygon; } diff --git a/ps/music-drawing-routines.ps b/ps/music-drawing-routines.ps index 64bd1bf56a..b8f36aa208 100644 --- a/ps/music-drawing-routines.ps +++ b/ps/music-drawing-routines.ps @@ -149,33 +149,6 @@ bind def } ifelse } bind def -% Nice beam with rounded corners -/draw_beam % slope width thick blot -{ - /blot exch def - blot setlinewidth - - 0 setlinecap - 1 setlinejoin - - blot sub /t exch def - blot sub /w exch def - w mul /h exch def - - blot 2 div t 2 div neg moveto - w h rlineto - 0 t rlineto - w neg h neg rlineto - 0 t neg rlineto - - currentdict /testing known { - %% outline only, for testing: - stroke - }{ - closepath gsave stroke grestore fill - } ifelse -} bind def - /draw_polygon % x(n) y(n) x(n-1) y(n-1) ... x(1) y(1) n blot fill { /fillp exch def diff --git a/scm/define-music-properties.scm b/scm/define-music-properties.scm index dfaff81440..18f9011fc5 100644 --- a/scm/define-music-properties.scm +++ b/scm/define-music-properties.scm @@ -49,6 +49,7 @@ descend in the context tree.") (force-accidental ,boolean? "If set, a cautionary accidental should always be printed on this note") (grob-property ,symbol? "The symbol of the grob property to set. ") (grob-value ,scheme? "The value of the grob property to set") + (input-tag ,scheme? "Arbitrary marker to relate input and output") (inversion ,boolean? "If set, this chord note is inverted.") (label ,markup? "label of a mark.") (last-pitch ,ly:pitch? "The last pitch after relativization.") diff --git a/scm/output-gnome.scm b/scm/output-gnome.scm index eddab1e1a3..589cfbf3cb 100644 --- a/scm/output-gnome.scm +++ b/scm/output-gnome.scm @@ -194,54 +194,6 @@ lilypond -fgnome input/simple-song.ly (ly:all-stencil-expressions) (ly:all-output-backend-commands))) -(define (beam width slope thick blot) - (define cursor '(0 . 0)) - (define (rmoveto def x y) - (set! cursor (cons (+ x (car cursor)) (+ y (cdr cursor)))) - (moveto def (car cursor) (cdr cursor))) - (define (rlineto def x y) - (set! cursor (cons (+ x (car cursor)) (+ y (cdr cursor)))) - (lineto def (car cursor) (cdr cursor))) - (let* ((def (make )) - (bezier (make - #:parent (canvas-root) - #:fill-color "black" - #:outline-color "black" - #:width-units blot - #:join-style 'round)) - (t (- thick blot)) - (w (- width blot)) - (h (* w slope))) - - (reset def) - (rmoveto def (/ blot 2) (/ t 2)) - (rlineto def w (- h)) - (rlineto def 0 (- t)) - (rlineto def (- w) h) - (rlineto def 0 t) - (closepath def) - (set-path-def bezier def) - bezier)) - -(define (square-beam width slope thick blot) - (let* ((def (make )) - (y (* (- width) slope)) - (props (make - #:parent (canvas-root) - #:fill-color "black" - #:outline-color "black" - #:width-units 0.0))) - - (reset def) - (moveto def 0 0) - (lineto def width y) - (lineto def width (- y thick)) - (lineto def 0 (- thick)) - (lineto def 0 0) - (closepath def) - (set-path-def props def) - props)) - ;; two beziers (define (bezier-sandwich lst thick) (let* ((def (make )) diff --git a/scm/output-ps.scm b/scm/output-ps.scm index 9c2e6908e7..681fec17f0 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -21,7 +21,6 @@ blank circle dot - beam dashed-slur char setcolor @@ -73,11 +72,6 @@ ;;; Lily output interface, PostScript implementation --- cleanup and docme ;;; -;;; Output-interface functions -(define (beam width slope thick blot) - (string-append - (ly:numbers->string (list slope width thick blot)) " draw_beam" )) - ;; two beziers (define (bezier-sandwich lst thick) (string-append diff --git a/scm/output-socket.scm b/scm/output-socket.scm index 74451f3aa8..52f80348ee 100644 --- a/scm/output-socket.scm +++ b/scm/output-socket.scm @@ -24,12 +24,20 @@ (format "drawline ~a ~a ~a ~a ~a" thick x1 y2 x2 y2)) +(define-public (polygon xy-coords blot do-fill) + (format "polygon ~a ~a ~a" + blot + (if do-fill "True" "False") + (string-join + (map number->string xy-coords)) + )) (define-public (named-glyph font glyph) - (format "glyphshow ~a \"~a\" ~a" + (format "glyphshow ~a \"~a\" ~a \"~a\"" (ly:font-glyph-name-to-charcode font glyph) (ly:font-name font) (modified-font-metric-font-scaling font) + glyph )) (define-public (placebox x y s) @@ -58,25 +66,33 @@ (y (cdr offset)) ) - (list (+ x (car x-ext)) - (+ y (car y-ext)) - (+ x (cdr x-ext)) - (+ y (cdr y-ext))) - )) + (map (lambda (x) + (if (inf? x) 0.0 x)) + + (list (+ x (car x-ext)) + (+ y (car y-ext)) + (+ x (cdr x-ext)) + (+ y (cdr y-ext))) + ))) (define-public (no-origin) "nocause\n") (define-public (grob-cause offset grob) (let* - ((cause (music-cause grob))) - (if (and cause (integer? (ly:music-property cause 'input-tag))) - (apply format - (append - (list "cause ~a ~a ~a ~a ~a\n" (ly:music-property cause 'input-tag)) - (grob-bbox grob offset) - )) - ""))) + ((cause (music-cause grob)) + (tag (if (and cause (integer? (ly:music-property cause 'input-tag))) + (ly:music-property cause 'input-tag) + -1)) + (name (cdr (assoc 'name (ly:grob-property grob 'meta)))) + ) + + (apply format + (append (list "cause ~a \"~a\" ~a ~a ~a ~a\n" + tag name) + + (grob-bbox grob offset)) + ))) (define-public (glyph-string postscript-font-name diff --git a/scm/output-svg.scm b/scm/output-svg.scm index 0b0ec7e66b..a1df2f474c 100644 --- a/scm/output-svg.scm +++ b/scm/output-svg.scm @@ -185,64 +185,6 @@ "") -(define (rect-beam width slope thick blot-diameter) - (let* ((x width) - (y (* slope width)) - (z (/ y x))) - (entity 'rect "" - ;; The stroke will stick out. To use stroke, - ;; the stroke-width must be subtracted from all other dimensions. - ;;'(stroke-linejoin . "round") - ;;'(stroke-linecap . "round") - ;;`(stroke-width . ,blot-diameter) - ;;'(stroke . "red") - ;;'(fill . "orange") - - `(x . 0) - `(y . ,(- (/ thick 2))) - `(width . ,width) - `(height . ,(+ thick (* (abs z) (/ thick 2)))) - `(rx . ,(/ blot-diameter 2)) - `(transform . ,(format #f "matrix (1, ~f, 0, 1, 0, 0)" z) - )))) - -(define (beam width slope thick blot-diameter) - (let* ((b blot-diameter) - (t (- thick b)) - (w (- width b)) - (h (* w slope))) - (entity 'polygon "" - '(stroke-linejoin . "round") - '(stroke-linecap . "round") - `(stroke-width . ,blot-diameter) - '(stroke . "currentColor") - '(fill . "currentColor") - `(points . ,(string-join - (map offset->point - (list (cons (/ b 2) (/ t 2)) - (cons (+ w (/ b 2)) (+ h (/ t 2))) - (cons (+ w (/ b 2)) (+ h (- (/ t 2)))) - (cons (/ b 2) (- (/ t 2))))))) - ))) - -(define (path-beam width slope thick blot-diameter) - (let* ((b blot-diameter) - (t (- thick b)) - (w (- width b)) - (h (* w slope))) - (entity 'path "" - '(stroke-linejoin . "round") - '(stroke-linecap . "round") - `(stroke-width . ,blot-diameter) - '(stroke . "currentColor") - '(fill . "currentColor") - `(d . ,(format #f "M ~S,~S l ~S,~S l ~S,~S l ~S,~S l ~S,~S" - (/ b 2) (/ t 2) - w (- h) - 0 (- t) - (- w) h - 0 t)) - ))) (define (bezier-sandwich lst thick) (let* ((first (list-tail lst 4)) @@ -290,6 +232,7 @@ (define (placebox x y expr) (entity 'g + ;; FIXME -- JCN ;;(dispatch expr) expr diff --git a/scm/output-tex.scm b/scm/output-tex.scm index 690ed6d2d9..01dfeb4033 100644 --- a/scm/output-tex.scm +++ b/scm/output-tex.scm @@ -24,7 +24,6 @@ blank circle dot - beam dashed-slur named-glyph dashed-line @@ -79,9 +78,6 @@ (define (embedded-ps string) (embedded-ps (list 'embedded-ps string))) -(define (beam width slope thick blot) - (embedded-ps (list 'beam width slope thick blot))) - (define (dashed-slur thick on off lst) (embedded-ps (list 'dashed-slur thick on off `(quote ,lst)))) -- 2.39.2