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