lily/grob-scheme.cc

   1 /*
   2   grob-scheme.cc -- Scheme entry points for the grob datatype
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 1998--2007 Jan Nieuwenhuizen <janneke@gnu.org>
   7   Han-Wen Nienhuys <hanwen@xs4all.nl>
   8 */
   9
  10 #include "warn.hh"              // error()
  11 #include "item.hh"
  12 #include "output-def.hh"
  13 #include "system.hh"
  14 #include "font-interface.hh"
  15 #include "paper-score.hh"
  16 #include "grob-array.hh"
  17
  18 LY_DEFINE (ly_grob_property_data, "ly:grob-property-data",
  19            2, 0, 0, (SCM grob, SCM sym),
  20            "Retrieve @var{sym} for @var{grob} but don't process callbacks.")
  21 {
  22   Grob *sc = unsmob_grob (grob);
  23   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
  24   SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
  25
  26   return sc->get_property_data (sym);
  27 }
  28
  29 LY_DEFINE (ly_grob_set_property_x, "ly:grob-set-property!",
  30            3, 0, 0, (SCM grob, SCM sym, SCM val),
  31            "Set @var{sym} in grob @var{grob} to value @var{val}")
  32 {
  33   Grob *sc = unsmob_grob (grob);
  34   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
  35   SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
  36
  37   if (!ly_is_procedure (val)
  38       && !type_check_assignment (sym, val, ly_symbol2scm ("backend-type?")))
  39     error ("typecheck failed");
  40
  41   sc->set_property (sym, val);
  42   return SCM_UNSPECIFIED;
  43 }
  44
  45 LY_DEFINE (ly_grob_property, "ly:grob-property",
  46            2, 1, 0, (SCM grob, SCM sym, SCM deflt),
  47            "Return the value of a value in grob @var{g} of property @var{sym}. "
  48            "It will return @code{'()} or @var{deflt} (if specified) "
  49            "if  @var{sym} is undefined in @var{g}."
  50            "\n\n")
  51 {
  52   Grob *sc = unsmob_grob (grob);
  53   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
  54   SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
  55   if (deflt == SCM_UNDEFINED)
  56     deflt = SCM_EOL;
  57
  58   SCM retval = sc->internal_get_property (sym);
  59   if (retval == SCM_EOL)
  60     retval = deflt;
  61
  62   return retval;
  63 }
  64
  65
  66 LY_DEFINE (ly_grob_interfaces, "ly:grob-interfaces",
  67            1, 0, 0, (SCM grob),
  68            "Return the interfaces list of grob @var{grob}.")
  69 {
  70   Grob *sc = unsmob_grob (grob);
  71   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
  72
  73   return sc->interfaces ();
  74 }
  75
  76 LY_DEFINE (ly_grob_object, "ly:grob-object",
  77            2, 0, 0, (SCM grob, SCM sym),
  78            "Return the value of a pointer in grob @var{g} of property @var{sym}. "
  79            "It will return @code{' ()} (end-of-list) "
  80            "if  @var{sym} is undefined in @var{g}."
  81            "\n\n")
  82 {
  83   Grob *sc = unsmob_grob (grob);
  84   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
  85   SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
  86
  87   return sc->internal_get_object (sym);
  88 }
  89
  90
  91
  92 /* TODO: make difference between scaled and unscalead variable in
  93    calling (i.e different funcs.) */
  94 LY_DEFINE (ly_grob_layout, "ly:grob-layout",
  95            1, 0, 0, (SCM g),
  96            "Get @code{\\layout} definition from grob @var{g}.")
  97 {
  98   Grob *sc = unsmob_grob (g);
  99   SCM_ASSERT_TYPE (sc, g, SCM_ARG1, __FUNCTION__, "grob");
 100
 101   return sc->layout ()->self_scm ();
 102 }
 103
 104 LY_DEFINE (ly_grob_alist_chain, "ly:grob-alist-chain",
 105            1, 1, 0, (SCM grob, SCM global),
 106            "Get an alist chain for grob @var{grob}, with @var{global} as the "
 107            "global default. If unspecified, @code{font-defaults} "
 108            "from the layout block is taken. ")
 109 {
 110   Grob *sc = unsmob_grob (grob);
 111   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 112
 113   if (global == SCM_UNDEFINED)
 114     {
 115       global = sc->layout ()->lookup_variable (ly_symbol2scm ("font-defaults"));
 116       if (global == SCM_UNDEFINED)
 117         global = SCM_EOL;
 118     }
 119
 120   return sc->get_property_alist_chain (global);
 121 }
 122
 123 LY_DEFINE (ly_get_extent, "ly:grob-extent",
 124            3, 0, 0, (SCM grob, SCM refp, SCM axis),
 125            "Get the extent in @var{axis} direction of @var{grob} relative to "
 126            "the grob @var{refp}")
 127 {
 128   Grob *sc = unsmob_grob (grob);
 129   Grob *ref = unsmob_grob (refp);
 130
 131   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 132   SCM_ASSERT_TYPE (ref, refp, SCM_ARG2, __FUNCTION__, "grob");
 133   SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG3, __FUNCTION__, "axis");
 134
 135   Axis a = Axis (scm_to_int (axis));
 136
 137
 138   if (ref->common_refpoint (sc, a) != ref)
 139     {
 140       // ugh. should use other error message
 141       SCM_ASSERT_TYPE (false, refp, SCM_ARG2, __FUNCTION__, "common refpoint");
 142     }
 143   return ly_interval2scm (sc->extent (ref, a));
 144 }
 145
 146 LY_DEFINE (ly_grob_robust_relative_extent, "ly:grob-robust-relative-extent",
 147            3, 0, 0, (SCM grob, SCM refp, SCM axis),
 148            "Get the extent in @var{axis} direction of @var{grob} relative to "
 149            "the grob @var{refp}, or (0,0) if empty")
 150 {
 151   Grob *sc = unsmob_grob (grob);
 152   Grob *ref = unsmob_grob (refp);
 153
 154   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 155   SCM_ASSERT_TYPE (ref, refp, SCM_ARG2, __FUNCTION__, "grob");
 156   SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG3, __FUNCTION__, "axis");
 157
 158   Axis a = Axis (scm_to_int (axis));
 159
 160   if (ref->common_refpoint (sc, a) != ref)
 161     {
 162       // ugh. should use other error message
 163       SCM_ASSERT_TYPE (false, refp, SCM_ARG2, __FUNCTION__, "common refpoint");
 164     }
 165
 166   return ly_interval2scm (robust_relative_extent (sc, ref, a));
 167 }
 168
 169 LY_DEFINE (ly_grob_relative_coordinate, "ly:grob-relative-coordinate",
 170            3, 0, 0, (SCM grob, SCM refp, SCM axis),
 171            "Get the coordinate in @var{axis} direction of @var{grob} relative to "
 172            "the grob @var{refp}")
 173 {
 174   Grob *sc = unsmob_grob (grob);
 175   Grob *ref = unsmob_grob (refp);
 176
 177   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 178   SCM_ASSERT_TYPE (ref, refp, SCM_ARG2, __FUNCTION__, "grob");
 179   SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG3, __FUNCTION__, "axis");
 180
 181   Axis a = Axis (scm_to_int (axis));
 182
 183
 184   if (ref->common_refpoint (sc, a) != ref)
 185     {
 186       // ugh. should use other error message
 187       SCM_ASSERT_TYPE (false, refp, SCM_ARG2, __FUNCTION__, "common refpoint");
 188     }
 189
 190   return scm_from_double (sc->relative_coordinate (ref,a));
 191 }
 192
 193
 194 LY_DEFINE (ly_grob_parent, "ly:grob-parent",
 195            2, 0, 0, (SCM grob, SCM axis),
 196            "Get the parent of @var{grob}.  @var{axis} is 0 for the X-axis, "
 197            "1 for the Y-axis.")
 198 {
 199   Grob *sc = unsmob_grob (grob);
 200   SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 201   SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG2, __FUNCTION__, "axis");
 202
 203   Grob *par = sc->get_parent (Axis (scm_to_int (axis)));
 204   return par ? par->self_scm () : SCM_EOL;
 205 }
 206
 207 LY_DEFINE (ly_grob_properties, "ly:grob-properties",
 208            1, 0, 0, (SCM grob),
 209            "Get the mutable proprerties of @var{grob}.")
 210 {
 211   Grob *g = unsmob_grob (grob);
 212   SCM_ASSERT_TYPE (g, grob, SCM_ARG1, __FUNCTION__, "grob");
 213
 214   /* FIXME: uhg? copy/read only? */
 215   return g->mutable_property_alist_;
 216 }
 217
 218 LY_DEFINE (ly_grob_basic_properties, "ly:grob-basic-properties",
 219            1, 0, 0, (SCM grob),
 220            "Get the immutable properties of @var{grob}.")
 221 {
 222   Grob *g = unsmob_grob (grob);
 223   SCM_ASSERT_TYPE (g, grob, SCM_ARG1, __FUNCTION__, "grob");
 224
 225   /* FIXME: uhg? copy/read only? */
 226   return g->immutable_property_alist_;
 227 }
 228
 229 LY_DEFINE (ly_grob_system, "ly:grob-system",
 230            1, 0, 0, (SCM g),
 231            "Return the System Grob of @var{g}.")
 232 {
 233   Grob *me = unsmob_grob (g);
 234   SCM_ASSERT_TYPE (me, g, SCM_ARG1, __FUNCTION__, "grob");
 235
 236   if (System *g = me->get_system ())
 237     return g->self_scm ();
 238
 239   return SCM_EOL;
 240 }
 241
 242 LY_DEFINE (ly_grob_original, "ly:grob-original",
 243            1, 0, 0, (SCM grob),
 244            "Return the unbroken original Grob of @var{grob}.")
 245 {
 246   Grob *me = unsmob_grob (grob);
 247   SCM_ASSERT_TYPE (me, grob, SCM_ARG1, __FUNCTION__, "grob");
 248   return me->original () ? me->original ()->self_scm () : me->self_scm ();
 249 }
 250
 251
 252 LY_DEFINE (ly_grob_suicide_x, "ly:grob-suicide!",
 253            1, 0, 0, (SCM g),
 254            "Kill @var{g}.")
 255 {
 256   Grob *me = unsmob_grob (g);
 257   SCM_ASSERT_TYPE (me, g, SCM_ARG1, __FUNCTION__, "grob");
 258
 259   me->suicide ();
 260   return SCM_UNSPECIFIED;
 261 }
 262
 263 LY_DEFINE (ly_grob_translate_axis_x, "ly:grob-translate-axis!",
 264            3, 0, 0, (SCM g, SCM d, SCM a),
 265            "Translate @var{g} on axis @var{a} over distance @var{d}.")
 266 {
 267   Grob *me = unsmob_grob (g);
 268   SCM_ASSERT_TYPE (me, g, SCM_ARG1, __FUNCTION__, "grob");
 269   SCM_ASSERT_TYPE (scm_is_number (d), d, SCM_ARG2, __FUNCTION__, "dimension");
 270   SCM_ASSERT_TYPE (is_axis (a), a, SCM_ARG3, __FUNCTION__, "axis");
 271
 272   me->translate_axis (scm_to_double (d), Axis (scm_to_int (a)));
 273   return SCM_UNSPECIFIED;
 274 }
 275
 276 LY_DEFINE (ly_grob_default_font, "ly:grob-default-font",
 277            1, 0, 0, (SCM grob),
 278            "Return the default font for grob @var{gr}.")
 279 {
 280   Grob *gr = unsmob_grob (grob);
 281   SCM_ASSERT_TYPE (gr, grob, SCM_ARG1, __FUNCTION__, "grob");
 282
 283   return Font_interface::get_default_font (gr)->self_scm ();
 284 }
 285
 286
 287 /*
 288   TODO: consider swapping order, so we can do
 289
 290   (grob-common-refpoint a b c d e)
 291  */
 292 LY_DEFINE (ly_grob_common_refpoint, "ly:grob-common-refpoint",
 293            3, 0, 0,  (SCM grob, SCM other, SCM axis),
 294            "Find the common refpoint of @var{grob} and @var{other} for @var{axis}."
 295            )
 296 {
 297
 298   Grob *gr = unsmob_grob (grob);
 299   SCM_ASSERT_TYPE (gr, grob, SCM_ARG1, __FUNCTION__, "grob");
 300
 301   Grob *o = unsmob_grob (other);
 302   SCM_ASSERT_TYPE (o, other, SCM_ARG2, __FUNCTION__, "grob");
 303
 304   SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG3, __FUNCTION__, "axis");
 305
 306   Grob *refp = gr->common_refpoint (o,  Axis (scm_to_int (axis)));
 307   return refp ? refp->self_scm () : SCM_BOOL_F;
 308 }
 309
 310 LY_DEFINE (ly_grob_common_refpoint_of_array, "ly:grob-common-refpoint-of-array",
 311            3, 0, 0,  (SCM grob, SCM others, SCM axis),
 312            "Find the common refpoint of @var{grob} and @var{others} "
 313            "(a grob-array) for @var{axis}."
 314            )
 315 {
 316   Grob *gr = unsmob_grob (grob);
 317   SCM_ASSERT_TYPE (gr, grob, SCM_ARG1, __FUNCTION__, "grob");
 318
 319   Grob_array *ga = unsmob_grob_array (others);
 320   SCM_ASSERT_TYPE (ga, others, SCM_ARG2, __FUNCTION__, "grob array");
 321   SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG3, __FUNCTION__, "axis");
 322
 323   Grob *refp = common_refpoint_of_array (ga->array (), gr, Axis (scm_to_int (axis)));
 324   return refp ? refp->self_scm () : SCM_BOOL_F;
 325 }