view release on metacpan or  search on metacpan

Perl.xs  view on Meta::CPAN

#define PERL_NO_GET_CONTEXT	/* we want efficiency */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

/* perl force */

#include "aesth.h"

typedef struct private {
    SV *state_sv;
    SV *force_sv;
    SV *closure;
} *private;

declare_aesth(perl);

define_setup(perl) {
    private private;
    I32 count;
    SV *s;
    aglo_state tmp;
    dSP;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(sv_2mortal(newRV(force_sv)));
    PUSHs(s = sv_2mortal(newRV(state_sv)));
    PUTBACK;

    tmp = C_CHECK(state_sv, "Graph::Layout::Aesthetic", "state_sv");
    if (tmp != state) croak("state is not the struct referred by state_sv");

    /* We don't check the class of force_sv. If the user wants to do evil
       things, let him */

    /* Temporarily increase refcounts on things we need later just in case
       the "setup" method destroys their last reference */
    sv_2mortal(SvREFCNT_inc(state_sv));
    sv_2mortal(SvREFCNT_inc(force_sv));
    count = call_method("setup", G_SCALAR);
    if (count != 1) croak("Forced scalar context call succeeded in returning %d values. This is impossible", (int) count);

    SPAGAIN;

    Newc(__LINE__, private, sizeof(struct private) + (2*state->dimensions-1) * sizeof(aglo_real), char, struct private);
    private->closure  = SvREFCNT_inc(POPs);
    private->state_sv = newRV(state_sv);
    /* private->state_sv is effectively a self-reference */
    sv_rvweaken(private->state_sv);
    private->force_sv = newRV(force_sv);
    PUTBACK;
    FREETMPS;
    LEAVE;
    return private;
}

define_cleanup(perl) {
    I32 count;
    SV *f = PRIVATE->force_sv;
    SV *s = PRIVATE->state_sv;
    SV *c = PRIVATE->closure;

    dSP;

    Safefree(private);

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    EXTEND(SP, 3);
    PUSHs(sv_2mortal(f));
    PUSHs(sv_2mortal(s));
    PUSHs(sv_2mortal(c));
    PUTBACK;

    count = call_method("cleanup", G_VOID);
    if (count) {
        if (count < 0) croak("Forced void context call of 'cleanup' succeeded in returning %d values. This is impossible", (int) count);
        SPAGAIN;
        SP -= count;
        PUTBACK;
    }

    FREETMPS;
    LEAVE;
    return;
}

define_aesth(perl) {
    I32 count;
    aglo_vertex j, v;
    aglo_unsigned i, d;
    AV *gav, *av;
    SV *gradient_sv;
    dSP;

    ENTER;
    SAVETMPS;

    gav = newAV();
    gradient_sv = sv_2mortal(newRV_noinc((SV *) gav));
    
    d = state->dimensions;
    v = state->graph->vertices;
    av_extend(gav, v-1);
    for (j=0; j<v; j++) {
        av = newAV();
        av_push(gav, newRV_noinc((SV *) av));