1 /* 2 This file is part of LilyPond, the GNU music typesetter. 3 4 Copyright (C) 2005--2021 Han-Wen Nienhuys <hanwen@xs4all.nl> 5 6 LilyPond is free software: you can redistribute it and/or modify 7 it under the terms of the GNU General Public License as published by 8 the Free Software Foundation, either version 3 of the License, or 9 (at your option) any later version. 10 11 LilyPond is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 GNU General Public License for more details. 15 16 You should have received a copy of the GNU General Public License 17 along with LilyPond. If not, see <http://www.gnu.org/licenses/>. 18 */ 19 20 #include "music.hh" 21 22 #include "duration.hh" 23 #include "input.hh" 24 #include "lily-imports.hh" 25 #include "program-option.hh" 26 #include "warn.hh" 27 28 LY_DEFINE (ly_music_length, "ly:music-length", 29 1, 0, 0, (SCM mus), 30 "Get the length of music expression @var{mus} and return" 31 " it as a @code{Moment} object.") 32 { 33 auto *const sc = LY_ASSERT_SMOB (Music, mus, 1); 34 return to_scm (sc->get_length ()); 35 } 36 37 LY_DEFINE (ly_music_property, "ly:music-property", 38 2, 1, 0, (SCM mus, SCM sym, SCM val), 39 "Return the value for property @var{sym} of music expression" 40 " @var{mus}. If no value is found, return @var{val} or" 41 " @code{'()} if @var{val} is not specified.") 42 { 43 LY_ASSERT_SMOB (Music, mus, 1); 44 return ly_prob_property (mus, sym, val); 45 } 46 47 LY_DEFINE (ly_music_set_property_x, "ly:music-set-property!", 48 3, 0, 0, (SCM mus, SCM sym, SCM val), 49 "Set property @var{sym} in music expression @var{mus} to" 50 " @var{val}.") 51 { 52 LY_ASSERT_SMOB (Music, mus, 1); 53 54 return ly_prob_set_property_x (mus, sym, val); 55 } 56 57 LY_DEFINE (ly_music_start, "ly:music-start", 58 1, 0, 0, (SCM mus), 59 "Get the start of music expression @var{mus} and return" 60 " it as a @code{Moment} object.") 61 { 62 auto *const sc = LY_ASSERT_SMOB (Music, mus, 1); 63 return to_scm (sc->start_mom ()); 64 } 65 66 /* todo: property args */ 67 LY_DEFINE (ly_make_music, "ly:make-music", 68 1, 0, 0, (SCM props), 69 "Make a C++ @code{Music} object and initialize it with" 70 " @var{props}.\n" 71 "\n" 72 "This function is for internal use and is only called by" 73 " @code{make-music}, which is the preferred interface" 74 " for creating music objects.") 75 { 76 Music *ms = new Music (props); 77 return ms->unprotect (); 78 } 79 80 LY_DEFINE (ly_music_p, "ly:music?", 81 1, 0, 0, (SCM obj), 82 "Is @var{obj} a @code{Music} object?") 83 { 84 return ly_bool2scm (unsmob<Music> (obj)); 85 } 86 87 LY_DEFINE (ly_event_p, "ly:event?", 88 1, 0, 0, (SCM obj), 89 "Is @var{obj} a proper (non-rhythmic) @code{Event} object?") 90 { 91 if (Music *m = unsmob<Music> (obj)) 92 { 93 return scm_from_bool (m->is_mus_type ("post-event")); 94 } 95 return SCM_BOOL_F; 96 } 97 98 /* todo: property args */ 99 LY_DEFINE (ly_music_mutable_properties, "ly:music-mutable-properties", 100 1, 0, 0, (SCM mus), 101 "Return an alist containing the mutable properties of @var{mus}." 102 " The immutable properties are not available, since they are" 103 " constant and initialized by the @code{make-music} function.") 104 { 105 auto *const m = LY_ASSERT_SMOB (Music, mus, 1); 106 return m->get_property_alist (true); 107 } 108 109 LY_DEFINE (ly_music_list_p, "ly:music-list?", 110 1, 0, 0, (SCM lst), 111 "Is @var{lst} a list of music objects?") 112 { 113 if (!ly_is_list (lst)) 114 return SCM_BOOL_F; 115 116 while (scm_is_pair (lst)) 117 { 118 if (!unsmob<Music> (scm_car (lst))) 119 return SCM_BOOL_F; 120 lst = scm_cdr (lst); 121 } 122 123 return SCM_BOOL_T; 124 } 125 126 LY_DEFINE (ly_music_deep_copy, "ly:music-deep-copy", 127 1, 1, 0, (SCM m, SCM origin), 128 "Copy @var{m} and all sub expressions of@tie{}@var{m}." 129 " @var{m} may be an arbitrary type; cons cells and music" 130 " are copied recursively. If @var{origin} is given," 131 " it is used as the origin for one level of music by calling" 132 " @code{ly:set-origin!} on the copy.") 133 { 134 m = music_deep_copy (m); 135 136 if (SCM_UNBNDP (origin)) 137 return m; 138 139 if (Music *mus = unsmob<Music> (origin)) 140 origin = get_property (mus, "origin"); 141 142 if (scm_is_false (origin) || scm_is_null (origin)) 143 return m; 144 145 LY_ASSERT_SMOB (Input, origin, 2); 146 147 set_origin (m, origin); 148 return m; 149 } 150 151 LY_DEFINE (ly_set_origin_x, "ly:set-origin!", 152 1, 1, 0, (SCM m, SCM origin), 153 "Set the origin given in @var{origin} to @var{m}." 154 " @var{m} is typically a music expression or a list" 155 " of music. List structures are searched recursively," 156 " but recursion stops at the changed music expressions" 157 " themselves.\n" 158 "\n" 159 "@var{origin} is generally of type @code{ly:input-location?}," 160 " defaulting to @code{(*location*)}. Other valid values for" 161 " @code{origin} are a music expression which is then used as" 162 " the source of location information, or @code{#f}" 163 " or @code{'()} in which case no action is performed." 164 " The return value is @var{m} itself.") 165 { 166 if (SCM_UNBNDP (origin)) 167 origin = scm_fluid_ref (Lily::f_location); 168 else if (Music *mus = unsmob<Music> (origin)) 169 origin = get_property (mus, "origin"); 170 171 if (scm_is_false (origin) || scm_is_null (origin)) 172 return m; 173 174 LY_ASSERT_SMOB (Input, origin, 2); 175 176 set_origin (m, origin); 177 return m; 178 } 179 180 LY_DEFINE (ly_music_transpose, "ly:music-transpose", 181 2, 0, 0, (SCM m, SCM p), 182 "Transpose @var{m} such that central@tie{}C is mapped" 183 " to@tie{}@var{p}. Return@tie{}@var{m}.") 184 { 185 auto *const sc = LY_ASSERT_SMOB (Music, m, 1); 186 auto *const sp = LY_ASSERT_SMOB (Pitch, p, 2); 187 188 sc->transpose (*sp); 189 // SCM_UNDEFINED ? 190 return sc->self_scm (); 191 } 192 193 LY_DEFINE (ly_make_music_relative_x, "ly:make-music-relative!", 194 2, 0, 0, (SCM music, SCM pitch), 195 "Make @var{music} relative to @var{pitch}," 196 " return final pitch.") 197 { 198 auto *const m = LY_ASSERT_SMOB (Music, music, 1); 199 auto start = *LY_ASSERT_SMOB (Pitch, pitch, 2); 200 201 Pitch last = m->to_relative_octave (start); 202 203 return last.smobbed_copy (); 204 } 205 206 LY_DEFINE (ly_music_duration_length, "ly:music-duration-length", 1, 0, 0, 207 (SCM mus), 208 "Extract the duration field from @var{mus} and return the" 209 " length.") 210 { 211 auto *const m = LY_ASSERT_SMOB (Music, mus, 1); 212 213 Duration *d = unsmob<Duration> (get_property (m, "duration")); 214 Moment len; 215 216 if (d) 217 len = Moment (d->get_length ()); 218 else 219 programming_error ("music has no duration"); 220 return to_scm (len); 221 } 222 223 LY_DEFINE (ly_music_duration_compress, "ly:music-duration-compress", 2, 0, 0, 224 (SCM mus, SCM fact), 225 "Compress @var{mus} by factor @var{fact}, which is a" 226 " @code{Moment}.") 227 { 228 auto *const m = LY_ASSERT_SMOB (Music, mus, 1); 229 auto *const f = LY_ASSERT_SMOB (Moment, fact, 2); 230 231 Duration *d = unsmob<Duration> (get_property (m, "duration")); 232 if (d) 233 set_property (m, "duration", d->compressed (f->main_part_).smobbed_copy ()); 234 return SCM_UNSPECIFIED; 235 } 236 237 /* 238 This is hairy, since the scale in a key-change event may contain 239 octaveless notes. 240 241 242 TODO: this should use ly:pitch. 243 */ 244 LY_DEFINE (ly_transpose_key_alist, "ly:transpose-key-alist", 245 2, 0, 0, (SCM l, SCM pit), 246 "Make a new key alist of@tie{}@var{l} transposed by" 247 " pitch @var{pit}.") 248 { 249 SCM newlist = SCM_EOL; 250 Pitch p (*LY_ASSERT_SMOB (Pitch, pit, 2)); 251 252 for (SCM s = l; scm_is_pair (s); s = scm_cdr (s)) 253 { 254 SCM key = scm_caar (s); 255 SCM alter = scm_cdar (s); 256 if (scm_is_pair (key)) 257 { 258 Pitch orig (scm_to_int (scm_car (key)), 259 scm_to_int (scm_cdr (key)), 260 from_scm<Rational> (alter)); 261 262 orig = orig.transposed (p); 263 264 SCM key = scm_cons (to_scm (orig.get_octave ()), 265 to_scm (orig.get_notename ())); 266 267 newlist = scm_cons (scm_cons (key, to_scm (orig.get_alteration ())), 268 newlist); 269 } 270 else if (scm_is_number (key)) 271 { 272 Pitch orig (0, scm_to_int (key), from_scm<Rational> (alter)); 273 orig = orig.transposed (p); 274 275 key = to_scm (orig.get_notename ()); 276 alter = to_scm (orig.get_alteration ()); 277 newlist = scm_cons (scm_cons (key, alter), newlist); 278 } 279 } 280 return scm_reverse_x (newlist, SCM_EOL); 281 } 282