lily/grob-scheme.cc

   1 /*
   2   grob-scheme.cc -- Scheme entry points for the grob datatype
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 1998--2007 Jan Nieuwenhuizen <janneke@gnu.org>
   7   Han-Wen Nienhuys <hanwen@xs4all.nl>
   8 */
   9
  10 #include "warn.hh"              // error()
  11 #include "item.hh"
  12 #include "output-def.hh"
  13 #include "system.hh"
  14 #include "font-interface.hh"
  15 #include "paper-score.hh"
  16 #include "grob-array.hh"
  17
  18 LY_DEFINE (ly_grob_property_data, "ly:grob-property-data",
  19            2, 0, 0, (SCM grob, SCM sym),
  20            "Retrieve @var{sym} for @var{grob} but don't process callbacks.")
  21 {
  22   Grob *sc = unsmob_grob (grob);
  23   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
  24   SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
  25
  26   return sc->get_property_data (sym);
  27 }
  28
  29 LY_DEFINE (ly_grob_set_property_x, "ly:grob-set-property!",
  30            3, 0, 0, (SCM grob, SCM sym, SCM val),
  31            "Set @var{sym} in grob @var{grob} to value @var{val}")
  32 {
  33   Grob *sc = unsmob_grob (grob);
  34   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
  35   SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
  36
  37   if (!ly_is_procedure (val)
  38       && !type_check_assignment (sym, val, ly_symbol2scm ("backend-type?")))
  39     error ("typecheck failed");
  40
  41   sc->set_property (sym, val);
  42   return SCM_UNSPECIFIED;
  43 }
  44
  45 LY_DEFINE (ly_grob_property, "ly:grob-property",
  46            2, 1, 0, (SCM grob, SCM sym, SCM deflt),
  47            "Return the value of a value in grob @var{g} of property @var{sym}. "
  48            "It will return @code{'()} or @var{deflt} (if specified) "
  49            "if  @var{sym} is undefined in @var{g}."
  50            "\n\n")
  51 {
  52   Grob *sc = unsmob_grob (grob);
  53   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
  54   SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
  55   if (deflt == SCM_UNDEFINED)
  56     deflt = SCM_EOL;
  57
  58   SCM retval = sc->internal_get_property (sym);
  59   if (retval == SCM_EOL)
  60     retval = deflt;
  61
  62   return retval;
  63 }
  64
  65
  66 LY_DEFINE (ly_grob_interfaces, "ly:grob-interfaces",
  67            1, 0, 0, (SCM grob),
  68            "Return the interfaces list of grob @var{grob}.")
  69 {
  70   Grob *sc = unsmob_grob (grob);
  71   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
  72
  73   return sc->interfaces ();
  74 }
  75
  76 LY_DEFINE (ly_grob_object, "ly:grob-object",
  77            2, 0, 0, (SCM grob, SCM sym),
  78            "Return the value of a pointer in grob @var{g} of property @var{sym}. "
  79            "It will return @code{' ()} (end-of-list) "
  80            "if  @var{sym} is undefined in @var{g}."
  81            "\n\n")
  82 {
  83   Grob *sc = unsmob_grob (grob);
  84   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
  85   SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
  86
  87   return sc->internal_get_object (sym);
  88 }
  89
  90 LY_DEFINE (ly_spanner_get_bound, "ly:spanner-bound",
  91            2, 0, 0, (SCM slur, SCM dir),
  92            "Get one of the bounds of @var{spanner}. @var{dir} is @code{-1} "
  93            "for left, and @code{1} for right.")
  94 {
  95   Spanner *sl = dynamic_cast<Spanner *> (unsmob_grob (slur));
  96   SCM_ASSERT_TYPE (sl, slur, SCM_ARG1, __FUNCTION__, "spanner grob");
  97   SCM_ASSERT_TYPE (is_direction (dir), slur, SCM_ARG2, __FUNCTION__, "dir");
  98   return sl->get_bound (to_dir (dir))->self_scm ();
  99 }
 100
 101 /* TODO: make difference between scaled and unscalead variable in
 102    calling (i.e different funcs.) */
 103 LY_DEFINE (ly_grob_layout, "ly:grob-layout",
 104            1, 0, 0, (SCM g),
 105            "Get @code{\\layout} definition from grob @var{g}.")
 106 {
 107   Grob *sc = unsmob_grob (g);
 108   SCM_ASSERT_TYPE (sc, g, SCM_ARG1, __FUNCTION__, "grob");
 109
 110   return sc->layout ()->self_scm ();
 111 }
 112
 113 LY_DEFINE (ly_grob_alist_chain, "ly:grob-alist-chain",
 114            1, 1, 0, (SCM grob, SCM global),
 115            "Get an alist chain for grob @var{grob}, with @var{global} as the "
 116            "global default. If unspecified, @code{font-defaults} "
 117            "from the layout block is taken. ")
 118 {
 119   Grob *sc = unsmob_grob (grob);
 120   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 121
 122   if (global == SCM_UNDEFINED)
 123     {
 124       global = sc->layout ()->lookup_variable (ly_symbol2scm ("font-defaults"));
 125       if (global == SCM_UNDEFINED)
 126         global = SCM_EOL;
 127     }
 128
 129   return sc->get_property_alist_chain (global);
 130 }
 131
 132 LY_DEFINE (ly_get_extent, "ly:grob-extent",
 133            3, 0, 0, (SCM grob, SCM refp, SCM axis),
 134            "Get the extent in @var{axis} direction of @var{grob} relative to "
 135            "the grob @var{refp}")
 136 {
 137   Grob *sc = unsmob_grob (grob);
 138   Grob *ref = unsmob_grob (refp);
 139
 140   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 141   SCM_ASSERT_TYPE (ref, refp, SCM_ARG2, __FUNCTION__, "grob");
 142   SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG3, __FUNCTION__, "axis");
 143
 144   Axis a = Axis (scm_to_int (axis));
 145
 146
 147   if (ref->common_refpoint (sc, a) != ref)
 148     {
 149       // ugh. should use other error message
 150       SCM_ASSERT_TYPE (false, refp, SCM_ARG2, __FUNCTION__, "common refpoint");
 151     }
 152   return ly_interval2scm (sc->extent (ref, a));
 153 }
 154
 155 LY_DEFINE (ly_grob_robust_relative_extent, "ly:grob-robust-relative-extent",
 156            3, 0, 0, (SCM grob, SCM refp, SCM axis),
 157            "Get the extent in @var{axis} direction of @var{grob} relative to "
 158            "the grob @var{refp}, or (0,0) if empty")
 159 {
 160   Grob *sc = unsmob_grob (grob);
 161   Grob *ref = unsmob_grob (refp);
 162
 163   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 164   SCM_ASSERT_TYPE (ref, refp, SCM_ARG2, __FUNCTION__, "grob");
 165   SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG3, __FUNCTION__, "axis");
 166
 167   Axis a = Axis (scm_to_int (axis));
 168
 169   if (ref->common_refpoint (sc, a) != ref)
 170     {
 171       // ugh. should use other error message
 172       SCM_ASSERT_TYPE (false, refp, SCM_ARG2, __FUNCTION__, "common refpoint");
 173     }
 174
 175   return ly_interval2scm (robust_relative_extent (sc, ref, a));
 176 }
 177
 178 LY_DEFINE (ly_grob_relative_coordinate, "ly:grob-relative-coordinate",
 179            3, 0, 0, (SCM grob, SCM refp, SCM axis),
 180            "Get the coordinate in @var{axis} direction of @var{grob} relative to "
 181            "the grob @var{refp}")
 182 {
 183   Grob *sc = unsmob_grob (grob);
 184   Grob *ref = unsmob_grob (refp);
 185
 186   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 187   SCM_ASSERT_TYPE (ref, refp, SCM_ARG2, __FUNCTION__, "grob");
 188   SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG3, __FUNCTION__, "axis");
 189
 190   Axis a = Axis (scm_to_int (axis));
 191
 192
 193   if (ref->common_refpoint (sc, a) != ref)
 194     {
 195       // ugh. should use other error message
 196       SCM_ASSERT_TYPE (false, refp, SCM_ARG2, __FUNCTION__, "common refpoint");
 197     }
 198
 199   return scm_from_double (sc->relative_coordinate (ref,a));
 200 }
 201
 202
 203 LY_DEFINE (ly_grob_parent, "ly:grob-parent",
 204            2, 0, 0, (SCM grob, SCM axis),
 205            "Get the parent of @var{grob}.  @var{axis} is 0 for the X-axis, "
 206            "1 for the Y-axis.")
 207 {
 208   Grob *sc = unsmob_grob (grob);
 209   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 210   SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG2, __FUNCTION__, "axis");
 211
 212   Grob *par = sc->get_parent (Axis (scm_to_int (axis)));
 213   return par ? par->self_scm () : SCM_EOL;
 214 }
 215
 216 LY_DEFINE (ly_grob_properties, "ly:grob-properties",
 217            1, 0, 0, (SCM grob),
 218            "Get the mutable proprerties of @var{grob}.")
 219 {
 220   Grob *g = unsmob_grob (grob);
 221   SCM_ASSERT_TYPE (g, grob, SCM_ARG1, __FUNCTION__, "grob");
 222
 223   /* FIXME: uhg? copy/read only? */
 224   return g->mutable_property_alist_;
 225 }
 226
 227 LY_DEFINE (ly_grob_basic_properties, "ly:grob-basic-properties",
 228            1, 0, 0, (SCM grob),
 229            "Get the immutable properties of @var{grob}.")
 230 {
 231   Grob *g = unsmob_grob (grob);
 232   SCM_ASSERT_TYPE (g, grob, SCM_ARG1, __FUNCTION__, "grob");
 233
 234   /* FIXME: uhg? copy/read only? */
 235   return g->immutable_property_alist_;
 236 }
 237
 238 LY_DEFINE (ly_grob_system, "ly:grob-system",
 239            1, 0, 0, (SCM g),
 240            "Return the System Grob of @var{g}.")
 241 {
 242   Grob *me = unsmob_grob (g);
 243   SCM_ASSERT_TYPE (me, g, SCM_ARG1, __FUNCTION__, "grob");
 244
 245   if (System *g = me->get_system ())
 246     return g->self_scm ();
 247
 248   return SCM_EOL;
 249 }
 250
 251 LY_DEFINE (ly_grob_original, "ly:grob-original",
 252            1, 0, 0, (SCM grob),
 253            "Return the unbroken original Grob of @var{grob}.")
 254 {
 255   Grob *me = unsmob_grob (grob);
 256   SCM_ASSERT_TYPE (me, grob, SCM_ARG1, __FUNCTION__, "grob");
 257   return me->original () ? me->original ()->self_scm () : me->self_scm ();
 258 }
 259
 260 /* TODO: maybe we should return a vector -- random access is more
 261    logical for this list? */
 262 LY_DEFINE (ly_spanner_broken_into, "ly:spanner-broken-into",
 263            1, 0, 0, (SCM spanner),
 264            "Return broken-into list for @var{spanner}.")
 265 {
 266   Spanner *me = dynamic_cast<Spanner *> (unsmob_grob (spanner));
 267   SCM_ASSERT_TYPE (me, spanner, SCM_ARG1, __FUNCTION__, "spanner");
 268
 269   SCM s = SCM_EOL;
 270   for (vsize i = me->broken_intos_.size (); i--;)
 271     s = scm_cons (me->broken_intos_[i]->self_scm (), s);
 272   return s;
 273 }
 274
 275 LY_DEFINE (ly_grob_suicide_x, "ly:grob-suicide!",
 276            1, 0, 0, (SCM g),
 277            "Kill @var{g}.")
 278 {
 279   Grob *me = unsmob_grob (g);
 280   SCM_ASSERT_TYPE (me, g, SCM_ARG1, __FUNCTION__, "grob");
 281
 282   me->suicide ();
 283   return SCM_UNSPECIFIED;
 284 }
 285
 286 LY_DEFINE (ly_grob_translate_axis_x, "ly:grob-translate-axis!",
 287            3, 0, 0, (SCM g, SCM d, SCM a),
 288            "Translate @var{g} on axis @var{a} over distance @var{d}.")
 289 {
 290   Grob *me = unsmob_grob (g);
 291   SCM_ASSERT_TYPE (me, g, SCM_ARG1, __FUNCTION__, "grob");
 292   SCM_ASSERT_TYPE (scm_is_number (d), d, SCM_ARG2, __FUNCTION__, "dimension");
 293   SCM_ASSERT_TYPE (is_axis (a), a, SCM_ARG3, __FUNCTION__, "axis");
 294
 295   me->translate_axis (scm_to_double (d), Axis (scm_to_int (a)));
 296   return SCM_UNSPECIFIED;
 297 }
 298
 299 LY_DEFINE (ly_spanner_p, "ly:spanner?",
 300            1, 0, 0, (SCM g),
 301            "Is  @var{g} a spanner object?")
 302 {
 303   Grob *me = unsmob_grob (g);
 304   bool b = dynamic_cast<Spanner *> (me);
 305
 306   return ly_bool2scm (b);
 307 }
 308
 309 LY_DEFINE (ly_grob_default_font, "ly:grob-default-font",
 310            1, 0, 0, (SCM grob),
 311            "Return the default font for grob @var{gr}.")
 312 {
 313   Grob *gr = unsmob_grob (grob);
 314   SCM_ASSERT_TYPE (gr, grob, SCM_ARG1, __FUNCTION__, "grob");
 315
 316   return Font_interface::get_default_font (gr)->self_scm ();
 317 }
 318
 319
 320 /*
 321   TODO: consider swapping order, so we can do
 322
 323   (grob-common-refpoint a b c d e)
 324  */
 325 LY_DEFINE (ly_grob_common_refpoint, "ly:grob-common-refpoint",
 326            3, 0, 0,  (SCM grob, SCM other, SCM axis),
 327            "Find the common refpoint of @var{grob} and @var{other} for @var{axis}."
 328            )
 329 {
 330
 331   Grob *gr = unsmob_grob (grob);
 332   SCM_ASSERT_TYPE (gr, grob, SCM_ARG1, __FUNCTION__, "grob");
 333
 334   Grob *o = unsmob_grob (other);
 335   SCM_ASSERT_TYPE (o, other, SCM_ARG2, __FUNCTION__, "grob");
 336
 337   SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG3, __FUNCTION__, "axis");
 338
 339   Grob *refp = gr->common_refpoint (o,  Axis (scm_to_int (axis)));
 340   return refp ? refp->self_scm () : SCM_BOOL_F;
 341 }
 342
 343 LY_DEFINE (ly_grob_common_refpoint_of_array, "ly:grob-common-refpoint-of-array",
 344            3, 0, 0,  (SCM grob, SCM others, SCM axis),
 345            "Find the common refpoint of @var{grob} and @var{others} "
 346            "(a grob-array) for @var{axis}."
 347            )
 348 {
 349   Grob *gr = unsmob_grob (grob);
 350   SCM_ASSERT_TYPE (gr, grob, SCM_ARG1, __FUNCTION__, "grob");
 351
 352   Grob_array *ga = unsmob_grob_array (others);
 353   SCM_ASSERT_TYPE (ga, others, SCM_ARG2, __FUNCTION__, "grob array");
 354   SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG3, __FUNCTION__, "axis");
 355
 356   Grob *refp = common_refpoint_of_array (ga->array (), gr, Axis (scm_to_int (axis)));
 357   return refp ? refp->self_scm () : SCM_BOOL_F;
 358 }