static SCM
make_duration (SCM l, SCM d)
{
+ SCM_ASSERT_TYPE(gh_number_p(l), l, SCM_ARG1, __FUNCTION__, "integer");
+ SCM_ASSERT_TYPE(gh_number_p(d), d, SCM_ARG2, __FUNCTION__, "integer");
+
Duration p (gh_scm2int (l), gh_scm2int (d));
return p.smobbed_copy ();
}
ly_font_interface_get_default_font (SCM grob)
{
Grob * gr = unsmob_grob (grob);
-
- if (!gr)
- {
- warning ("ly_font_interface_get_default_font (): invalid argument");
- return SCM_UNDEFINED;
- }
+ SCM_ASSERT_TYPE(gr, grob, SCM_ARG1, __FUNCTION__, "grob");
return Font_interface::get_default_font (gr)->self_scm ();
}
SCM
ly_find_glyph_by_name (SCM font, SCM name)
{
- if (!unsmob_metrics (font) || !gh_string_p (name))
- {
- warning ("ly-find-glyph-by-name: invalid argument.");
- Molecule m;
- return m.smobbed_copy ();
- }
+ Font_metric *fm = unsmob_metrics (font);
+ SCM_ASSERT_TYPE(fm, font, SCM_ARG1, __FUNCTION__, "font-metric");
+ SCM_ASSERT_TYPE(gh_string_p (name), name, SCM_ARG2, __FUNCTION__, "string");
- return unsmob_metrics (font)->find_by_name (ly_scm2string (name)).smobbed_copy ();
+ return fm->find_by_name (ly_scm2string (name)).smobbed_copy ();
}
ly_text_dimension (SCM font, SCM text)
{
Box b;
-
- if (!unsmob_metrics (font) || !gh_string_p(text))
- {
- warning ("ly-find-glyph-by-name: invalid argument.");
- Molecule m;
- return m.smobbed_copy ();
- }
- else
- {
- b = unsmob_metrics (font)->text_dimension (ly_scm2string (text));
- }
+ Font_metric *fm = unsmob_metrics (font);
+ SCM_ASSERT_TYPE(fm, font, SCM_ARG1, __FUNCTION__, "font-metric");
+ SCM_ASSERT_TYPE(gh_string_p (text), text, SCM_ARG2, __FUNCTION__, "string");
+
+ b = fm->text_dimension (ly_scm2string (text));
return gh_cons (ly_interval2scm (b[X_AXIS]), ly_interval2scm(b[Y_AXIS]));
}
*/
Real get_realvar (SCM symbol) const;
Real get_var (String id) const;
- SCM get_scmvar (String id)const;
+ SCM get_scmvar (String id)const;
+ SCM get_scmvar_scm (SCM sym) const;
void reinit ();
Paper_def ();
Paper_def (Paper_def const&);
_ {
return FIGURE_SPACE;
}
- \] {
- return FIGURE_BRACKET_CLOSE;
- }
- \[ {
- return FIGURE_BRACKET_OPEN;
- }
\> {
return FIGURE_CLOSE;
}
#include "file-results.hh" // urg? header_global_p
#include "paper-outputter.hh"
+/*
+ This is an almost empty thing. The only substantial thing this class
+ handles, is scaling up and down to real-world dimensions (internally
+ dimensions are against global staff-space.)
+
+ */
Paper_def::Paper_def ()
{
}
return scope_p_->scm_elem (ly_symbol2scm (s.ch_C ()));
}
+
+SCM
+Paper_def::get_scmvar_scm (SCM sym) const
+{
+ return gh_double2scm (get_realvar (sym));
+}
+
Real
Paper_def::get_realvar (SCM s) const
{
br_bass_figure:
'[' bass_figure {
- unsmob_music ($2)->set_mus_property ("bracket-start", SCM_BOOL_T);
+ $$ = $2;
+ unsmob_music ($$)->set_mus_property ("bracket-start", SCM_BOOL_T);
}
| bass_figure {
-
+ $$ = $1;
}
| br_bass_figure ']' {
+ $$ = $1;
unsmob_music ($1)->set_mus_property ("bracket-stop", SCM_BOOL_T);
}
;
{
Translator *t = unsmob_translator (context);
Translator_group* tr= dynamic_cast<Translator_group*> (t);
- if (!t || !tr)
- {
- /* programming_error? */
- warning (_ ("ly-get-trans-property: expecting a Translator_group argument"));
- return SCM_EOL;
- }
+ SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Translator group");
+ SCM_ASSERT_TYPE(gh_symbol_p(name), name, SCM_ARG2, __FUNCTION__, "symbol");
+
return tr->internal_get_property (name);
}
SCM
ly_set_trans_property (SCM context, SCM name, SCM val)
{
-
Translator *t = unsmob_translator (context);
Translator_group* tr= dynamic_cast<Translator_group*> (t);
- if (tr)
- {
- tr->internal_set_property (name, val);
- }
+
+ SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Translator group");
+ tr->internal_set_property (name, val);
+
return SCM_UNSPECIFIED;
}
;;;; todo: make interfaces as 1st level objects in LilyPond.
-
-(define (fontify-text font-metric text)
- "Set TEXT with font FONT-METRIC, returning a molecule."
- (let* ((b (ly-text-dimension font-metric text)))
- (ly-make-molecule
- (ly-fontify-atom font-metric `(text ,text)) (car b) (cdr b))
- ))
-
(define (brew-one-figure grob fig-music)
"Brew a single column for a music figure"
(let* (
mol))
-(define (stack-molecules axis dir padding mols)
- "Stack molecules MOLS in direction AXIS,DIR, using PADDING."
- (if (null? mols)
- '()
- (if (pair? mols)
- (ly-combine-molecule-at-edge (car mols) axis dir
- (stack-molecules axis dir padding (cdr mols))
- padding
- )
- )
- ))
(define (brew-bass-figure grob)
"Make a molecule for a Figured Bass grob"
(let* (
(figs (ly-get-grob-property grob 'causes ))
- (fig-mols (map (lambda (x) (brew-one-figure grob x)) figs))
- (fig-mol (stack-molecules 1 -1 0.2 fig-mols))
+ (mol (ly-make-molecule '() '(0 . 0) '(0 . 0)))
+ (padding (ly-get-grob-property grob 'padding))
+ (kerning (ly-get-grob-property grob 'kern))
+ (thickness (*
+ (ly-get-paper-variable grob 'stafflinethickness)
+ (ly-get-grob-property grob 'thickness))
+ )
)
- (ly-align-to! fig-mol Y DOWN)
- fig-mol
- ))
+
+
+ (define (brew-complete-figure grob figs mol)
+ "recursive function: take some stuff from FIGS, and add it to MOL."
+ (define (end-bracket? fig)
+ (eq? (ly-get-mus-property fig 'bracket-stop) #t)
+ )
+
+ (if (null? figs)
+ mol
+ (if (eq? (ly-get-mus-property (car figs) 'bracket-start) #t)
+ (let* (
+ (gather-todo (take-from-list-until figs '() end-bracket?))
+ (unbr-mols
+ (map
+ (lambda (x) (brew-one-figure grob x))
+ (reverse! (car gather-todo) '())))
+ (br-mol (bracketify-molecule
+ (stack-molecules Y UP kerning unbr-mols)
+ Y thickness (* 2 padding) padding))
+ )
+ (brew-complete-figure
+ grob (cdr gather-todo)
+ (ly-combine-molecule-at-edge mol Y UP br-mol kerning)
+ )
+ )
+ (brew-complete-figure
+ grob (cdr figs)
+ (ly-combine-molecule-at-edge mol Y UP (brew-one-figure grob (car figs))
+ kerning))
+ )
+ ))
+
+
+ (set! mol (brew-complete-figure grob (reverse figs) mol))
+ (ly-align-to! mol Y DOWN)
+ mol
+ ))
+(define (take-from-list-until todo gathered crit?)
+ "return (G, T), where (reverse G) + T = GATHERED + TODO, and the last of G
+is the first to satisfy CRIT "
+ (if (null? todo)
+ (cons gathered todo)
+ (if (crit? (car todo))
+ (cons (cons (car todo) gathered) (cdr todo))
+ (take-from-list-until (cdr todo) (cons (car todo) gathered) crit?)
+ )
+ ))
+; test:
+; (take-from-list-until '(1 2 3 4 5) '() (lambda (x) (eq? x 3)))
+; ((3 2 1) 4 5)
+
+
+
; Make a function that checks score element for being of a specific type.
(define (make-type-checker symbol)
(lambda (elt)
"pdf.scm"
"pdftex.scm"
"c++.scm"
+ "molecule.scm"
"bass-figure.scm"
"grob-property-description.scm"
"context-description.scm"
--- /dev/null
+
+(define (stack-molecules axis dir padding mols)
+ "Stack molecules MOLS in direction AXIS,DIR, using PADDING."
+ (if (null? mols)
+ '()
+ (if (pair? mols)
+ (ly-combine-molecule-at-edge (car mols) axis dir
+ (stack-molecules axis dir padding (cdr mols))
+ padding
+ )
+ )
+ ))
+
+
+
+
+(define (fontify-text font-metric text)
+ "Set TEXT with font FONT-METRIC, returning a molecule."
+ (let* ((b (ly-text-dimension font-metric text)))
+ (ly-make-molecule
+ (ly-fontify-atom font-metric `(text ,text)) (car b) (cdr b))
+ ))
+
+(define (other-axis a)
+ (remainder (+ a 1) 2))
+
+(define (bracketify-molecule mol axis thick protusion padding)
+ "Add brackets around MOL, producing a new molecule."
+
+ (let* (
+ (ext (ly-get-molecule-extent mol axis))
+ (lb (ly-bracket axis ext -1 thick protusion))
+ (rb (ly-bracket axis ext 1 thick protusion))
+ )
+ (set! mol (ly-combine-molecule-at-edge mol (other-axis axis) 1 lb padding))
+ (set! mol (ly-combine-molecule-at-edge mol (other-axis axis) -1 rb padding))
+ mol
+ ))
projects / lilypond.git / commitdiff