+2002-12-01 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+ * lily/font-interface.cc (get-font): take alist chain i.s.o. alist
+ argument
+
+ * scm/music-functions.scm (display-music): new function
+ (music-map): change arg order.
+
+ * input/regression/new-markup-syntax.scm: new file
+
+ * lily/parser.yy (markup): add \markup { .. } syntax.
+
+ * scm/new-markup.scm (override-markup): new function
+ (lookup-markup): new function
+ (music-markup): new function
+ (lookup-markup-command): use markup-signature to store argument
+ format for parser.
+
+ * lily/lexer.ll: preliminary \markup syntax.
+
+
2002-11-30 Heikki Junes <hjunes@cc.hut.fi>
* make/lilypond.mandrake.spec.in: remove extra %changelog entries,
MAJOR_VERSION=1
MINOR_VERSION=7
PATCH_LEVEL=8
-MY_PATCH_LEVEL=
+MY_PATCH_LEVEL=hwn1
# Use the above to send patches: MY_PATCH_LEVEL is always empty for a
# released version.
texidoc =
"With @code{music-map}, you can apply functions operating on a single
-piece of music to an entire music expression. In this example, the
-scripts and dynamics of the first measure of music are applied to the
-2nd measure. "
+piece of music to an entire music expression. In this example, the the
+function @code{notes-to-skip} changes a note to a skip. When applied
+to an entire music expression in the 1st measure, the scripts and
+dynamics are left over. These are put onto the 2nd measure."
}
-
\version "1.7.8"
#(define (notes-to-skip m)
\notes \relative c'' \context Voice {
\foobar
- < \apply #(lambda (x) (music-map x notes-to-skip))
+ < \apply #(lambda (x) (music-map notes-to-skip x))
\foobar
{ d2 d2 } >
}}
--- /dev/null
+\header {
+texidoc = "New markup syntax."
+
+}
+\version "1.7.8"
+
+
+\score {
+ \notes \transpose c d
+%\apply #display-music
+ {
+ \property Voice.TextScript \set #'molecule-callback = #brew-new-markup-molecule
+ eses'-\markup { foo \bold bar \column < baz bazr >
+ \override #'(font-family . music) \lookup #"noteheads-0"
+ } }
+}
SCM
Font_interface::get_property_alist_chain (SCM grob)
{
-
Grob * g = unsmob_grob (grob);
SCM_ASSERT_TYPE(g, grob, SCM_ARG1, __FUNCTION__, "grob");
return font_alist_chain (g);
-
}
-
-
-
/*
todo: split up this func, reuse in text_item?
}
LY_DEFINE(ly_font_interface_get_font,"ly:get-font", 2, 0, 0,
- (SCM grob, SCM alist),
- "Return a font metric satisfying the font-qualifiers in @var{alist}.
-
-
-The font object represents the metric information of a font. Every font
-that is loaded into LilyPond can be accessed via Scheme.
-
-LilyPond only needs to know the dimension of glyph to be able to process
-them. This information is stored in font metric files. LilyPond can read
-two types of font-metrics: @TeX{} Font Metric files (TFM files) and
-Adobe Font Metric files (AFM files). LilyPond will always try to load
-AFM files first since they are more versatile.
-
-")
+ (SCM grob, SCM chain),
+ "Return a font metric satisfying the font-qualifiers in the alist chain @var{chain}.\n"
+"\n"
+"The font object represents the metric information of a font. Every font\n"
+"that is loaded into LilyPond can be accessed via Scheme. \n"
+"\n"
+"LilyPond only needs to know the dimension of glyph to be able to process\n"
+"them. This information is stored in font metric files. LilyPond can read\n"
+"two types of font-metrics: @TeX{} Font Metric files (TFM files) and\n"
+"Adobe Font Metric files (AFM files). LilyPond will always try to load\n"
+"AFM files first since they are more versatile.\n"
+"\n"
+"An alist chain is a list of alists.\n")
{
Grob * gr = unsmob_grob (grob);
SCM_ASSERT_TYPE(gr, grob, SCM_ARG1, __FUNCTION__, "grob");
- Font_metric*fm=
- Font_interface::get_font (gr, gh_cons (alist,
- Font_interface::font_alist_chain (gr)));
-
+ Font_metric*fm = Font_interface::get_font (gr, chain);
return fm->self_scm();
}
-
Font_metric *
Font_interface::get_font (Grob *me, SCM chain)
{
SCM lookup_identifier (String s);
void push_note_state ();
+ void push_markup_state ();
void push_figuredbass_state ();
void push_chord_state ();
void push_lyric_state ();
void strip_leading_white (String&);
String lyric_fudge (String s);
+SCM
+lookup_markup_command (String s);
bool
valid_version_b (String s);
SCM (* scm_parse_error_handler) (void *);
+
%}
%option c++
%x figures
%x quote
%x longcomment
-
+%x markup
A [a-zA-Z]
AA {A}|_
exit (1);
}
-<INITIAL,chords,lyrics,notes,figures># { //embedded scm
+<INITIAL,markup,chords,lyrics,notes,figures># { //embedded scm
//char const* s = YYText () + 1;
char const* s = here_str0 ();
int n = 0;
}
+<markup>{
+ \" {
+ start_quote ();
+ }
+ {NOTECOMMAND} {
+ String str (YYText() + 1);
+ SCM s = lookup_markup_command (str);
+
+ if (gh_pair_p (s)) {
+ yylval.scm = gh_car(s);
+ SCM tag = gh_cdr(s);
+ if (tag == ly_symbol2scm("markup0"))
+ return MARKUP_HEAD_MARKUP0;
+ else if (tag == ly_symbol2scm ("markup0-markup1"))
+ return MARKUP_HEAD_MARKUP0_MARKUP1;
+ else if (tag == ly_symbol2scm ("markup-list0"))
+ return MARKUP_HEAD_LIST0;
+ else if (tag == ly_symbol2scm ("scm0"))
+ return MARKUP_HEAD_SCM0;
+ else if (tag == ly_symbol2scm ("scm0-scm1"))
+ return MARKUP_HEAD_SCM0_SCM1;
+ else if (tag == ly_symbol2scm ("scm0-markup1"))
+ return MARKUP_HEAD_SCM0_MARKUP1;
+ else if (tag == ly_symbol2scm ("scm0-scm1-markup2"))
+ return MARKUP_HEAD_SCM0_SCM1_MARKUP2;
+ else {
+ ly_display_scm (s);
+ assert(false);
+ }
+ } else
+ return scan_escaped_word (str);
+ }
+ {WORD} {
+ /* ugr. This sux. */
+ String s (YYText ());
+ if (s == "__")
+ return yylval.i = EXTENDER;
+ if (s == "--")
+ return yylval.i = HYPHEN;
+ s = lyric_fudge (s);
+
+ char c = s[s.length () - 1];
+ if (c == '{' || c == '}') // brace open is for not confusing dumb tools.
+ here_input ().warning (
+ _ ("Brace found at end of lyric. Did you forget a space?"));
+ yylval.scm = scm_makfrom0str (s.to_str0 ());
+ return STRING;
+ }
+ {WHITE} {
+
+ }
+ . {
+ return YYText ()[0];
+ }
+}
+
<<EOF>> {
yy_push_state (lyrics);
}
+void
+My_lily_lexer::push_markup_state ()
+{
+ yy_push_state (markup);
+}
+
void
My_lily_lexer::pop_state ()
{
yy_top_state ();
avoid_silly_flex_induced_gcc_warnings ();
}
+
+SCM
+lookup_markup_command (String s)
+{
+ static SCM proc ;
+ if (!proc)
+ proc = scm_c_eval_string ("lookup-markup-command");
+
+ return scm_call_1 (proc, scm_makfrom0str (s.to_str0 ()));
+}
{"lyrics", LYRICS},
{"key", KEY},
{"mark", MARK},
+ {"markup", MARKUP},
{"once", ONCE},
{"pitch", PITCH},
{"time", TIME_T},
%token <i> UNSIGNED
%token <scm> REAL
+%token MARKUP
+%token <scm> MARKUP_HEAD_MARKUP0 MARKUP_HEAD_SCM0_MARKUP1 MARKUP_HEAD_MARKUP0_MARKUP1
+%token <scm> MARKUP_HEAD_SCM0 MARKUP_HEAD_SCM0_MARKUP1 MARKUP_HEAD_SCM0_SCM1_MARKUP2 MARKUP_HEAD_SCM0_SCM1
+
+%token <scm> MARKUP_IDENTIFIER MARKUP_HEAD_LIST0
+%type <scm> markup markup_line markup_list markup_list_body full_markup
+
%type <outputdef> output_def
%type <scm> lilypond_header lilypond_header_body
%type <music> open_event_parens close_event_parens open_event close_event
$$ = $1->self_scm ();
scm_gc_unprotect_object ($$);
}
+ | full_markup {
+ $$ = $1;
+ }
| output_def {
$$ = $1->self_scm ();
scm_gc_unprotect_object ($$);
t->set_spot (THIS->here_input ());
$$ = t;
}
+ | full_markup {
+ Music *t = MY_MAKE_MUSIC("TextScriptEvent");
+ t->set_mus_property ("text", $1);
+ t->set_spot (THIS->here_input ());
+ $$ = t;
+ }
| string {
Music *t = MY_MAKE_MUSIC("TextScriptEvent");
t->set_mus_property ("text", $1);
;
+
+full_markup:
+ MARKUP
+ { THIS->lexer_->push_markup_state (); }
+ markup
+ { $$ = $3;
+ THIS->lexer_->pop_state ();
+ }
+ ;
+
+markup:
+ STRING {
+ static SCM simple;
+ if (!simple)
+ simple = scm_c_eval_string ("simple-markup");
+
+ $$ = scm_list_n (simple, $1, SCM_UNDEFINED);
+ }
+ | MARKUP_HEAD_MARKUP0 markup {
+ $$ = scm_list_n ($1, $2, SCM_UNDEFINED);
+ }
+ | MARKUP_HEAD_SCM0_MARKUP1 SCM_T markup {
+ $$ = scm_list_n ($1, $2, $3, SCM_UNDEFINED);
+ }
+ | markup_line {
+ $$ = $1;
+ }
+ | MARKUP_HEAD_LIST0 markup_list {
+ $$ = scm_list_n ($1,$2, SCM_UNDEFINED);
+ }
+ | MARKUP_HEAD_SCM0 embedded_scm {
+ $$ = scm_list_n ($1, $2, SCM_UNDEFINED);
+ }
+ | MARKUP_HEAD_SCM0_SCM1_MARKUP2 embedded_scm embedded_scm markup {
+ $$ = scm_list_n ($1, $2, $3, $4, SCM_UNDEFINED);
+ }
+ | MARKUP_IDENTIFIER {
+ $$ = $1;
+ }
+
+ ;
+
+markup_list:
+ '<' markup_list_body '>' { $$ = scm_reverse_x ($2, SCM_EOL); }
+ ;
+
+markup_line:
+ '{' markup_list_body '}' {
+ static SCM line ;
+ if (!line)
+ line = scm_c_eval_string ("line-markup");
+
+ $$ = scm_list_n (line, scm_reverse_x ($2, SCM_EOL), SCM_UNDEFINED);
+ }
+ ;
+
+markup_list_body:
+ /**/ { $$ = SCM_EOL; }
+ | markup_list_body markup {
+ $$ = gh_cons ($2, $1) ;
+ }
+ ;
+
+
%%
void
}
+
+bool
+markup_p (SCM x)
+{
+ return gh_pair_p (x)
+ && SCM_BOOL_F != scm_object_property (gh_car (x), ly_symbol2scm ("markup-signature"));
+}
/*
It is a little strange, to have this function in this file, but
otherwise, we have to import music classes into the lexer.
*destination = p->self_scm();
return MUSIC_OUTPUT_DEF_IDENTIFIER;
+ } else if (markup_p (sid)) {
+ *destination = sid;
+ return MARKUP_IDENTIFIER;
}
+
return -1;
}
-#if 0
-
-markup:
- STRING {
- $$ = scm_list_n (scm_c_eval_string ("simple-markup"), $1, SCM_UNDEFINED);
- }
- | MARKUP_HEAD0 markup
- | MARKUP_HEAD1 SCM_T markup
- | MARKUP_HEAD2 markup
- | MARKUP_LIST_HEAD
- | MARKUP_LIST_HEAD
- | markup_list {
- $$ = $1
- ;
-
-markup_list:
- '<' markup_list_body '>' { $$ = scm_reverse_x ($1, SCM_EOL); }
- ;
-
-markup_line:
- '{' markup_list_body '}' { $$ = .. scm_reverse_x ($1, SCM_EOL); }
-
- ;
-markup_list_body:
- /**/ { $$ = SCM_EOL; }
- markup_list_body markup {
- $$ = gh_cons ($2, $1) ;
- }
- ;
-#endif
(define (brew-one-figure grob fig-music)
"Brew a single column for a music figure"
(let* (
- (mf (ly:get-font grob '( (font-family . music) )))
- (nf (ly:get-font grob '( (font-family . number) )))
+ (mf (ly:get-font grob (cons '((font-family . music))
+ Font_interface::get_property_alist_chain
+ )))
+ (nf (ly:get-font grob
+ (cons '((font-family . number))
+ Font_interface::get_property_alist_chain)))
(mol (ly:make-molecule '() '(0 . 0) '(0 . 1.0)))
(fig (ly:get-mus-property fig-music 'figure))
(acc (ly:get-mus-property fig-music 'alteration))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define-public (music-map music function)
+(define-public (music-map function music)
"Apply @var{function} to @var{music} and all of the music it contains. "
(let* ((es (ly:get-mus-property music 'elements))
(e (ly:get-mus-property music 'element))
)
(ly:set-mus-property! music 'elements
- (map (lambda (y) (music-map y function)) es))
+ (map (lambda (y) (music-map function y)) es))
(if (ly:music? e)
- (ly:set-mus-property! music 'element (music-map e function)))
+ (ly:set-mus-property! music 'element (music-map function e)))
(function music)
))
+(define-public (display-one-music music)
+ (display music)
+ music
+ )
-
+(define-public (display-music arg)
+ (music-map display-one-music arg))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(e (ly:get-mus-property music 'element))
(n (ly:music-name music))
(f (lambda (x) (shift-duration-log x shift dot)))
+ (d (ly:get-mus-property music 'duration))
)
;; FIXME: broken by the great music rename.
- (if (or (equal? n "Note_req")
- (equal? n "Rest_req"))
+ (if (ly:duration? d)
(let* (
- (d (ly:get-mus-property music 'duration))
(cp (ly:duration-factor d))
(nd (ly:make-duration (+ shift (ly:duration-log d))
(+ dot (duration-dot-count d))
(define-public (line-markup grob props . rest)
(stack-molecules
X 1 1.0
- (map (lambda (x) (interpret_markup grob props x)) (car rest)))
+ (map (lambda (x) (interpret-markup grob props x)) (car rest)))
)
(define (combine-molecule-list lst)
))
(define-public (combine-markup grob props . rest)
- (combine-molecule-list (map (lambda (x) (interpret_markup grob props x)) (car rest))))
+ (combine-molecule-list (map (lambda (x) (interpret-markup grob props x)) (car rest))))
(define-public (bold-markup grob props . rest)
- (interpret_markup grob (cons '((font-series . bold)) props) (car rest))
+ (interpret-markup grob (cons (cons '(font-series . bold) (car props)) (cdr props)) (car rest))
)
(define-public (column-markup grob props . rest)
(stack-molecules
Y -1 0.0
- (map (lambda (x) (interpret_markup grob props x)) (car rest)))
+ (map (lambda (x) (interpret-markup grob props x)) (car rest)))
)
-;; todo. Use macro?
-(map
- (lambda (x)
+(define-public (music-markup grob props . rest)
+ (ly:find-glyph-by-name
+ (ly:get-font grob (cons '((font-family . music)) props))
+ (car rest))
+ )
+
+(define-public (lookup-markup grob props . rest)
+ "Lookup a glyph by name."
+ (ly:find-glyph-by-name
+ (ly:get-font grob props)
+ (car rest))
+ )
- (set-object-property!
- (eval (string->symbol (string-append (symbol->string x) "-markup")) (current-module))
- 'markup-function? #t))
+(define-public (override-markup grob props . rest)
+ "Tack the 1st args in REST onto PROPS."
+ (interpret-markup grob (cons (list (car rest)) props)
+ (cadr rest)))
+
+(map (lambda (x)
+ (set-object-property! (car x) 'markup-signature (cdr x))
+ )
+ (list (cons bold-markup 'markup0)
+ (cons column-markup 'markup-list0)
+ (cons line-markup 'markup-list0)
+ (cons combine-markup 'markup0-markup1)
+ (cons simple-markup 'markup0)
+ (cons music-markup 'scm0)
+ (cons override-markup 'scm0-markup1)
+ (cons lookup-markup 'scm0)
+ ))
+
+(define markup-module (current-module))
+
+(define-public (lookup-markup-command code)
+ (let*
+ ( (sym (string->symbol (string-append code "-markup")))
+ (var (module-local-variable markup-module sym))
+ )
+ (if (eq? var #f)
+ #f
+ (cons (variable-ref var) (object-property (variable-ref var) 'markup-signature))
+ )
+ ))
- '(simple column bold combine line )
- )
(define-public (brew-new-markup-molecule grob)
- (interpret_markup grob
+ (interpret-markup grob
(Font_interface::get_property_alist_chain grob)
(ly:get-grob-property grob 'text)
)
)
-(define (interpret_markup grob props markup)
+(define (interpret-markup grob props markup)
(let*
(
(func (car markup))
(apply func (cons grob (cons props args)) )
))
+
(define (new-markup? x)
(markup-function? (car x))
)
(define (markup-function? x)
- (object-property 'markup-function? x))
+ (object-property 'markup-signature? x))
projects / lilypond.git / commitdiff