2004-05-09 Han-Wen Nienhuys <hanwen@xs4all.nl>
+ * lily/paper-outputter.cc (output_stencil): use
+ interpret_stencil_expr
+
+ * lily/stencil.cc (LY_DEFINE): ly_stencil_fonts: new function.
+ (interpret_stencil_expr): new function. Generic stencil
+ interpretation.
+
* lily/paper-def.cc (find_scaled_font): divide lookup
magnification by outpuscale for non-virtual fontmetrics. This
fixes ludicrously long font definitions for text
#include "warn.hh"
#include "libc-extension.hh"
#include "afm.hh"
-#include "stencil.hh"
#include "dimensions.hh"
Adobe_font_metric::Adobe_font_metric (AFM_Font_info *fi)
}
Offset
-Font_metric::get_indexed_wxwy (int )const
+Font_metric::get_indexed_wxwy (int) const
{
return Offset (0, 0);
}
void dump_scheme (SCM);
void output_scheme (SCM scm);
- void output_stencil (Stencil*);
+ void output_stencil (Stencil);
void output_header (Paper_def*, SCM, int, bool);
void output_line (SCM, Offset*, bool);
void output_page (Page*, bool);
It is implemented as a "tree" of scheme expressions, as in
Expr = combine Expr Expr
- | translate Offset Expr
- | SCHEME
- ;
+ | translate Offset Expr
+ | origin (ORIGIN) Expr
+ | no-origin Expr
+ | (SCHEME)
+ ;
SCHEME is a Scheme expression that --when eval'd-- produces the
desired output.
efficient to add "fresh" stencils to what you're going to build.
* Do not create Stencil objects on the heap. That includes passing
- around Stencil* which are produced by unsmob_stencil().
+ around Stencil* which are produced by unsmob_stencil(). Either
+ copy Stencil objects, or use SCM references.
* Empty stencils have empty dimensions. If add_at_edge is used to
init the stencil, we assume that
DECLARE_UNSMOB(Stencil,stencil);
SCM fontify_atom (Font_metric const*, SCM atom);
+void interpret_stencil_expr (SCM expr,
+ void (*func) (void*, SCM),
+ void *func_arg,
+ Offset o);
+
Stencil create_stencil (SCM print);
ly_quote_scm (ly_offset2scm (*origin)),
ly_quote_scm (ly_offset2scm (dim))));
- output_stencil (unsmob_stencil (p->to_stencil ()));
+ output_stencil (*unsmob_stencil (p->to_stencil ()));
(*origin)[Y_AXIS] += dim[Y_AXIS];
output_scheme (scm_list_2 (ly_symbol2scm ("stop-system"),
ly_quote_scm (ly_offset2scm (Offset (0, 0))),
ly_quote_scm (ly_offset2scm (Offset (0, 0)))));
- output_stencil (unsmob_stencil (p->to_stencil ()));
+ output_stencil (*unsmob_stencil (p->to_stencil ()));
output_scheme (scm_list_2 (ly_symbol2scm ("stop-system"), SCM_BOOL_T));
output_scheme (scm_list_2 (ly_symbol2scm ("stop-page"),
odef->self_scm ()));
}
+
void
-Paper_outputter::output_stencil (Stencil *stil)
+paper_outputter_dump (void * po, SCM x)
{
- output_expr (stil->expr (), stil->origin ());
+ Paper_outputter * me = (Paper_outputter*) po;
+ me->output_scheme (x);
}
-/* TODO: replaceme/rewriteme, see output-ps.scm: output-stencil */
+
void
-Paper_outputter::output_expr (SCM expr, Offset o)
+Paper_outputter::output_stencil (Stencil stil)
{
- while (1)
- {
- if (!ly_c_pair_p (expr))
- return;
-
- SCM head =ly_car (expr);
- if (unsmob_input (head))
- {
- Input *ip = unsmob_input (head);
- output_scheme (scm_list_4 (ly_symbol2scm ("define-origin"),
- scm_makfrom0str (ip->file_string ()
- .to_str0 ()),
- scm_int2num (ip->line_number ()),
- scm_int2num (ip->column_number ())));
- expr = ly_cadr (expr);
- }
- else if (head == ly_symbol2scm ("no-origin"))
- {
- output_scheme (scm_list_1 (head));
- expr = ly_cadr (expr);
- }
- else if (head == ly_symbol2scm ("translate-stencil"))
- {
- o += ly_scm2offset (ly_cadr (expr));
- expr = ly_caddr (expr);
- }
- else if (head == ly_symbol2scm ("combine-stencil"))
- {
- output_expr (ly_cadr (expr), o);
- expr = ly_caddr (expr);
- }
- else
- {
- output_scheme (scm_list_4 (ly_symbol2scm ("placebox"),
- scm_make_real (o[X_AXIS]),
- scm_make_real (o[Y_AXIS]),
- expr));
- return;
- }
- }
+ interpret_stencil_expr (stil.expr (), paper_outputter_dump,
+ (void*) this, Offset (0,0));
}
+
#include <math.h>
#include <libc-extension.hh> // isinf
+#include "input.hh"
#include "font-metric.hh"
#include "dimensions.hh"
#include "interval.hh"
{
add_stencil (moved_to_edge (a, d, s, padding, minimum));
}
+
+
+/****************************************************************/
+
+void
+interpret_stencil_expr (SCM expr,
+ void (*func) (void*, SCM),
+ void *func_arg,
+ Offset o)
+{
+ while (1)
+ {
+ if (!ly_c_pair_p (expr))
+ return;
+
+ SCM head =ly_car (expr);
+ if (unsmob_input (head))
+ {
+ Input *ip = unsmob_input (head);
+ (*func)(func_arg,
+ scm_list_4 (ly_symbol2scm ("define-origin"),
+ scm_makfrom0str (ip->file_string ()
+ .to_str0 ()),
+ scm_int2num (ip->line_number ()),
+ scm_int2num (ip->column_number ())));
+
+ expr = ly_cadr (expr);
+ }
+ else if (head == ly_symbol2scm ("no-origin"))
+ {
+ (*func) (func_arg, scm_list_1 (head));
+ expr = ly_cadr (expr);
+ }
+ else if (head == ly_symbol2scm ("translate-stencil"))
+ {
+ o += ly_scm2offset (ly_cadr (expr));
+ expr = ly_caddr (expr);
+ }
+ else if (head == ly_symbol2scm ("combine-stencil"))
+ {
+ interpret_stencil_expr (ly_cadr (expr), func, func_arg, o);
+ expr = ly_caddr (expr);
+ }
+ else
+ {
+ (*func) (func_arg,
+ scm_list_4 (ly_symbol2scm ("placebox"),
+ scm_make_real (o[X_AXIS]),
+ scm_make_real (o[Y_AXIS]),
+ expr));
+ return;
+ }
+ }
+}
+
+
+struct Font_list
+{
+ SCM list_;
+};
+
+static void
+find_font_function (void * fs, SCM x)
+{
+ Font_struct * me = (Font_struct*)fs;
+
+ if (ly_car (x) == ly_symbol2scm ("placebox"))
+ {
+ SCM args = ly_cdr (x);
+ SCM what = ly_caddr (x);
+
+ if (ly_c_pair_p (what))
+ {
+ SCM head = ly_car (what);
+ if (ly_symbol2scm ("text") == head)
+ me->fonts_ = scm_cons (ly_cadr (what), me->fonts_);
+ else if (head == ly_symbol2scm ("char"))
+ me->fonts_ = scm_cons (ly_cadr (what), me->fonts_);
+ }
+ }
+}
+
+LY_DEFINE(ly_stencil_fonts, "ly:stencil-fonts",
+ 1,0,0, (s),
+ "Analyse @var{s}, and return a list of fonts used in @var{s}."
+{
+ Stencil *stil =unsmob_stencil (s);
+ SCM_ASSERT_TYPE (stil, s, SCM_ARG1, __FUNCTION__, "Stencil");
+ Font_list fl;
+
+ fl.list_ = SCM_EOL;
+
+ interpret_stencil_expr (stil.expr (), &find_font_function,
+ (void*) &fl, Offset (0,0));
+
+ return fl.list_;
+}
(string-append (apply string-append (map output-scope scopes)))))
-;; hmm, looks like recursing call is always last statement, does guile
-;; think so too?
-(define (output-stencil port expr offset)
- (if (pair? expr)
- (let ((head (car expr)))
- (cond
- ((ly:input-location? head)
- (display (apply define-origin (ly:input-location head)) port)
- (output-stencil port (cadr expr) offset))
- ((eq? head 'no-origin)
- (display (expression->string head) port)
- (output-stencil port (cadr expr) offset))
- ((eq? head 'translate-stencil)
- (output-stencil port (caddr expr) (offset-add offset (cadr expr))))
- ((eq? head 'combine-stencil)
- (output-stencil port (cadr expr) offset)
- (output-stencil port (caddr expr) offset))
- (else
- (display (placebox (car offset) (cdr offset)
- (expression->string expr)) port))))))
-
(define (placebox x y s)
(string-append
(ly:number->string x) " " (ly:number->string y) " { " s " } place-box\n"))
projects / lilypond.git / commitdiff