lily/grob.cc

   1 /*
   2   score-elem.cc -- implement Grob
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c)  1997--2000 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_i_ = 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_i_ = s.status_i_;
 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   assert (status_i_ >=0);
 226
 227   if (status_i_ >= final)
 228     return;
 229
 230   if (status_i_== busy)
 231     {
 232       programming_error ("Element is busy, come back later");
 233       return;
 234     }
 235
 236   status_i_= busy;
 237
 238   for (SCM d=  get_grob_property ("dependencies"); gh_pair_p (d); d = gh_cdr (d))
 239     {
 240       unsmob_grob (gh_car (d))
 241         ->calculate_dependencies (final, busy, funcname);
 242     }
 243
 244   // ughugh.
 245   String s = ly_symbol2string (funcname);
 246   SCM proc = get_grob_property (s.ch_C());
 247   if (gh_procedure_p (proc))
 248     gh_call1 (proc, this->self_scm ());
 249
 250   status_i_= final;
 251
 252 }
 253
 254 Molecule *
 255 Grob::get_molecule ()  const
 256 {
 257   SCM mol = get_grob_property ("molecule");
 258   if (unsmob_molecule (mol))
 259     return unsmob_molecule (mol);
 260
 261   mol =  get_uncached_molecule ();
 262
 263   Grob *me = (Grob*)this;
 264   me->set_grob_property ("molecule", mol);
 265
 266   return unsmob_molecule (mol);
 267 }
 268 SCM
 269 Grob::get_uncached_molecule ()const
 270 {
 271   SCM proc = get_grob_property ("molecule-callback");
 272
 273   SCM  mol = SCM_EOL;
 274   if (gh_procedure_p (proc))
 275     mol = gh_apply (proc, gh_list (this->self_scm (), SCM_UNDEFINED));
 276
 277
 278   Molecule *m = unsmob_molecule (mol);
 279
 280   if (unsmob_molecule (mol))
 281     {
 282       /*
 283         TODO: add option for not copying origin info.
 284       */
 285       SCM origin =get_grob_property ("origin");
 286       if (!unsmob_input (origin))
 287         origin =ly_symbol2scm ("no-origin");
 288
 289
 290       // ugr.
 291
 292       mol = Molecule (m->extent_box (),
 293                       gh_list (origin, m->get_expr (), SCM_UNDEFINED)
 294                       ). smobbed_copy ();
 295
 296       m = unsmob_molecule (mol);
 297     }
 298
 299
 300
 301   /*
 302     transparent retains dimensions of element.
 303    */
 304   if (m && to_boolean (get_grob_property ("transparent")))
 305     mol = Molecule (m->extent_box (), SCM_EOL).smobbed_copy ();
 306
 307   return mol;
 308 }
 309
 310 /*
 311
 312   VIRTUAL STUBS
 313
 314  */
 315 void
 316 Grob::do_break_processing()
 317 {
 318 }
 319
 320
 321
 322
 323
 324
 325 Line_of_score *
 326 Grob::line_l() const
 327 {
 328   return 0;
 329 }
 330
 331 void
 332 Grob::add_dependency (Grob*e)
 333 {
 334   if (e)
 335     {
 336       Pointer_group_interface ::add_element (this, "dependencies",e);
 337
 338     }
 339   else
 340     programming_error ("Null dependency added");
 341 }
 342
 343
 344
 345
 346 /**
 347       Do break substitution in S, using CRITERION. Return new value.
 348       CRITERION is either a SMOB pointer to the desired line, or a number
 349       representing the break direction. Do not modify SRC.
 350 */
 351 SCM
 352 Grob::handle_broken_smobs (SCM src, SCM criterion)
 353 {
 354  again:
 355   Grob *sc = unsmob_grob (src);
 356   if (sc)
 357     {
 358       if (gh_number_p (criterion))
 359         {
 360           Item * i = dynamic_cast<Item*> (sc);
 361           Direction d = to_dir (criterion);
 362           if (i && i->break_status_dir () != d)
 363             {
 364               Item *br = i->find_prebroken_piece (d);
 365               return  (br) ? br->self_scm () : SCM_UNDEFINED;
 366             }
 367         }
 368       else
 369         {
 370           Line_of_score * line
 371             = dynamic_cast<Line_of_score*> (unsmob_grob (criterion));
 372           if (sc->line_l () != line)
 373             {
 374               sc = sc->find_broken_piece (line);
 375
 376             }
 377
 378           /* now: !sc || (sc && sc->line_l () == line) */
 379           if (!sc)
 380             return SCM_UNDEFINED;
 381
 382           /* now: sc && sc->line_l () == line */
 383           if (!line
 384               || (sc->common_refpoint (line, X_AXIS)
 385                   && sc->common_refpoint (line, Y_AXIS)))
 386             {
 387               return sc->self_scm ();
 388             }
 389           return SCM_UNDEFINED;
 390         }
 391     }
 392   else if (gh_pair_p (src))
 393     {
 394       SCM oldcar =gh_car (src);
 395       /*
 396         UGH! breaks on circular lists.
 397       */
 398       SCM newcar = handle_broken_smobs (oldcar, criterion);
 399       SCM oldcdr = gh_cdr (src);
 400
 401       if (newcar == SCM_UNDEFINED
 402           && (gh_pair_p (oldcdr) || oldcdr == SCM_EOL))
 403         {
 404           /*
 405             This is tail-recursion, ie.
 406
 407             return handle_broken_smobs (cdr, criterion);
 408
 409             We don't want to rely on the compiler to do this.  Without
 410             tail-recursion, this easily crashes with a stack overflow.  */
 411           src =  oldcdr;
 412           goto again;
 413         }
 414
 415       SCM newcdr = handle_broken_smobs (oldcdr, criterion);
 416       return gh_cons (newcar, newcdr);
 417     }
 418   else
 419     return src;
 420
 421   return src;
 422 }
 423
 424 void
 425 Grob::handle_broken_dependencies()
 426 {
 427   Spanner * s= dynamic_cast<Spanner*> (this);
 428   if (original_l_ && s)
 429     return;
 430
 431   if (s)
 432     {
 433       for (int i = 0;  i< s->broken_into_l_arr_ .size (); i++)
 434         {
 435           Grob * sc = s->broken_into_l_arr_[i];
 436           Line_of_score * l = sc->line_l ();
 437           sc->mutable_property_alist_ =
 438             handle_broken_smobs (mutable_property_alist_,
 439                                  l ? l->self_scm () : SCM_UNDEFINED);
 440         }
 441     }
 442
 443
 444   Line_of_score *line = line_l();
 445
 446   if (line && common_refpoint (line, X_AXIS) && common_refpoint (line, Y_AXIS))
 447     {
 448       mutable_property_alist_
 449         = handle_broken_smobs (mutable_property_alist_,
 450                                line ? line->self_scm () : SCM_UNDEFINED);
 451     }
 452   else if (dynamic_cast <Line_of_score*> (this))
 453     {
 454       mutable_property_alist_ = handle_broken_smobs (mutable_property_alist_,
 455                                             SCM_UNDEFINED);
 456     }
 457   else
 458     {
 459       /*
 460         This element is `invalid'; it has been removed from all
 461         dependencies, so let's junk the element itself.
 462
 463         do not do this for Line_of_score, since that would remove
 464         references to the originals of score-elts, which get then GC'd
 465         (a bad thing.)
 466       */
 467       suicide();
 468     }
 469 }
 470
 471 /*
 472  Note that we still want references to this element to be
 473  rearranged, and not silently thrown away, so we keep pointers
 474  like {broken_into_{drul,array}, original}
 475 */
 476 void
 477 Grob::suicide ()
 478 {
 479   mutable_property_alist_ = SCM_EOL;
 480   immutable_property_alist_ = SCM_EOL;
 481
 482   set_extent_callback (SCM_EOL, Y_AXIS);
 483   set_extent_callback (SCM_EOL, X_AXIS);
 484
 485   for (int a= X_AXIS; a <= Y_AXIS; a++)
 486     {
 487       dim_cache_[a].offset_callbacks_ = SCM_EOL;
 488       dim_cache_[a].offsets_left_ = 0;
 489     }
 490 }
 491
 492 void
 493 Grob::handle_prebroken_dependencies()
 494 {
 495 }
 496
 497 Grob*
 498 Grob::find_broken_piece (Line_of_score*) const
 499 {
 500   return 0;
 501 }
 502
 503 void
 504 Grob::translate_axis (Real y, Axis a)
 505 {
 506   if (isinf (y) || isnan (y))
 507     programming_error (_(INFINITY_MSG));
 508   else
 509     {
 510       dim_cache_[a].offset_ += y;
 511     }
 512 }
 513
 514 Real
 515 Grob::relative_coordinate (Grob const*refp, Axis a) const
 516 {
 517   if (refp == this)
 518     return 0.0;
 519
 520   /*
 521     We catch PARENT_L_ == nil case with this, but we crash if we did
 522     not ask for the absolute coordinate (ie. REFP == nil.)
 523
 524    */
 525   if (refp == dim_cache_[a].parent_l_)
 526     return get_offset (a);
 527   else
 528     return get_offset (a) + dim_cache_[a].parent_l_->relative_coordinate (refp, a);
 529 }
 530
 531 Real
 532 Grob::get_offset (Axis a) const
 533 {
 534   Grob *me = (Grob*) this;
 535   while (dim_cache_[a].offsets_left_)
 536     {
 537       int l = --me->dim_cache_[a].offsets_left_;
 538       SCM cb = scm_list_ref (dim_cache_[a].offset_callbacks_,  gh_int2scm (l));
 539       SCM retval = gh_call2 (cb, self_scm (), gh_int2scm (a));
 540
 541       Real r =  gh_scm2double (retval);
 542       if (isinf (r) || isnan (r))
 543         {
 544           programming_error (INFINITY_MSG);
 545           r = 0.0;
 546         }
 547       me->dim_cache_[a].offset_ +=r;
 548     }
 549   return dim_cache_[a].offset_;
 550 }
 551
 552
 553 MAKE_SCHEME_CALLBACK(Grob,point_dimension_callback,2);
 554 SCM
 555 Grob::point_dimension_callback (SCM , SCM )
 556 {
 557   return ly_interval2scm ( Interval (0,0));
 558 }
 559
 560 bool
 561 Grob::empty_b (Axis a)const
 562 {
 563   return ! (gh_pair_p (dim_cache_[a].dimension_ ) ||
 564             gh_procedure_p (dim_cache_[a].dimension_ ));
 565 }
 566
 567 /*
 568   TODO: add
 569
 570     Grob *refpoint
 571
 572   to arguments?
 573  */
 574 Interval
 575 Grob::extent (Grob * refp, Axis a) const
 576 {
 577   Real x = relative_coordinate (refp, a);
 578
 579
 580   Dimension_cache * d = (Dimension_cache *)&dim_cache_[a];
 581   Interval ext ;
 582   if (gh_pair_p (d->dimension_))
 583     ;
 584   else if (gh_procedure_p (d->dimension_))
 585     {
 586       /*
 587         FIXME: add doco on types, and should typecheck maybe?
 588        */
 589       d->dimension_= gh_call2 (d->dimension_, self_scm(), gh_int2scm (a));
 590     }
 591   else
 592     return ext;
 593
 594   if (!gh_pair_p (d->dimension_))
 595     return ext;
 596
 597   ext = ly_scm2interval (d->dimension_);
 598
 599   SCM extra = get_grob_property (a == X_AXIS
 600                                 ? "extra-extent-X"
 601                                 : "extra-extent-Y");
 602
 603   /*
 604     signs ?
 605    */
 606   if (gh_pair_p (extra))
 607     {
 608       ext[BIGGER] +=  gh_scm2double (gh_cdr (extra));
 609       ext[SMALLER] +=   gh_scm2double (gh_car (extra));
 610     }
 611
 612   extra = get_grob_property (a == X_AXIS
 613                                 ? "minimum-extent-X"
 614                                 : "minimum-extent-Y");
 615   if (gh_pair_p (extra))
 616     {
 617       ext.unite (Interval (gh_scm2double (gh_car (extra)),
 618                            gh_scm2double (gh_cdr (extra))));
 619     }
 620
 621   ext.translate (x);
 622
 623   return ext;
 624 }
 625
 626
 627 Grob*
 628 Grob::parent_l (Axis a) const
 629 {
 630   return  dim_cache_[a].parent_l_;
 631 }
 632
 633 Grob *
 634 Grob::common_refpoint (Grob const* s, Axis a) const
 635 {
 636   /*
 637     I don't like the quadratic aspect of this code, but I see no other
 638     way. The largest chain of parents might be 10 high or so, so
 639     it shouldn't be a real issue. */
 640   for (Grob const *c = this; c; c = c->dim_cache_[a].parent_l_)
 641     for (Grob const * d = s; d; d = d->dim_cache_[a].parent_l_)
 642       if (d == c)
 643         return (Grob*)d;
 644
 645   return 0;
 646 }
 647
 648
 649 Grob *
 650 Grob::common_refpoint (SCM elist, Axis a) const
 651 {
 652   Grob * common = (Grob*) this;
 653   for (; gh_pair_p (elist); elist = gh_cdr (elist))
 654     {
 655       Grob * s = unsmob_grob (gh_car (elist));
 656       if (s)
 657         common = common->common_refpoint (s, a);
 658     }
 659
 660   return common;
 661 }
 662
 663 String
 664 Grob::name () const
 665 {
 666   SCM meta = get_grob_property ("meta");
 667   SCM nm = scm_assoc (ly_symbol2scm ("name"), meta);
 668   nm =  (gh_pair_p (nm)) ? gh_cdr (nm) : SCM_EOL;
 669   return  gh_string_p (nm) ?ly_scm2string (nm) :  classname (this);
 670 }
 671
 672 void
 673 Grob::add_offset_callback (SCM cb, Axis a)
 674 {
 675   if (!has_offset_callback_b (cb, a))
 676   {
 677     dim_cache_[a].offset_callbacks_ = gh_cons (cb, dim_cache_[a].offset_callbacks_ );
 678     dim_cache_[a].offsets_left_ ++;
 679   }
 680 }
 681
 682 bool
 683 Grob::has_extent_callback_b (SCM cb, Axis a)const
 684 {
 685   return scm_equal_p (cb, dim_cache_[a].dimension_) == SCM_BOOL_T;
 686 }
 687
 688
 689 bool
 690 Grob::has_extent_callback_b (Axis a) const
 691 {
 692   return gh_procedure_p (dim_cache_[a].dimension_);
 693 }
 694
 695 bool
 696 Grob::has_offset_callback_b (SCM cb, Axis a)const
 697 {
 698   return scm_memq (cb, dim_cache_[a].offset_callbacks_) != SCM_BOOL_F;
 699 }
 700
 701 void
 702 Grob::set_extent_callback (SCM dc, Axis a)
 703 {
 704   dim_cache_[a].dimension_ =dc;
 705 }
 706
 707 void
 708 Grob::set_parent (Grob *g, Axis a)
 709 {
 710   dim_cache_[a].parent_l_ = g;
 711 }
 712
 713 MAKE_SCHEME_CALLBACK(Grob,fixup_refpoint,1);
 714 SCM
 715 Grob::fixup_refpoint (SCM smob)
 716 {
 717   Grob *me = unsmob_grob (smob);
 718   for (int a = X_AXIS; a < NO_AXES; a ++)
 719     {
 720       Axis ax = (Axis)a;
 721       Grob * parent = me->parent_l (ax);
 722
 723       if (!parent)
 724         continue;
 725
 726       if (parent->line_l () != me->line_l () && me->line_l ())
 727         {
 728           Grob * newparent = parent->find_broken_piece (me->line_l ());
 729           me->set_parent (newparent, ax);
 730         }
 731
 732       if (Item * i  = dynamic_cast<Item*> (me))
 733         {
 734           Item *parenti = dynamic_cast<Item*> (parent);
 735
 736           if (parenti && i)
 737             {
 738               Direction  my_dir = i->break_status_dir () ;
 739               if (my_dir!= parenti->break_status_dir())
 740                 {
 741                   Item *newparent =  parenti->find_prebroken_piece (my_dir);
 742                   me->set_parent (newparent, ax);
 743                 }
 744             }
 745         }
 746     }
 747   return smob;
 748 }
 749
 750
 751
 752 /****************************************************
 753   SMOB funcs
 754  ****************************************************/
 755
 756
 757 IMPLEMENT_UNSMOB(Grob, grob);
 758 IMPLEMENT_SMOBS(Grob);
 759 IMPLEMENT_DEFAULT_EQUAL_P(Grob);
 760
 761 SCM
 762 Grob::mark_smob (SCM ses)
 763 {
 764   Grob * s = (Grob*) SCM_CELL_WORD_1(ses);
 765   scm_gc_mark (s->immutable_property_alist_);
 766   scm_gc_mark (s->mutable_property_alist_);
 767
 768   for (int a =0 ; a < 2; a++)
 769     {
 770       scm_gc_mark (s->dim_cache_[a].offset_callbacks_);
 771       scm_gc_mark (s->dim_cache_[a].dimension_);
 772     }
 773
 774   if (s->parent_l (Y_AXIS))
 775     scm_gc_mark (s->parent_l (Y_AXIS)->self_scm ());
 776   if (s->parent_l (X_AXIS))
 777     scm_gc_mark (s->parent_l (X_AXIS)->self_scm ());
 778
 779   if (s->original_l_)
 780     scm_gc_mark (s->original_l_->self_scm ());
 781   return s->do_derived_mark ();
 782 }
 783
 784 int
 785 Grob::print_smob (SCM s, SCM port, scm_print_state *)
 786 {
 787   Grob *sc = (Grob *) gh_cdr (s);
 788
 789   scm_puts ("#<Grob ", port);
 790   scm_puts ((char *)sc->name ().ch_C(), port);
 791
 792   /*
 793     don't try to print properties, that is too much hassle.
 794    */
 795   scm_puts (" >", port);
 796   return 1;
 797 }
 798
 799 SCM
 800 Grob::do_derived_mark ()
 801 {
 802   return SCM_EOL;
 803 }
 804
 805
 806 SCM
 807 ly_set_grob_property (SCM elt, SCM sym, SCM val)
 808 {
 809   Grob * sc = unsmob_grob (elt);
 810
 811   if (!gh_symbol_p (sym))
 812     {
 813       error ("Not a symbol");
 814       ly_display_scm (sym);
 815       return SCM_UNSPECIFIED;
 816     }
 817
 818   if (sc)
 819     {
 820       sc->set_grob_property (sym, val);
 821     }
 822   else
 823     {
 824       error ("Not a score element");
 825       ly_display_scm (elt);
 826     }
 827
 828   return SCM_UNSPECIFIED;
 829 }
 830
 831
 832 SCM
 833 ly_get_grob_property (SCM elt, SCM sym)
 834 {
 835   Grob * sc = unsmob_grob (elt);
 836
 837   if (sc)
 838     {
 839       return sc->get_grob_property (sym);
 840     }
 841   else
 842     {
 843       error ("Not a score element");
 844       ly_display_scm (elt);
 845     }
 846   return SCM_UNSPECIFIED;
 847 }
 848
 849
 850 void
 851 Grob::discretionary_processing()
 852 {
 853 }
 854
 855
 856
 857 SCM
 858 spanner_get_bound (SCM slur, SCM dir)
 859 {
 860   return dynamic_cast<Spanner*> (unsmob_grob (slur))->get_bound (to_dir (dir))->self_scm ();
 861 }
 862
 863
 864
 865 static SCM interfaces_sym;
 866 static void
 867 init_functions ()
 868 {
 869   interfaces_sym = scm_permanent_object (ly_symbol2scm ("interfaces"));
 870
 871   scm_make_gsubr ("ly-get-elt-property", 2, 0, 0, (Scheme_function_unknown)ly_get_grob_property);
 872   scm_make_gsubr ("ly-set-elt-property", 3, 0, 0, (Scheme_function_unknown)ly_set_grob_property);
 873   scm_make_gsubr ("ly-get-spanner-bound", 2 , 0, 0, (Scheme_function_unknown) spanner_get_bound);
 874 }
 875
 876 bool
 877 Grob::has_interface (SCM k)
 878 {
 879   SCM ifs = get_grob_property (interfaces_sym);
 880
 881   return scm_memq (k, ifs) != SCM_BOOL_F;
 882 }
 883
 884 void
 885 Grob::set_interface (SCM k)
 886 {
 887   if (has_interface (k))
 888     return ;
 889   else
 890     {
 891       set_grob_property (interfaces_sym,
 892                         gh_cons  (k, get_grob_property (interfaces_sym)));
 893     }
 894 }
 895
 896
 897 ADD_SCM_INIT_FUNC(scoreelt, init_functions);
 898 IMPLEMENT_TYPE_P(Grob, "ly-grob?");