#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;
int count;
SV *f, *s;
IV tmp;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
EXTEND(SP, 2);
PUSHs(sv_2mortal(newRV(force_sv)));
PUSHs(s = sv_2mortal(newRV(state_sv)));
PUTBACK;
if (!sv_derived_from(s, "Graph::Layout::Aesthetic"))
croak("State_sv is not of type Graph::Layout::Aesthetic");
tmp = SvIV(state_sv);
if (state != INT2PTR(aglo_state, tmp))
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);
SPAGAIN;
if (count != 1) croak("Forced scalar context call succeeded in returning %d values. This is impossible", count);
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) {
int count;
SV *f = PRIVATE->force_sv;
SV *s = PRIVATE->state_sv;
SV *c = PRIVATE->closure;
Safefree(private);
dSP;
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_DISCARD | G_VOID);
FREETMPS;
LEAVE;
if (count) croak("Forced void context call succeeded in returning %d values. This is impossible", count);
return;
}
define_aesth(perl) {
int 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));
av_extend(av, d-1);
for (i=0; i<d; i++) av_push(av, newSVnv(*gradient++));
}
PUSHMARK(SP);
EXTEND(SP, 4);
PUSHs(PRIVATE->force_sv);
PUSHs(PRIVATE->state_sv);
PUSHs(gradient_sv);
PUSHs(PRIVATE->closure);
PUTBACK;
count = call_method("gradient", G_DISCARD | G_VOID);
if (count) croak("Forced void context call succeeded in returning %d values. This is impossible", count);
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;
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:
EXTEND(SP, 1);
PUSHs(&PL_sv_undef);
void
cleanup(SV *force, SV *state, SV *closure)
PPCODE: