2 music.cc -- implement Music
4 source file of the GNU LilyPond music typesetter
6 (c) 1997--2001 Han-Wen Nienhuys <hanwen@cs.uu.nl>
9 #include "input-smob.hh"
11 #include "music-list.hh"
14 #include "ly-smobs.icc"
17 ly_deep_mus_copy (SCM m
)
21 SCM ss
= unsmob_music (m
)->clone ()->self_scm ();
22 scm_unprotect_object (ss
);
25 else if (gh_pair_p (m
))
27 return gh_cons (ly_deep_mus_copy (gh_car (m
)), ly_deep_mus_copy (gh_cdr (m
)));
36 immutable_property_alist_
= SCM_EOL
;
37 mutable_property_alist_
= SCM_EOL
;
41 Music::Music (Music
const &m
)
43 immutable_property_alist_
= m
.immutable_property_alist_
;
44 SCM c
=ly_deep_mus_copy (m
.mutable_property_alist_
);
45 mutable_property_alist_
= c
;
49 set_spot (*m
.origin ());
55 immutable_property_alist_
= l
;
56 mutable_property_alist_
= SCM_EOL
;
62 Music::mark_smob (SCM m
)
64 Music
* mus
= (Music
*)SCM_CELL_WORD_1 (m
);
65 scm_gc_mark (mus
->immutable_property_alist_
);
66 scm_gc_mark (mus
->mutable_property_alist_
);
71 Music::compress (Moment
)
78 Music::length_mom () const
80 SCM l
= get_mus_property ("length");
81 if (unsmob_moment (l
))
82 return *unsmob_moment (l
);
83 else if (gh_procedure_p (l
))
85 SCM res
= gh_call1 (l
, self_scm ());
86 return *unsmob_moment (res
);
93 Music::start_mom () const
100 print_alist (SCM a
, SCM port
)
102 for (SCM s
= a
; gh_pair_p (s
); s
= gh_cdr (s
))
104 scm_display (gh_caar (s
), port
);
105 scm_puts (" = ", port
);
106 scm_write (gh_cdar (s
), port
);
107 scm_puts ("\n", port
);
112 Music::print_smob (SCM s
, SCM p
, scm_print_state
*)
114 scm_puts ("#<Music ", p
);
115 Music
* m
= unsmob_music (s
);
116 scm_puts (classname (m
),p
);
118 print_alist (m
->mutable_property_alist_
, p
);
119 print_alist (m
->immutable_property_alist_
, p
);
126 Music::to_relative_octave (Pitch m
)
133 Music::transpose (Pitch
)
137 IMPLEMENT_TYPE_P (Music
, "music?");
138 IMPLEMENT_UNSMOB (Music
,music
);
139 IMPLEMENT_SMOBS (Music
);
140 IMPLEMENT_DEFAULT_EQUAL_P (Music
);
142 /****************************/
145 Music::get_mus_property (const char *nm
) const
147 SCM sym
= ly_symbol2scm (nm
);
148 return get_mus_property (sym
);
152 Music::get_mus_property (SCM sym
) const
154 SCM s
= scm_sloppy_assq (sym
, mutable_property_alist_
);
158 s
= scm_sloppy_assq (sym
, immutable_property_alist_
);
159 return (s
== SCM_BOOL_F
) ? SCM_EOL
: gh_cdr (s
);
163 Remove the value associated with KEY, and return it. The result is
164 that a next call will yield SCM_EOL (and not the underlying
168 Music::remove_mus_property (const char* key
)
170 SCM val
= get_mus_property (key
);
172 set_mus_property (key
, SCM_EOL
);
177 Music::set_mus_property (const char* k
, SCM v
)
179 SCM s
= ly_symbol2scm (k
);
180 set_mus_property (s
, v
);
184 Music::set_immutable_mus_property (const char*k
, SCM v
)
186 SCM s
= ly_symbol2scm (k
);
187 set_immutable_mus_property (s
, v
);
191 Music::set_immutable_mus_property (SCM s
, SCM v
)
193 immutable_property_alist_
= gh_cons (gh_cons (s
,v
), mutable_property_alist_
);
194 mutable_property_alist_
= scm_assq_remove_x (mutable_property_alist_
, s
);
197 Music::set_mus_property (SCM s
, SCM v
)
199 mutable_property_alist_
= scm_assq_set_x (mutable_property_alist_
, s
, v
);
205 Music::set_spot (Input ip
)
207 set_mus_property ("origin", make_input (ip
));
213 Music::origin () const
215 Input
*ip
= unsmob_input (get_mus_property ("origin"));
216 return ip
? ip
: & dummy_input_global
;
229 ly_get_mus_property (SCM mus
, SCM sym
)
231 Music
* sc
= unsmob_music (mus
);
235 return sc
->get_mus_property (sym
);
239 warning (_ ("ly_get_mus_property (): Not a Music"));
240 scm_write (mus
, scm_current_error_port ());
247 ly_set_mus_property (SCM mus
, SCM sym
, SCM val
)
249 Music
* sc
= unsmob_music (mus
);
251 if (!gh_symbol_p (sym
))
253 warning (_ ("ly_set_mus_property (): Not a symbol"));
254 scm_write (mus
, scm_current_error_port ());
256 return SCM_UNSPECIFIED
;
261 sc
->set_mus_property (sym
, val
);
265 warning (_ ("ly_set_mus_property (): not of type Music"));
266 scm_write (mus
, scm_current_error_port ());
269 return SCM_UNSPECIFIED
;
273 // to do property args
275 ly_make_music (SCM type
)
277 if (!gh_string_p (type
))
279 warning (_ ("ly_make_music (): Not a string"));
280 scm_write (type
, scm_current_error_port ());
282 return SCM_UNSPECIFIED
;
286 SCM s
= get_music (ly_scm2string (type
))->self_scm ();
287 scm_unprotect_object (s
);
293 ly_music_name (SCM mus
)
295 Music
* m
= unsmob_music (mus
);
299 warning (_ ("ly_music_name (): Not a music expression"));
300 scm_write (mus
, scm_current_error_port ());
304 return ly_str02scm (nm
);
310 scm_make_gsubr ("ly-get-mus-property", 2, 0, 0, (Scheme_function_unknown
)ly_get_mus_property
);
311 scm_make_gsubr ("ly-set-mus-property", 3, 0, 0, (Scheme_function_unknown
)ly_set_mus_property
);
312 scm_make_gsubr ("ly-make-music", 1, 0, 0, (Scheme_function_unknown
)ly_make_music
);
313 scm_make_gsubr ("ly-music-name", 1, 0, 0, (Scheme_function_unknown
)ly_music_name
);
315 ADD_SCM_INIT_FUNC (musicscm
,init_functions
);