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