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