* 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.
+2005-07-13 Han-Wen Nienhuys <hanwen@xs4all.nl>
+
+ * 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 <isizaki@mte.biglobe.ne.jp>
* scripts/lilypond-book.py: Prevent occuring error when
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<Offset> points, Real blotdiameter);
+ static Stencil round_filled_polygon (Array<Offset> 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);
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
* shrinked polygon). --jr
*/
Stencil
-Lookup::round_filled_polygon (Array<Offset> points, Real blotdiameter)
+Lookup::round_filled_polygon (Array<Offset> 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 ();
return Line_interface::make_line (blotdiameter, points[0], points[1]);
/* shrink polygon in size by 0.5 * blotdiameter */
- Array<Offset> shrinked_points;
- shrinked_points.set_size (points.size ());
+ Array<Offset> 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++)
{
}
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;
}
} 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
(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.")
(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 <gnome-canvas-path-def>))
- (bezier (make <gnome-canvas-bpath>
- #: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 <gnome-canvas-path-def>))
- (y (* (- width) slope))
- (props (make <gnome-canvas-bpath>
- #: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 <gnome-canvas-path-def>))
blank
circle
dot
- beam
dashed-slur
char
setcolor
;;; 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
(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)
(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
"")
-(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))
(define (placebox x y expr)
(entity 'g
+
;; FIXME -- JCN
;;(dispatch expr)
expr
blank
circle
dot
- beam
dashed-slur
named-glyph
dashed-line
(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))))
projects / lilypond.git / commitdiff