#ifdef __cplusplus
extern "C" {
#endif

#define MIN_PERL_DEFINE 1

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#ifdef __cplusplus
}
#endif

/* Is time() portable everywhere?  Hope so!  XXX */

static double fallback_NVtime()
{ return time(0); }

static void fallback_U2time(U32 *ret)
{
  ret[0]=time(0);
  ret[1]=0;
}

/*-----------------*/

static int    Installed=0;
static double (*realNVtime)();
static void   (*realU2time)(U32 *);

static double Lost;    /** time relative to now */
static double Zero;    /** apply Scale from when? */
static double Scale;   /** speed of time (.5 == half speed) */

static void reset_warp()
{
    Lost=0;
    Zero=(*realNVtime)();
    Scale=1;
}

/*-----------------*/

static double warped_NVtime()
{
    double now = (*realNVtime)() - Lost;
    double delta = now - Zero;
    delta *= Scale;
    return Zero + delta;
}

static void warped_U2time(U32 *ret)
{
    /* performance doesn't matter enough for a native
       non-float implementation */
    double now = warped_NVtime();
    U32 unow = now;
    ret[0] = unow;
    ret[1] = (now - unow) * 1000000;
}

MODULE = Time::Warp            PACKAGE = Time::Warp

PROTOTYPES: ENABLE

void
install_time_api()
	CODE:
{
    SV **svp;
    if (Installed) {
	warn("Time::Warp::install_time_api() called more than once");
	return;
    }
    Installed=1;
    svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0);
    if (!svp) {
	warn("Time::Warp: Time::HiRes is not loaded --\n\tat best 1s time accuracy is available");
	hv_store(PL_modglobal, "Time::NVtime", 12,
		 newSViv((IV) fallback_NVtime), 0);
	hv_store(PL_modglobal, "Time::U2time", 12,
		 newSViv((IV) fallback_U2time), 0);
    }
    svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0);
    if (!SvIOK(*svp)) croak("Time::NVtime isn't a function pointer");
    realNVtime = (double(*)()) SvIV(*svp);
    svp = hv_fetch(PL_modglobal, "Time::U2time", 12, 0);
    if (!SvIOK(*svp)) croak("Time::U2time isn't a function pointer");
    realU2time = (void(*)(U32*)) SvIV(*svp);
    hv_store(PL_modglobal, "Time::NVtime", 12,
	     newSViv((IV) warped_NVtime), 0);
    hv_store(PL_modglobal, "Time::U2time", 12,
	     newSViv((IV) warped_U2time), 0);

    reset_warp();
}

void
reset()
	CODE:
	reset_warp();

void
to(when)
     double when
     CODE:
{
    Lost += (warped_NVtime() - when) / Scale;
}

void
scale(...)
     PPCODE:
{
    if (items == 0) {
	XPUSHs(sv_2mortal(newSVnv(Scale)));
    } else {
	Zero = warped_NVtime();
	Lost = 0;
	Scale = SvNV(ST(0));
	if (Scale < 0) {
	    warn("Sorry, Time::Warp cannot go backwards");
	    Scale = 1;
	}
	else if (Scale < .001) {
	    warn("Sorry, Time::Warp cannot stop time");
	    Scale = .001;
	}
    }
}

void
time()
     PPCODE:
{
    XPUSHs(sv_2mortal(newSVnv(warped_NVtime())));
}