lily/grob.cc

   1 /*
   2   score-elem.cc -- implement Grob
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c)  1997--2001 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7 */
   8
   9
  10 #include <string.h>
  11 #include <math.h>
  12
  13 #include "input-smob.hh"
  14 #include "libc-extension.hh"
  15 #include "group-interface.hh"
  16 #include "misc.hh"
  17 #include "paper-score.hh"
  18 #include "paper-def.hh"
  19 #include "molecule.hh"
  20 #include "grob.hh"
  21 #include "debug.hh"
  22 #include "spanner.hh"
  23 #include "line-of-score.hh"
  24 #include "item.hh"
  25 #include "paper-column.hh"
  26 #include "molecule.hh"
  27 #include "misc.hh"
  28 #include "paper-outputter.hh"
  29 #include "dimension-cache.hh"
  30 #include "side-position-interface.hh"
  31 #include "item.hh"
  32
  33 #include "ly-smobs.icc"
  34
  35 /*
  36 TODO:
  37
  38 remove dynamic_cast<Spanner,Item> and put this code into respective
  39   subclass.
  40 */
  41
  42
  43 #define INFINITY_MSG "Infinity or NaN encountered"
  44
  45 Grob::Grob (SCM basicprops)
  46 {
  47   /*
  48     fixme: default should be no callback.
  49    */
  50
  51   pscore_l_=0;
  52   status_c_ = 0;
  53   original_l_ = 0;
  54   immutable_property_alist_ =  basicprops;
  55   mutable_property_alist_ = SCM_EOL;
  56
  57   smobify_self ();
  58
  59   char const*onames[] = {"X-offset-callbacks", "Y-offset-callbacks"};
  60   char const*enames[] = {"X-extent-callback", "Y-extent-callback"};
  61
  62   for (int a = X_AXIS; a <= Y_AXIS; a++){
  63     SCM l = get_grob_property (onames[a]);
  64
  65     if (scm_ilength (l) >=0)
  66       {
  67         dim_cache_[a].offset_callbacks_ = l;
  68         dim_cache_[a].offsets_left_ = scm_ilength (l);
  69       }
  70     else
  71       {
  72         programming_error ("[XY]-offset-callbacks must be a list");
  73       }
  74
  75     SCM cb = get_grob_property (enames[a]);
  76
  77     /*
  78       Should change default to be empty?
  79      */
  80     if (cb != SCM_BOOL_F && !gh_procedure_p (cb) && !gh_pair_p (cb))
  81       cb = molecule_extent_proc;
  82
  83     dim_cache_[a].dimension_ = cb;
  84   }
  85
  86   SCM meta = get_grob_property ("meta");
  87   SCM ifs = scm_assoc (ly_symbol2scm ("interfaces"), meta);
  88
  89   set_grob_property ("interfaces",gh_cdr (ifs));
  90 }
  91
  92
  93 Grob::Grob (Grob const&s)
  94    : dim_cache_ (s.dim_cache_)
  95 {
  96   original_l_ = (Grob*) &s;
  97   immutable_property_alist_ = s.immutable_property_alist_;
  98   mutable_property_alist_ = SCM_EOL;
  99
 100   status_c_ = s.status_c_;
 101   pscore_l_ = s.pscore_l_;
 102
 103   smobify_self ();
 104 }
 105
 106 Grob::~Grob ()
 107 {
 108   /*
 109     do nothing scm-ish and no unprotecting here.
 110    */
 111 }
 112
 113
 114 SCM
 115 Grob::get_grob_property (const char *nm) const
 116 {
 117   SCM sym = ly_symbol2scm (nm);
 118   return get_grob_property (sym);
 119 }
 120
 121 SCM
 122 Grob::get_grob_property (SCM sym) const
 123 {
 124   SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
 125   if (s != SCM_BOOL_F)
 126     return gh_cdr (s);
 127
 128   s = scm_sloppy_assq (sym, immutable_property_alist_);
 129   return (s == SCM_BOOL_F) ? SCM_EOL : gh_cdr (s);
 130 }
 131
 132 /*
 133   Remove the value associated with KEY, and return it. The result is
 134   that a next call will yield SCM_UNDEFINED (and not the underlying
 135   `basic' property.
 136 */
 137 SCM
 138 Grob::remove_grob_property (const char* key)
 139 {
 140   SCM val = get_grob_property (key);
 141   if (val != SCM_EOL)
 142     set_grob_property (key, SCM_EOL);
 143   return val;
 144 }
 145
 146 void
 147 Grob::set_grob_property (const char* k, SCM v)
 148 {
 149   SCM s = ly_symbol2scm (k);
 150   set_grob_property (s, v);
 151 }
 152
 153 /*
 154   Puts the k, v in the immutable_property_alist_, which is convenient for
 155   storing variables that are needed during the breaking process. (eg.
 156   Line_of_score::rank : int)
 157  */
 158 void
 159 Grob::set_immutable_grob_property (const char*k, SCM v)
 160 {
 161   SCM s = ly_symbol2scm (k);
 162   set_immutable_grob_property (s, v);
 163 }
 164
 165 void
 166 Grob::set_immutable_grob_property (SCM s, SCM v)
 167 {
 168   immutable_property_alist_ = gh_cons (gh_cons (s,v), mutable_property_alist_);
 169   mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, s);
 170 }
 171 void
 172 Grob::set_grob_property (SCM s, SCM v)
 173 {
 174   mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
 175 }
 176
 177
 178 MAKE_SCHEME_CALLBACK (Grob,molecule_extent,2);
 179 SCM
 180 Grob::molecule_extent (SCM element_smob, SCM scm_axis)
 181 {
 182   Grob *s = unsmob_grob (element_smob);
 183   Axis a = (Axis) gh_scm2int (scm_axis);
 184
 185   Molecule *m = s->get_molecule ();
 186   Interval e ;
 187   if (m)
 188     e = m->extent (a);
 189   return ly_interval2scm (e);
 190 }
 191
 192 MAKE_SCHEME_CALLBACK (Grob,preset_extent,2);
 193
 194 SCM
 195 Grob::preset_extent (SCM element_smob, SCM scm_axis)
 196 {
 197   Grob *s = unsmob_grob (element_smob);
 198   Axis a = (Axis) gh_scm2int (scm_axis);
 199
 200   SCM ext = s->get_grob_property ((a == X_AXIS)
 201                                  ? "extent-X"
 202                                  : "extent-Y");
 203
 204   if (gh_pair_p (ext))
 205     {
 206       Real l = gh_scm2double (gh_car (ext));
 207       Real r = gh_scm2double (gh_cdr (ext));
 208       return ly_interval2scm (Interval (l, r));
 209     }
 210
 211   return ly_interval2scm (Interval ());
 212 }
 213
 214
 215
 216 Paper_def*
 217 Grob::paper_l ()  const
 218 {
 219  return pscore_l_ ? pscore_l_->paper_l_ : 0;
 220 }
 221
 222 void
 223 Grob::calculate_dependencies (int final, int busy, SCM funcname)
 224 {
 225   if (status_c_ >= final)
 226     return;
 227
 228   if (status_c_== busy)
 229     {
 230       programming_error ("Element is busy, come back later");
 231       return;
 232     }
 233
 234   status_c_= busy;
 235
 236   for (SCM d=  get_grob_property ("dependencies"); gh_pair_p (d); d = gh_cdr (d))
 237     {
 238       unsmob_grob (gh_car (d))
 239         ->calculate_dependencies (final, busy, funcname);
 240     }
 241
 242   // ughugh.
 243   String s = ly_symbol2string (funcname);
 244   SCM proc = get_grob_property (s.ch_C ());
 245   if (gh_procedure_p (proc))
 246     gh_call1 (proc, this->self_scm ());
 247
 248   status_c_= final;
 249
 250 }
 251
 252 Molecule *
 253 Grob::get_molecule ()  const
 254 {
 255   SCM mol = get_grob_property ("molecule");
 256   if (unsmob_molecule (mol))
 257     return unsmob_molecule (mol);
 258
 259   mol =  get_uncached_molecule ();
 260
 261   Grob *me = (Grob*)this;
 262   me->set_grob_property ("molecule", mol);
 263
 264   return unsmob_molecule (mol);
 265 }
 266 SCM
 267 Grob::get_uncached_molecule ()const
 268 {
 269   SCM proc = get_grob_property ("molecule-callback");
 270
 271   SCM  mol = SCM_EOL;
 272   if (gh_procedure_p (proc))
 273     mol = gh_apply (proc, gh_list (this->self_scm (), SCM_UNDEFINED));
 274
 275
 276   Molecule *m = unsmob_molecule (mol);
 277
 278   if (unsmob_molecule (mol))
 279     {
 280       /*
 281         TODO: add option for not copying origin info.
 282       */
 283       SCM origin =get_grob_property ("origin");
 284       if (!unsmob_input (origin))
 285         origin =ly_symbol2scm ("no-origin");
 286
 287
 288       // ugr.
 289
 290       mol = Molecule (m->extent_box (),
 291                       gh_list (origin, m->get_expr (), SCM_UNDEFINED)
 292                       ). smobbed_copy ();
 293
 294       m = unsmob_molecule (mol);
 295     }
 296
 297   /*
 298     transparent retains dimensions of element.
 299    */
 300   if (m && to_boolean (get_grob_property ("transparent")))
 301     mol = Molecule (m->extent_box (), SCM_EOL).smobbed_copy ();
 302
 303   return mol;
 304 }
 305
 306 /*
 307
 308   VIRTUAL STUBS
 309
 310  */
 311 void
 312 Grob::do_break_processing ()
 313 {
 314 }
 315
 316
 317
 318
 319
 320
 321 Line_of_score *
 322 Grob::line_l () const
 323 {
 324   return 0;
 325 }
 326
 327 void
 328 Grob::add_dependency (Grob*e)
 329 {
 330   if (e)
 331     {
 332       Pointer_group_interface ::add_element (this, "dependencies",e);
 333
 334     }
 335   else
 336     programming_error ("Null dependency added");
 337 }
 338
 339
 340
 341
 342 /**
 343       Do break substitution in S, using CRITERION. Return new value.
 344       CRITERION is either a SMOB pointer to the desired line, or a number
 345       representing the break direction. Do not modify SRC.
 346 */
 347 SCM
 348 Grob::handle_broken_grobs (SCM src, SCM criterion)
 349 {
 350  again:
 351   Grob *sc = unsmob_grob (src);
 352   if (sc)
 353     {
 354       if (gh_number_p (criterion))
 355         {
 356           Item * i = dynamic_cast<Item*> (sc);
 357           Direction d = to_dir (criterion);
 358           if (i && i->break_status_dir () != d)
 359             {
 360               Item *br = i->find_prebroken_piece (d);
 361               return (br) ? br->self_scm () : SCM_UNDEFINED;
 362             }
 363         }
 364       else
 365         {
 366           Line_of_score * line
 367             = dynamic_cast<Line_of_score*> (unsmob_grob (criterion));
 368           if (sc->line_l () != line)
 369             {
 370               sc = sc->find_broken_piece (line);
 371
 372             }
 373
 374           /* now: !sc || (sc && sc->line_l () == line) */
 375           if (!sc)
 376             return SCM_UNDEFINED;
 377
 378           /* now: sc && sc->line_l () == line */
 379           if (!line
 380               || (sc->common_refpoint (line, X_AXIS)
 381                   && sc->common_refpoint (line, Y_AXIS)))
 382             {
 383               return sc->self_scm ();
 384             }
 385           return SCM_UNDEFINED;
 386         }
 387     }
 388   else if (gh_pair_p (src))
 389     {
 390       SCM oldcar =gh_car (src);
 391       /*
 392         UGH! breaks on circular lists.
 393       */
 394       SCM newcar = handle_broken_grobs (oldcar, criterion);
 395       SCM oldcdr = gh_cdr (src);
 396
 397       if (newcar == SCM_UNDEFINED
 398           && (gh_pair_p (oldcdr) || oldcdr == SCM_EOL))
 399         {
 400           /*
 401             This is tail-recursion, ie.
 402
 403             return handle_broken_grobs (cdr, criterion);
 404
 405             We don't want to rely on the compiler to do this.  Without
 406             tail-recursion, this easily crashes with a stack overflow.  */
 407           src =  oldcdr;
 408           goto again;
 409         }
 410
 411       SCM newcdr = handle_broken_grobs (oldcdr, criterion);
 412       return gh_cons (newcar, newcdr);
 413     }
 414   else
 415     return src;
 416
 417   return src;
 418 }
 419
 420 void
 421 Grob::handle_broken_dependencies ()
 422 {
 423   Spanner * s= dynamic_cast<Spanner*> (this);
 424   if (original_l_ && s)
 425     return;
 426
 427   if (s)
 428     {
 429       for (int i = 0;  i< s->broken_into_l_arr_ .size (); i++)
 430         {
 431           Grob * sc = s->broken_into_l_arr_[i];
 432           Line_of_score * l = sc->line_l ();
 433           sc->mutable_property_alist_ =
 434             handle_broken_grobs (mutable_property_alist_,
 435                                  l ? l->self_scm () : SCM_UNDEFINED);
 436         }
 437     }
 438
 439
 440   Line_of_score *line = line_l ();
 441
 442   if (line && common_refpoint (line, X_AXIS) && common_refpoint (line, Y_AXIS))
 443     {
 444       mutable_property_alist_
 445         = handle_broken_grobs (mutable_property_alist_,
 446                                line ? line->self_scm () : SCM_UNDEFINED);
 447     }
 448   else if (dynamic_cast <Line_of_score*> (this))
 449     {
 450       mutable_property_alist_ = handle_broken_grobs (mutable_property_alist_,
 451                                             SCM_UNDEFINED);
 452     }
 453   else
 454     {
 455       /*
 456         This element is `invalid'; it has been removed from all
 457         dependencies, so let's junk the element itself.
 458
 459         do not do this for Line_of_score, since that would remove
 460         references to the originals of score-elts, which get then GC'd
 461  (a bad thing.)
 462       */
 463       suicide ();
 464     }
 465 }
 466
 467 /*
 468  Note that we still want references to this element to be
 469  rearranged, and not silently thrown away, so we keep pointers
 470  like {broken_into_{drul,array}, original}
 471 */
 472 void
 473 Grob::suicide ()
 474 {
 475   mutable_property_alist_ = SCM_EOL;
 476   immutable_property_alist_ = SCM_EOL;
 477
 478   set_extent_callback (SCM_EOL, Y_AXIS);
 479   set_extent_callback (SCM_EOL, X_AXIS);
 480
 481   for (int a= X_AXIS; a <= Y_AXIS; a++)
 482     {
 483       dim_cache_[a].offset_callbacks_ = SCM_EOL;
 484       dim_cache_[a].offsets_left_ = 0;
 485     }
 486 }
 487
 488 void
 489 Grob::handle_prebroken_dependencies ()
 490 {
 491 }
 492
 493 Grob*
 494 Grob::find_broken_piece (Line_of_score*) const
 495 {
 496   return 0;
 497 }
 498
 499 void
 500 Grob::translate_axis (Real y, Axis a)
 501 {
 502   if (isinf (y) || isnan (y))
 503     programming_error (_ (INFINITY_MSG));
 504   else
 505     {
 506       dim_cache_[a].offset_ += y;
 507     }
 508 }
 509
 510 Real
 511 Grob::relative_coordinate (Grob const*refp, Axis a) const
 512 {
 513   if (refp == this)
 514     return 0.0;
 515
 516   /*
 517     We catch PARENT_L_ == nil case with this, but we crash if we did
 518     not ask for the absolute coordinate (ie. REFP == nil.)
 519
 520    */
 521   if (refp == dim_cache_[a].parent_l_)
 522     return get_offset (a);
 523   else
 524     return get_offset (a) + dim_cache_[a].parent_l_->relative_coordinate (refp, a);
 525 }
 526
 527 Real
 528 Grob::get_offset (Axis a) const
 529 {
 530   Grob *me = (Grob*) this;
 531   while (dim_cache_[a].offsets_left_)
 532     {
 533       int l = --me->dim_cache_[a].offsets_left_;
 534       SCM cb = scm_list_ref (dim_cache_[a].offset_callbacks_,  gh_int2scm (l));
 535       SCM retval = gh_call2 (cb, self_scm (), gh_int2scm (a));
 536
 537       Real r =  gh_scm2double (retval);
 538       if (isinf (r) || isnan (r))
 539         {
 540           programming_error (INFINITY_MSG);
 541           r = 0.0;
 542         }
 543       me->dim_cache_[a].offset_ +=r;
 544     }
 545   return dim_cache_[a].offset_;
 546 }
 547
 548
 549 MAKE_SCHEME_CALLBACK (Grob,point_dimension_callback,2);
 550 SCM
 551 Grob::point_dimension_callback (SCM , SCM)
 552 {
 553   return ly_interval2scm (Interval (0,0));
 554 }
 555
 556 bool
 557 Grob::empty_b (Axis a)const
 558 {
 559   return ! (gh_pair_p (dim_cache_[a].dimension_) ||
 560             gh_procedure_p (dim_cache_[a].dimension_));
 561 }
 562
 563 /*
 564   TODO: add
 565
 566     Grob *refpoint
 567
 568   to arguments?
 569  */
 570 Interval
 571 Grob::extent (Grob * refp, Axis a) const
 572 {
 573   Real x = relative_coordinate (refp, a);
 574
 575
 576   Dimension_cache * d = (Dimension_cache *)&dim_cache_[a];
 577   Interval ext ;
 578   if (gh_pair_p (d->dimension_))
 579     ;
 580   else if (gh_procedure_p (d->dimension_))
 581     {
 582       /*
 583         FIXME: add doco on types, and should typecheck maybe?
 584        */
 585       d->dimension_= gh_call2 (d->dimension_, self_scm (), gh_int2scm (a));
 586     }
 587   else
 588     return ext;
 589
 590   if (!gh_pair_p (d->dimension_))
 591     return ext;
 592
 593   ext = ly_scm2interval (d->dimension_);
 594
 595   SCM extra = get_grob_property (a == X_AXIS
 596                                 ? "extra-extent-X"
 597                                 : "extra-extent-Y");
 598
 599   /*
 600     signs ?
 601    */
 602   if (gh_pair_p (extra))
 603     {
 604       ext[BIGGER] +=  gh_scm2double (gh_cdr (extra));
 605       ext[SMALLER] +=   gh_scm2double (gh_car (extra));
 606     }
 607
 608   extra = get_grob_property (a == X_AXIS
 609                                 ? "minimum-extent-X"
 610                                 : "minimum-extent-Y");
 611   if (gh_pair_p (extra))
 612     {
 613       ext.unite (Interval (gh_scm2double (gh_car (extra)),
 614                            gh_scm2double (gh_cdr (extra))));
 615     }
 616
 617   ext.translate (x);
 618
 619   return ext;
 620 }
 621
 622
 623 Grob*
 624 Grob::parent_l (Axis a) const
 625 {
 626   return  dim_cache_[a].parent_l_;
 627 }
 628
 629 Grob *
 630 Grob::common_refpoint (Grob const* s, Axis a) const
 631 {
 632   /*
 633     I don't like the quadratic aspect of this code, but I see no other
 634     way. The largest chain of parents might be 10 high or so, so
 635     it shouldn't be a real issue. */
 636   for (Grob const *c = this; c; c = c->dim_cache_[a].parent_l_)
 637     for (Grob const * d = s; d; d = d->dim_cache_[a].parent_l_)
 638       if (d == c)
 639         return (Grob*)d;
 640
 641   return 0;
 642 }
 643
 644
 645 Grob *
 646 Grob::common_refpoint (SCM elist, Axis a) const
 647 {
 648   Grob * common = (Grob*) this;
 649   for (; gh_pair_p (elist); elist = gh_cdr (elist))
 650     {
 651       Grob * s = unsmob_grob (gh_car (elist));
 652       if (s)
 653         common = common->common_refpoint (s, a);
 654     }
 655
 656   return common;
 657 }
 658
 659 String
 660 Grob::name () const
 661 {
 662   SCM meta = get_grob_property ("meta");
 663   SCM nm = scm_assoc (ly_symbol2scm ("name"), meta);
 664   nm = (gh_pair_p (nm)) ? gh_cdr (nm) : SCM_EOL;
 665   return  gh_string_p (nm) ?ly_scm2string (nm) :  classname (this);
 666 }
 667
 668 void
 669 Grob::add_offset_callback (SCM cb, Axis a)
 670 {
 671   if (!has_offset_callback_b (cb, a))
 672   {
 673     dim_cache_[a].offset_callbacks_ = gh_cons (cb, dim_cache_[a].offset_callbacks_);
 674     dim_cache_[a].offsets_left_ ++;
 675   }
 676 }
 677
 678 bool
 679 Grob::has_extent_callback_b (SCM cb, Axis a)const
 680 {
 681   return scm_equal_p (cb, dim_cache_[a].dimension_) == SCM_BOOL_T;
 682 }
 683
 684
 685 bool
 686 Grob::has_extent_callback_b (Axis a) const
 687 {
 688   return gh_procedure_p (dim_cache_[a].dimension_);
 689 }
 690
 691 bool
 692 Grob::has_offset_callback_b (SCM cb, Axis a)const
 693 {
 694   return scm_memq (cb, dim_cache_[a].offset_callbacks_) != SCM_BOOL_F;
 695 }
 696
 697 void
 698 Grob::set_extent_callback (SCM dc, Axis a)
 699 {
 700   dim_cache_[a].dimension_ =dc;
 701 }
 702
 703 void
 704 Grob::set_parent (Grob *g, Axis a)
 705 {
 706   dim_cache_[a].parent_l_ = g;
 707 }
 708
 709 MAKE_SCHEME_CALLBACK (Grob,fixup_refpoint,1);
 710 SCM
 711 Grob::fixup_refpoint (SCM smob)
 712 {
 713   Grob *me = unsmob_grob (smob);
 714   for (int a = X_AXIS; a < NO_AXES; a ++)
 715     {
 716       Axis ax = (Axis)a;
 717       Grob * parent = me->parent_l (ax);
 718
 719       if (!parent)
 720         continue;
 721
 722       if (parent->line_l () != me->line_l () && me->line_l ())
 723         {
 724           Grob * newparent = parent->find_broken_piece (me->line_l ());
 725           me->set_parent (newparent, ax);
 726         }
 727
 728       if (Item * i  = dynamic_cast<Item*> (me))
 729         {
 730           Item *parenti = dynamic_cast<Item*> (parent);
 731
 732           if (parenti && i)
 733             {
 734               Direction  my_dir = i->break_status_dir () ;
 735               if (my_dir!= parenti->break_status_dir ())
 736                 {
 737                   Item *newparent =  parenti->find_prebroken_piece (my_dir);
 738                   me->set_parent (newparent, ax);
 739                 }
 740             }
 741         }
 742     }
 743   return smob;
 744 }
 745
 746
 747
 748 /****************************************************
 749   SMOB funcs
 750  ****************************************************/
 751
 752
 753 IMPLEMENT_UNSMOB (Grob, grob);
 754 IMPLEMENT_SMOBS (Grob);
 755 IMPLEMENT_DEFAULT_EQUAL_P (Grob);
 756
 757 SCM
 758 Grob::mark_smob (SCM ses)
 759 {
 760   Grob * s = (Grob*) SCM_CELL_WORD_1 (ses);
 761   scm_gc_mark (s->immutable_property_alist_);
 762   scm_gc_mark (s->mutable_property_alist_);
 763
 764   for (int a =0 ; a < 2; a++)
 765     {
 766       scm_gc_mark (s->dim_cache_[a].offset_callbacks_);
 767       scm_gc_mark (s->dim_cache_[a].dimension_);
 768     }
 769
 770   if (s->parent_l (Y_AXIS))
 771     scm_gc_mark (s->parent_l (Y_AXIS)->self_scm ());
 772   if (s->parent_l (X_AXIS))
 773     scm_gc_mark (s->parent_l (X_AXIS)->self_scm ());
 774
 775   if (s->original_l_)
 776     scm_gc_mark (s->original_l_->self_scm ());
 777   return s->do_derived_mark ();
 778 }
 779
 780 int
 781 Grob::print_smob (SCM s, SCM port, scm_print_state *)
 782 {
 783   Grob *sc = (Grob *) gh_cdr (s);
 784
 785   scm_puts ("#<Grob ", port);
 786   scm_puts ((char *)sc->name ().ch_C (), port);
 787
 788   /*
 789     don't try to print properties, that is too much hassle.
 790    */
 791   scm_puts (" >", port);
 792   return 1;
 793 }
 794
 795 SCM
 796 Grob::do_derived_mark ()
 797 {
 798   return SCM_EOL;
 799 }
 800
 801
 802 SCM
 803 ly_set_grob_property (SCM elt, SCM sym, SCM val)
 804 {
 805   Grob * sc = unsmob_grob (elt);
 806
 807   if (!gh_symbol_p (sym))
 808     {
 809       error ("Not a symbol");
 810       ly_display_scm (sym);
 811       return SCM_UNSPECIFIED;
 812     }
 813
 814   if (sc)
 815     {
 816       sc->set_grob_property (sym, val);
 817     }
 818   else
 819     {
 820       error ("Not a score element");
 821       ly_display_scm (elt);
 822     }
 823
 824   return SCM_UNSPECIFIED;
 825 }
 826
 827
 828 SCM
 829 ly_get_grob_property (SCM elt, SCM sym)
 830 {
 831   Grob * sc = unsmob_grob (elt);
 832
 833   if (sc)
 834     {
 835       return sc->get_grob_property (sym);
 836     }
 837   else
 838     {
 839       error ("Not a score element");
 840       ly_display_scm (elt);
 841     }
 842   return SCM_UNSPECIFIED;
 843 }
 844
 845
 846 void
 847 Grob::discretionary_processing ()
 848 {
 849 }
 850
 851
 852
 853 SCM
 854 spanner_get_bound (SCM slur, SCM dir)
 855 {
 856   return dynamic_cast<Spanner*> (unsmob_grob (slur))->get_bound (to_dir (dir))->self_scm ();
 857 }
 858
 859
 860
 861 static SCM interfaces_sym;
 862 static void
 863 init_functions ()
 864 {
 865   interfaces_sym = scm_permanent_object (ly_symbol2scm ("interfaces"));
 866
 867   scm_c_define_gsubr ("ly-get-grob-property", 2, 0, 0,
 868                       (Scheme_function_unknown)ly_get_grob_property);
 869   scm_c_define_gsubr ("ly-set-grob-property", 3, 0, 0,
 870                       (Scheme_function_unknown)ly_set_grob_property);
 871   scm_c_define_gsubr ("ly-get-spanner-bound", 2 , 0, 0,
 872                       (Scheme_function_unknown) spanner_get_bound);
 873 }
 874
 875 bool
 876 Grob::has_interface (SCM k)
 877 {
 878   SCM ifs = get_grob_property (interfaces_sym);
 879
 880   return scm_memq (k, ifs) != SCM_BOOL_F;
 881 }
 882
 883 void
 884 Grob::set_interface (SCM k)
 885 {
 886   if (has_interface (k))
 887     return ;
 888   else
 889     {
 890       set_grob_property (interfaces_sym,
 891                         gh_cons (k, get_grob_property (interfaces_sym)));
 892     }
 893 }
 894
 895
 896 ADD_SCM_INIT_FUNC (scoreelt, init_functions);
 897 IMPLEMENT_TYPE_P (Grob, "ly-grob?");