view release on metacpan or  search on metacpan

Perl.xs  view on Meta::CPAN

    if (!SvROK(gradient_sv))
        croak("Gradient is not a reference anymore");
    gav = (AV*) SvRV(gradient_sv);
    if (SvTYPE(gav) != SVt_PVAV)
        croak("Gradient is not an array reference anymore");

    if (av_len(gav)+1 != v)
        croak("Expected force->gradient to return a size %"UVuf
              " list, but got %"UVuf" values", (UV) v, (UV) (av_len(gav)+1));

    while (v) {
        SV **sp, *sv;

        sp = av_fetch(gav, --v, 0);
        if (!sp) croak("Gradient for vertex %"UVuf" is unset", (UV) v);
        sv = *sp;
        SvGETMAGIC(sv);
        if (!SvOK(sv)) 
            croak("Gradient for vertex %"UVuf" is undefined", (UV) v);
        if (!SvROK(sv))
            croak("Gradient for vertex %"UVuf" is not a reference", (UV) v);
        av = (AV*) SvRV(sv);
        if (SvTYPE(av) != SVt_PVAV)
            croak("Gradient for vertex %"UVuf" is not an array reference",
                  (UV) v);
        if (av_len(av)+1 != d)
            croak("Gradient for vertex %"UVuf" is a reference to an array of size %"UVuf", expected %"UVuf, (UV) v, (UV) (av_len(av)+1), (UV) d);
        gradient -= d;
        for (i=0; i<d; i++) {
            sp = av_fetch(av, i, 0);
            if (!sp) croak("Gradient for vertex %"UVuf", coordinate %"UVuf" is unset", (UV) v, (UV) i);
            sv = *sp;
            gradient[i] = (aglo_real) SvNV(sv);
        }
    }
    FREETMPS;
    LEAVE;
    return;
}

MODULE = Graph::Layout::Aesthetic::Force::Perl		PACKAGE = Graph::Layout::Aesthetic::Force::Perl
PROTOTYPES: ENABLE

SV *
new(const char *class)
  PREINIT:
    aglo_force force;
  CODE:
    New(__LINE__, force, 1, struct aglo_force);
    force->aesth_gradient = ae_perl;
    force->aesth_setup	  = ae_setup_perl;
    force->aesth_cleanup  = ae_cleanup_perl;
    force->private_data   = force->user_data = NULL;
    RETVAL = NEWSV(1, 0);
    sv_setref_pv(RETVAL, class, (void*) force);
  OUTPUT:
    RETVAL

void
setup(SV *force, SV *state)
  PPCODE:
    PERL_UNUSED_VAR(force);
    PERL_UNUSED_VAR(state);
    EXTEND(SP, 1);
    PUSHs(&PL_sv_undef);

void
cleanup(SV *force, SV *state, SV *closure)
  PPCODE:
    PERL_UNUSED_VAR(force);
    PERL_UNUSED_VAR(state);
    PERL_UNUSED_VAR(closure);