lily/grob.cc

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