Use scalar instead of embedded_scm for context mod overrides.
[lilypond/mpolesky.git] / lily / pitch-scheme.cc
blob1ecc247ed13911110dfccf21463d739a718d0fe3
1 /*
2 pitch-scheme.cc -- implement scheme functions for Pitch
4 source file of the GNU LilyPond music typesetter
6 (c) 2005--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
7 */
9 #include "pitch.hh"
11 LY_DEFINE (ly_pitch_transpose, "ly:pitch-transpose",
12 2, 0, 0, (SCM p, SCM delta),
13 "Transpose @var{p} by the amount @var{delta},"
14 " where @var{delta} is relative to middle@tie{}C.")
16 LY_ASSERT_SMOB (Pitch, p, 1);
17 LY_ASSERT_SMOB (Pitch, delta, 2);
19 Pitch *t = unsmob_pitch (p);
20 Pitch *d = unsmob_pitch (delta);
21 return t->transposed (*d).smobbed_copy ();
24 /* Should add optional args. */
25 LY_DEFINE (ly_make_pitch, "ly:make-pitch",
26 2, 1, 0, (SCM octave, SCM note, SCM alter),
27 "@var{octave} is specified by an integer, zero for the octave"
28 " containing middle@tie{}C. @var{note} is a number indexing the"
29 " global default scale, with 0 corresponding to pitch@tie{}C"
30 " and 6 usually corresponding to pitch@tie{}B. @var{alter} is"
31 " a rational number of 200-cent whole tones for alteration.")
34 LY_ASSERT_TYPE (scm_is_integer, octave, 1);
35 LY_ASSERT_TYPE (scm_is_integer, note, 2);
36 LY_ASSERT_TYPE (scm_is_rational, alter, 3);
38 Pitch p (scm_to_int (octave), scm_to_int (note),
39 ly_scm2rational (alter));
41 return p.smobbed_copy ();
44 LY_DEFINE (ly_pitch_negate, "ly:pitch-negate", 1, 0, 0,
45 (SCM p),
46 "Negate @var{p}.")
48 LY_ASSERT_SMOB (Pitch, p, 1);
49 Pitch *pp = unsmob_pitch (p);
50 return pp->negated ().smobbed_copy ();
53 LY_DEFINE (ly_pitch_steps, "ly:pitch-steps", 1, 0, 0,
54 (SCM p),
55 "Number of steps counted from middle@tie{}C of the"
56 " pitch@tie{}@var{p}.")
58 LY_ASSERT_SMOB (Pitch, p, 1);
59 Pitch *pp = unsmob_pitch (p);
60 return scm_from_int (pp->steps ());
63 LY_DEFINE (ly_pitch_octave, "ly:pitch-octave",
64 1, 0, 0, (SCM pp),
65 "Extract the octave from pitch@tie{}@var{pp}.")
67 LY_ASSERT_SMOB (Pitch, pp, 1);
68 Pitch *p = unsmob_pitch (pp);
69 int q = p->get_octave ();
70 return scm_from_int (q);
73 LY_DEFINE (ly_pitch_alteration, "ly:pitch-alteration",
74 1, 0, 0, (SCM pp),
75 "Extract the alteration from pitch@tie{}@var{pp}.")
77 LY_ASSERT_SMOB (Pitch, pp, 1);
78 Pitch *p = unsmob_pitch (pp);
79 Rational q = p->get_alteration ();
81 return ly_rational2scm (q);
84 LY_DEFINE (pitch_notename, "ly:pitch-notename",
85 1, 0, 0, (SCM pp),
86 "Extract the note name from pitch @var{pp}.")
88 LY_ASSERT_SMOB (Pitch, pp, 1);
89 Pitch *p = unsmob_pitch (pp);
90 int q = p->get_notename ();
91 return scm_from_int (q);
94 LY_DEFINE (ly_pitch_quartertones, "ly:pitch-quartertones",
95 1, 0, 0, (SCM pp),
96 "Calculate the number of quarter tones of@tie{}@var{pp} from"
97 " middle@tie{}C.")
99 LY_ASSERT_SMOB (Pitch, pp, 1);
100 Pitch *p = unsmob_pitch (pp);
101 int q = p->rounded_quartertone_pitch ();
102 return scm_from_int (q);
105 LY_DEFINE (ly_pitch_semitones, "ly:pitch-semitones",
106 1, 0, 0, (SCM pp),
107 "Calculate the number of semitones of@tie{}@var{pp} from"
108 " middle@tie{}C.")
110 LY_ASSERT_SMOB (Pitch, pp, 1);
111 Pitch *p = unsmob_pitch (pp);
112 int q = p->rounded_semitone_pitch ();
113 return scm_from_int (q);
116 LY_DEFINE (ly_pitch_less_p, "ly:pitch<?",
117 2, 0, 0, (SCM p1, SCM p2),
118 "Is @var{p1} lexicographically smaller than @var{p2}?")
120 LY_ASSERT_SMOB (Pitch, p1, 1);
121 LY_ASSERT_SMOB (Pitch, p2, 2);
123 Pitch *a = unsmob_pitch (p1);
124 Pitch *b = unsmob_pitch (p2);
126 if (Pitch::compare (*a, *b) < 0)
127 return SCM_BOOL_T;
128 else
129 return SCM_BOOL_F;
132 LY_DEFINE (ly_pitch_diff, "ly:pitch-diff",
133 2, 0, 0, (SCM pitch, SCM root),
134 "Return pitch @var{delta} such that @var{pitch} transposed by"
135 " @var{delta} equals @var{root}.")
138 LY_ASSERT_SMOB (Pitch, pitch, 1);
139 LY_ASSERT_SMOB (Pitch, root, 2);
141 Pitch *p = unsmob_pitch (pitch);
142 Pitch *r = unsmob_pitch (root);
144 return pitch_interval (*r, *p).smobbed_copy ();
147 /* FIXME: probably isn't the right place for this function */
148 #include "context.hh"
149 LY_DEFINE (ly_set_middle_C_x, "ly:set-middle-C!",
150 1, 0, 0, (SCM context),
151 "Set the @code{middleCPosition} variable in @var{context}"
152 " based on the variables @code{middleCClefPosition} and"
153 " middleCOffset.")
155 LY_ASSERT_SMOB (Context, context, 1);
157 Context *c = unsmob_context (context);
158 int clef_pos = robust_scm2int (c->get_property ("middleCClefPosition"), 0);
159 int offset = robust_scm2int (c->get_property ("middleCOffset"), 0);
161 c->set_property (ly_symbol2scm ("middleCPosition"), scm_from_int (clef_pos + offset));
162 return SCM_UNDEFINED;