[Quest API] Use binding library for perl apis (#2216)

* Add perlbind library

* Convert perl apis to perlbind
This commit is contained in:
hg
2022-07-03 22:33:45 -04:00
committed by GitHub
parent 2829d21057
commit 7e8a24fcec
50 changed files with 14324 additions and 31962 deletions
+17 -88
View File
@@ -4,104 +4,33 @@
#ifdef EMBPERL_XS_CLASSES
#include "../common/global_define.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "../common/linked_list.h"
#include "embperl.h"
#include "hate_list.h"
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
#define VALIDATE_THIS_IS_HATE \
do { \
if (sv_derived_from(ST(0), "HateEntry")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(struct_HateList*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type HateEntry"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
XS(XS_HateEntry_GetEnt); /* prototype to pass -Wmissing-prototypes */
XS(XS_HateEntry_GetEnt) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: HateEntry::GetEnt(THIS)"); // @categories Script Utility, Hate and Aggro
{
struct_HateList *THIS;
Mob *RETVAL;
VALIDATE_THIS_IS_HATE;
RETVAL = THIS->entity_on_hatelist;
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "Mob", (void *) RETVAL);
}
XSRETURN(1);
Mob* Perl_HateEntry_GetEnt(struct_HateList* self) // @categories Script Utility, Hate and Aggro
{
return self->entity_on_hatelist;
}
XS(XS_HateEntry_GetHate); /* prototype to pass -Wmissing-prototypes */
XS(XS_HateEntry_GetHate) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: HateEntry::GetHate(THIS)"); // @categories Script Utility, Hate and Aggro
{
struct_HateList *THIS;
int64 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_HATE;
RETVAL = THIS->stored_hate_amount;
XSprePUSH;
PUSHi((IV) RETVAL);
}
XSRETURN(1);
int64_t Perl_HateEntry_GetHate(struct_HateList* self) // @categories Script Utility, Hate and Aggro
{
return self->stored_hate_amount;
}
XS(XS_HateEntry_GetDamage); /* prototype to pass -Wmissing-prototypes */
XS(XS_HateEntry_GetDamage) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: HateEntry::GetDamage(THIS)"); // @categories Script Utility, Hate and Aggro
{
struct_HateList *THIS;
int64 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_HATE;
RETVAL = THIS->hatelist_damage;
XSprePUSH;
PUSHi((IV) RETVAL);
}
XSRETURN(1);
int64_t Perl_HateEntry_GetDamage(struct_HateList* self) // @categories Script Utility, Hate and Aggro
{
return self->hatelist_damage;
}
#ifdef __cplusplus
extern "C"
#endif
void perl_register_hateentry()
{
perl::interpreter perl(PERL_GET_THX);
XS(boot_HateEntry);
XS(boot_HateEntry) {
dXSARGS;
char file[256];
strncpy(file, __FILE__, 256);
file[255] = 0;
if (items != 1)
fprintf(stderr, "boot_quest does not take any arguments.");
char buf[128];
//add the strcpy stuff to get rid of const warnings....
XS_VERSION_BOOTCHECK;
newXSproto(strcpy(buf, "GetDamage"), XS_HateEntry_GetDamage, file, "$");
newXSproto(strcpy(buf, "GetEnt"), XS_HateEntry_GetEnt, file, "$");
newXSproto(strcpy(buf, "GetHate"), XS_HateEntry_GetHate, file, "$");
XSRETURN_YES;
auto package = perl.new_class<struct_HateList>("HateEntry");
package.add("GetDamage", &Perl_HateEntry_GetDamage);
package.add("GetEnt", &Perl_HateEntry_GetEnt);
package.add("GetHate", &Perl_HateEntry_GetHate);
}
#endif //EMBPERL_XS_CLASSES