1 #ifdef __cplusplus
2 extern "C" {
3 #endif
4
5 #define MIN_PERL_DEFINE 1
6
7 #include "EXTERN.h"
8 #include "perl.h"
9 #include "XSUB.h"
10
11 #ifdef __cplusplus
12 }
13 #endif
14
15 /* Is time() portable everywhere? Hope so! XXX */
16
fallback_NVtime()17 static NV fallback_NVtime()
18 { return time(0); }
19
fallback_U2time(U32 * ret)20 static void fallback_U2time(U32 *ret)
21 {
22 ret[0]=time(0);
23 ret[1]=0;
24 }
25
26 /*-----------------*/
27
28 static int Installed=0;
29 static NV (*realNVtime)();
30 static void (*realU2time)(U32 *);
31
32 static double Lost; /** time relative to now */
33 static double Zero; /** apply Scale from when? */
34 static double Scale; /** speed of time (.5 == half speed) */
35
reset_warp()36 static void reset_warp()
37 {
38 Lost=0;
39 Zero=(*realNVtime)();
40 Scale=1;
41 }
42
43 /*-----------------*/
44
warped_NVtime()45 static NV warped_NVtime()
46 {
47 double now = (*realNVtime)() - Lost;
48 double delta = now - Zero;
49 delta *= Scale;
50 return Zero + delta;
51 }
52
warped_U2time(U32 * ret)53 static void warped_U2time(U32 *ret)
54 {
55 /* performance doesn't matter enough for a native
56 non-float implementation */
57 double now = warped_NVtime();
58 U32 unow = now;
59 ret[0] = unow;
60 ret[1] = (now - unow) * 1000000;
61 }
62
63 MODULE = Time::Warp PACKAGE = Time::Warp
64
65 PROTOTYPES: ENABLE
66
67 void
install_time_api()68 install_time_api()
69 CODE:
70 {
71 SV **svp;
72 if (Installed) {
73 warn("Time::Warp::install_time_api() called more than once");
74 return;
75 }
76 Installed=1;
77 svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0);
78 if (!svp) {
79 warn("Time::Warp: Time::HiRes is not loaded --\n\tat best 1s time accuracy is available");
80 hv_store(PL_modglobal, "Time::NVtime", 12,
81 newSViv((IV) fallback_NVtime), 0);
82 hv_store(PL_modglobal, "Time::U2time", 12,
83 newSViv((IV) fallback_U2time), 0);
84 }
85 svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0);
86 if (!SvIOK(*svp)) croak("Time::NVtime isn't a function pointer");
87 realNVtime = (NV(*)()) SvIV(*svp);
88 svp = hv_fetch(PL_modglobal, "Time::U2time", 12, 0);
89 if (!SvIOK(*svp)) croak("Time::U2time isn't a function pointer");
90 realU2time = (void(*)(U32*)) SvIV(*svp);
91 hv_store(PL_modglobal, "Time::NVtime", 12,
92 newSViv((IV) warped_NVtime), 0);
93 hv_store(PL_modglobal, "Time::U2time", 12,
94 newSViv((IV) warped_U2time), 0);
95
96 reset_warp();
97 }
98
99 void
100 reset()
101 CODE:
102 reset_warp();
103
104 void
to(when)105 to(when)
106 double when
107 CODE:
108 {
109 Lost += (warped_NVtime() - when) / Scale;
110 }
111
112 void
scale(...)113 scale(...)
114 PPCODE:
115 {
116 if (items == 0) {
117 XPUSHs(sv_2mortal(newSVnv(Scale)));
118 } else {
119 Zero = warped_NVtime();
120 Lost = 0;
121 Scale = SvNV(ST(0));
122 if (Scale < 0) {
123 warn("Sorry, Time::Warp cannot go backwards");
124 Scale = 1;
125 }
126 else if (Scale < .001) {
127 warn("Sorry, Time::Warp cannot stop time");
128 Scale = .001;
129 }
130 }
131 }
132
133 void
time()134 time()
135 PPCODE:
136 {
137 XPUSHs(sv_2mortal(newSVnv(warped_NVtime())));
138 }
139