… | |
… | |
43 | extern sint64 *levels; // the experience table |
43 | extern sint64 *levels; // the experience table |
44 | |
44 | |
45 | typedef object object_ornull; |
45 | typedef object object_ornull; |
46 | typedef maptile maptile_ornull; |
46 | typedef maptile maptile_ornull; |
47 | |
47 | |
|
|
48 | #if IVSIZE >= 8 |
|
|
49 | typedef IV val64; |
|
|
50 | # define newSVval64 newSViv |
|
|
51 | # define SvVAL64 SvIV |
|
|
52 | #else |
48 | typedef double val64; |
53 | typedef double val64; |
49 | #define newSVval64 newSVnv |
54 | # define newSVval64 newSVnv |
50 | #define SvVAL64 SvNV |
55 | # define SvVAL64 SvNV |
|
|
56 | #endif |
51 | |
57 | |
52 | static f_plug_api gethook = cfapi_get_hooks; |
58 | static f_plug_api gethook = cfapi_get_hooks; |
53 | static f_plug_api object_set_property = cfapi_object_set_property; |
59 | static f_plug_api object_set_property = cfapi_object_set_property; |
54 | static f_plug_api object_insert = cfapi_object_insert; |
60 | static f_plug_api object_insert = cfapi_object_insert; |
55 | |
61 | |
56 | static HV *obj_cache; |
|
|
57 | static PerlInterpreter *perl; |
62 | static PerlInterpreter *perl; |
58 | |
63 | |
59 | static AV *cb_global, *cb_object, *cb_player, *cb_type, *cb_map; |
64 | static AV *cb_global, *cb_object, *cb_player, *cb_type, *cb_map; |
60 | |
65 | |
61 | ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
66 | ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
… | |
… | |
81 | |
86 | |
82 | if (!obj->self) |
87 | if (!obj->self) |
83 | obj->self = newSVptr (obj, klass); |
88 | obj->self = newSVptr (obj, klass); |
84 | |
89 | |
85 | return newSVsv (obj->self); |
90 | return newSVsv (obj->self); |
86 | } |
|
|
87 | |
|
|
88 | static void |
|
|
89 | SVptr_cache_set (void *ptr, SV *sv) |
|
|
90 | { |
|
|
91 | hv_store (obj_cache, (char *)&ptr, sizeof (ptr), sv, 0); |
|
|
92 | } |
|
|
93 | |
|
|
94 | static SV * |
|
|
95 | SVptr_cache_get (void *ptr) |
|
|
96 | { |
|
|
97 | SV **he = hv_fetch (obj_cache, (char *)&ptr, sizeof (ptr), 0); |
|
|
98 | |
|
|
99 | return he ? *he : 0; |
|
|
100 | } |
|
|
101 | |
|
|
102 | static SV * |
|
|
103 | newSVptr_cached (void *ptr, const char *klass) |
|
|
104 | { |
|
|
105 | SV *sv; |
|
|
106 | |
|
|
107 | if (!ptr) |
|
|
108 | return &PL_sv_undef; |
|
|
109 | |
|
|
110 | sv = SVptr_cache_get (ptr); |
|
|
111 | |
|
|
112 | if (!sv) |
|
|
113 | { |
|
|
114 | HV *hv = newHV (); |
|
|
115 | sv_magic ((SV *)hv, 0, PERL_MAGIC_ext, (char *)ptr, 0); |
|
|
116 | sv = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); |
|
|
117 | |
|
|
118 | SVptr_cache_set (ptr, sv); |
|
|
119 | } |
|
|
120 | |
|
|
121 | return newSVsv (sv); |
|
|
122 | } |
91 | } |
123 | |
92 | |
124 | static void |
93 | static void |
125 | clearSVptr (SV *sv) |
94 | clearSVptr (SV *sv) |
126 | { |
95 | { |
… | |
… | |
182 | |
151 | |
183 | //TODO: |
152 | //TODO: |
184 | inline SV *to_sv (New_Face * v) { return to_sv (v->name); } |
153 | inline SV *to_sv (New_Face * v) { return to_sv (v->name); } |
185 | inline SV *to_sv (treasurelist * v) { return to_sv (v->name); } |
154 | inline SV *to_sv (treasurelist * v) { return to_sv (v->name); } |
186 | |
155 | |
187 | inline SV *to_sv (UUID v) { |
156 | inline SV *to_sv (UUID v) |
|
|
157 | { |
188 | char buf[128]; |
158 | char buf[128]; |
189 | snprintf (buf, 128, "<1,%llx>", (unsigned long long)v.seq + UUID_SKIP * 2); |
159 | snprintf (buf, 128, "<1,%" PRIx64 ">", v.seq); |
190 | return newSVpv (buf, 0); |
160 | return newSVpv (buf, 0); |
191 | } |
161 | } |
192 | |
162 | |
193 | inline void sv_to (SV *sv, shstr &v) { v = SvOK (sv) ? SvPV_nolen (sv) : 0; } |
163 | inline void sv_to (SV *sv, shstr &v) { v = SvOK (sv) ? SvPV_nolen (sv) : 0; } |
194 | inline void sv_to (SV *sv, char * &v) { free (v); v = SvOK (sv) ? strdup (SvPV_nolen (sv)) : 0; } //TODO: verify that all simple pointers are strdup-managed |
164 | inline void sv_to (SV *sv, char * &v) { free (v); v = SvOK (sv) ? strdup (SvPV_nolen (sv)) : 0; } //TODO: verify that all simple pointers are strdup-managed |
… | |
… | |
220 | inline void sv_to (SV *sv, refptr<T> &v) { T *tmp; sv_to (sv, tmp); v = tmp; } |
190 | inline void sv_to (SV *sv, refptr<T> &v) { T *tmp; sv_to (sv, tmp); v = tmp; } |
221 | |
191 | |
222 | template<int N> |
192 | template<int N> |
223 | inline void sv_to (SV *sv, char (&v)[N]) { assign (v, SvPV_nolen (sv)); } |
193 | inline void sv_to (SV *sv, char (&v)[N]) { assign (v, SvPV_nolen (sv)); } |
224 | |
194 | |
225 | inline void sv_to (SV *sv, UUID &v) { |
195 | inline void sv_to (SV *sv, UUID &v) |
226 | char *sv_str = SvOK (sv) ? SvPV_nolen (sv) : 0; |
196 | { |
227 | unsigned int version = 0; |
197 | unsigned int version; |
228 | unsigned long long seq = 0; |
|
|
229 | |
198 | |
230 | if (!sv_str) |
199 | if (2 != sscanf (SvPV_nolen (sv), "<%d.%" SCNx64 ">", &version, &v.seq) || 1 != version) |
231 | return; |
200 | croak ("unparsable uuid: %s", SvPV_nolen (sv)); |
232 | |
|
|
233 | if (2 == sscanf (sv_str, "<%d.%llx>", &version, &seq) && version == 1) |
|
|
234 | { |
|
|
235 | v.seq = seq; |
|
|
236 | } |
|
|
237 | |
|
|
238 | return; |
|
|
239 | } |
201 | } |
240 | |
202 | |
241 | static SV * |
203 | static SV * |
242 | newSVdt_va (va_list &ap, data_type type) |
204 | newSVdt_va (va_list &ap, data_type type) |
243 | { |
205 | { |
… | |
… | |
922 | if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl)) |
884 | if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl)) |
923 | { |
885 | { |
924 | printf ("unable to initialize perl-interpreter, aborting.\n"); |
886 | printf ("unable to initialize perl-interpreter, aborting.\n"); |
925 | exit (EXIT_FAILURE); |
887 | exit (EXIT_FAILURE); |
926 | } |
888 | } |
927 | |
|
|
928 | obj_cache = newHV (); |
|
|
929 | } |
889 | } |
930 | |
890 | |
931 | void cfperl_main () |
891 | void cfperl_main () |
932 | { |
892 | { |
933 | dSP; |
893 | dSP; |
… | |
… | |
2356 | case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break; |
2316 | case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break; |
2357 | } |
2317 | } |
2358 | OUTPUT: |
2318 | OUTPUT: |
2359 | RETVAL |
2319 | RETVAL |
2360 | |
2320 | |
|
|
2321 | void fix_walls (maptile *map, int x, int y) |
|
|
2322 | |
|
|
2323 | void fix_walls_around (maptile *map, int x, int y) |
2361 | |
2324 | |
2362 | MODULE = cf PACKAGE = cf::arch |
2325 | MODULE = cf PACKAGE = cf::arch |
2363 | |
2326 | |
2364 | archetype *find (const char *name) |
2327 | archetype *find (const char *name) |
2365 | CODE: |
2328 | CODE: |