pa/eqemu-server
2
0
Fork 0
mirror of https://github.com/EQEmu/Server.git synced 2025-12-13 10:31:29 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Convert perl apis to perlbind

Browse Source
This commit is contained in:
hg 2022-04-28 21:07:29 -04:00
parent a2c6252c58
commit 4a66c3918a
22 changed files with 12094 additions and 31949 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
zone/embparser.cpp
View File

@ -33,6 +33,31 @@
extern Zone *zone;
#ifdef EMBPERL_XS
void perl_register_quest();
#ifdef EMBPERL_XS_CLASSES
void perl_register_mob();
void perl_register_npc();
void perl_register_client();
void perl_register_corpse();
void perl_register_entitylist();
void perl_register_perlpacket();
void perl_register_group();
void perl_register_raid();
void perl_register_inventory();
void perl_register_questitem();
void perl_register_spell();
void perl_register_hateentry();
void perl_register_object();
void perl_register_doors();
void perl_register_expedition();
void perl_register_expedition_lock_messages();
#ifdef BOTS
void perl_register_bot();
#endif // BOTS
#endif // EMBPERL_XS_CLASSES
#endif // EMBPERL_XS
const char *QuestEventSubroutines[_LargestEventID] = {
"EVENT_SAY",
"EVENT_ITEM",
@ -804,7 +829,7 @@ int PerlembParser::SendCommands(
perl->eval(cmd.c_str());
#ifdef EMBPERL_XS_CLASSES
dTHX;
{
std::string cl = (std::string) "$" + (std::string) pkgprefix + (std::string) "::client";
std::string np = (std::string) "$" + (std::string) pkgprefix + (std::string) "::npc";
@ -946,76 +971,31 @@ int PerlembParser::SendCommands(
void PerlembParser::MapFunctions()
{
dTHX;
_empty_sv = newSV(0);
perl->eval(
"{"
"package quest;"
"&boot_quest;" //load our quest XS
#ifdef EMBPERL_XS_CLASSES
"package Mob;"
"&boot_Mob;" //load our Mob XS
"package Client;"
"our @ISA = qw(Mob);" //client inherits mob.
"&boot_Mob;" //load our Mob XS
"&boot_Client;" //load our Client XS
"package NPC;"
"our @ISA = qw(Mob);" //NPC inherits mob.
"&boot_Mob;" //load our Mob XS
"&boot_NPC;" //load our NPC XS
"package Corpse;"
"our @ISA = qw(Mob);" //Corpse inherits mob.
"&boot_Mob;" //load our Mob XS
"&boot_Corpse;" //load our Mob XS
"package EntityList;"
"&boot_EntityList;" //load our EntityList XS
"package PerlPacket;"
"&boot_PerlPacket;" //load our PerlPacket XS
"package Group;"
"&boot_Group;" //load our Group XS
"package Raid;"
"&boot_Raid;" //load our Raid XS
"package Inventory;"
"&boot_Inventory;" // load inventory XS
"package QuestItem;"
"&boot_QuestItem;" // load quest Item XS
"package Spell;"
"&boot_Spell;" // load quest Spell XS
"package HateEntry;"
"&boot_HateEntry;" // load quest Hate XS
"package Object;"
"&boot_Object;" // load quest Object XS
"package Doors;"
"&boot_Doors;" // load quest Doors XS
"package Expedition;"
"&boot_Expedition;"
perl_register_quest();
#ifdef EMBPERL_XS_CLASSES
perl_register_mob();
perl_register_npc();
perl_register_client();
perl_register_corpse();
perl_register_entitylist();
perl_register_perlpacket();
perl_register_group();
perl_register_raid();
perl_register_inventory();
perl_register_questitem();
perl_register_spell();
perl_register_hateentry();
perl_register_object();
perl_register_doors();
perl_register_expedition();
perl_register_expedition_lock_messages();
#ifdef BOTS
"package Bot;"
"our @ISA = qw(NPC);" // Bot inherits NPC
"&boot_Mob;" // load our Mob XS
"&boot_NPC;" // load our NPC XS
"&boot_Bot;" // load our Bot XS
#endif
#endif
"package main;"
"}"
);
perl_register_bot();
#endif // BOTS
#endif // EMBPERL_XS_CLASSES
}
void PerlembParser::GetQuestTypes(

12433
zone/embparser_api.cpp
View File

File diff suppressed because it is too large Load Diff

54
zone/embperl.cpp
View File

@ -22,30 +22,6 @@ Eglin
#define GvCV_set(gv,cv) (GvCV(gv) = (cv))
#endif
#ifdef EMBPERL_XS
EXTERN_C XS(boot_quest);
#ifdef EMBPERL_XS_CLASSES
EXTERN_C XS(boot_Mob);
EXTERN_C XS(boot_NPC);
EXTERN_C XS(boot_Client);
EXTERN_C XS(boot_Corpse);
EXTERN_C XS(boot_EntityList);
EXTERN_C XS(boot_Group);
EXTERN_C XS(boot_Raid);
EXTERN_C XS(boot_Inventory);
EXTERN_C XS(boot_QuestItem);
EXTERN_C XS(boot_Spell);
EXTERN_C XS(boot_HateEntry);
EXTERN_C XS(boot_Object);
EXTERN_C XS(boot_Doors);
EXTERN_C XS(boot_PerlPacket);
EXTERN_C XS(boot_Expedition);
#ifdef BOTS
EXTERN_C XS(boot_Bot);
#endif
#endif
#endif
#ifdef EMBPERL_IO_CAPTURE
XS(XS_EQEmuIO_PRINT);
#endif //EMBPERL_IO_CAPTURE
@ -74,36 +50,6 @@ EXTERN_C void xs_init(pTHX)
//add the strcpy stuff to get rid of const warnings....
newXS(strcpy(buf, "DynaLoader::boot_DynaLoader"), boot_DynaLoader, file);
newXS(strcpy(buf, "quest::boot_qc"), boot_qc, file);
#ifdef EMBPERL_XS
newXS(strcpy(buf, "quest::boot_quest"), boot_quest, file);
#ifdef EMBPERL_XS_CLASSES
newXS(strcpy(buf, "Mob::boot_Mob"), boot_Mob, file);
newXS(strcpy(buf, "NPC::boot_Mob"), boot_Mob, file);
newXS(strcpy(buf, "NPC::boot_NPC"), boot_NPC, file);
newXS(strcpy(buf, "Corpse::boot_Mob"), boot_Mob, file);
newXS(strcpy(buf, "Corpse::boot_Corpse"), boot_Corpse, file);
newXS(strcpy(buf, "Client::boot_Mob"), boot_Mob, file);
newXS(strcpy(buf, "Client::boot_Client"), boot_Client, file);
newXS(strcpy(buf, "EntityList::boot_EntityList"), boot_EntityList, file);
newXS(strcpy(buf, "PerlPacket::boot_PerlPacket"), boot_PerlPacket, file);
newXS(strcpy(buf, "Group::boot_Group"), boot_Group, file);
newXS(strcpy(buf, "Raid::boot_Raid"), boot_Raid, file);
newXS(strcpy(buf, "Inventory::boot_Inventory"), boot_Inventory, file);
newXS(strcpy(buf, "QuestItem::boot_QuestItem"), boot_QuestItem, file);
newXS(strcpy(buf, "Spell::boot_Spell"), boot_Spell, file);
newXS(strcpy(buf, "HateEntry::boot_HateEntry"), boot_HateEntry, file);
newXS(strcpy(buf, "Object::boot_Object"), boot_Object, file);
newXS(strcpy(buf, "Doors::boot_Doors"), boot_Doors, file);
newXS(strcpy(buf, "Expedition::boot_Expedition"), boot_Expedition, file);
#ifdef BOTS
newXS(strcpy(buf, "Bot::boot_Mob"), boot_Mob, file);
newXS(strcpy(buf, "Bot::boot_NPC"), boot_NPC, file);
newXS(strcpy(buf, "Bot::boot_Bot"), boot_Bot, file);
#endif
;
#endif
#endif
#ifdef EMBPERL_IO_CAPTURE
newXS(strcpy(buf, "EQEmuIO::PRINT"), XS_EQEmuIO_PRINT, file);
#endif

21
zone/embperl.h
View File

@ -18,22 +18,13 @@ Eglin
#include <stdio.h>
#include <string.h>
//headers from the Perl distribution
#include <EXTERN.h>
#define WIN32IO_IS_STDIO
// this option disables distinct int/float/string function argument types for
// backwards compatibility with current perl api usage
// e.g. quest::settimer(0, 1) using number for timer name instead of string
#define PERLBIND_NO_STRICT_SCALAR_TYPES
#include <perlbind/perlbind.h>
namespace perl = perlbind;
#ifndef WIN32
extern "C" { //the perl headers dont do this for us...
#endif
#if _MSC_VER
#define __inline__ __inline
#define __builtin_expect
#endif
#include <perl.h>
#include <XSUB.h>
#ifndef WIN32
};
#endif
#ifdef WIN32
#define snprintf _snprintf
#endif

48
zone/embxs.cpp
View File

@ -20,17 +20,14 @@
#include "../common/global_define.h"
#include "../common/eqemu_logsys.h"
#include "embxs.h"
#include "embperl.h"
#include "masterentity.h"
#include "command.h"
#ifdef BOTS
#include "bot_command.h"
#endif
#include "embperl.h"
#include "embxs.h"
const char *getItemName(unsigned itemid)
{
const EQ::ItemData* item = nullptr;
@ -42,43 +39,10 @@ const char *getItemName(unsigned itemid)
return nullptr;
}
XS(XS_qc_getItemName); /* prototype to pass -Wmissing-prototypes */
XS(XS_qc_getItemName)
{
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: quest::getItemName(itemid)");
{
unsigned itemid = (unsigned)SvUV(ST(0));
const char * RETVAL;
dXSTARG;
RETVAL = getItemName(itemid);
sv_setpv(TARG, RETVAL); XSprePUSH; PUSHTARG;
}
XSRETURN(1);
}
EXTERN_C XS(boot_qc); /* prototype to pass -Wmissing-prototypes */
EXTERN_C XS(boot_qc)
{
dXSARGS;
char file[256];
strncpy(file, __FILE__, 256);
file[255] = '\0';
if(items != 1)
LogError("boot_qc does not take any arguments");
char buf[128]; //shouldent have any function names longer than this.
//add the strcpy stuff to get rid of const warnings....
XS_VERSION_BOOTCHECK ;
newXS(strcpy(buf, "quest::getItemName"), XS_qc_getItemName, file);
XSRETURN_YES;
std::string Perl__qc_getItemName(unsigned itemid)
{
auto result = getItemName(itemid);
return result ? result : "";
}
#ifdef EMBPERL_IO_CAPTURE

21
zone/embxs.h
View File

@ -1,24 +1,7 @@
#ifndef EMBXS_H
#define EMBXS_H
//headers from the Perl distribution
#include <EXTERN.h>
#define WIN32IO_IS_STDIO
#ifndef WIN32
extern "C" { //the perl headers dont do this for us...
#endif
#if _MSC_VER
#define __inline__ __inline
#define __builtin_expect
#endif
#include <perl.h>
#include <XSUB.h>
#ifndef WIN32
};
#endif
const char *getItemName(unsigned itemid);
XS(XS_qc_getItemName); /* prototype to pass -Wmissing-prototypes */
EXTERN_C XS(boot_qc); /* prototype to pass -Wmissing-prototypes */
std::string Perl__qc_getItemName(unsigned itemid);
#endif // EMBXS_H

239
zone/perl_bot.cpp
View File

@ -3,176 +3,93 @@
#ifdef EMBPERL_XS_CLASSES
#include "../common/global_define.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "bot.h"
#ifdef THIS
#undef THIS
#endif
#define VALIDATE_THIS_IS_BOT \
do { \
if (sv_derived_from(ST(0), "Bot")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(Bot*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type Bot"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
XS(XS_Bot_GetOwner);
XS(XS_Bot_GetOwner)
Mob* Perl_Bot_GetOwner(Bot* self) // @categories Script Utility, Bot
{
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Bot::GetOwner(THIS)"); // @categories Script Utility, Bot
{
Bot* THIS;
Mob* bot_owner;
VALIDATE_THIS_IS_BOT;
bot_owner = THIS->GetBotOwner();
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "Mob", (void*)bot_owner);
}
XSRETURN(1);
return self->GetBotOwner();
}
XS(XS_Bot_AddBotItem); /* prototype to pass -Wmissing-prototypes */
XS(XS_Bot_AddBotItem) {
dXSARGS;
if (items < 3 || items > 11)
Perl_croak(aTHX_ "Usage: Bot::AddBotItem(THIS, uint16 slot_id, uint32 item_id, [int16 charges = -1], [bool attuned = false], [uint32 augment_one = 0], [uint32 augment_two = 0], [uint32 augment_three = 0], [uint32 augment_four = 0], [uint32 augment_five = 0], [uint32 augment_six = 0])"); // @categories Inventory and Items, Script Utility
{
Bot* THIS;
uint16 slot_id = (uint16) SvUV(ST(1));
uint32 item_id = (uint32) SvUV(ST(2));
int16 charges = -1;
bool attuned = false;
uint32 augment_one = 0;
uint32 augment_two = 0;
uint32 augment_three = 0;
uint32 augment_four = 0;
uint32 augment_five = 0;
uint32 augment_six = 0;
VALIDATE_THIS_IS_BOT;
if (items > 3) {
charges = (int16) SvIV(ST(3));
}
if (items > 4) {
attuned = (bool) SvTRUE(ST(4));
}
if (items > 5) {
augment_one = (uint32) SvUV(ST(5));
}
if (items > 6) {
augment_two = (uint32) SvUV(ST(6));
}
if (items > 7) {
augment_three = (uint32) SvUV(ST(7));
}
if (items > 8) {
augment_four = (uint32) SvUV(ST(8));
}
if (items > 9) {
augment_five = (uint32) SvUV(ST(9));
}
if (items > 10) {
augment_six = (uint32) SvUV(ST(10));
}
THIS->AddBotItem(slot_id, item_id, charges, attuned, augment_one, augment_two, augment_three, augment_four, augment_five, augment_six);
}
XSRETURN_EMPTY;
}
XS(XS_Bot_CountBotItem);
XS(XS_Bot_CountBotItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Bot::CountBotItem(THIS, uint32 item_id)");
{
Bot* THIS;
int item_count = 0;
uint32 item_id = (uint32) SvUV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_BOT;
item_count = THIS->CountBotItem(item_id);
XSprePUSH;
PUSHu((UV) item_count);
}
XSRETURN(1);
}
XS(XS_Bot_HasBotItem);
XS(XS_Bot_HasBotItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Bot:HasBotItem(THIS, uint32 item_id)");
{
Bot* THIS;
bool has_item = false;
uint32 item_id = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_BOT;
has_item = THIS->HasBotItem(item_id);
ST(0) = boolSV(has_item);
sv_2mortal(ST(0));
}
XSRETURN(1);
}
XS(XS_Bot_RemoveBotItem);
XS(XS_Bot_RemoveBotItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Bot::RemoveBotItem(THIS, uint32 item_id)"); // @categories Spells and Disciplines
{
Bot* THIS;
uint32 item_id = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_BOT;
THIS->RemoveBotItem(item_id);
}
XSRETURN_EMPTY;
}
#ifdef __cplusplus
extern "C"
#endif
XS(boot_Bot);
XS(boot_Bot)
// todo: should just take a hash instead of all these overloads
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id) // @categories Inventory and Items
{
dXSARGS;
char file[256];
strncpy(file, __FILE__, 256);
file[255] = 0;
self->AddBotItem(slot_id, item_id);
}
if (items != 1)
fprintf(stderr, "boot_Bot does not take any arguments.");
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id, uint16 charges) // @categories Inventory and Items
{
self->AddBotItem(slot_id, item_id, charges);
}
char buf[128];
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id, uint16 charges, bool attuned) // @categories Inventory and Items
{
self->AddBotItem(slot_id, item_id, charges, attuned);
}
XS_VERSION_BOOTCHECK;
newXSproto(strcpy(buf, "AddBotItem"), XS_Bot_AddBotItem, file, "$$$;$$$$$$$$");
newXSproto(strcpy(buf, "CountBotItem"), XS_Bot_CountBotItem, file, "$$");
newXSproto(strcpy(buf, "GetOwner"), XS_Bot_GetOwner, file, "$");
newXSproto(strcpy(buf, "HasBotItem"), XS_Bot_HasBotItem, file, "$$");
newXSproto(strcpy(buf, "RemoveBotItem"), XS_Bot_RemoveBotItem, file, "$$");
XSRETURN_YES;
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id, uint16 charges, bool attuned, uint32 aug1) // @categories Inventory and Items
{
self->AddBotItem(slot_id, item_id, charges, attuned, aug1);
}
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id, uint16 charges, bool attuned, uint32 aug1, uint32 aug2) // @categories Inventory and Items
{
self->AddBotItem(slot_id, item_id, charges, attuned, aug1, aug2);
}
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id, uint16 charges, bool attuned, uint32 aug1, uint32 aug2, uint32 aug3) // @categories Inventory and Items
{
self->AddBotItem(slot_id, item_id, charges, attuned, aug1, aug2, aug3);
}
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id, uint16 charges, bool attuned, uint32 aug1, uint32 aug2, uint32 aug3, uint32 aug4) // @categories Inventory and Items
{
self->AddBotItem(slot_id, item_id, charges, attuned, aug1, aug2, aug3, aug4);
}
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id, uint16 charges, bool attuned, uint32 aug1, uint32 aug2, uint32 aug3, uint32 aug4, uint32 aug5) // @categories Inventory and Items
{
self->AddBotItem(slot_id, item_id, charges, attuned, aug1, aug2, aug3, aug4, aug5);
}
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id, uint16 charges, bool attuned, uint32 aug1, uint32 aug2, uint32 aug3, uint32 aug4, uint32 aug5, uint32 aug6) // @categories Inventory and Items
{
self->AddBotItem(slot_id, item_id, charges, attuned, aug1, aug2, aug3, aug4, aug5, aug6);
}
uint32 Perl_Bot_CountBotItem(Bot* self, uint32 item_id)
{
return self->CountBotItem(item_id);
}
bool Perl_Bot_HasBotItem(Bot* self, uint32 item_id)
{
return self->HasBotItem(item_id);
}
void Perl_Bot_RemoveBotItem(Bot* self, uint32 item_id)
{
return self->RemoveBotItem(item_id);
}
void perl_register_bot()
{
perl::interpreter state(PERL_GET_THX);
auto package = state.new_class<Bot>("Bot");
package.add_base_class("NPC");
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32))&Perl_Bot_AddBotItem);
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32, uint16))&Perl_Bot_AddBotItem);
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32, uint16, bool))&Perl_Bot_AddBotItem);
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32, uint16, bool, uint32))&Perl_Bot_AddBotItem);
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32, uint16, bool, uint32, uint32))&Perl_Bot_AddBotItem);
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32, uint16, bool, uint32, uint32, uint32))&Perl_Bot_AddBotItem);
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32, uint16, bool, uint32, uint32, uint32, uint32))&Perl_Bot_AddBotItem);
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32, uint16, bool, uint32, uint32, uint32, uint32, uint32))&Perl_Bot_AddBotItem);
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32, uint16, bool, uint32, uint32, uint32, uint32, uint32, uint32))&Perl_Bot_AddBotItem);
package.add("CountBotItem", &Perl_Bot_CountBotItem);
package.add("GetOwner", &Perl_Bot_GetOwner);
package.add("HasBotItem", &Perl_Bot_HasBotItem);
package.add("RemoveBotItem", &Perl_Bot_RemoveBotItem);
}
#endif //EMBPERL_XS_CLASSES

8645
zone/perl_client.cpp
View File

File diff suppressed because it is too large Load Diff

569
zone/perl_doors.cpp
View File

@ -4,504 +4,183 @@
#include "../common/global_define.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "doors.h"
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
#define VALIDATE_THIS_IS_DOOR \
do { \
if (sv_derived_from(ST(0), "Doors")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(Doors*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type Doors"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
XS(XS_Doors_GetDoorDBID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetDoorDBID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetDoorDBID(THIS)"); // @categories Doors
{
Doors *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetDoorDBID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Doors_GetDoorDBID(Doors* self) // @categories Doors
{
return self->GetDoorDBID();
}
XS(XS_Doors_GetDoorID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetDoorID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetDoorID(THIS)"); // @categories Doors
{
Doors *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetDoorID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Doors_GetDoorID(Doors* self) // @categories Doors
{
return self->GetDoorID();
}
XS(XS_Doors_GetID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetID(THIS)"); // @categories Doors
{
Doors *THIS;
uint16 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetEntityID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Doors_GetID(Doors* self) // @categories Doors
{
return self->GetEntityID();
}
XS(XS_Doors_GetX); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetX) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetX(THIS)"); // @categories Doors
{
Doors *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetPosition().x;
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
float Perl_Doors_GetX(Doors* self) // @categories Doors
{
return self->GetPosition().x;
}
XS(XS_Doors_GetY); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetY) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetY(THIS)"); // @categories Doors
{
Doors *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetPosition().y;
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
float Perl_Doors_GetY(Doors* self) // @categories Doors
{
return self->GetPosition().y;
}
XS(XS_Doors_GetZ); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetZ) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetZ(THIS)"); // @categories Doors
{
Doors *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetPosition().z;
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
float Perl_Doors_GetZ(Doors* self) // @categories Doors
{
return self->GetPosition().z;
}
XS(XS_Doors_GetHeading); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetHeading) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetHeading(THIS)"); // @categories Doors
{
Doors *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetPosition().w;
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
float Perl_Doors_GetHeading(Doors* self) // @categories Doors
{
return self->GetPosition().w;
}
XS(XS_Doors_GetOpenType); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetOpenType) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetOpenType(THIS)"); // @categories Doors
{
Doors *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetOpenType();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Doors_GetOpenType(Doors* self) // @categories Doors
{
return self->GetOpenType();
}
XS(XS_Doors_GetLockpick); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetLockpick) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetLockpick(THIS)"); // @categories Doors, Skills and Recipes
{
Doors *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetLockpick();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Doors_GetLockpick(Doors* self) // @categories Doors, Skills and Recipes
{
return self->GetLockpick();
}
XS(XS_Doors_GetKeyItem); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetKeyItem) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetKeyItem(THIS)"); // @categories Doors
{
Doors *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetKeyItem();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Doors_GetKeyItem(Doors* self) // @categories Doors
{
return self->GetKeyItem();
}
XS(XS_Doors_GetNoKeyring); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetNoKeyring) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::GetNoKeyring(THIS, uint8 type)"); // @categories Doors
{
Doors *THIS;
uint8 type = (uint8) SvUV(ST(1));
VALIDATE_THIS_IS_DOOR;
THIS->GetNoKeyring();
}
XSRETURN_EMPTY;
uint8_t Perl_Doors_GetNoKeyring(Doors* self) // @categories Doors
{
return self->GetNoKeyring();
}
XS(XS_Doors_GetIncline); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetIncline) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetIncline(THIS)"); // @categories Doors
{
Doors *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetIncline();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
int Perl_Doors_GetIncline(Doors* self) // @categories Doors
{
return self->GetIncline();
}
XS(XS_Doors_GetSize); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetSize) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetSize(THIS)"); // @categories Doors
{
Doors *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetSize();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Doors_GetSize(Doors* self) // @categories Doors
{
return self->GetSize();
}
XS(XS_Doors_SetOpenType); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetOpenType) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetOpenType(THIS, uint32 open_type)"); // @categories Doors
{
Doors *THIS;
uint32 type = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_DOOR;
THIS->SetOpenType(type);
}
XSRETURN_EMPTY;
void Perl_Doors_SetOpenType(Doors* self, uint32_t open_type) // @categories Doors
{
self->SetOpenType(open_type);
}
XS(XS_Doors_SetLockpick); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetLockpick) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetLockpick(THIS, uint32 lockpick_type)"); // @categories Doors
{
Doors *THIS;
uint32 type = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_DOOR;
THIS->SetLockpick(type);
}
XSRETURN_EMPTY;
void Perl_Doors_SetLockpick(Doors* self, uint32_t lockpick_type) // @categories Doors
{
self->SetLockpick(lockpick_type);
}
XS(XS_Doors_SetKeyItem); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetKeyItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetKeyItem(THIS, uint32 key_item_id)"); // @categories Doors
{
Doors *THIS;
uint32 type = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_DOOR;
THIS->SetKeyItem(type);
}
XSRETURN_EMPTY;
void Perl_Doors_SetKeyItem(Doors* self, uint32_t key_item_id) // @categories Doors
{
self->SetKeyItem(key_item_id);
}
XS(XS_Doors_SetNoKeyring); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetNoKeyring) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetNoKeyring(THIS, uint8 no_key_ring)"); // @categories Doors
{
Doors *THIS;
uint8 type = (uint8) SvUV(ST(1));
VALIDATE_THIS_IS_DOOR;
THIS->SetNoKeyring(type);
}
XSRETURN_EMPTY;
void Perl_Doors_SetNoKeyring(Doors* self, uint8_t no_key_ring) // @categories Doors
{
self->SetNoKeyring(no_key_ring);
}
XS(XS_Doors_SetIncline); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetIncline) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetIncline(THIS, uint32 incline)"); // @categories Doors
{
Doors *THIS;
uint32 type = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_DOOR;
THIS->SetIncline(type);
}
XSRETURN_EMPTY;
void Perl_Doors_SetIncline(Doors* self, uint32_t incline) // @categories Doors
{
self->SetIncline(incline);
}
XS(XS_Doors_SetSize); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetSize) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetSize(THIS, uint32 size)"); // @categories Doors
{
Doors *THIS;
uint32 type = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_DOOR;
THIS->SetSize(type);
}
XSRETURN_EMPTY;
void Perl_Doors_SetSize(Doors* self, uint32_t size) // @categories Doors
{
self->SetSize(size);
}
XS(XS_Doors_SetLocation); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetLocation) {
dXSARGS;
if (items != 4)
Perl_croak(aTHX_ "Usage: Doors::SetLocation(THIS, float x, float y, float z)"); // @categories Doors
{
Doors *THIS;
float x = (float) SvNV(ST(1));
float y = (float) SvNV(ST(2));
float z = (float) SvNV(ST(3));
VALIDATE_THIS_IS_DOOR;
THIS->SetLocation(x, y, z);
}
XSRETURN_EMPTY;
void Perl_Doors_SetLocation(Doors* self, float x, float y, float z) // @categories Doors
{
self->SetLocation(x, y, z);
}
XS(XS_Doors_SetX); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetX) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetX(THIS, float x)"); // @categories Doors
{
Doors *THIS;
float x = (float) SvNV(ST(1));
VALIDATE_THIS_IS_DOOR;
auto position = THIS->GetPosition();
position.x = x;
THIS->SetPosition(position);
}
XSRETURN_EMPTY;
void Perl_Doors_SetX(Doors* self, float x) // @categories Doors
{
auto position = self->GetPosition();
position.x = x;
self->SetPosition(position);
}
XS(XS_Doors_SetY); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetY) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetY(THIS, float y)"); // @categories Doors
{
Doors *THIS;
float y = (float) SvNV(ST(1));
VALIDATE_THIS_IS_DOOR;
auto position = THIS->GetPosition();
position.y = y;
THIS->SetPosition(position);
}
XSRETURN_EMPTY;
void Perl_Doors_SetY(Doors* self, float y) // @categories Doors
{
auto position = self->GetPosition();
position.y = y;
self->SetPosition(position);
}
XS(XS_Doors_SetZ); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetZ) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetZ(THIS, float z)"); // @categories Doors
{
Doors *THIS;
float z = (float) SvNV(ST(1));
VALIDATE_THIS_IS_DOOR;
auto position = THIS->GetPosition();
position.z = z;
THIS->SetPosition(position);
}
XSRETURN_EMPTY;
void Perl_Doors_SetZ(Doors* self, float z) // @categories Doors
{
auto position = self->GetPosition();
position.z = z;
self->SetPosition(position);
}
XS(XS_Doors_SetHeading); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetHeading) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetHeading(THIS, float heading)"); // @categories Doors
{
Doors *THIS;
float heading = (float) SvNV(ST(1));
VALIDATE_THIS_IS_DOOR;
auto position = THIS->GetPosition();
position.w = heading;
THIS->SetPosition(position);
}
XSRETURN_EMPTY;
void Perl_Doors_SetHeading(Doors* self, float heading) // @categories Doors
{
auto position = self->GetPosition();
position.w = heading;
self->SetPosition(position);
}
XS(XS_Doors_SetModelName); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetModelName) {
dXSARGS;
if (items < 1 || items > 2)
Perl_croak(aTHX_ "Usage: Doors::SetModelName(THIS, string name)"); // @categories Doors
{
Doors *THIS;
char *name = nullptr;
VALIDATE_THIS_IS_DOOR;
if (items > 1) { name = (char *) SvPV_nolen(ST(1)); }
THIS->SetDoorName(name);
}
XSRETURN_EMPTY;
}
XS(XS_Doors_GetModelName); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetModelName) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetModelName(THIS)"); // @categories Doors
{
Doors *THIS;
Const_char *RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetDoorName();
sv_setpv(TARG, RETVAL);
XSprePUSH;
PUSHTARG;
}
XSRETURN(1);
void Perl_Doors_SetModelName(Doors* self, const char* name) // @categories Doors
{
self->SetDoorName(name);
}
XS(XS_Doors_CreateDatabaseEntry); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_CreateDatabaseEntry) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::InsertDoor(THIS)"); // @categories Doors
{
Doors *THIS;
VALIDATE_THIS_IS_DOOR;
THIS->CreateDatabaseEntry();
}
XSRETURN_EMPTY;
std::string Perl_Doors_GetModelName(Doors* self) // @categories Doors
{
return self->GetDoorName();
}
#ifdef __cplusplus
extern "C"
#endif
XS(boot_Doors); /* prototype to pass -Wmissing-prototypes */
XS(boot_Doors) {
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, "CreateDatabaseEntry"), XS_Doors_CreateDatabaseEntry, file, "$");
newXSproto(strcpy(buf, "GetDoorDBID"), XS_Doors_GetDoorDBID, file, "$");
newXSproto(strcpy(buf, "GetDoorID"), XS_Doors_GetDoorID, file, "$");
newXSproto(strcpy(buf, "GetHeading"), XS_Doors_GetHeading, file, "$");
newXSproto(strcpy(buf, "GetID"), XS_Doors_GetID, file, "$");
newXSproto(strcpy(buf, "GetIncline"), XS_Doors_GetIncline, file, "$");
newXSproto(strcpy(buf, "GetKeyItem"), XS_Doors_GetKeyItem, file, "$");
newXSproto(strcpy(buf, "GetLockPick"), XS_Doors_GetLockpick, file, "$");
newXSproto(strcpy(buf, "GetModelName"), XS_Doors_GetModelName, file, "$");
newXSproto(strcpy(buf, "GetNoKeyring"), XS_Doors_GetNoKeyring, file, "$");
newXSproto(strcpy(buf, "GetOpenType"), XS_Doors_GetOpenType, file, "$");
newXSproto(strcpy(buf, "GetSize"), XS_Doors_GetSize, file, "$");
newXSproto(strcpy(buf, "GetX"), XS_Doors_GetX, file, "$");
newXSproto(strcpy(buf, "GetY"), XS_Doors_GetY, file, "$");
newXSproto(strcpy(buf, "GetZ"), XS_Doors_GetZ, file, "$");
newXSproto(strcpy(buf, "SetHeading"), XS_Doors_SetHeading, file, "$$");
newXSproto(strcpy(buf, "SetIncline"), XS_Doors_SetIncline, file, "$$");
newXSproto(strcpy(buf, "SetKeyItem"), XS_Doors_SetKeyItem, file, "$$");
newXSproto(strcpy(buf, "SetLocation"), XS_Doors_SetLocation, file, "$$$$");
newXSproto(strcpy(buf, "SetLockPick"), XS_Doors_SetLockpick, file, "$$");
newXSproto(strcpy(buf, "SetModelName"), XS_Doors_SetModelName, file, "$$");
newXSproto(strcpy(buf, "SetNoKeyring"), XS_Doors_SetNoKeyring, file, "$$");
newXSproto(strcpy(buf, "SetOpenType"), XS_Doors_SetOpenType, file, "$$");
newXSproto(strcpy(buf, "SetSize"), XS_Doors_SetSize, file, "$$");
newXSproto(strcpy(buf, "SetX"), XS_Doors_SetX, file, "$$");
newXSproto(strcpy(buf, "SetY"), XS_Doors_SetY, file, "$$");
newXSproto(strcpy(buf, "SetZ"), XS_Doors_SetZ, file, "$$");
XSRETURN_YES;
void Perl_Doors_CreateDatabaseEntry(Doors* self) // @categories Doors
{
self->CreateDatabaseEntry();
}
void perl_register_doors()
{
perl::interpreter perl(PERL_GET_THX);
auto package = perl.new_class<Doors>("Doors");
package.add("CreateDatabaseEntry", &Perl_Doors_CreateDatabaseEntry);
package.add("GetDoorDBID", &Perl_Doors_GetDoorDBID);
package.add("GetDoorID", &Perl_Doors_GetDoorID);
package.add("GetHeading", &Perl_Doors_GetHeading);
package.add("GetID", &Perl_Doors_GetID);
package.add("GetIncline", &Perl_Doors_GetIncline);
package.add("GetKeyItem", &Perl_Doors_GetKeyItem);
package.add("GetLockPick", &Perl_Doors_GetLockpick);
package.add("GetModelName", &Perl_Doors_GetModelName);
package.add("GetNoKeyring", &Perl_Doors_GetNoKeyring);
package.add("GetOpenType", &Perl_Doors_GetOpenType);
package.add("GetSize", &Perl_Doors_GetSize);
package.add("GetX", &Perl_Doors_GetX);
package.add("GetY", &Perl_Doors_GetY);
package.add("GetZ", &Perl_Doors_GetZ);
package.add("SetHeading", &Perl_Doors_SetHeading);
package.add("SetIncline", &Perl_Doors_SetIncline);
package.add("SetKeyItem", &Perl_Doors_SetKeyItem);
package.add("SetLocation", &Perl_Doors_SetLocation);
package.add("SetLockPick", &Perl_Doors_SetLockpick);
package.add("SetModelName", &Perl_Doors_SetModelName);
package.add("SetNoKeyring", &Perl_Doors_SetNoKeyring);
package.add("SetOpenType", &Perl_Doors_SetOpenType);
package.add("SetSize", &Perl_Doors_SetSize);
package.add("SetX", &Perl_Doors_SetX);
package.add("SetY", &Perl_Doors_SetY);
package.add("SetZ", &Perl_Doors_SetZ);
}
#endif //EMBPERL_XS_CLASSES

1900
zone/perl_entity.cpp
View File

File diff suppressed because it is too large Load Diff

762
zone/perl_expedition.cpp
View File

@ -2,669 +2,267 @@
#ifdef EMBPERL_XS_CLASSES
#include "embperl.h"
#include "expedition.h"
#include "zone_store.h"
#include "embperl.h"
#include "../common/global_define.h"
#ifdef seed
#undef seed
#endif
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
#define VALIDATE_THIS_IS_EXPEDITION \
do { \
if (sv_derived_from(ST(0), "Expedition")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(Expedition*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type Expedition"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
XS(XS_Expedition_AddLockout);
XS(XS_Expedition_AddLockout) {
dXSARGS;
if (items != 3) {
Perl_croak(aTHX_ "Usage: Expedition::AddLockout(THIS, string event_name, uint32 seconds)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
std::string event_name(SvPV_nolen(ST(1)));
uint32_t seconds = static_cast<uint32_t>(SvUV(ST(2)));
THIS->AddLockout(event_name, seconds);
XSRETURN_EMPTY;
void Perl_Expedition_AddLockout(Expedition* self, std::string event_name, uint32_t seconds)
{
self->AddLockout(event_name, seconds);
}
XS(XS_Expedition_AddLockoutDuration);
XS(XS_Expedition_AddLockoutDuration) {
dXSARGS;
if (items != 3 && items != 4) {
Perl_croak(aTHX_ "Usage: Expedition::AddLockout(THIS, string event_name, int seconds, [bool members_only = true])");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
std::string event_name(SvPV_nolen(ST(1)));
int seconds = static_cast<int>(SvUV(ST(2)));
if (items == 4)
{
bool members_only = (bool)SvTRUE(ST(3));
THIS->AddLockoutDuration(event_name, seconds, members_only);
}
else
{
THIS->AddLockoutDuration(event_name, seconds);
}
XSRETURN_EMPTY;
void Perl_Expedition_AddLockoutDuration(Expedition* self, std::string event_name, int seconds)
{
self->AddLockoutDuration(event_name, seconds);
}
XS(XS_Expedition_AddReplayLockout);
XS(XS_Expedition_AddReplayLockout) {
dXSARGS;
if (items != 2) {
Perl_croak(aTHX_ "Usage: Expedition::AddReplayLockout(THIS, uint32 seconds)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
uint32_t seconds = static_cast<uint32_t>(SvUV(ST(1)));
THIS->AddReplayLockout(seconds);
XSRETURN_EMPTY;
void Perl_Expedition_AddLockoutDuration(Expedition* self, std::string event_name, int seconds, bool members_only)
{
self->AddLockoutDuration(event_name, seconds, members_only);
}
XS(XS_Expedition_AddReplayLockoutDuration);
XS(XS_Expedition_AddReplayLockoutDuration) {
dXSARGS;
if (items != 2 && items != 3) {
Perl_croak(aTHX_ "Usage: Expedition::AddReplayLockoutDuration(THIS, int seconds, [bool members_only = true])");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
int seconds = static_cast<int>(SvUV(ST(1)));
if (items == 3)
{
bool members_only = (bool)SvTRUE(ST(2));
THIS->AddReplayLockoutDuration(seconds, members_only);
}
else
{
THIS->AddReplayLockoutDuration(seconds);
}
XSRETURN_EMPTY;
void Perl_Expedition_AddReplayLockout(Expedition* self, uint32_t seconds)
{
self->AddReplayLockout(seconds);
}
XS(XS_Expedition_GetDynamicZoneID);
XS(XS_Expedition_GetDynamicZoneID) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetDynamicZoneID(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_UV(THIS->GetDynamicZone()->GetID());
void Perl_Expedition_AddReplayLockoutDuration(Expedition* self, int seconds)
{
self->AddReplayLockoutDuration(seconds);
}
XS(XS_Expedition_GetID);
XS(XS_Expedition_GetID) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetID(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_UV(THIS->GetID());
void Perl_Expedition_AddReplayLockoutDuration(Expedition* self, int seconds, bool members_only)
{
self->AddReplayLockoutDuration(seconds, members_only);
}
XS(XS_Expedition_GetInstanceID);
XS(XS_Expedition_GetInstanceID) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetInstanceID(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_UV(THIS->GetDynamicZone()->GetInstanceID());
uint32_t Perl_Expedition_GetDynamicZoneID(Expedition* self)
{
return self->GetDynamicZone()->GetID();
}
XS(XS_Expedition_GetLeaderName);
XS(XS_Expedition_GetLeaderName) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetLeaderName(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_PV(THIS->GetLeaderName().c_str());
uint32_t Perl_Expedition_GetID(Expedition* self)
{
return self->GetID();
}
XS(XS_Expedition_GetLockouts);
XS(XS_Expedition_GetLockouts) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetLockouts(THIS)");
}
uint16_t Perl_Expedition_GetInstanceID(Expedition* self)
{
return self->GetDynamicZone()->GetInstanceID();
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
std::string Perl_Expedition_GetLeaderName(Expedition* self)
{
return self->GetLeaderName();
}
HV* hash = newHV();
auto lockouts = THIS->GetLockouts();
perl::reference Perl_Expedition_GetLockouts(Expedition* self)
{
perl::hash table;
auto lockouts = self->GetLockouts();
for (const auto& lockout : lockouts)
{
hv_store(hash, lockout.first.c_str(), static_cast<uint32_t>(lockout.first.size()),
newSVuv(lockout.second.GetSecondsRemaining()), 0);
table[lockout.first] = lockout.second.GetSecondsRemaining();
}
ST(0) = sv_2mortal(newRV_noinc((SV*)hash)); // take ownership of hash (refcnt remains 1)
XSRETURN(1);
return perl::reference(table);
}
XS(XS_Expedition_GetLootEventByNPCTypeID);
XS(XS_Expedition_GetLootEventByNPCTypeID) {
dXSARGS;
if (items != 2) {
Perl_croak(aTHX_ "Usage: Expedition::GetLootEventByNPCTypeID(THIS, uint32 npc_type_id)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
uint32_t npc_type_id = static_cast<uint32_t>(SvUV(ST(1)));
XSRETURN_PV(THIS->GetLootEventByNPCTypeID(npc_type_id).c_str());
std::string Perl_Expedition_GetLootEventByNPCTypeID(Expedition* self, uint32_t npc_type_id)
{
return self->GetLootEventByNPCTypeID(npc_type_id);
}
XS(XS_Expedition_GetLootEventBySpawnID);
XS(XS_Expedition_GetLootEventBySpawnID) {
dXSARGS;
if (items != 2) {
Perl_croak(aTHX_ "Usage: Expedition::GetLootEventBySpawnID(THIS, uint32 spawn_id)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
uint32_t spawn_id = static_cast<uint32_t>(SvUV(ST(1)));
XSRETURN_PV(THIS->GetLootEventBySpawnID(spawn_id).c_str());
std::string Perl_Expedition_GetLootEventBySpawnID(Expedition* self, uint32_t spawn_id)
{
return self->GetLootEventBySpawnID(spawn_id);
}
XS(XS_Expedition_GetMemberCount);
XS(XS_Expedition_GetMemberCount) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetMemberCount(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_UV(THIS->GetDynamicZone()->GetMemberCount());
uint32_t Perl_Expedition_GetMemberCount(Expedition* self)
{
return self->GetDynamicZone()->GetMemberCount();
}
XS(XS_Expedition_GetMembers);
XS(XS_Expedition_GetMembers) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetMembers(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
HV* hash = newHV();
for (const auto& member : THIS->GetDynamicZone()->GetMembers())
perl::reference Perl_Expedition_GetMembers(Expedition* self)
{
perl::hash table;
for (const auto& member : self->GetDynamicZone()->GetMembers())
{
hv_store(hash, member.name.c_str(), static_cast<uint32_t>(member.name.size()),
newSVuv(member.id), 0);
table[member.name] = member.id;
}
ST(0) = sv_2mortal(newRV_noinc((SV*)hash));
XSRETURN(1);
return perl::reference(table);
}
XS(XS_Expedition_GetName);
XS(XS_Expedition_GetName) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetName(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_PV(THIS->GetName().c_str());
std::string Perl_Expedition_GetName(Expedition* self)
{
return self->GetName();
}
XS(XS_Expedition_GetSecondsRemaining);
XS(XS_Expedition_GetSecondsRemaining) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetSecondsRemaining(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_UV(THIS->GetDynamicZone()->GetSecondsRemaining());
uint32_t Perl_Expedition_GetSecondsRemaining(Expedition* self)
{
return self->GetDynamicZone()->GetSecondsRemaining();
}
XS(XS_Expedition_GetUUID);
XS(XS_Expedition_GetUUID) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetUUID(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_PV(THIS->GetDynamicZone()->GetUUID().c_str());
std::string Perl_Expedition_GetUUID(Expedition* self)
{
return self->GetDynamicZone()->GetUUID();
}
XS(XS_Expedition_GetZoneID);
XS(XS_Expedition_GetZoneID) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetZoneID(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_UV(THIS->GetDynamicZone()->GetZoneID());
uint16_t Perl_Expedition_GetZoneID(Expedition* self)
{
return self->GetDynamicZone()->GetZoneID();
}
XS(XS_Expedition_GetZoneName);
XS(XS_Expedition_GetZoneName) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetZoneName(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_PV(ZoneName(THIS->GetDynamicZone()->GetZoneID()));
std::string Perl_Expedition_GetZoneName(Expedition* self)
{
return ZoneName(self->GetDynamicZone()->GetZoneID());
}
XS(XS_Expedition_GetZoneVersion);
XS(XS_Expedition_GetZoneVersion) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetZoneVersion(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_UV(THIS->GetDynamicZone()->GetZoneVersion());
uint32_t Perl_Expedition_GetZoneVersion(Expedition* self)
{
return self->GetDynamicZone()->GetZoneVersion();
}
XS(XS_Expedition_HasLockout);
XS(XS_Expedition_HasLockout) {
dXSARGS;
if (items != 2) {
Perl_croak(aTHX_ "Usage: Expedition::HasLockout(THIS, string event_name)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
std::string event_name(SvPV_nolen(ST(1)));
bool result = THIS->HasLockout(event_name);
ST(0) = boolSV(result);
XSRETURN(1);
bool Perl_Expedition_HasLockout(Expedition* self, std::string event_name)
{
return self->HasLockout(event_name);
}
XS(XS_Expedition_HasReplayLockout);
XS(XS_Expedition_HasReplayLockout) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::HasReplayLockout(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
bool result = THIS->HasReplayLockout();
ST(0) = boolSV(result);
XSRETURN(1);
bool Perl_Expedition_HasReplayLockout(Expedition* self)
{
return self->HasReplayLockout();
}
XS(XS_Expedition_IsLocked);
XS(XS_Expedition_IsLocked) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::IsLocked(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
ST(0) = boolSV(THIS->IsLocked());
XSRETURN(1);
bool Perl_Expedition_IsLocked(Expedition* self)
{
return self->IsLocked();
}
XS(XS_Expedition_RemoveCompass);
XS(XS_Expedition_RemoveCompass) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::RemoveCompass(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
THIS->GetDynamicZone()->SetCompass(0, 0, 0, 0, true);
XSRETURN_EMPTY;
void Perl_Expedition_RemoveCompass(Expedition* self)
{
self->GetDynamicZone()->SetCompass(0, 0, 0, 0, true);
}
XS(XS_Expedition_RemoveLockout);
XS(XS_Expedition_RemoveLockout) {
dXSARGS;
if (items != 2) {
Perl_croak(aTHX_ "Usage: Expedition::RemoveLockout(THIS, string event_name)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
std::string event_name(SvPV_nolen(ST(1)));
THIS->RemoveLockout(event_name);
XSRETURN_EMPTY;
void Perl_Expedition_RemoveLockout(Expedition* self, std::string event_name)
{
self->RemoveLockout(event_name);
}
XS(XS_Expedition_SetCompass);
XS(XS_Expedition_SetCompass) {
dXSARGS;
if (items != 5) {
Perl_croak(aTHX_ "Usage: Expedition::SetCompass(THIS, uint32 zone_id | string zone_name, float x, float y, float z)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
float x = static_cast<float>(SvNV(ST(2)));
float y = static_cast<float>(SvNV(ST(3)));
float z = static_cast<float>(SvNV(ST(4)));
if (SvTYPE(ST(1)) == SVt_PV)
{
std::string zone_name(SvPV_nolen(ST(1)));
THIS->GetDynamicZone()->SetCompass(ZoneID(zone_name), x, y, z, true);
}
else if (SvTYPE(ST(1)) == SVt_IV)
{
uint32_t zone_id = static_cast<uint32_t>(SvUV(ST(1)));
THIS->GetDynamicZone()->SetCompass(zone_id, x, y, z, true);
}
else
{
Perl_croak(aTHX_ "Expedition::SetCompass expected an integer or string");
}
XSRETURN_EMPTY;
void Perl_Expedition_SetCompass(Expedition* self, perl::scalar zone, float x, float y, float z)
{
uint32_t zone_id = zone.is_string() ? ZoneID(zone.c_str()) : zone.as<uint32_t>();
self->GetDynamicZone()->SetCompass(zone_id, x, y, z, true);
}
XS(XS_Expedition_SetLocked);
XS(XS_Expedition_SetLocked) {
dXSARGS;
if (items != 2 && items != 3 && items != 4) {
Perl_croak(aTHX_ "Usage: Expedition::SetLocked(THIS, bool locked, [int lock_msg = 0], [uint32 color = 15])");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
bool locked = (bool)SvTRUE(ST(1));
int lock_msg = (items == 3) ? static_cast<int>(SvIV(ST(2))) : 0;
if (items == 4)
{
THIS->SetLocked(locked, static_cast<ExpeditionLockMessage>(lock_msg), true, (uint32)SvUV(ST(3)));
}
else
{
THIS->SetLocked(locked, static_cast<ExpeditionLockMessage>(lock_msg), true);
}
XSRETURN_EMPTY;
void Perl_Expedition_SetLocked(Expedition* self, bool locked)
{
self->SetLocked(locked, ExpeditionLockMessage::None);
}
XS(XS_Expedition_SetLootEventByNPCTypeID);
XS(XS_Expedition_SetLootEventByNPCTypeID) {
dXSARGS;
if (items != 3) {
Perl_croak(aTHX_ "Usage: Expedition::SetLootEventByNPCTypeID(THIS, uint32 npc_type_id, string event_name)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
uint32_t npc_type_id = static_cast<uint32_t>(SvUV(ST(1)));
std::string event_name(SvPV_nolen(ST(2)));
THIS->SetLootEventByNPCTypeID(npc_type_id, event_name);
XSRETURN_EMPTY;
void Perl_Expedition_SetLocked(Expedition* self, bool locked, int lock_msg)
{
self->SetLocked(locked, static_cast<ExpeditionLockMessage>(lock_msg), true);
}
XS(XS_Expedition_SetLootEventBySpawnID);
XS(XS_Expedition_SetLootEventBySpawnID) {
dXSARGS;
if (items != 3) {
Perl_croak(aTHX_ "Usage: Expedition::SetLootEventBySpawnID(THIS, uint32 spawn_id, string event_name)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
uint32_t spawn_id = static_cast<uint32_t>(SvUV(ST(1)));
std::string event_name(SvPV_nolen(ST(2)));
THIS->SetLootEventBySpawnID(spawn_id, event_name);
XSRETURN_EMPTY;
void Perl_Expedition_SetLocked(Expedition* self, bool locked, int lock_msg, uint32_t color)
{
self->SetLocked(locked, static_cast<ExpeditionLockMessage>(lock_msg), true, color);
}
XS(XS_Expedition_SetReplayLockoutOnMemberJoin);
XS(XS_Expedition_SetReplayLockoutOnMemberJoin) {
dXSARGS;
if (items != 2) {
Perl_croak(aTHX_ "Usage: Expedition::SetReplayLockoutOnMemberJoin(THIS, bool enable)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
bool enable = (bool)SvTRUE(ST(1));
THIS->SetReplayLockoutOnMemberJoin(enable, true);
XSRETURN_EMPTY;
void Perl_Expedition_SetLootEventByNPCTypeID(Expedition* self, uint32_t npc_type_id, std::string event_name)
{
self->SetLootEventByNPCTypeID(npc_type_id, event_name);
}
XS(XS_Expedition_SetSafeReturn);
XS(XS_Expedition_SetSafeReturn) {
dXSARGS;
if (items != 6) {
Perl_croak(aTHX_ "Usage: Expedition::SetSafeReturn(THIS, uint32 zone_id | string zone_name, float x, float y, float z, float heading)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
float x = static_cast<float>(SvNV(ST(2)));
float y = static_cast<float>(SvNV(ST(3)));
float z = static_cast<float>(SvNV(ST(4)));
float heading = static_cast<float>(SvNV(ST(5)));
if (SvTYPE(ST(1)) == SVt_PV)
{
std::string zone_name(SvPV_nolen(ST(1)));
THIS->GetDynamicZone()->SetSafeReturn(ZoneID(zone_name), x, y, z, heading, true);
}
else if (SvTYPE(ST(1)) == SVt_IV)
{
uint32_t zone_id = static_cast<uint32_t>(SvUV(ST(1)));
THIS->GetDynamicZone()->SetSafeReturn(zone_id, x, y, z, heading, true);
}
else
{
Perl_croak(aTHX_ "Expedition::SetSafeReturn expected an integer or string");
}
XSRETURN_EMPTY;
void Perl_Expedition_SetLootEventBySpawnID(Expedition* self, uint32_t entity_id, std::string event_name)
{
self->SetLootEventBySpawnID(entity_id, event_name);
}
XS(XS_Expedition_SetSecondsRemaining);
XS(XS_Expedition_SetSecondsRemaining) {
dXSARGS;
if (items != 2) {
Perl_croak(aTHX_ "Usage: Expedition::SetSecondsRemaining(THIS, uint32 seconds_remaining)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
uint32_t seconds_remaining = static_cast<uint32_t>(SvUV(ST(1)));
THIS->GetDynamicZone()->SetSecondsRemaining(seconds_remaining);
XSRETURN_EMPTY;
void Perl_Expedition_SetReplayLockoutOnMemberJoin(Expedition* self, bool enable)
{
self->SetReplayLockoutOnMemberJoin(enable, true);
}
XS(XS_Expedition_SetZoneInLocation);
XS(XS_Expedition_SetZoneInLocation) {
dXSARGS;
if (items != 5) {
Perl_croak(aTHX_ "Usage: Expedition::SetZoneInLocation(THIS, float x, float y, float z, float heading)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
float x = static_cast<float>(SvNV(ST(1)));
float y = static_cast<float>(SvNV(ST(2)));
float z = static_cast<float>(SvNV(ST(3)));
float heading = static_cast<float>(SvNV(ST(4)));
THIS->GetDynamicZone()->SetZoneInLocation(x, y, z, heading, true);
XSRETURN_EMPTY;
void Perl_Expedition_SetSafeReturn(Expedition* self, perl::scalar zone, float x, float y, float z, float heading)
{
uint32_t zone_id = zone.is_string() ? ZoneID(zone.c_str()) : zone.as<uint32_t>();
self->GetDynamicZone()->SetSafeReturn(zone_id, x, y, z, heading, true);
}
XS(XS_Expedition_UpdateLockoutDuration);
XS(XS_Expedition_UpdateLockoutDuration) {
dXSARGS;
if (items != 3 && items != 4) {
Perl_croak(aTHX_ "Usage: Expedition::UpdateLockoutDuration(THIS, string event_name, uint32 seconds, [bool members_only = true])");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
std::string event_name(SvPV_nolen(ST(1)));
uint32_t seconds = static_cast<uint32_t>(SvUV(ST(2)));
if (items == 4)
{
bool members_only = (bool)SvTRUE(ST(3));
THIS->UpdateLockoutDuration(event_name, seconds, members_only);
}
else
{
THIS->UpdateLockoutDuration(event_name, seconds);
}
XSRETURN_EMPTY;
void Perl_Expedition_SetSecondsRemaining(Expedition* self, uint32_t seconds_remaining)
{
self->GetDynamicZone()->SetSecondsRemaining(seconds_remaining);
}
XS(boot_Expedition);
XS(boot_Expedition) {
dXSARGS;
char file[256];
strncpy(file, __FILE__, 256);
file[255] = 0;
void Perl_Expedition_SetZoneInLocation(Expedition* self, float x, float y, float z, float heading)
{
self->GetDynamicZone()->SetZoneInLocation(x, y, z, heading, true);
}
if (items != 1) {
fprintf(stderr, "boot_Expedition does not take any arguments.");
}
char buf[128];
void Perl_Expedition_UpdateLockoutDuration(Expedition* self, std::string event_name, uint32_t seconds)
{
self->UpdateLockoutDuration(event_name, seconds);
}
XS_VERSION_BOOTCHECK;
newXSproto(strcpy(buf, "AddLockout"), XS_Expedition_AddLockout, file, "$$$");
newXSproto(strcpy(buf, "AddLockoutDuration"), XS_Expedition_AddLockoutDuration, file, "$$$;$");
newXSproto(strcpy(buf, "AddReplayLockout"), XS_Expedition_AddReplayLockout, file, "$$");
newXSproto(strcpy(buf, "AddReplayLockoutDuration"), XS_Expedition_AddReplayLockoutDuration, file, "$$;$");
newXSproto(strcpy(buf, "GetDynamicZoneID"), XS_Expedition_GetDynamicZoneID, file, "$");
newXSproto(strcpy(buf, "GetID"), XS_Expedition_GetID, file, "$");
newXSproto(strcpy(buf, "GetInstanceID"), XS_Expedition_GetInstanceID, file, "$");
newXSproto(strcpy(buf, "GetLeaderName"), XS_Expedition_GetLeaderName, file, "$");
newXSproto(strcpy(buf, "GetLockouts"), XS_Expedition_GetLockouts, file, "$");
newXSproto(strcpy(buf, "GetLootEventByNPCTypeID"), XS_Expedition_GetLootEventByNPCTypeID, file, "$$");
newXSproto(strcpy(buf, "GetLootEventBySpawnID"), XS_Expedition_GetLootEventBySpawnID, file, "$$");
newXSproto(strcpy(buf, "GetMemberCount"), XS_Expedition_GetMemberCount, file, "$");
newXSproto(strcpy(buf, "GetMembers"), XS_Expedition_GetMembers, file, "$");
newXSproto(strcpy(buf, "GetName"), XS_Expedition_GetName, file, "$");
newXSproto(strcpy(buf, "GetSecondsRemaining"), XS_Expedition_GetSecondsRemaining, file, "$");
newXSproto(strcpy(buf, "GetUUID"), XS_Expedition_GetUUID, file, "$");
newXSproto(strcpy(buf, "GetZoneID"), XS_Expedition_GetZoneID, file, "$");
newXSproto(strcpy(buf, "GetZoneName"), XS_Expedition_GetZoneName, file, "$");
newXSproto(strcpy(buf, "GetZoneVersion"), XS_Expedition_GetZoneVersion, file, "$");
newXSproto(strcpy(buf, "HasLockout"), XS_Expedition_HasLockout, file, "$$");
newXSproto(strcpy(buf, "HasReplayLockout"), XS_Expedition_HasReplayLockout, file, "$");
newXSproto(strcpy(buf, "IsLocked"), XS_Expedition_IsLocked, file, "$");
newXSproto(strcpy(buf, "RemoveCompass"), XS_Expedition_RemoveCompass, file, "$");
newXSproto(strcpy(buf, "RemoveLockout"), XS_Expedition_RemoveLockout, file, "$$");
newXSproto(strcpy(buf, "SetCompass"), XS_Expedition_SetCompass, file, "$$$$$");
newXSproto(strcpy(buf, "SetLocked"), XS_Expedition_SetLocked, file, "$$;$$");
newXSproto(strcpy(buf, "SetLootEventByNPCTypeID"), XS_Expedition_SetLootEventByNPCTypeID, file, "$$$");
newXSproto(strcpy(buf, "SetLootEventBySpawnID"), XS_Expedition_SetLootEventBySpawnID, file, "$$$");
newXSproto(strcpy(buf, "SetReplayLockoutOnMemberJoin"), XS_Expedition_SetReplayLockoutOnMemberJoin, file, "$$");
newXSproto(strcpy(buf, "SetSafeReturn"), XS_Expedition_SetSafeReturn, file, "$$$$$$");
newXSproto(strcpy(buf, "SetSecondsRemaining"), XS_Expedition_SetSecondsRemaining, file, "$$");
newXSproto(strcpy(buf, "SetZoneInLocation"), XS_Expedition_SetZoneInLocation, file, "$$$$$");
newXSproto(strcpy(buf, "UpdateLockoutDuration"), XS_Expedition_UpdateLockoutDuration, file, "$$$;$");
void Perl_Expedition_UpdateLockoutDuration(Expedition* self, std::string event_name, uint32_t seconds, bool members_only)
{
self->UpdateLockoutDuration(event_name, seconds, members_only);
}
HV* stash = gv_stashpvs("ExpeditionLockMessage", GV_ADD);
newCONSTSUB(stash, "None", newSViv(static_cast<int>(ExpeditionLockMessage::None)));
newCONSTSUB(stash, "Close", newSViv(static_cast<int>(ExpeditionLockMessage::Close)));
newCONSTSUB(stash, "Begin", newSViv(static_cast<int>(ExpeditionLockMessage::Begin)));
void perl_register_expedition()
{
perl::interpreter perl(PERL_GET_THX);
XSRETURN_YES;
auto package = perl.new_class<Expedition>("Expedition");
package.add("AddLockout", &Perl_Expedition_AddLockout);
package.add("AddLockoutDuration", (void(*)(Expedition*, std::string, int))&Perl_Expedition_AddLockoutDuration);
package.add("AddLockoutDuration", (void(*)(Expedition*, std::string, int, bool))&Perl_Expedition_AddLockoutDuration);
package.add("AddReplayLockout", &Perl_Expedition_AddReplayLockout);
package.add("AddReplayLockoutDuration", (void(*)(Expedition*, int))&Perl_Expedition_AddReplayLockoutDuration);
package.add("AddReplayLockoutDuration", (void(*)(Expedition*, int, bool))&Perl_Expedition_AddReplayLockoutDuration);
package.add("GetDynamicZoneID", &Perl_Expedition_GetDynamicZoneID);
package.add("GetID", &Perl_Expedition_GetID);
package.add("GetInstanceID", &Perl_Expedition_GetInstanceID);
package.add("GetLeaderName", &Perl_Expedition_GetLeaderName);
package.add("GetLockouts", &Perl_Expedition_GetLockouts);
package.add("GetLootEventByNPCTypeID", &Perl_Expedition_GetLootEventByNPCTypeID);
package.add("GetLootEventBySpawnID", &Perl_Expedition_GetLootEventBySpawnID);
package.add("GetMemberCount", &Perl_Expedition_GetMemberCount);
package.add("GetMembers", &Perl_Expedition_GetMembers);
package.add("GetName", &Perl_Expedition_GetName);
package.add("GetSecondsRemaining", &Perl_Expedition_GetSecondsRemaining);
package.add("GetUUID", &Perl_Expedition_GetUUID);
package.add("GetZoneID", &Perl_Expedition_GetZoneID);
package.add("GetZoneName", &Perl_Expedition_GetZoneName);
package.add("GetZoneVersion", &Perl_Expedition_GetZoneVersion);
package.add("HasLockout", &Perl_Expedition_HasLockout);
package.add("HasReplayLockout", &Perl_Expedition_HasReplayLockout);
package.add("IsLocked", &Perl_Expedition_IsLocked);
package.add("RemoveCompass", &Perl_Expedition_RemoveCompass);
package.add("RemoveLockout", &Perl_Expedition_RemoveLockout);
package.add("SetCompass", &Perl_Expedition_SetCompass);
package.add("SetLocked", (void(*)(Expedition*, bool))&Perl_Expedition_SetLocked);
package.add("SetLocked", (void(*)(Expedition*, bool, int))&Perl_Expedition_SetLocked);
package.add("SetLocked", (void(*)(Expedition*, bool, int, uint32_t))&Perl_Expedition_SetLocked);
package.add("SetLootEventByNPCTypeID", &Perl_Expedition_SetLootEventByNPCTypeID);
package.add("SetLootEventBySpawnID", &Perl_Expedition_SetLootEventBySpawnID);
package.add("SetReplayLockoutOnMemberJoin", &Perl_Expedition_SetReplayLockoutOnMemberJoin);
package.add("SetSafeReturn", &Perl_Expedition_SetSafeReturn);
package.add("SetSecondsRemaining", &Perl_Expedition_SetSecondsRemaining);
package.add("SetZoneInLocation", &Perl_Expedition_SetZoneInLocation);
package.add("UpdateLockoutDuration", (void(*)(Expedition*, std::string, uint32_t))&Perl_Expedition_UpdateLockoutDuration);
package.add("UpdateLockoutDuration", (void(*)(Expedition*, std::string, uint32_t, bool))&Perl_Expedition_UpdateLockoutDuration);
}
void perl_register_expedition_lock_messages()
{
perl::interpreter perl(PERL_GET_THX);
auto package = perl.new_package("ExpeditionLockMessage");
package.add_const("None", static_cast<int>(ExpeditionLockMessage::None));
package.add_const("Close", static_cast<int>(ExpeditionLockMessage::Close));
package.add_const("Begin", static_cast<int>(ExpeditionLockMessage::Begin));
}
#endif //EMBPERL_XS_CLASSES

578
zone/perl_groups.cpp
View File

@ -4,475 +4,149 @@
#include "../common/global_define.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "groups.h"
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
void Perl_Group_DisbandGroup(Group* self) // @categories Script Utility, Group
{
self->DisbandGroup();
}
#define VALIDATE_THIS_IS_GROUP \
do { \
if (sv_derived_from(ST(0), "Group")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(Group*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type Group"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
bool Perl_Group_IsGroupMember(Group* self, Mob* client) // @categories Account and Character, Script Utility, Group
{
return self->IsGroupMember(client);
}
XS(XS_Group_DisbandGroup); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_DisbandGroup) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Group::DisbandGroup(THIS)"); // @categories Script Utility, Group
void Perl_Group_CastGroupSpell(Group* self, Mob* caster, uint16 spell_id) // @categories Account and Character, Script Utility, Group
{
self->CastGroupSpell(caster, spell_id);
}
void Perl_Group_SplitExp(Group* self, uint32_t exp, Mob* other) // @categories Account and Character, Script Utility, Group
{
self->SplitExp(exp, other);
}
void Perl_Group_GroupMessage(Group* self, Mob* sender, const char* message) // @categories Script Utility, Group
{
// if no language is specificed, send it in common
self->GroupMessage(sender, 0, 100, message);
}
void Perl_Group_GroupMessage(Group* self, Mob* sender, uint8_t language, const char* message) // @categories Script Utility, Group
{
if ((language >= MAX_PP_LANGUAGE) || (language < 0))
{
Group *THIS;
VALIDATE_THIS_IS_GROUP;
THIS->DisbandGroup();
language = 0;
}
XSRETURN_EMPTY;
self->GroupMessage(sender, language, 100, message);
}
XS(XS_Group_IsGroupMember); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_IsGroupMember) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Group::IsGroupMember(THIS, client)"); // @categories Account and Character, Script Utility, Group
uint32_t Perl_Group_GetTotalGroupDamage(Group* self, Mob* other) // @categories Script Utility, Group
{
return self->GetTotalGroupDamage(other);
}
void Perl_Group_SplitMoney(Group* self, uint32 copper, uint32 silver, uint32 gold, uint32 platinum) // @categories Currency and Points, Script Utility, Group
{
self->SplitMoney(copper, silver, gold, platinum);
}
void Perl_Group_SetLeader(Group* self, Mob* new_leader) // @categories Account and Character, Script Utility, Group
{
self->SetLeader(new_leader);
}
Mob* Perl_Group_GetLeader(Group* self) // @categories Account and Character, Script Utility, Group
{
return self->GetLeader();
}
std::string Perl_Group_GetLeaderName(Group* self) // @categories Account and Character, Script Utility, Group
{
return self->GetLeaderName();
}
void Perl_Group_SendHPPacketsTo(Group* self, Mob* new_member) // @categories Script Utility, Group
{
self->SendHPManaEndPacketsTo(new_member);
}
void Perl_Group_SendHPPacketsFrom(Group* self, Mob* new_member) // @categories Script Utility, Group
{
self->SendHPPacketsFrom(new_member);
}
bool Perl_Group_IsLeader(Group* self, Mob* leadertest) // @categories Account and Character, Script Utility, Group
{
return self->IsLeader(leadertest);
}
int Perl_Group_GroupCount(Group* self) // @categories Script Utility, Group
{
return self->GroupCount();
}
uint32_t Perl_Group_GetHighestLevel(Group* self) // @categories Script Utility, Group
{
return self->GetHighestLevel();
}
void Perl_Group_TeleportGroup(Group* self, Mob* sender, uint32 zone_id, float x, float y, float z, float heading) // @categories Script Utility, Group
{
self->TeleportGroup(sender, zone_id, 0, x, y, z, heading);
}
uint32_t Perl_Group_GetID(Group* self) // @categories Script Utility, Group
{
return self->GetID();
}
Client* Perl_Group_GetMember(Group* self, int group_index) // @categories Account and Character, Script Utility, Group
{
Mob* member = nullptr;
if (group_index >= 0 && group_index < 6)
{
Group *THIS;
bool RETVAL;
Mob *client;
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
client = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "client is not of type Mob");
if (client == nullptr)
Perl_croak(aTHX_ "client is nullptr, avoiding crash.");
RETVAL = THIS->IsGroupMember(client);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
member = self->members[group_index];
}
XSRETURN(1);
return member ? member->CastToClient() : nullptr;
}
XS(XS_Group_CastGroupSpell); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_CastGroupSpell) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Group::CastGroupSpell(THIS, Mob* caster, uint16 spell_id)"); // @categories Account and Character, Script Utility, Group
{
Group *THIS;
Mob *caster;
uint16 spellid = (uint16) SvUV(ST(2));
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
caster = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "caster is not of type Mob");
if (caster == nullptr)
Perl_croak(aTHX_ "caster is nullptr, avoiding crash.");
THIS->CastGroupSpell(caster, spellid);
}
XSRETURN_EMPTY;
bool Perl_Group_DoesAnyMemberHaveExpeditionLockout(Group* self, std::string expedition_name, std::string event_name)
{
return self->DoesAnyMemberHaveExpeditionLockout(expedition_name, event_name);
}
XS(XS_Group_SplitExp); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_SplitExp) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Group::SplitExp(THIS, uint32 exp, Mob* other)"); // @categories Account and Character, Script Utility, Group
{
Group *THIS;
uint32 exp = (uint32) SvUV(ST(1));
Mob *other;
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(2), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(2)));
other = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "other is not of type Mob");
if (other == nullptr)
Perl_croak(aTHX_ "other is nullptr, avoiding crash.");
THIS->SplitExp(exp, other);
}
XSRETURN_EMPTY;
bool Perl_Group_DoesAnyMemberHaveExpeditionLockout(Group* self, std::string expedition_name, std::string event_name, int max_check_count)
{
return self->DoesAnyMemberHaveExpeditionLockout(expedition_name, event_name, max_check_count);
}
XS(XS_Group_GroupMessage); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_GroupMessage) {
dXSARGS;
if ((items != 3) && (items != 4)) // the 3 item version is kept for backwards compatability
Perl_croak(aTHX_ "Usage: Group::GroupMessage(THIS, Mob* sender, uint8 language, string message)"); // @categories Script Utility, Group
{
Group *THIS;
Mob *sender;
uint8 language;
char *message;
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
sender = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "sender is not of type Mob");
if (sender == nullptr)
Perl_croak(aTHX_ "sender is nullptr, avoiding crash.");
void perl_register_group()
{
perl::interpreter perl(PERL_GET_THX);
if (items == 4) {
language = (uint8) SvUV(ST(2));
if ((language >= MAX_PP_LANGUAGE) || (language < 0))
language = 0;
message = (char *) SvPV_nolen(ST(3));
THIS->GroupMessage(sender, language, 100, message);
} else { // if no language is specificed, send it in common
message = (char *) SvPV_nolen(ST(2));
THIS->GroupMessage(sender, 0, 100, message);
}
}
XSRETURN_EMPTY;
}
XS(XS_Group_GetTotalGroupDamage); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_GetTotalGroupDamage) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Group::GetTotalGroupDamage(THIS, Mob* other)"); // @categories Script Utility, Group
{
Group *THIS;
uint32 RETVAL;
dXSTARG;
Mob *other;
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
other = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "other is not of type Mob");
if (other == nullptr)
Perl_croak(aTHX_ "other is nullptr, avoiding crash.");
RETVAL = THIS->GetTotalGroupDamage(other);
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Group_SplitMoney); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_SplitMoney) {
dXSARGS;
if (items != 5)
Perl_croak(aTHX_ "Usage: Group::SplitMoney(THIS, uint32 copper, uint32 silver, uint32 gold, uint32 platinum)"); // @categories Currency and Points, Script Utility, Group
{
Group *THIS;
uint32 copper = (uint32) SvUV(ST(1));
uint32 silver = (uint32) SvUV(ST(2));
uint32 gold = (uint32) SvUV(ST(3));
uint32 platinum = (uint32) SvUV(ST(4));
VALIDATE_THIS_IS_GROUP;
THIS->SplitMoney(copper, silver, gold, platinum);
}
XSRETURN_EMPTY;
}
XS(XS_Group_SetLeader); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_SetLeader) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Group::SetLeader(THIS, Mob* new_leader)"); // @categories Account and Character, Script Utility, Group
{
Group *THIS;
Mob *newleader;
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
newleader = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "newleader is not of type Mob");
if (newleader == nullptr)
Perl_croak(aTHX_ "newleader is nullptr, avoiding crash.");
THIS->SetLeader(newleader);
}
XSRETURN_EMPTY;
}
XS(XS_Group_GetLeader); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_GetLeader) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Group::GetLeader(THIS)"); // @categories Account and Character, Script Utility, Group
{
Group *THIS;
Mob *RETVAL;
VALIDATE_THIS_IS_GROUP;
RETVAL = THIS->GetLeader();
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "Mob", (void *) RETVAL);
}
XSRETURN(1);
}
XS(XS_Group_GetLeaderName); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_GetLeaderName) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Group::GetLeaderName(THIS)"); // @categories Account and Character, Script Utility, Group
{
Group *THIS;
const char *RETVAL;
dXSTARG;
VALIDATE_THIS_IS_GROUP;
RETVAL = THIS->GetLeaderName();
sv_setpv(TARG, RETVAL);
XSprePUSH;
PUSHTARG;
}
XSRETURN(1);
}
XS(XS_Group_SendHPPacketsTo); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_SendHPPacketsTo) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Group::SendHPPacketsTo(THIS, Mob* new_member)"); // @categories Script Utility, Group
{
Group *THIS;
Mob *newmember;
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
newmember = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "newmember is not of type Mob");
if (newmember == nullptr)
Perl_croak(aTHX_ "newmember is nullptr, avoiding crash.");
THIS->SendHPManaEndPacketsTo(newmember);
}
XSRETURN_EMPTY;
}
XS(XS_Group_SendHPPacketsFrom); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_SendHPPacketsFrom) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Group::SendHPPacketsFrom(THIS, Mob* new_member)"); // @categories Script Utility, Group
{
Group *THIS;
Mob *newmember;
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
newmember = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "newmember is not of type Mob");
if (newmember == nullptr)
Perl_croak(aTHX_ "newmember is nullptr, avoiding crash.");
THIS->SendHPPacketsFrom(newmember);
}
XSRETURN_EMPTY;
}
XS(XS_Group_IsLeader); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_IsLeader) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Group::IsLeader(THIS, Mob* target)"); // @categories Account and Character, Script Utility, Group
{
Group *THIS;
bool RETVAL;
Mob *leadertest;
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
leadertest = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "leadertest is not of type Mob");
if (leadertest == nullptr)
Perl_croak(aTHX_ "leadertest is nullptr, avoiding crash.");
RETVAL = THIS->IsLeader(leadertest);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
}
XS(XS_Group_GroupCount); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_GroupCount) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Group::GroupCount(THIS)"); // @categories Script Utility, Group
{
Group *THIS;
uint8 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_GROUP;
RETVAL = THIS->GroupCount();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Group_GetHighestLevel); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_GetHighestLevel) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Group::GetHighestLevel(THIS)"); // @categories Script Utility, Group
{
Group *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_GROUP;
RETVAL = THIS->GetHighestLevel();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Group_TeleportGroup); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_TeleportGroup) {
dXSARGS;
if (items != 7)
Perl_croak(aTHX_ "Usage: Group::TeleportGroup(THIS, Mob* sender, uint32 zone_id, float x, float y, float z, float heading)"); // @categories Script Utility, Group
{
Group *THIS;
Mob *sender;
uint32 zoneID = (uint32) SvUV(ST(2));
float x = (float) SvNV(ST(3));
float y = (float) SvNV(ST(4));
float z = (float) SvNV(ST(5));
float heading = (float) SvNV(ST(6));
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
sender = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "sender is not of type Mob");
if (sender == nullptr)
Perl_croak(aTHX_ "sender is nullptr, avoiding crash.");
THIS->TeleportGroup(sender, zoneID, 0, x, y, z, heading);
}
XSRETURN_EMPTY;
}
XS(XS_Group_GetID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_GetID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Group::GetID(THIS)"); // @categories Script Utility, Group
{
Group *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_GROUP;
RETVAL = THIS->GetID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Group_GetMember);
XS(XS_Group_GetMember) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Group::GetMember(THIS, int group_index)"); // @categories Account and Character, Script Utility, Group
{
Group *THIS;
Mob *member;
Client *RETVAL = nullptr;
dXSTARG;
VALIDATE_THIS_IS_GROUP;
int index = (int) SvUV(ST(1));
if (index < 0 || index > 5)
RETVAL = nullptr;
else {
member = THIS->members[index];
if (member != nullptr)
RETVAL = member->CastToClient();
}
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "Client", (void *) RETVAL);
}
XSRETURN(1);
}
XS(XS_Group_DoesAnyMemberHaveExpeditionLockout);
XS(XS_Group_DoesAnyMemberHaveExpeditionLockout) {
dXSARGS;
if (items != 3 && items != 4) {
Perl_croak(aTHX_ "Usage: Group::DoesAnyMemberHaveExpeditionLockout(THIS, string expedition_name, string event_name, [int max_check_count = 0])");
}
Group* THIS = nullptr;
VALIDATE_THIS_IS_GROUP;
std::string expedition_name(SvPV_nolen(ST(1)));
std::string event_name(SvPV_nolen(ST(2)));
int max_check_count = (items == 4) ? static_cast<int>(SvIV(ST(3))) : 0;
bool result = THIS->DoesAnyMemberHaveExpeditionLockout(expedition_name, event_name, max_check_count);
ST(0) = boolSV(result);
XSRETURN(1);
}
#ifdef __cplusplus
extern "C"
#endif
XS(boot_Group); /* prototype to pass -Wmissing-prototypes */
XS(boot_Group) {
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, "CastGroupSpell"), XS_Group_CastGroupSpell, file, "$$$");
newXSproto(strcpy(buf, "DisbandGroup"), XS_Group_DisbandGroup, file, "$");
newXSproto(strcpy(buf, "DoesAnyMemberHaveExpeditionLockout"), XS_Group_DoesAnyMemberHaveExpeditionLockout, file, "$$$;$");
newXSproto(strcpy(buf, "GetHighestLevel"), XS_Group_GetHighestLevel, file, "$");
newXSproto(strcpy(buf, "GetID"), XS_Group_GetID, file, "$");
newXSproto(strcpy(buf, "GetLeader"), XS_Group_GetLeader, file, "$");
newXSproto(strcpy(buf, "GetLeaderName"), XS_Group_GetLeaderName, file, "$");
newXSproto(strcpy(buf, "GetMember"), XS_Group_GetMember, file, "$$");
newXSproto(strcpy(buf, "GetTotalGroupDamage"), XS_Group_GetTotalGroupDamage, file, "$$");
newXSproto(strcpy(buf, "GroupCount"), XS_Group_GroupCount, file, "$");
newXSproto(strcpy(buf, "GroupMessage"), XS_Group_GroupMessage, file, "$$$");
newXSproto(strcpy(buf, "IsGroupMember"), XS_Group_IsGroupMember, file, "$$");
newXSproto(strcpy(buf, "IsLeader"), XS_Group_IsLeader, file, "$$");
newXSproto(strcpy(buf, "SendHPPacketsFrom"), XS_Group_SendHPPacketsFrom, file, "$$");
newXSproto(strcpy(buf, "SendHPPacketsTo"), XS_Group_SendHPPacketsTo, file, "$$");
newXSproto(strcpy(buf, "SetLeader"), XS_Group_SetLeader, file, "$$");
newXSproto(strcpy(buf, "SplitExp"), XS_Group_SplitExp, file, "$$$");
newXSproto(strcpy(buf, "SplitMoney"), XS_Group_SplitMoney, file, "$$$$$");
newXSproto(strcpy(buf, "TeleportGroup"), XS_Group_TeleportGroup, file, "$$$$$$$");
XSRETURN_YES;
auto package = perl.new_class<Group>("Group");
package.add("CastGroupSpell", &Perl_Group_CastGroupSpell);
package.add("DisbandGroup", &Perl_Group_DisbandGroup);
package.add("DoesAnyMemberHaveExpeditionLockout", (bool(*)(Group*, std::string, std::string))&Perl_Group_DoesAnyMemberHaveExpeditionLockout);
package.add("DoesAnyMemberHaveExpeditionLockout", (bool(*)(Group*, std::string, std::string, int))&Perl_Group_DoesAnyMemberHaveExpeditionLockout);
package.add("GetHighestLevel", &Perl_Group_GetHighestLevel);
package.add("GetID", &Perl_Group_GetID);
package.add("GetLeader", &Perl_Group_GetLeader);
package.add("GetLeaderName", &Perl_Group_GetLeaderName);
package.add("GetMember", &Perl_Group_GetMember);
package.add("GetTotalGroupDamage", &Perl_Group_GetTotalGroupDamage);
package.add("GroupCount", &Perl_Group_GroupCount);
package.add("GroupMessage", (void(*)(Group*, Mob*, const char*))&Perl_Group_GroupMessage);
package.add("GroupMessage", (void(*)(Group*, Mob*, uint8_t, const char*))&Perl_Group_GroupMessage);
package.add("IsGroupMember", &Perl_Group_IsGroupMember);
package.add("IsLeader", &Perl_Group_IsLeader);
package.add("SendHPPacketsFrom", &Perl_Group_SendHPPacketsFrom);
package.add("SendHPPacketsTo", &Perl_Group_SendHPPacketsTo);
package.add("SetLeader", &Perl_Group_SetLeader);
package.add("SplitExp", &Perl_Group_SplitExp);
package.add("SplitMoney", &Perl_Group_SplitMoney);
package.add("TeleportGroup", &Perl_Group_TeleportGroup);
}
#endif //EMBPERL_XS_CLASSES

105
zone/perl_hateentry.cpp
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

617
zone/perl_inventory.cpp
View File

@ -4,525 +4,204 @@
#ifdef EMBPERL_XS_CLASSES
#include "../common/global_define.h"
#include "../common/inventory_profile.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "../common/inventory_profile.h"
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
#define VALIDATE_THIS_IS_INVENTORY \
do { \
if (sv_derived_from(ST(0), "Inventory")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(EQ::InventoryProfile*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type EQ::InventoryProfile"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
XS(XS_Inventory_CanItemFitInContainer);
XS(XS_Inventory_CanItemFitInContainer) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Inventory::CanItemFitInContainer(THIS, ItemInstance item_to_check, ItemInstance container_to_check)");
{
EQ::InventoryProfile* THIS;
bool can_fit = false;
EQ::ItemInstance* item_to_check = (EQ::ItemInstance*)SvIV((SV*)SvRV(ST(1)));
EQ::ItemInstance* container_to_check = (EQ::ItemInstance*)SvIV((SV*)SvRV(ST(2)));
const EQ::ItemData* item_data = item_to_check->GetItem();
const EQ::ItemData* container_data = container_to_check->GetItem();
VALIDATE_THIS_IS_INVENTORY;
can_fit = THIS->CanItemFitInContainer(item_data, container_data);
ST(0) = boolSV(can_fit);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_Inventory_CanItemFitInContainer(EQ::InventoryProfile* self, EQ::ItemInstance* item_to_check, EQ::ItemInstance* container_to_check)
{
const EQ::ItemData* item_data = item_to_check->GetItem();
const EQ::ItemData* container_data = container_to_check->GetItem();
return self->CanItemFitInContainer(item_data, container_data);
}
XS(XS_Inventory_CheckNoDrop);
XS(XS_Inventory_CheckNoDrop) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::CheckNoDrop(THIS, int16 slot_id)");
{
EQ::InventoryProfile* THIS;
bool no_drop = false;
int16 slot_id = (int16)SvIV(ST(1));
VALIDATE_THIS_IS_INVENTORY;
no_drop = THIS->CheckNoDrop(slot_id);
ST(0) = boolSV(no_drop);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_Inventory_CheckNoDrop(EQ::InventoryProfile* self, int16_t slot_id)
{
return self->CheckNoDrop(slot_id);
}
XS(XS_Inventory_DeleteItem);
XS(XS_Inventory_DeleteItem) {
dXSARGS;
if (items < 2 || items > 3)
Perl_croak(aTHX_ "Usage: Inventory::DeleteItem(THIS, int16 slot_id, [uint8 quantity = 0])");
{
EQ::InventoryProfile* THIS;
bool item_deleted = false;
int16 slot_id = (int16)SvIV(ST(1));
uint8 quantity = 0;
VALIDATE_THIS_IS_INVENTORY;
if (items > 2)
quantity = (uint8)SvUV(ST(2));
item_deleted = THIS->DeleteItem(slot_id, quantity);
ST(0) = boolSV(item_deleted);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_Inventory_DeleteItem(EQ::InventoryProfile* self, int16_t slot_id)
{
return self->DeleteItem(slot_id);
}
XS(XS_Inventory_FindFreeSlot);
XS(XS_Inventory_FindFreeSlot) {
dXSARGS;
if (items < 3 || items > 5)
Perl_croak(aTHX_ "Usage: Inventory::FindFreeSlot(THIS, bool is_for_bag, bool try_cursor, [uint8 min_size = 0, bool is_arrow = false])");
{
EQ::InventoryProfile* THIS;
int16 free_slot;
bool is_for_bag = (bool)SvNV(ST(1));
bool try_cursor = (bool)SvNV(ST(2));
uint8 min_size = 0;
bool is_arrow = false;
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
if (items > 3)
min_size = (uint8)SvUV(ST(3));
if (items > 4)
is_arrow = (bool)SvNV(ST(4));
free_slot = THIS->FindFreeSlot(is_for_bag, try_cursor, min_size, is_arrow);
XSprePUSH;
PUSHi((IV)free_slot);
}
XSRETURN(1);
bool Perl_Inventory_DeleteItem(EQ::InventoryProfile* self, int16_t slot_id, uint8_t quantity)
{
return self->DeleteItem(slot_id, quantity);
}
XS(XS_Inventory_GetBagIndex);
XS(XS_Inventory_GetBagIndex) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::GetBagIndex(THIS, int16 slot_id)");
{
EQ::InventoryProfile* THIS;
uint8 bag_index;
int16 slot_id = (int16)SvIV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
bag_index = THIS->CalcBagIdx(slot_id);
XSprePUSH;
PUSHu((UV) bag_index);
}
XSRETURN(1);
int Perl_Inventory_FindFreeSlot(EQ::InventoryProfile* self, bool is_for_bag, bool try_cursor)
{
return self->FindFreeSlot(is_for_bag, try_cursor);
}
XS(XS_Inventory_GetItem);
XS(XS_Inventory_GetItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::GetItem(THIS, int16 slot_id)");
{
EQ::InventoryProfile* THIS;
EQ::ItemInstance* item;
int16 slot_id = (int16)SvIV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
item = THIS->GetItem(slot_id);
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "QuestItem", (void*)item);
}
XSRETURN(1);
int Perl_Inventory_FindFreeSlot(EQ::InventoryProfile* self, bool is_for_bag, bool try_cursor, uint8_t min_size)
{
return self->FindFreeSlot(is_for_bag, try_cursor, min_size);
}
XS(XS_Inventory_GetMaterialFromSlot);
XS(XS_Inventory_GetMaterialFromSlot) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::GetMaterialFromSlot(THIS, int16 slot_id)");
{
EQ::InventoryProfile* THIS;
uint8 material;
int16 slot_id = (int16)SvIV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
material = THIS->CalcMaterialFromSlot(slot_id);
XSprePUSH;
PUSHu((UV) material);
}
XSRETURN(1);
int Perl_Inventory_FindFreeSlot(EQ::InventoryProfile* self, bool is_for_bag, bool try_cursor, uint8_t min_size, bool is_arrow)
{
return self->FindFreeSlot(is_for_bag, try_cursor, min_size, is_arrow);
}
XS(XS_Inventory_GetSlotByItemInst);
XS(XS_Inventory_GetSlotByItemInst) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::GetSlotByItemInst(THIS, ItemInstance item)");
{
EQ::InventoryProfile* THIS;
int slot_id;
EQ::ItemInstance* item = (EQ::ItemInstance*)SvIV((SV*)SvRV(ST(1)));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
slot_id = THIS->GetSlotByItemInst(item);
XSprePUSH;
PUSHi((IV) slot_id);
}
XSRETURN(1);
int Perl_Inventory_GetBagIndex(EQ::InventoryProfile* self, int16_t slot_id)
{
return self->CalcBagIdx(slot_id);
}
XS(XS_Inventory_GetSlotFromMaterial);
XS(XS_Inventory_GetSlotFromMaterial) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::GetSlotFromMaterial(THIS, uint8 material)");
{
EQ::InventoryProfile* THIS;
int16 slot_id;
uint8 material = (uint8)SvUV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
slot_id = THIS->CalcSlotFromMaterial(material);
XSprePUSH;
PUSHi((IV) slot_id);
}
XSRETURN(1);
EQ::ItemInstance* Perl_Inventory_GetItem(EQ::InventoryProfile* self, int16_t slot_id)
{
return self->GetItem(slot_id);
}
XS(XS_Inventory_GetSlotID);
XS(XS_Inventory_GetSlotID) {
dXSARGS;
if (items < 2 || items > 3)
Perl_croak(aTHX_ "Usage: Inventory::GetSlotID(THIS, int16 slot_id, [uint8 bag_index])");
{
EQ::InventoryProfile* THIS;
int16 slot_id = (int16)SvIV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
if (items == 2)
slot_id = THIS->CalcSlotId(slot_id);
if (items == 3) {
uint8 bag_index = (uint8)SvUV(ST(2));
slot_id = THIS->CalcSlotId(slot_id, bag_index);
}
XSprePUSH;
PUSHi((IV) slot_id);
}
XSRETURN(1);
int Perl_Inventory_GetMaterialFromSlot(EQ::InventoryProfile* self, int16_t slot_id)
{
return self->CalcMaterialFromSlot(slot_id);
}
XS(XS_Inventory_HasItem);
XS(XS_Inventory_HasItem) {
dXSARGS;
if (items < 2 || items > 4)
Perl_croak(aTHX_ "Usage: Inventory::HasItem(THIS, uint32 item_id, [uint8 quantity, uint8 where])");
{
EQ::InventoryProfile* THIS;
int16 slot_id;
uint32 item_id = (uint32)SvUV(ST(1));
uint8 quantity = 0;
uint8 where_to_look = 0xFF;
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
if (items > 2)
quantity = (uint8)SvUV(ST(2));
if (items > 3)
where_to_look = (uint8)SvUV(ST(3));
slot_id = THIS->HasItem(item_id, quantity, where_to_look);
XSprePUSH;
PUSHi((IV) slot_id);
}
XSRETURN(1);
int Perl_Inventory_GetSlotByItemInst(EQ::InventoryProfile* self, EQ::ItemInstance* item)
{
return self->GetSlotByItemInst(item);
}
XS(XS_Inventory_HasItemByLoreGroup);
XS(XS_Inventory_HasItemByLoreGroup) {
dXSARGS;
if (items < 2 || items > 3)
Perl_croak(aTHX_ "Usage: Inventory::HasItemByLoreGroup(THIS, uint32 loregroup, [uint8 where])");
{
EQ::InventoryProfile* THIS;
int16 slot_id;
uint32 loregroup = (uint32)SvUV(ST(1));
uint8 where_to_look = 0xFF;
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
if (items > 2)
where_to_look = (uint8)SvUV(ST(2));
slot_id = THIS->HasItemByLoreGroup(loregroup, where_to_look);
XSprePUSH;
PUSHi((IV) slot_id);
}
XSRETURN(1);
int Perl_Inventory_GetSlotFromMaterial(EQ::InventoryProfile* self, uint8_t material)
{
return self->CalcSlotFromMaterial(material);
}
XS(XS_Inventory_HasItemByUse);
XS(XS_Inventory_HasItemByUse) {
dXSARGS;
if (items < 3 || items > 4)
Perl_croak(aTHX_ "Usage: Inventory::HasItemByUse(THIS, uint8 use, uint8 quantity, [uint8 where])");
{
EQ::InventoryProfile* THIS;
int16 slot_id;
uint8 item_use = (uint8)SvUV(ST(1));
uint8 quantity = (uint8)SvUV(ST(2));
uint8 where_to_look = 0xFF;
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
if (items > 3)
where_to_look = (uint8)SvUV(ST(3));
slot_id = THIS->HasItemByUse(item_use, quantity, where_to_look);
XSprePUSH;
PUSHi((IV) slot_id);
}
XSRETURN(1);
int Perl_Inventory_GetSlotID(EQ::InventoryProfile* self, int16_t slot_id)
{
return self->CalcSlotId(slot_id);
}
XS(XS_Inventory_HasSpaceForItem);
XS(XS_Inventory_HasSpaceForItem) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Inventory::HasSpaceForItem(THIS, ItemInstance item_to_check, uint8 quantity)");
{
EQ::InventoryProfile* THIS;
bool has_space = false;
EQ::ItemInstance* item_to_check = (EQ::ItemInstance*)SvIV((SV*)SvRV(ST(1)));
uint8 quantity = (uint8)SvUV(ST(2));
const EQ::ItemData* item_data = item_to_check->GetItem();
VALIDATE_THIS_IS_INVENTORY;
has_space = THIS->HasSpaceForItem(item_data, quantity);
ST(0) = boolSV(has_space);
sv_2mortal(ST(0));
}
XSRETURN(1);
int Perl_Inventory_GetSlotID(EQ::InventoryProfile* self, int16_t slot_id, uint8_t bag_index)
{
return self->CalcSlotId(slot_id, bag_index);
}
XS(XS_Inventory_PopItem);
XS(XS_Inventory_PopItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::PopItem(THIS, int16 slot_id)");
{
EQ::InventoryProfile* THIS;
EQ::ItemInstance* item;
int16 slot_id = (int16)SvIV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
item = THIS->PopItem(slot_id);
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "QuestItem", (void*)item);
}
XSRETURN(1);
int Perl_Inventory_HasItem(EQ::InventoryProfile* self, uint32_t item_id)
{
return self->HasItem(item_id);
}
XS(XS_Inventory_SupportsContainers);
XS(XS_Inventory_SupportsContainers) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::SupportsContainers(THIS, int16 slot_id)");
{
EQ::InventoryProfile* THIS;
bool supports_containers = false;
int16 slot_id = (int16)SvIV(ST(1));
VALIDATE_THIS_IS_INVENTORY;
supports_containers = THIS->SupportsContainers(slot_id);
ST(0) = boolSV(supports_containers);
sv_2mortal(ST(0));
}
XSRETURN(1);
int Perl_Inventory_HasItem(EQ::InventoryProfile* self, uint32_t item_id, uint8_t quantity)
{
return self->HasItem(item_id, quantity);
}
XS(XS_Inventory_SwapItem);
XS(XS_Inventory_SwapItem) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Inventory::SwapItem(THIS, int16 source_slot_id, int16 destination_slot_id)");
{
EQ::InventoryProfile* THIS;
bool item_swapped = false;
int16 source_slot_id = (int16)SvIV(ST(1));
int16 destination_slot_id = (int16)SvIV(ST(2));
EQ::InventoryProfile::SwapItemFailState fail_state = EQ::InventoryProfile::swapInvalid;
VALIDATE_THIS_IS_INVENTORY;
item_swapped = THIS->SwapItem(source_slot_id, destination_slot_id, fail_state);
ST(0) = boolSV(item_swapped);
sv_2mortal(ST(0));
}
XSRETURN(1);
int Perl_Inventory_HasItem(EQ::InventoryProfile* self, uint32_t item_id, uint8_t quantity, uint8_t where_to_look)
{
return self->HasItem(item_id, quantity, where_to_look);
}
XS(XS_Inventory_PushCursor);
XS(XS_Inventory_PushCursor) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::PushCursor(THIS, ItemInstance item)");
{
EQ::InventoryProfile* THIS;
int16 slot_id;
EQ::ItemInstance* item = (EQ::ItemInstance*)SvIV((SV*)SvRV(ST(1)));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
if (item)
slot_id = THIS->PushCursor(*item);
else
slot_id = 0;
XSprePUSH;
PUSHi((IV) slot_id);
}
XSRETURN(1);
int Perl_Inventory_HasItemByLoreGroup(EQ::InventoryProfile* self, uint32_t loregroup)
{
return self->HasItemByLoreGroup(loregroup);
}
XS(XS_Inventory_PutItem);
XS(XS_Inventory_PutItem) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Inventory::PutItem(THIS, int16 slot_id, ItemInstance item)");
{
EQ::InventoryProfile* THIS;
int16 slot_id = (int16)SvUV(ST(1));
EQ::ItemInstance* item = (EQ::ItemInstance*)SvIV((SV*)SvRV(ST(2)));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
if (item)
slot_id = THIS->PutItem(slot_id, *item);
else
slot_id = 0;
XSprePUSH;
PUSHi((IV) slot_id);
}
XSRETURN(1);
int Perl_Inventory_HasItemByLoreGroup(EQ::InventoryProfile* self, uint32_t loregroup, uint8_t where_to_look)
{
return self->HasItemByLoreGroup(loregroup, where_to_look);
}
XS(XS_Inventory_HasAugmentEquippedByID);
XS(XS_Inventory_HasAugmentEquippedByID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::HasAugmentEquippedByID(THIS, uint32 item_id)");
{
EQ::InventoryProfile* THIS;
bool has_equipped = false;
uint32 item_id = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_INVENTORY;
has_equipped = THIS->HasAugmentEquippedByID(item_id);
ST(0) = boolSV(has_equipped);
sv_2mortal(ST(0));
}
XSRETURN(1);
int Perl_Inventory_HasItemByUse(EQ::InventoryProfile* self, uint8_t item_use, uint8_t quantity)
{
return self->HasItemByUse(item_use, quantity);
}
XS(XS_Inventory_CountAugmentEquippedByID);
XS(XS_Inventory_CountAugmentEquippedByID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::CountAugmentEquippedByID(THIS, uint32 item_id)");
{
EQ::InventoryProfile* THIS;
int quantity = 0;
uint32 item_id = (uint32) SvUV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
quantity = THIS->CountAugmentEquippedByID(item_id);
XSprePUSH;
PUSHi((IV) quantity);
}
XSRETURN(1);
int Perl_Inventory_HasItemByUse(EQ::InventoryProfile* self, uint8_t item_use, uint8_t quantity, uint8_t where_to_look)
{
return self->HasItemByUse(item_use, quantity, where_to_look);
}
XS(XS_Inventory_HasItemEquippedByID);
XS(XS_Inventory_HasItemEquippedByID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::HasItemEquippedByID(THIS, uint32 item_id)");
{
EQ::InventoryProfile* THIS;
bool has_equipped = false;
uint32 item_id = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_INVENTORY;
has_equipped = THIS->HasItemEquippedByID(item_id);
ST(0) = boolSV(has_equipped);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_Inventory_HasSpaceForItem(EQ::InventoryProfile* self, EQ::ItemInstance* item_to_check, uint8_t quantity)
{
const EQ::ItemData* item_data = item_to_check->GetItem();
return self->HasSpaceForItem(item_data, quantity);
}
XS(XS_Inventory_CountItemEquippedByID);
XS(XS_Inventory_CountItemEquippedByID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::CountItemEquippedByID(THIS, uint32 item_id)");
{
EQ::InventoryProfile* THIS;
int quantity = 0;
uint32 item_id = (uint32) SvUV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
quantity = THIS->CountItemEquippedByID(item_id);
XSprePUSH;
PUSHi((IV) quantity);
}
XSRETURN(1);
EQ::ItemInstance* Perl_Inventory_PopItem(EQ::InventoryProfile* self, int16_t slot_id)
{
return self->PopItem(slot_id);
}
#ifdef __cplusplus
extern "C"
#endif
bool Perl_Inventory_SupportsContainers(EQ::InventoryProfile* self, int16_t slot_id)
{
return self->SupportsContainers(slot_id);
}
XS(boot_Inventory);
XS(boot_Inventory) {
dXSARGS;
char file[256];
strncpy(file, __FILE__, 256);
file[255] = 0;
if (items != 1)
fprintf(stderr, "boot_quest does not take any arguments.");
bool Perl_Inventory_SwapItem(EQ::InventoryProfile* self, int16_t source_slot_id, int16_t destination_slot_id)
{
EQ::InventoryProfile::SwapItemFailState fail_state = EQ::InventoryProfile::swapInvalid;
return self->SwapItem(source_slot_id, destination_slot_id, fail_state);
}
char buf[128];
XS_VERSION_BOOTCHECK;
newXSproto(strcpy(buf, "CanItemFitInContainer"), XS_Inventory_CanItemFitInContainer, file, "$$$");
newXSproto(strcpy(buf, "CountAugmentEquippedByID"), XS_Inventory_CountAugmentEquippedByID, file, "$$");
newXSproto(strcpy(buf, "CountItemEquippedByID"), XS_Inventory_CountItemEquippedByID, file, "$$");
newXSproto(strcpy(buf, "CheckNoDrop"), XS_Inventory_CheckNoDrop, file, "$$");
newXSproto(strcpy(buf, "DeleteItem"), XS_Inventory_DeleteItem, file, "$$;$");
newXSproto(strcpy(buf, "FindFreeSlot"), XS_Inventory_FindFreeSlot, file, "$$$;$$");
newXSproto(strcpy(buf, "GetBagIndex"), XS_Inventory_GetBagIndex, file, "$$");
newXSproto(strcpy(buf, "GetItem"), XS_Inventory_GetItem, file, "$$;$");
newXSproto(strcpy(buf, "GetMaterialFromSlot"), XS_Inventory_GetMaterialFromSlot, file, "$$");
newXSproto(strcpy(buf, "GetSlotByItemInst"), XS_Inventory_GetSlotByItemInst, file, "$$");
newXSproto(strcpy(buf, "GetSlotFromMaterial"), XS_Inventory_GetSlotFromMaterial, file, "$$");
newXSproto(strcpy(buf, "GetSlotID"), XS_Inventory_GetSlotID, file, "$$;$");
newXSproto(strcpy(buf, "HasAugmentEquippedByID"), XS_Inventory_HasAugmentEquippedByID, file, "$$");
newXSproto(strcpy(buf, "HasItem"), XS_Inventory_HasItem, file, "$$;$$");
newXSproto(strcpy(buf, "HasItemByLoreGroup"), XS_Inventory_HasItemByLoreGroup, file, "$$;$");
newXSproto(strcpy(buf, "HasItemByUse"), XS_Inventory_HasItemByUse, file, "$$;$$");
newXSproto(strcpy(buf, "HasItemEquippedByID"), XS_Inventory_HasItemEquippedByID, file, "$$");
newXSproto(strcpy(buf, "HasSpaceForItem"), XS_Inventory_HasSpaceForItem, file, "$$$");
newXSproto(strcpy(buf, "PopItem"), XS_Inventory_PopItem, file, "$$");
newXSproto(strcpy(buf, "PushCursor"), XS_Inventory_PushCursor, file, "$$");
newXSproto(strcpy(buf, "PutItem"), XS_Inventory_PutItem, file, "$$$");
newXSproto(strcpy(buf, "SupportsContainers"), XS_Inventory_SupportsContainers, file, "$$");
newXSproto(strcpy(buf, "SwapItem"), XS_Inventory_SwapItem, file, "$$$");
XSRETURN_YES;
int Perl_Inventory_PushCursor(EQ::InventoryProfile* self, EQ::ItemInstance* item)
{
return self->PushCursor(*item);
}
int Perl_Inventory_PutItem(EQ::InventoryProfile* self, int16_t slot_id, EQ::ItemInstance* item)
{
return self->PutItem(slot_id, *item);
}
bool Perl_Inventory_HasAugmentEquippedByID(EQ::InventoryProfile* self, uint32_t item_id)
{
return self->HasAugmentEquippedByID(item_id);
}
int Perl_Inventory_CountAugmentEquippedByID(EQ::InventoryProfile* self, uint32_t item_id)
{
return self->CountAugmentEquippedByID(item_id);
}
bool Perl_Inventory_HasItemEquippedByID(EQ::InventoryProfile* self, uint32_t item_id)
{
return self->HasItemEquippedByID(item_id);
}
int Perl_Inventory_CountItemEquippedByID(EQ::InventoryProfile* self, uint32_t item_id)
{
return self->CountItemEquippedByID(item_id);
}
void perl_register_inventory()
{
perl::interpreter perl(PERL_GET_THX);
auto package = perl.new_class<EQ::InventoryProfile>("Inventory");
package.add("CanItemFitInContainer", &Perl_Inventory_CanItemFitInContainer);
package.add("CountAugmentEquippedByID", &Perl_Inventory_CountAugmentEquippedByID);
package.add("CountItemEquippedByID", &Perl_Inventory_CountItemEquippedByID);
package.add("CheckNoDrop", &Perl_Inventory_CheckNoDrop);
package.add("DeleteItem", (bool(*)(EQ::InventoryProfile*, int16_t))&Perl_Inventory_DeleteItem);
package.add("DeleteItem", (bool(*)(EQ::InventoryProfile*, int16_t, uint8_t))&Perl_Inventory_DeleteItem);
package.add("FindFreeSlot", (int(*)(EQ::InventoryProfile*, bool, bool))&Perl_Inventory_FindFreeSlot);
package.add("FindFreeSlot", (int(*)(EQ::InventoryProfile*, bool, bool, uint8_t))&Perl_Inventory_FindFreeSlot);
package.add("FindFreeSlot", (int(*)(EQ::InventoryProfile*, bool, bool, uint8_t, bool))&Perl_Inventory_FindFreeSlot);
package.add("GetBagIndex", &Perl_Inventory_GetBagIndex);
package.add("GetItem", &Perl_Inventory_GetItem);
package.add("GetMaterialFromSlot", &Perl_Inventory_GetMaterialFromSlot);
package.add("GetSlotByItemInst", &Perl_Inventory_GetSlotByItemInst);
package.add("GetSlotFromMaterial", &Perl_Inventory_GetSlotFromMaterial);
package.add("GetSlotID", (int(*)(EQ::InventoryProfile*, int16_t))&Perl_Inventory_GetSlotID);
package.add("GetSlotID", (int(*)(EQ::InventoryProfile*, int16_t, uint8_t))&Perl_Inventory_GetSlotID);
package.add("HasAugmentEquippedByID", &Perl_Inventory_HasAugmentEquippedByID);
package.add("HasItem", (int(*)(EQ::InventoryProfile*, uint32_t))&Perl_Inventory_HasItem);
package.add("HasItem", (int(*)(EQ::InventoryProfile*, uint32_t, uint8_t))&Perl_Inventory_HasItem);
package.add("HasItem", (int(*)(EQ::InventoryProfile*, uint32_t, uint8_t, uint8_t))&Perl_Inventory_HasItem);
package.add("HasItemByLoreGroup", (int(*)(EQ::InventoryProfile*, uint32_t))&Perl_Inventory_HasItemByLoreGroup);
package.add("HasItemByLoreGroup", (int(*)(EQ::InventoryProfile*, uint32_t, uint8_t))&Perl_Inventory_HasItemByLoreGroup);
package.add("HasItemByUse", (int(*)(EQ::InventoryProfile*, uint8_t, uint8_t))&Perl_Inventory_HasItemByUse);
package.add("HasItemByUse", (int(*)(EQ::InventoryProfile*, uint8_t, uint8_t, uint8_t))&Perl_Inventory_HasItemByUse);
package.add("HasItemEquippedByID", &Perl_Inventory_HasItemEquippedByID);
package.add("HasSpaceForItem", &Perl_Inventory_HasSpaceForItem);
package.add("PopItem", &Perl_Inventory_PopItem);
package.add("PushCursor", &Perl_Inventory_PushCursor);
package.add("PutItem", &Perl_Inventory_PutItem);
package.add("SupportsContainers", &Perl_Inventory_SupportsContainers);
package.add("SwapItem", &Perl_Inventory_SwapItem);
}
#endif //EMBPERL_XS_CLASSES

9951
zone/perl_mob.cpp
View File

File diff suppressed because it is too large Load Diff

2372
zone/perl_npc.cpp
View File

File diff suppressed because it is too large Load Diff

854
zone/perl_object.cpp
View File

@ -4,756 +4,272 @@
#include "../common/global_define.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "object.h"
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
#define VALIDATE_THIS_IS_OBJECT \
do { \
if (sv_derived_from(ST(0), "Object")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(Object*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type Object"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
XS(XS_Object_IsGroundSpawn); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_IsGroundSpawn) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::IsGroundSpawn(THIS)"); // @categories Objects
{
Object *THIS;
bool RETVAL;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->IsGroundSpawn();
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_Object_IsGroundSpawn(Object* self) // @categories Objects
{
return self->IsGroundSpawn();
}
XS(XS_Object_Close); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_Close) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::Close(THIS)"); // @categories Objects
{
Object *THIS;
VALIDATE_THIS_IS_OBJECT;
THIS->Close();
}
XSRETURN_EMPTY;
void Perl_Object_Close(Object* self) // @categories Objects
{
self->Close();
}
XS(XS_Object_Delete); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_Delete) {
dXSARGS;
if (items < 1 || items > 2)
Perl_croak(aTHX_ "Usage: Object::Delete(THIS, [bool reset_state = false])"); // @categories Objects
{
Object *THIS;
bool reset_state;
VALIDATE_THIS_IS_OBJECT;
if (items < 2)
reset_state = false;
else {
reset_state = (bool) SvTRUE(ST(1));
}
THIS->Delete(reset_state);
}
XSRETURN_EMPTY;
}
XS(XS_Object_StartDecay); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_StartDecay) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::StartDecay(THIS)"); // @categories Objects
{
Object *THIS;
VALIDATE_THIS_IS_OBJECT;
THIS->StartDecay();
}
XSRETURN_EMPTY;
void Perl_Object_Delete(Object* self) // @categories Objects
{
self->Delete();
}
XS(XS_Object_DeleteItem); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_DeleteItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::DeleteItem(THIS, uint8 index)"); // @categories Objects
{
Object *THIS;
uint8 index = (uint8) SvUV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->DeleteItem(index);
}
XSRETURN_EMPTY;
void Perl_Object_Delete(Object* self, bool reset_state) // @categories Objects
{
self->Delete(reset_state);
}
XS(XS_Object_IsObject); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_IsObject) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::IsObject(THIS)"); // @categories Objects
{
Object *THIS;
bool RETVAL;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->IsObject();
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
void Perl_Object_StartDecay(Object* self) // @categories Objects
{
self->StartDecay();
}
XS(XS_Object_Save); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_Save) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::Save(THIS)"); // @categories Objects
{
Object *THIS;
bool RETVAL;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->Save();
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
void Perl_Object_DeleteItem(Object* self, uint8_t index) // @categories Objects
{
self->DeleteItem(index);
}
XS(XS_Object_SetID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetID(THIS, uint16 id)"); // @categories Objects
{
Object *THIS;
uint16 set_id = (uint16) SvUV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetID(set_id);
}
XSRETURN_EMPTY;
bool Perl_Object_IsObject(Object* self) // @categories Objects
{
return self->IsObject();
}
XS(XS_Object_ClearUser); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_ClearUser) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::ClearUser(THIS)"); // @categories Objects
{
Object *THIS;
VALIDATE_THIS_IS_OBJECT;
THIS->ClearUser();
}
XSRETURN_EMPTY;
bool Perl_Object_Save(Object* self) // @categories Objects
{
return self->Save();
}
XS(XS_Object_GetDBID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetDBID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetDBID(THIS)"); // @categories Objects
{
Object *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetDBID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
void Perl_Object_SetID(Object* self, uint16_t set_id) // @categories Objects
{
self->SetID(set_id);
}
XS(XS_Object_GetID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetID(THIS)"); // @categories Objects
{
Object *THIS;
uint16 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
void Perl_Object_ClearUser(Object* self) // @categories Objects
{
self->ClearUser();
}
XS(XS_Object_GetX); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetX) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetX(THIS)"); // @categories Objects
{
Object *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetX();
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Object_GetDBID(Object* self) // @categories Objects
{
return self->GetDBID();
}
XS(XS_Object_GetY); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetY) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetY(THIS)"); // @categories Objects
{
Object *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetY();
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Object_GetID(Object* self) // @categories Objects
{
return self->GetID();
}
XS(XS_Object_GetZ); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetZ) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetZ(THIS)"); // @categories Objects
{
Object *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetZ();
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
float Perl_Object_GetX(Object* self) // @categories Objects
{
return self->GetX();
}
XS(XS_Object_GetHeading); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetHeading) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetHeading(THIS)"); // @categories Objects
{
Object *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetHeadingData();
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
float Perl_Object_GetY(Object* self) // @categories Objects
{
return self->GetY();
}
XS(XS_Object_VarSave); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_VarSave) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::VarSave(THIS)"); // @categories Objects
{
Object *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->VarSave();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
float Perl_Object_GetZ(Object* self) // @categories Objects
{
return self->GetZ();
}
XS(XS_Object_GetType); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetType) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetType(THIS)"); // @categories Objects
{
Object *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetType();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
float Perl_Object_GetHeading(Object* self) // @categories Objects
{
return self->GetHeadingData();
}
XS(XS_Object_SetType); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetType) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetType(THIS, uint32 type)"); // @categories Objects
{
Object *THIS;
uint32 type = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetType(type);
}
XSRETURN_EMPTY;
uint32_t Perl_Object_VarSave(Object* self) // @categories Objects
{
return self->VarSave();
}
XS(XS_Object_GetIcon); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetIcon) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetIcon(THIS)"); // @categories Objects
{
Object *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetIcon();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Object_GetType(Object* self) // @categories Objects
{
return self->GetType();
}
XS(XS_Object_SetIcon); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetIcon) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetIcon(THIS, uint32 icon)"); // @categories Objects
{
Object *THIS;
uint32 icon = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetIcon(icon);
}
XSRETURN_EMPTY;
void Perl_Object_SetType(Object* self, uint32_t type) // @categories Objects
{
self->SetType(type);
}
XS(XS_Object_GetItemID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetItemID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetItemID(THIS)"); // @categories Objects
{
Object *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetItemID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Object_GetIcon(Object* self) // @categories Objects
{
return self->GetIcon();
}
XS(XS_Object_SetItemID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetItemID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetItemID(THIS, uint32 item_id)"); // @categories Objects
{
Object *THIS;
uint32 itemid = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetItemID(itemid);
}
XSRETURN_EMPTY;
void Perl_Object_SetIcon(Object* self, uint32_t icon) // @categories Objects
{
self->SetIcon(icon);
}
XS(XS_Object_SetLocation); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetLocation) {
dXSARGS;
if (items != 4)
Perl_croak(aTHX_ "Usage: Object::SetLocation(THIS, float x, float y, float z)"); // @categories Objects
{
Object *THIS;
float x = (float) SvNV(ST(1));
float y = (float) SvNV(ST(2));
float z = (float) SvNV(ST(3));
VALIDATE_THIS_IS_OBJECT;
THIS->SetLocation(x, y, z);
}
XSRETURN_EMPTY;
uint32_t Perl_Object_GetItemID(Object* self) // @categories Objects
{
return self->GetItemID();
}
XS(XS_Object_SetX); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetX) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetX(THIS, float x)"); // @categories Objects
{
Object *THIS;
float pos = (float) SvNV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetX(pos);
}
XSRETURN_EMPTY;
void Perl_Object_SetItemID(Object* self, uint32_t itemid) // @categories Objects
{
self->SetItemID(itemid);
}
XS(XS_Object_SetY); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetY) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetY(THIS, float y)"); // @categories Objects
{
Object *THIS;
float pos = (float) SvNV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetY(pos);
}
XSRETURN_EMPTY;
void Perl_Object_SetLocation(Object* self, float x, float y, float z) // @categories Objects
{
self->SetLocation(x, y, z);
}
XS(XS_Object_SetZ); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetZ) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetZ(THIS, float z)"); // @categories Objects
{
Object *THIS;
float pos = (float) SvNV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetZ(pos);
}
XSRETURN_EMPTY;
void Perl_Object_SetX(Object* self, float x) // @categories Objects
{
self->SetX(x);
}
XS(XS_Object_SetHeading); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetHeading) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetHeading(THIS, float heading)"); // @categories Objects
{
Object *THIS;
float heading = (float) SvNV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetHeading(heading);
}
XSRETURN_EMPTY;
void Perl_Object_SetY(Object* self, float y) // @categories Objects
{
self->SetY(y);
}
XS(XS_Object_SetModelName); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetModelName) {
dXSARGS;
if (items < 1 || items > 2)
Perl_croak(aTHX_ "Usage: Object::SetModelName(THIS, string name)"); // @categories Objects
{
Object *THIS;
char *name = nullptr;
VALIDATE_THIS_IS_OBJECT;
if (items > 1) { name = (char *) SvPV_nolen(ST(1)); }
THIS->SetModelName(name);
}
XSRETURN_EMPTY;
}
XS(XS_Object_GetModelName); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetModelName) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetModelName(THIS)"); // @categories Objects
{
Object *THIS;
Const_char *RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetModelName();
sv_setpv(TARG, RETVAL);
XSprePUSH;
PUSHTARG;
}
XSRETURN(1);
void Perl_Object_SetZ(Object* self, float z) // @categories Objects
{
self->SetZ(z);
}
XS(XS_Object_Repop); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_Repop) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::Repop(THIS)"); // @categories Objects
{
Object *THIS;
dXSTARG;
VALIDATE_THIS_IS_OBJECT; THIS->Repop();
}
XSRETURN_EMPTY;
void Perl_Object_SetHeading(Object* self, float heading) // @categories Objects
{
self->SetHeading(heading);
}
XS(XS_Object_Depop); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_Depop) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::Depop(THIS)"); // @categories Objects
{
Object *THIS;
dXSTARG;
VALIDATE_THIS_IS_OBJECT; THIS->Depop();
}
XSRETURN_EMPTY;
void Perl_Object_SetModelName(Object* self, const char* name) // @categories Objects
{
self->SetModelName(name);
}
XS(XS_Object_GetEntityVariable); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetEntityVariable) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::GetEntityVariable(THIS, string key)"); // @categories Objects
{
Object *THIS;
Const_char *id = SvPV_nolen(ST(1));
Const_char *RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetEntityVariable(id);
sv_setpv(TARG, RETVAL);
XSprePUSH;
PUSHTARG;
}
XSRETURN(1);
std::string Perl_Object_GetModelName(Object* self) // @categories Objects
{
return self->GetModelName();
}
XS(XS_Object_EntityVariableExists); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_EntityVariableExists) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::EntityVariableExists(THIS, string key)"); // @categories Objects
{
Object *THIS;
Const_char *id = SvPV_nolen(ST(1));
bool RETVAL;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->EntityVariableExists(id);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
void Perl_Object_Repop(Object* self) // @categories Objects
{
self->Repop();
}
XS(XS_Object_SetEntityVariable); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetEntityVariable) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Object::SetEntityVariable(THIS, string key, string var)"); // @categories Objects
{
Object *THIS;
Const_char *id = SvPV_nolen(ST(1));
const char *var = (const char *) SvPV_nolen(ST(2));
VALIDATE_THIS_IS_OBJECT;
THIS->SetEntityVariable(id, var);
}
XSRETURN_EMPTY;
void Perl_Object_Depop(Object* self) // @categories Objects
{
self->Depop();
}
XS(XS_Object_GetSolidType); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetSolidType) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetSolidType(THIS)"); // @categories Objects
{
Object *THIS;
uint16 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetSolidType();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
const char* Perl_Object_GetEntityVariable(Object* self, const char* key) // @categories Objects
{
// supports possible nullptr return
return self->GetEntityVariable(key);
}
XS(XS_Object_SetSolidType); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetSolidType) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetSolidType(THIS, uint16 type)"); // @categories Objects
{
Object *THIS;
uint16 type = (uint16) SvUV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetSolidType(type);
}
XSRETURN_EMPTY;
bool Perl_Object_EntityVariableExists(Object* self, const char* key) // @categories Objects
{
return self->EntityVariableExists(key);
}
XS(XS_Object_GetSize); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetSize) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetSize(THIS)"); // @categories Objects
{
Object *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetSize();
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
void Perl_Object_SetEntityVariable(Object* self, const char* key, const char* var) // @categories Objects
{
self->SetEntityVariable(key, var);
}
XS(XS_Object_SetSize); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetSize) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetSize(THIS, float size)"); // @categories Objects
{
Object *THIS;
float size = (float) SvNV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetSize(size);
}
XSRETURN_EMPTY;
uint32_t Perl_Object_GetSolidType(Object* self) // @categories Objects
{
return self->GetSolidType();
}
XS(XS_Object_SetTiltX); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetTiltX) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetTiltX(THIS, float tilt_x)"); // @categories Objects
{
Object *THIS;
float pos = (float) SvNV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetTiltX(pos);
}
XSRETURN_EMPTY;
void Perl_Object_SetSolidType(Object* self, uint16_t type) // @categories Objects
{
self->SetSolidType(type);
}
XS(XS_Object_SetTiltY); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetTiltY) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetTiltY(THIS, float tilt_y)"); // @categories Objects
{
Object *THIS;
float pos = (float) SvNV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetTiltY(pos);
}
XSRETURN_EMPTY;
float Perl_Object_GetSize(Object* self) // @categories Objects
{
return self->GetSize();
}
XS(XS_Object_GetTiltX); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetTiltX) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetTiltX(THIS)"); // @categories Objects
{
Object *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetTiltX();
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
void Perl_Object_SetSize(Object* self, float size) // @categories Objects
{
self->SetSize(size);
}
XS(XS_Object_GetTiltY); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetTiltY) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetTiltY(THIS)"); // @categories Objects
{
Object *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetTiltY();
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
void Perl_Object_SetTiltX(Object* self, float tilt_x) // @categories Objects
{
self->SetTiltX(tilt_x);
}
#ifdef __cplusplus
extern "C"
#endif
XS(boot_Object); /* prototype to pass -Wmissing-prototypes */
XS(boot_Object) {
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, "ClearUser"), XS_Object_ClearUser, file, "$");
newXSproto(strcpy(buf, "Close"), XS_Object_Close, file, "$");
newXSproto(strcpy(buf, "Delete"), XS_Object_Delete, file, "$$");
newXSproto(strcpy(buf, "DeleteItem"), XS_Object_DeleteItem, file, "$$");
newXSproto(strcpy(buf, "Depop"), XS_Object_Depop, file, "$");
newXSproto(strcpy(buf, "EntityVariableExists"), XS_Object_EntityVariableExists, file, "$$");
newXSproto(strcpy(buf, "GetDBID"), XS_Object_GetDBID, file, "$");
newXSproto(strcpy(buf, "GetEntityVariable"), XS_Object_GetEntityVariable, file, "$$");
newXSproto(strcpy(buf, "GetHeading"), XS_Object_GetHeading, file, "$");
newXSproto(strcpy(buf, "GetID"), XS_Object_GetID, file, "$");
newXSproto(strcpy(buf, "GetIcon"), XS_Object_GetIcon, file, "$");
newXSproto(strcpy(buf, "GetItemID"), XS_Object_GetItemID, file, "$");
newXSproto(strcpy(buf, "GetModelName"), XS_Object_GetModelName, file, "$");
newXSproto(strcpy(buf, "GetSize"), XS_Object_GetSize, file, "$");
newXSproto(strcpy(buf, "GetSolidType"), XS_Object_GetSolidType, file, "$");
newXSproto(strcpy(buf, "GetTiltX"), XS_Object_GetTiltX, file, "$$");
newXSproto(strcpy(buf, "GetTiltY"), XS_Object_GetTiltY, file, "$");
newXSproto(strcpy(buf, "GetType"), XS_Object_GetType, file, "$");
newXSproto(strcpy(buf, "GetX"), XS_Object_GetX, file, "$");
newXSproto(strcpy(buf, "GetY"), XS_Object_GetY, file, "$");
newXSproto(strcpy(buf, "GetZ"), XS_Object_GetZ, file, "$");
newXSproto(strcpy(buf, "IsGroundSpawn"), XS_Object_IsGroundSpawn, file, "$");
newXSproto(strcpy(buf, "Repop"), XS_Object_Repop, file, "$");
newXSproto(strcpy(buf, "Save"), XS_Object_Save, file, "$");
newXSproto(strcpy(buf, "SetEntityVariable"), XS_Object_SetEntityVariable, file, "$$$");
newXSproto(strcpy(buf, "SetHeading"), XS_Object_SetHeading, file, "$$");
newXSproto(strcpy(buf, "SetID"), XS_Object_SetID, file, "$$");
newXSproto(strcpy(buf, "SetIcon"), XS_Object_SetIcon, file, "$$");
newXSproto(strcpy(buf, "SetItemID"), XS_Object_SetItemID, file, "$$");
newXSproto(strcpy(buf, "SetLocation"), XS_Object_SetLocation, file, "$$$$");
newXSproto(strcpy(buf, "SetModelName"), XS_Object_SetModelName, file, "$$");
newXSproto(strcpy(buf, "SetSize"), XS_Object_SetSize, file, "$$");
newXSproto(strcpy(buf, "SetSolidType"), XS_Object_SetSolidType, file, "$$");
newXSproto(strcpy(buf, "SetTiltX"), XS_Object_SetTiltX, file, "$$");
newXSproto(strcpy(buf, "SetTiltY"), XS_Object_SetTiltY, file, "$");
newXSproto(strcpy(buf, "SetType"), XS_Object_SetType, file, "$$");
newXSproto(strcpy(buf, "SetX"), XS_Object_SetX, file, "$$");
newXSproto(strcpy(buf, "SetY"), XS_Object_SetY, file, "$$");
newXSproto(strcpy(buf, "SetZ"), XS_Object_SetZ, file, "$$");
newXSproto(strcpy(buf, "StartDecay"), XS_Object_StartDecay, file, "$$");
newXSproto(strcpy(buf, "VarSave"), XS_Object_VarSave, file, "$");
XSRETURN_YES;
void Perl_Object_SetTiltY(Object* self, float tilt_y) // @categories Objects
{
self->SetTiltY(tilt_y);
}
float Perl_Object_GetTiltX(Object* self) // @categories Objects
{
return self->GetTiltX();
}
float Perl_Object_GetTiltY(Object* self) // @categories Objects
{
return self->GetTiltY();
}
void perl_register_object()
{
perl::interpreter perl(PERL_GET_THX);
auto package = perl.new_class<Object>("Object");
package.add_base_class("Entity");
package.add("ClearUser", &Perl_Object_ClearUser);
package.add("Close", &Perl_Object_Close);
package.add("Delete", (void(*)(Object*))&Perl_Object_Delete);
package.add("Delete", (void(*)(Object*, bool))&Perl_Object_Delete);
package.add("DeleteItem", &Perl_Object_DeleteItem);
package.add("Depop", &Perl_Object_Depop);
package.add("EntityVariableExists", &Perl_Object_EntityVariableExists);
package.add("GetDBID", &Perl_Object_GetDBID);
package.add("GetEntityVariable", &Perl_Object_GetEntityVariable);
package.add("GetHeading", &Perl_Object_GetHeading);
package.add("GetID", &Perl_Object_GetID);
package.add("GetIcon", &Perl_Object_GetIcon);
package.add("GetItemID", &Perl_Object_GetItemID);
package.add("GetModelName", &Perl_Object_GetModelName);
package.add("GetSize", &Perl_Object_GetSize);
package.add("GetSolidType", &Perl_Object_GetSolidType);
package.add("GetTiltX", &Perl_Object_GetTiltX);
package.add("GetTiltY", &Perl_Object_GetTiltY);
package.add("GetType", &Perl_Object_GetType);
package.add("GetX", &Perl_Object_GetX);
package.add("GetY", &Perl_Object_GetY);
package.add("GetZ", &Perl_Object_GetZ);
package.add("IsGroundSpawn", &Perl_Object_IsGroundSpawn);
package.add("Repop", &Perl_Object_Repop);
package.add("Save", &Perl_Object_Save);
package.add("SetEntityVariable", &Perl_Object_SetEntityVariable);
package.add("SetHeading", &Perl_Object_SetHeading);
package.add("SetID", &Perl_Object_SetID);
package.add("SetIcon", &Perl_Object_SetIcon);
package.add("SetItemID", &Perl_Object_SetItemID);
package.add("SetLocation", &Perl_Object_SetLocation);
package.add("SetModelName", &Perl_Object_SetModelName);
package.add("SetSize", &Perl_Object_SetSize);
package.add("SetSolidType", &Perl_Object_SetSolidType);
package.add("SetTiltX", &Perl_Object_SetTiltX);
package.add("SetTiltY", &Perl_Object_SetTiltY);
package.add("SetType", &Perl_Object_SetType);
package.add("SetX", &Perl_Object_SetX);
package.add("SetY", &Perl_Object_SetY);
package.add("SetZ", &Perl_Object_SetZ);
package.add("StartDecay", &Perl_Object_StartDecay);
package.add("VarSave", &Perl_Object_VarSave);
}
#endif //EMBPERL_XS_CLASSES

428
zone/perl_perlpacket.cpp
View File

@ -3,421 +3,149 @@
#include "../common/global_define.h"
#include "../common/types.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "perlpacket.h"
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
#define VALIDATE_THIS_IS_PACKET \
do { \
if (sv_derived_from(ST(0), "PerlPacket")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(PerlPacket*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type PerlPacket"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
XS(XS_PerlPacket_new); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_new)
PerlPacket* Perl_PerlPacket_new(const char* class_name)
{
dXSARGS;
if (items < 1 || items > 3)
Perl_croak(aTHX_ "Usage: PerlPacket::new(CLASS, opcode= \"OP_Unknown\", len= 0)");
{
char *CLASS = (char *)SvPV_nolen(ST(0));
PerlPacket *RETVAL;
const char *opcode;
uint32 len;
if (items < 2)
opcode = "OP_Unknown";
else {
opcode = (char *)SvPV_nolen(ST(1));
}
if (items < 3)
len = 0;
else {
len = (uint32)SvUV(ST(2));
}
RETVAL = new PerlPacket(opcode, len);
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "PerlPacket", (void*)RETVAL);
}
XSRETURN(1);
return new PerlPacket();
}
XS(XS_PerlPacket_DESTROY); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_DESTROY)
PerlPacket* Perl_PerlPacket_new(const char* class_name, const char* opcode)
{
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: PerlPacket::DESTROY(THIS)");
{
PerlPacket * THIS;
VALIDATE_THIS_IS_PACKET;
delete THIS;
}
XSRETURN_EMPTY;
return new PerlPacket(opcode);
}
XS(XS_PerlPacket_SetOpcode); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SetOpcode)
PerlPacket* Perl_PerlPacket_new(const char* class_name, const char* opcode, uint32_t len)
{
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: PerlPacket::SetOpcode(THIS, opcode)");
{
PerlPacket * THIS;
bool RETVAL;
char * opcode = (char *)SvPV_nolen(ST(1));
VALIDATE_THIS_IS_PACKET;
RETVAL = THIS->SetOpcode(opcode);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
return new PerlPacket(opcode, len);
}
XS(XS_PerlPacket_Resize); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_Resize)
void Perl_PerlPacket_DESTROY(PerlPacket* self)
{
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: PerlPacket::Resize(THIS, len)");
{
PerlPacket * THIS;
uint32 len = (uint32)SvUV(ST(1));
VALIDATE_THIS_IS_PACKET;
THIS->Resize(len);
}
XSRETURN_EMPTY;
delete self;
}
XS(XS_PerlPacket_SendTo); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SendTo)
bool Perl_PerlPacket_SetOpcode(PerlPacket* self, const char* opcode)
{
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: PerlPacket::SendTo(THIS, who)");
{
PerlPacket * THIS;
Client * who;
VALIDATE_THIS_IS_PACKET;
if (sv_derived_from(ST(1), "Client")) {
IV tmp = SvIV((SV*)SvRV(ST(1)));
who = INT2PTR(Client *,tmp);
}
else
Perl_croak(aTHX_ "who is not of type Client");
if(who == nullptr)
Perl_croak(aTHX_ "who is nullptr, avoiding crash.");
THIS->SendTo(who);
}
XSRETURN_EMPTY;
return self->SetOpcode(opcode);
}
XS(XS_PerlPacket_SendToAll); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SendToAll)
void Perl_PerlPacket_Resize(PerlPacket* self, uint32_t len)
{
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: PerlPacket::SendToAll(THIS)");
{
PerlPacket * THIS;
VALIDATE_THIS_IS_PACKET;
THIS->SendToAll();
}
XSRETURN_EMPTY;
self->Resize(len);
}
XS(XS_PerlPacket_Zero); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_Zero)
void Perl_PerlPacket_SendTo(PerlPacket* self, Client* who)
{
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: PerlPacket::Zero(THIS)");
{
PerlPacket * THIS;
VALIDATE_THIS_IS_PACKET;
THIS->Zero();
}
XSRETURN_EMPTY;
self->SendTo(who);
}
XS(XS_PerlPacket_FromArray); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_FromArray)
void Perl_PerlPacket_SendToAll(PerlPacket* self)
{
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: PerlPacket::FromArray(THIS, numbers, length)");
{
PerlPacket * THIS;
int * numbers;
uint32 length = (uint32)SvUV(ST(2));
VALIDATE_THIS_IS_PACKET;
AV *av_numbers;
if (SvROK(ST(1)) && SvTYPE(SvRV(ST(1)))==SVt_PVAV)
av_numbers = (AV*)SvRV(ST(1));
else
Perl_croak(aTHX_ "numbers is not an array reference");
I32 len_numbers = av_len(av_numbers) + 1;
I32 ix_numbers;
numbers = new int[len_numbers];
for(ix_numbers = 0; ix_numbers < len_numbers; ix_numbers ++) {
SV **tmp = av_fetch(av_numbers, ix_numbers, 0);
if(tmp == nullptr || *tmp == nullptr) {
numbers[ix_numbers] = 0;
continue;
}
numbers[ix_numbers] = (int)SvIV(*tmp);
};
THIS->FromArray(numbers, length);
}
XSRETURN_EMPTY;
self->SendToAll();
}
XS(XS_PerlPacket_SetByte); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SetByte)
void Perl_PerlPacket_Zero(PerlPacket* self)
{
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: PerlPacket::SetByte(THIS, pos, val)");
{
PerlPacket * THIS;
uint32 pos = (uint32)SvUV(ST(1));
uint8 val = (uint8)SvUV(ST(2));
VALIDATE_THIS_IS_PACKET;
THIS->SetByte(pos, val);
}
XSRETURN_EMPTY;
self->Zero();
}
XS(XS_PerlPacket_SetShort); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SetShort)
void Perl_PerlPacket_FromArray(PerlPacket* self, perl::reference avref, uint32_t length)
{
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: PerlPacket::SetShort(THIS, pos, val)");
perl::array av_numbers = avref;
int* numbers = new int[av_numbers.size()];
for (int i = 0; i < av_numbers.size(); ++i)
{
PerlPacket * THIS;
uint32 pos = (uint32)SvUV(ST(1));
uint16 val = (uint16)SvUV(ST(2));
VALIDATE_THIS_IS_PACKET;
THIS->SetShort(pos, val);
numbers[i] = av_numbers[i];
}
XSRETURN_EMPTY;
self->FromArray(numbers, length);
delete[] numbers;
}
XS(XS_PerlPacket_SetLong); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SetLong)
void Perl_PerlPacket_SetByte(PerlPacket* self, uint32_t pos, uint8_t val)
{
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: PerlPacket::SetLong(THIS, pos, val)");
{
PerlPacket * THIS;
uint32 pos = (uint32)SvUV(ST(1));
uint32 val = (uint32)SvUV(ST(2));
VALIDATE_THIS_IS_PACKET;
THIS->SetLong(pos, val);
}
XSRETURN_EMPTY;
self->SetByte(pos, val);
}
XS(XS_PerlPacket_SetFloat); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SetFloat)
void Perl_PerlPacket_SetShort(PerlPacket* self, uint32_t pos, uint16_t val)
{
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: PerlPacket::SetFloat(THIS, pos, val)");
{
PerlPacket * THIS;
uint32 pos = (uint32)SvUV(ST(1));
float val = (float)SvNV(ST(2));
VALIDATE_THIS_IS_PACKET;
THIS->SetFloat(pos, val);
}
XSRETURN_EMPTY;
self->SetShort(pos, val);
}
XS(XS_PerlPacket_SetString); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SetString)
void Perl_PerlPacket_SetLong(PerlPacket* self, uint32_t pos, uint32_t val)
{
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: PerlPacket::SetString(THIS, pos, str)");
{
PerlPacket * THIS;
uint32 pos = (uint32)SvUV(ST(1));
char * str = (char *)SvPV_nolen(ST(2));
VALIDATE_THIS_IS_PACKET;
THIS->SetString(pos, str);
}
XSRETURN_EMPTY;
self->SetLong(pos, val);
}
XS(XS_PerlPacket_SetEQ1319); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SetEQ1319)
void Perl_PerlPacket_SetFloat(PerlPacket* self, uint32_t pos, float val)
{
dXSARGS;
if (items != 4)
Perl_croak(aTHX_ "Usage: PerlPacket::SetEQ1319(THIS, pos, part13, part19)");
{
PerlPacket * THIS;
uint32 pos = (uint32)SvUV(ST(1));
float part13 = (float)SvNV(ST(2));
float part19 = (float)SvNV(ST(3));
VALIDATE_THIS_IS_PACKET;
THIS->SetEQ1319(pos, part13, part19);
}
XSRETURN_EMPTY;
self->SetFloat(pos, val);
}
XS(XS_PerlPacket_SetEQ1913); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SetEQ1913)
void Perl_PerlPacket_SetString(PerlPacket* self, uint32_t pos, char* str)
{
dXSARGS;
if (items != 4)
Perl_croak(aTHX_ "Usage: PerlPacket::SetEQ1913(THIS, pos, part19, part13)");
{
PerlPacket * THIS;
uint32 pos = (uint32)SvUV(ST(1));
float part19 = (float)SvNV(ST(2));
float part13 = (float)SvNV(ST(3));
VALIDATE_THIS_IS_PACKET;
THIS->SetEQ1913(pos, part19, part13);
}
XSRETURN_EMPTY;
self->SetString(pos, str);
}
XS(XS_PerlPacket_GetByte); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_GetByte)
void Perl_PerlPacket_SetEQ1319(PerlPacket* self, uint32_t pos, float part13, float part19)
{
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: PerlPacket::GetByte(THIS, pos)");
{
PerlPacket * THIS;
uint8 RETVAL;
dXSTARG;
uint32 pos = (uint32)SvUV(ST(1));
VALIDATE_THIS_IS_PACKET;
RETVAL = THIS->GetByte(pos);
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
self->SetEQ1319(pos, part13, part19);
}
XS(XS_PerlPacket_GetShort); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_GetShort)
void Perl_PerlPacket_SetEQ1913(PerlPacket* self, uint32_t pos, float part19, float part13)
{
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: PerlPacket::GetShort(THIS, pos)");
{
PerlPacket * THIS;
uint16 RETVAL;
dXSTARG;
uint32 pos = (uint32)SvUV(ST(1));
VALIDATE_THIS_IS_PACKET;
RETVAL = THIS->GetShort(pos);
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
self->SetEQ1913(pos, part19, part13);
}
XS(XS_PerlPacket_GetLong); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_GetLong)
uint8_t Perl_PerlPacket_GetByte(PerlPacket* self, uint32_t pos)
{
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: PerlPacket::GetLong(THIS, pos)");
{
PerlPacket * THIS;
uint32 RETVAL;
dXSTARG;
uint32 pos = (uint32)SvUV(ST(1));
VALIDATE_THIS_IS_PACKET;
RETVAL = THIS->GetLong(pos);
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
return self->GetByte(pos);
}
XS(XS_PerlPacket_GetFloat); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_GetFloat)
uint16_t Perl_PerlPacket_GetShort(PerlPacket* self, uint32_t pos)
{
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: PerlPacket::GetFloat(THIS, pos)");
{
PerlPacket * THIS;
float RETVAL;
dXSTARG;
uint32 pos = (uint32)SvUV(ST(1));
VALIDATE_THIS_IS_PACKET;
RETVAL = THIS->GetFloat(pos);
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
return self->GetShort(pos);
}
#ifdef __cplusplus
extern "C"
#endif
XS(boot_PerlPacket); /* prototype to pass -Wmissing-prototypes */
XS(boot_PerlPacket)
uint32_t Perl_PerlPacket_GetLong(PerlPacket* self, uint32_t pos)
{
dXSARGS;
char file[256];
strncpy(file, __FILE__, 256);
file[255] = 0;
return self->GetLong(pos);
}
if(items != 1)
fprintf(stderr, "boot_quest does not take any arguments.");
char buf[128];
float Perl_PerlPacket_GetFloat(PerlPacket* self, uint32_t pos)
{
return self->GetFloat(pos);
}
//add the strcpy stuff to get rid of const warnings....
void perl_register_perlpacket()
{
perl::interpreter perl(PERL_GET_THX);
XS_VERSION_BOOTCHECK ;
newXSproto(strcpy(buf, "DESTROY"), XS_PerlPacket_DESTROY, file, "$");
newXSproto(strcpy(buf, "FromArray"), XS_PerlPacket_FromArray, file, "$$$");
newXSproto(strcpy(buf, "GetByte"), XS_PerlPacket_GetByte, file, "$$");
newXSproto(strcpy(buf, "GetFloat"), XS_PerlPacket_GetFloat, file, "$$");
newXSproto(strcpy(buf, "GetLong"), XS_PerlPacket_GetLong, file, "$$");
newXSproto(strcpy(buf, "GetShort"), XS_PerlPacket_GetShort, file, "$$");
newXSproto(strcpy(buf, "Resize"), XS_PerlPacket_Resize, file, "$$");
newXSproto(strcpy(buf, "SendTo"), XS_PerlPacket_SendTo, file, "$$");
newXSproto(strcpy(buf, "SendToAll"), XS_PerlPacket_SendToAll, file, "$");
newXSproto(strcpy(buf, "SetByte"), XS_PerlPacket_SetByte, file, "$$$");
newXSproto(strcpy(buf, "SetEQ1319"), XS_PerlPacket_SetEQ1319, file, "$$$$");
newXSproto(strcpy(buf, "SetEQ1913"), XS_PerlPacket_SetEQ1913, file, "$$$$");
newXSproto(strcpy(buf, "SetFloat"), XS_PerlPacket_SetFloat, file, "$$$");
newXSproto(strcpy(buf, "SetLong"), XS_PerlPacket_SetLong, file, "$$$");
newXSproto(strcpy(buf, "SetOpcode"), XS_PerlPacket_SetOpcode, file, "$$");
newXSproto(strcpy(buf, "SetShort"), XS_PerlPacket_SetShort, file, "$$$");
newXSproto(strcpy(buf, "SetString"), XS_PerlPacket_SetString, file, "$$$");
newXSproto(strcpy(buf, "Zero"), XS_PerlPacket_Zero, file, "$");
newXSproto(strcpy(buf, "new"), XS_PerlPacket_new, file, "$;$$");
XSRETURN_YES;
auto package = perl.new_class<PerlPacket>("PerlPacket");
package.add("DESTROY", &Perl_PerlPacket_DESTROY);
package.add("FromArray", &Perl_PerlPacket_FromArray);
package.add("GetByte", &Perl_PerlPacket_GetByte);
package.add("GetFloat", &Perl_PerlPacket_GetFloat);
package.add("GetLong", &Perl_PerlPacket_GetLong);
package.add("GetShort", &Perl_PerlPacket_GetShort);
package.add("Resize", &Perl_PerlPacket_Resize);
package.add("SendTo", &Perl_PerlPacket_SendTo);
package.add("SendToAll", &Perl_PerlPacket_SendToAll);
package.add("SetByte", &Perl_PerlPacket_SetByte);
package.add("SetEQ1319", &Perl_PerlPacket_SetEQ1319);
package.add("SetEQ1913", &Perl_PerlPacket_SetEQ1913);
package.add("SetFloat", &Perl_PerlPacket_SetFloat);
package.add("SetLong", &Perl_PerlPacket_SetLong);
package.add("SetOpcode", &Perl_PerlPacket_SetOpcode);
package.add("SetShort", &Perl_PerlPacket_SetShort);
package.add("SetString", &Perl_PerlPacket_SetString);
package.add("Zero", &Perl_PerlPacket_Zero);
package.add("new", (PerlPacket*(*)(const char*))&Perl_PerlPacket_new);
package.add("new", (PerlPacket*(*)(const char*, const char*))&Perl_PerlPacket_new);
package.add("new", (PerlPacket*(*)(const char*, const char*, uint32_t))&Perl_PerlPacket_new);
}
#endif //EMBPERL_XS_CLASSES

747
zone/perl_player_corpse.cpp
View File

@ -4,667 +4,238 @@
#include "../common/global_define.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "corpse.h"
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
#define VALIDATE_THIS_IS_CORPSE \
do { \
if (sv_derived_from(ST(0), "Corpse")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(Corpse*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type Corpse"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
XS(XS_Corpse_GetCharID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetCharID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetCharID(THIS)"); // @categories Account and Character, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetCharID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Corpse_GetCharID(Corpse* self) // @categories Account and Character, Corpse
{
return self->GetCharID();
}
XS(XS_Corpse_GetDecayTime); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetDecayTime) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetDecayTime(THIS)"); // @categories Script Utility, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetDecayTime();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Corpse_GetDecayTime(Corpse* self) // @categories Script Utility, Corpse
{
return self->GetDecayTime();
}
XS(XS_Corpse_Lock); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_Lock) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::Lock(THIS)"); // @categories Corpse
{
Corpse *THIS;
VALIDATE_THIS_IS_CORPSE;
THIS->Lock();
}
XSRETURN_EMPTY;
void Perl_Corpse_Lock(Corpse* self) // @categories Corpse
{
self->Lock();
}
XS(XS_Corpse_UnLock); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_UnLock) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::UnLock(THIS)"); // @categories Corpse
{
Corpse *THIS;
VALIDATE_THIS_IS_CORPSE;
THIS->UnLock();
}
XSRETURN_EMPTY;
void Perl_Corpse_UnLock(Corpse* self) // @categories Corpse
{
self->UnLock();
}
XS(XS_Corpse_IsLocked); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_IsLocked) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::IsLocked(THIS)"); // @categories Corpse
{
Corpse *THIS;
bool RETVAL;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->IsLocked();
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_Corpse_IsLocked(Corpse* self) // @categories Corpse
{
return self->IsLocked();
}
XS(XS_Corpse_ResetLooter); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_ResetLooter) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::ResetLooter(THIS)"); // @categories Corpse
{
Corpse *THIS;
VALIDATE_THIS_IS_CORPSE;
THIS->ResetLooter();
}
XSRETURN_EMPTY;
void Perl_Corpse_ResetLooter(Corpse* self) // @categories Corpse
{
self->ResetLooter();
}
XS(XS_Corpse_GetDBID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetDBID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetDBID(THIS)"); // @categories Script Utility, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetCorpseDBID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Corpse_GetDBID(Corpse* self) // @categories Script Utility, Corpse
{
return self->GetCorpseDBID();
}
XS(XS_Corpse_GetOwnerName); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetOwnerName) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetOwnerName(THIS)"); // @categories Account and Character, Corpse
{
Corpse *THIS;
char *RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetOwnerName();
sv_setpv(TARG, RETVAL);
XSprePUSH;
PUSHTARG;
}
XSRETURN(1);
std::string Perl_Corpse_GetOwnerName(Corpse* self) // @categories Account and Character, Corpse
{
return self->GetOwnerName();
}
XS(XS_Corpse_SetDecayTimer); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_SetDecayTimer) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::SetDecayTimer(THIS, uint32 decay_time)"); // @categories Corpse
{
Corpse *THIS;
uint32 decaytime = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_CORPSE;
THIS->SetDecayTimer(decaytime);
}
XSRETURN_EMPTY;
void Perl_Corpse_SetDecayTimer(Corpse* self, uint32_t decay_time) // @categories Corpse
{
self->SetDecayTimer(decay_time);
}
XS(XS_Corpse_IsEmpty); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_IsEmpty) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::IsEmpty(THIS)"); // @categories Inventory and Items, Corpse
{
Corpse *THIS;
bool RETVAL;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->IsEmpty();
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_Corpse_IsEmpty(Corpse* self) // @categories Inventory and Items, Corpse
{
return self->IsEmpty();
}
XS(XS_Corpse_AddItem); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_AddItem) {
dXSARGS;
if (items < 3 || items > 4)
Perl_croak(aTHX_ "Usage: Corpse::AddItem(THIS, uint32 item_id, uint16 charges, [unt16 slot = 0])"); // @categories Inventory and Items, Corpse
{
Corpse *THIS;
uint32 itemnum = (uint32) SvUV(ST(1));
uint16 charges = (uint16) SvUV(ST(2));
int16 slot;
VALIDATE_THIS_IS_CORPSE;
if (items < 4)
slot = 0;
else {
slot = (int16) SvIV(ST(3));
}
THIS->AddItem(itemnum, charges, slot);
}
XSRETURN_EMPTY;
void Perl_Corpse_AddItem(Corpse* self, uint32 item_id, uint16 charges) // @categories Inventory and Items, Corpse
{
self->AddItem(item_id, charges);
}
XS(XS_Corpse_GetWornItem); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetWornItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::GetWornItem(THIS, equipSlot)"); // @categories Inventory and Items, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
int16 equipSlot = (int16) SvIV(ST(1));
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetWornItem(equipSlot);
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
void Perl_Corpse_AddItem(Corpse* self, uint32 item_id, uint16 charges, uint16 slot) // @categories Inventory and Items, Corpse
{
self->AddItem(item_id, charges, slot);
}
XS(XS_Corpse_RemoveItem); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_RemoveItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::RemoveItem(THIS, uint16 loot_slot)"); // @categories Inventory and Items, Corpse
{
Corpse *THIS;
uint16 lootslot = (uint16) SvUV(ST(1));
VALIDATE_THIS_IS_CORPSE;
THIS->RemoveItem(lootslot);
}
XSRETURN_EMPTY;
uint32_t Perl_Corpse_GetWornItem(Corpse* self, uint16_t equip_slot) // @categories Inventory and Items, Corpse
{
return self->GetWornItem(equip_slot);
}
XS(XS_Corpse_SetCash); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_SetCash) {
dXSARGS;
if (items != 5)
Perl_croak(aTHX_ "Usage: Corpse::SetCash(THIS, uint16 copper, uint16 silver, uint16 gold, uint16 platinum)"); // @categories Currency and Points, Corpse
{
Corpse *THIS;
uint16 in_copper = (uint16) SvUV(ST(1));
uint16 in_silver = (uint16) SvUV(ST(2));
uint16 in_gold = (uint16) SvUV(ST(3));
uint16 in_platinum = (uint16) SvUV(ST(4));
VALIDATE_THIS_IS_CORPSE;
THIS->SetCash(in_copper, in_silver, in_gold, in_platinum);
}
XSRETURN_EMPTY;
void Perl_Corpse_RemoveItem(Corpse* self, uint16_t loot_slot) // @categories Inventory and Items, Corpse
{
self->RemoveItem(loot_slot);
}
XS(XS_Corpse_RemoveCash); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_RemoveCash) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::RemoveCash(THIS)"); // @categories Currency and Points, Corpse
{
Corpse *THIS;
VALIDATE_THIS_IS_CORPSE;
THIS->RemoveCash();
}
XSRETURN_EMPTY;
void Perl_Corpse_SetCash(Corpse* self, uint16 copper, uint16 silver, uint16 gold, uint16 platinum) // @categories Currency and Points, Corpse
{
self->SetCash(copper, silver, gold, platinum);
}
XS(XS_Corpse_CountItems); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_CountItems) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::CountItems(THIS)"); // @categories Inventory and Items, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->CountItems();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
void Perl_Corpse_RemoveCash(Corpse* self) // @categories Currency and Points, Corpse
{
self->RemoveCash();
}
XS(XS_Corpse_Delete); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_Delete) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::Delete(THIS)"); // @categories Corpse
{
Corpse *THIS;
VALIDATE_THIS_IS_CORPSE;
THIS->Delete();
}
XSRETURN_EMPTY;
uint32_t Perl_Corpse_CountItems(Corpse* self) // @categories Inventory and Items, Corpse
{
return self->CountItems();
}
XS(XS_Corpse_GetCopper); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetCopper) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetCopper(THIS)"); // @categories Currency and Points, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetCopper();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
void Perl_Corpse_Delete(Corpse* self) // @categories Corpse
{
self->Delete();
}
XS(XS_Corpse_GetSilver); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetSilver) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetSilver(THIS)"); // @categories Currency and Points, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetSilver();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Corpse_GetCopper(Corpse* self) // @categories Currency and Points, Corpse
{
return self->GetCopper();
}
XS(XS_Corpse_GetGold); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetGold) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetGold(THIS)"); // @categories Currency and Points, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetGold();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Corpse_GetSilver(Corpse* self) // @categories Currency and Points, Corpse
{
return self->GetSilver();
}
XS(XS_Corpse_GetPlatinum); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetPlatinum) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetPlatinum(THIS)"); // @categories Currency and Points, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetPlatinum();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Corpse_GetGold(Corpse* self)// @categories Currency and Points, Corpse
{
return self->GetGold();
}
XS(XS_Corpse_Summon); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_Summon) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Corpse::Summon(THIS, Client* client, bool is_spell)"); // @categories Corpse
{
Corpse *THIS;
Client *client;
bool spell = (bool) SvTRUE(ST(2));
VALIDATE_THIS_IS_CORPSE;
if (sv_derived_from(ST(1), "Client")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
client = INT2PTR(Client *, tmp);
} else
Perl_croak(aTHX_ "client is not of type Client");
if (client == nullptr)
Perl_croak(aTHX_ "client is nullptr, avoiding crash.");
THIS->Summon(client, spell, true);
}
XSRETURN_EMPTY;
uint32_t Perl_Corpse_GetPlatinum(Corpse* self) // @categories Currency and Points, Corpse
{
return self->GetPlatinum();
}
XS(XS_Corpse_CastRezz); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_CastRezz) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Corpse::CastRezz(THIS, uint16 spell_id, [Mob* caster = nullptr])"); // @categories Spells and Disciplines, Corpse
{
Corpse *THIS;
uint16 spellid = (uint16) SvUV(ST(1));
Mob *Caster;
VALIDATE_THIS_IS_CORPSE;
if (sv_derived_from(ST(2), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(2)));
Caster = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "Caster is not of type Mob");
if (Caster == nullptr)
Perl_croak(aTHX_ "Caster is nullptr, avoiding crash.");
THIS->CastRezz(spellid, Caster);
}
XSRETURN_EMPTY;
void Perl_Corpse_Summon(Corpse* self, Client* client, bool is_spell) // @categories Corpse
{
self->Summon(client, is_spell, true);
}
XS(XS_Corpse_CompleteRezz); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_CompleteRezz) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::CompleteRezz(THIS)"); // @categories Spells and Disciplines, Corpse
{
Corpse *THIS;
VALIDATE_THIS_IS_CORPSE;
THIS->CompleteResurrection();
}
XSRETURN_EMPTY;
void Perl_Corpse_CastRezz(Corpse* self, uint16_t spell_id, Mob* caster) // @categories Spells and Disciplines, Corpse
{
self->CastRezz(spell_id, caster);
}
XS(XS_Corpse_CanMobLoot); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_CanMobLoot) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::CanMobLoot(THIS, int character_id)"); // @categories Script Utility, Corpse
{
Corpse *THIS;
bool RETVAL;
int charid = (int) SvIV(ST(1));
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->CanPlayerLoot(charid);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
void Perl_Corpse_CompleteRezz(Corpse* self) // @categories Spells and Disciplines, Corpse
{
self->CompleteResurrection();
}
XS(XS_Corpse_AllowMobLoot); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_AllowMobLoot) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Corpse::AllowMobLoot(THIS, Mob* them, uint8 slot)"); // @categories Account and Character, Corpse
{
Corpse *THIS;
Mob *them;
uint8 slot = (uint8) SvUV(ST(2));
VALIDATE_THIS_IS_CORPSE;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
them = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "them is not of type Mob");
if (them == nullptr)
Perl_croak(aTHX_ "them is nullptr, avoiding crash.");
THIS->AllowPlayerLoot(them, slot);
}
XSRETURN_EMPTY;
bool Perl_Corpse_CanMobLoot(Corpse* self, int character_id) // @categories Script Utility, Corpse
{
return self->CanPlayerLoot(character_id);
}
XS(XS_Corpse_AddLooter); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_AddLooter) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::AddLooter(THIS, Mob* who)"); // @categories Account and Character, Corpse
{
Corpse *THIS;
Mob *who;
VALIDATE_THIS_IS_CORPSE;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
who = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "who is not of type Mob");
if (who == nullptr)
Perl_croak(aTHX_ "who is nullptr, avoiding crash.");
THIS->AddLooter(who);
}
XSRETURN_EMPTY;
void Perl_Corpse_AllowMobLoot(Corpse* self, Mob* them, uint8_t slot) // @categories Account and Character, Corpse
{
self->AllowPlayerLoot(them, slot);
}
XS(XS_Corpse_IsRezzed); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_IsRezzed) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::IsRezzed(THIS)"); // @categories Corpse
{
Corpse *THIS;
bool RETVAL;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->IsRezzed();
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
void Perl_Corpse_AddLooter(Corpse* self, Mob* who) // @categories Account and Character, Corpse
{
self->AddLooter(who);
}
XS(XS_Corpse_HasItem); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_HasItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::HasItem(THIS, uint32 item_id)"); // @categories Script Utility
{
Corpse *THIS;
bool has_item = false;
uint32 item_id = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_CORPSE;
has_item = THIS->HasItem(item_id);
ST(0) = boolSV(has_item);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_Corpse_IsRezzed(Corpse* self) // @categories Corpse
{
return self->IsRezzed();
}
XS(XS_Corpse_CountItem);
XS(XS_Corpse_CountItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::CountItem(THIS, uint32 item_id)"); // @categories Script Utility
{
Corpse *THIS;
uint16 item_count = 0;
uint32 item_id = (uint32) SvUV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
item_count = THIS->CountItem(item_id);
XSprePUSH;
PUSHu((UV) item_count);
}
XSRETURN(1);
bool Perl_Corpse_HasItem(Corpse* self, uint32_t item_id) // @categories Script Utility
{
return self->HasItem(item_id);
}
XS(XS_Corpse_GetItemIDBySlot);
XS(XS_Corpse_GetItemIDBySlot) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::GetItemIDBySlot(THIS, uint16 loot_slot)"); // @categories Script Utility
{
Corpse *THIS;
uint32 item_id = 0;
uint16 loot_slot = (uint16) SvUV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
item_id = THIS->GetItemIDBySlot(loot_slot);
XSprePUSH;
PUSHu((UV) item_id);
}
XSRETURN(1);
int Perl_Corpse_CountItem(Corpse* self, uint32_t item_id) // @categories Script Utility
{
return self->CountItem(item_id);
}
XS(XS_Corpse_GetFirstSlotByItemID);
XS(XS_Corpse_GetFirstSlotByItemID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::GetFirstSlotByItemID(THIS, uint32 item_id)"); // @categories Script Utility
{
Corpse *THIS;
uint16 loot_slot = 0;
uint32 item_id = (uint32) SvUV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
loot_slot = THIS->GetFirstSlotByItemID(item_id);
XSprePUSH;
PUSHu((UV) loot_slot);
}
XSRETURN(1);
uint32_t Perl_Corpse_GetItemIDBySlot(Corpse* self, uint16_t loot_slot) // @categories Script Utility
{
return self->GetItemIDBySlot(loot_slot);
}
XS(XS_Corpse_RemoveItemByID);
XS(XS_Corpse_RemoveItemByID) {
dXSARGS;
if (items != 2 && items != 3)
Perl_croak(aTHX_ "Usage: Corpse::RemoveItemByID(THIS, uint32 item_id, [int quantity = 1])"); // @categories Script Utility
{
Corpse *THIS;
uint32 item_id = (uint32) SvUV(ST(1));
int quantity = 1;
VALIDATE_THIS_IS_CORPSE;
if (items == 3)
quantity = (int) SvIV(ST(2));
THIS->RemoveItemByID(item_id, quantity);
}
XSRETURN_EMPTY;
int Perl_Corpse_GetFirstSlotByItemID(Corpse* self, uint32_t item_id) // @categories Script Utility
{
return self->GetFirstSlotByItemID(item_id);
}
XS(XS_Corpse_GetLootList);
XS(XS_Corpse_GetLootList) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetLootList(THIS)"); // @categories Script Utility
{
Corpse *THIS;
VALIDATE_THIS_IS_CORPSE;
auto corpse_items = THIS->GetLootList();
auto item_count = corpse_items.size();
if (item_count > 0) {
EXTEND(sp, item_count);
for (int index = 0; index < item_count; ++index) {
ST(index) = sv_2mortal(newSVuv(corpse_items[index]));
}
XSRETURN(item_count);
}
SV* return_value = &PL_sv_undef;
ST(0) = return_value;
XSRETURN(1);
}
void Perl_Corpse_RemoveItemByID(Corpse* self, uint32_t item_id) // @categories Script Utility
{
self->RemoveItemByID(item_id);
}
#ifdef __cplusplus
extern "C"
#endif
XS(boot_Corpse); /* prototype to pass -Wmissing-prototypes */
XS(boot_Corpse) {
dXSARGS;
char file[256];
strncpy(file, __FILE__, 256);
file[255] = 0;
void Perl_Corpse_RemoveItemByID(Corpse* self, uint32_t item_id, int quantity) // @categories Script Utility
{
self->RemoveItemByID(item_id);
}
if (items != 1)
fprintf(stderr, "boot_quest does not take any arguments.");
char buf[128];
perl::array Perl_Corpse_GetLootList(Corpse* self) // @categories Script Utility
{
perl::array result;
//add the strcpy stuff to get rid of const warnings....
auto corpse_items = self->GetLootList();
for (int i = 0; i < corpse_items.size(); ++i)
{
result.push_back(corpse_items[i]);
}
XS_VERSION_BOOTCHECK;
newXSproto(strcpy(buf, "AddItem"), XS_Corpse_AddItem, file, "$$$;$");
newXSproto(strcpy(buf, "AddLooter"), XS_Corpse_AddLooter, file, "$$");
newXSproto(strcpy(buf, "AllowMobLoot"), XS_Corpse_AllowMobLoot, file, "$$$");
newXSproto(strcpy(buf, "CanMobLoot"), XS_Corpse_CanMobLoot, file, "$$");
newXSproto(strcpy(buf, "CastRezz"), XS_Corpse_CastRezz, file, "$$$");
newXSproto(strcpy(buf, "CompleteRezz"), XS_Corpse_CompleteRezz, file, "$");
newXSproto(strcpy(buf, "CountItem"), XS_Corpse_CountItem, file, "$$");
newXSproto(strcpy(buf, "CountItems"), XS_Corpse_CountItems, file, "$");
newXSproto(strcpy(buf, "Delete"), XS_Corpse_Delete, file, "$");
newXSproto(strcpy(buf, "GetCharID"), XS_Corpse_GetCharID, file, "$");
newXSproto(strcpy(buf, "GetCopper"), XS_Corpse_GetCopper, file, "$");
newXSproto(strcpy(buf, "GetDBID"), XS_Corpse_GetDBID, file, "$");
newXSproto(strcpy(buf, "GetDecayTime"), XS_Corpse_GetDecayTime, file, "$");
newXSproto(strcpy(buf, "GetFirstSlotByItemID"), XS_Corpse_GetFirstSlotByItemID, file, "$$");
newXSproto(strcpy(buf, "GetGold"), XS_Corpse_GetGold, file, "$");
newXSproto(strcpy(buf, "GetItemIDBySlot"), XS_Corpse_GetItemIDBySlot, file, "$$");
newXSproto(strcpy(buf, "GetLootList"), XS_Corpse_GetLootList, file, "$");
newXSproto(strcpy(buf, "GetOwnerName"), XS_Corpse_GetOwnerName, file, "$");
newXSproto(strcpy(buf, "GetPlatinum"), XS_Corpse_GetPlatinum, file, "$");
newXSproto(strcpy(buf, "GetSilver"), XS_Corpse_GetSilver, file, "$");
newXSproto(strcpy(buf, "GetWornItem"), XS_Corpse_GetWornItem, file, "$$");
newXSproto(strcpy(buf, "HasItem"), XS_Corpse_HasItem, file, "$$");
newXSproto(strcpy(buf, "IsEmpty"), XS_Corpse_IsEmpty, file, "$");
newXSproto(strcpy(buf, "IsLocked"), XS_Corpse_IsLocked, file, "$");
newXSproto(strcpy(buf, "IsRezzed"), XS_Corpse_IsRezzed, file, "$");
newXSproto(strcpy(buf, "Lock"), XS_Corpse_Lock, file, "$");
newXSproto(strcpy(buf, "RemoveCash"), XS_Corpse_RemoveCash, file, "$");
newXSproto(strcpy(buf, "RemoveItem"), XS_Corpse_RemoveItem, file, "$$");
newXSproto(strcpy(buf, "RemoveItemByID"), XS_Corpse_RemoveItemByID, file, "$$;$");
newXSproto(strcpy(buf, "ResetLooter"), XS_Corpse_ResetLooter, file, "$");
newXSproto(strcpy(buf, "SetCash"), XS_Corpse_SetCash, file, "$$$$$");
newXSproto(strcpy(buf, "SetDecayTimer"), XS_Corpse_SetDecayTimer, file, "$$");
newXSproto(strcpy(buf, "Summon"), XS_Corpse_Summon, file, "$$$");
newXSproto(strcpy(buf, "UnLock"), XS_Corpse_UnLock, file, "$");
XSRETURN_YES;
return result;
}
void perl_register_corpse()
{
perl::interpreter perl(PERL_GET_THX);
auto package = perl.new_class<Corpse>("Corpse");
package.add_base_class("Mob");
package.add("AddItem", (void(*)(Corpse*, uint32, uint16))&Perl_Corpse_AddItem);
package.add("AddItem", (void(*)(Corpse*, uint32, uint16, uint16))&Perl_Corpse_AddItem);
package.add("AddLooter", &Perl_Corpse_AddLooter);
package.add("AllowMobLoot", &Perl_Corpse_AllowMobLoot);
package.add("CanMobLoot", &Perl_Corpse_CanMobLoot);
package.add("CastRezz", &Perl_Corpse_CastRezz);
package.add("CompleteRezz", &Perl_Corpse_CompleteRezz);
package.add("CountItem", &Perl_Corpse_CountItem);
package.add("CountItems", &Perl_Corpse_CountItems);
package.add("Delete", &Perl_Corpse_Delete);
package.add("GetCharID", &Perl_Corpse_GetCharID);
package.add("GetCopper", &Perl_Corpse_GetCopper);
package.add("GetDBID", &Perl_Corpse_GetDBID);
package.add("GetDecayTime", &Perl_Corpse_GetDecayTime);
package.add("GetFirstSlotByItemID", &Perl_Corpse_GetFirstSlotByItemID);
package.add("GetGold", &Perl_Corpse_GetGold);
package.add("GetItemIDBySlot", &Perl_Corpse_GetItemIDBySlot);
package.add("GetLootList", &Perl_Corpse_GetLootList);
package.add("GetOwnerName", &Perl_Corpse_GetOwnerName);
package.add("GetPlatinum", &Perl_Corpse_GetPlatinum);
package.add("GetSilver", &Perl_Corpse_GetSilver);
package.add("GetWornItem", &Perl_Corpse_GetWornItem);
package.add("HasItem", &Perl_Corpse_HasItem);
package.add("IsEmpty", &Perl_Corpse_IsEmpty);
package.add("IsLocked", &Perl_Corpse_IsLocked);
package.add("IsRezzed", &Perl_Corpse_IsRezzed);
package.add("Lock", &Perl_Corpse_Lock);
package.add("RemoveCash", &Perl_Corpse_RemoveCash);
package.add("RemoveItem", &Perl_Corpse_RemoveItem);
package.add("RemoveItemByID", (void(*)(Corpse*, uint32_t))&Perl_Corpse_RemoveItemByID);
package.add("RemoveItemByID", (void(*)(Corpse*, uint32_t, int))&Perl_Corpse_RemoveItemByID);
package.add("ResetLooter", &Perl_Corpse_ResetLooter);
package.add("SetCash", &Perl_Corpse_SetCash);
package.add("SetDecayTimer", &Perl_Corpse_SetDecayTimer);
package.add("Summon", &Perl_Corpse_Summon);
package.add("UnLock", &Perl_Corpse_UnLock);
}
#endif //EMBPERL_XS_CLASSES

254
zone/perl_questitem.cpp
View File

@ -4,234 +4,82 @@
#ifdef EMBPERL_XS_CLASSES
#include "../common/global_define.h"
#include "../common/item_instance.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "../common/item_instance.h"
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
#define VALIDATE_THIS_IS_ITEM \
do { \
if (sv_derived_from(ST(0), "QuestItem")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(EQ::ItemInstance*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type EQ::ItemInstance"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
XS(XS_QuestItem_GetName);
XS(XS_QuestItem_GetName) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: QuestItem::GetName(THIS)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
Const_char *RETVAL;
dXSTARG;
VALIDATE_THIS_IS_ITEM;
RETVAL = THIS->GetItem()->Name;
sv_setpv(TARG, RETVAL);
XSprePUSH;
PUSHTARG;
}
XSRETURN(1);
std::string Perl_QuestItem_GetName(EQ::ItemInstance* self) // @categories Inventory and Items
{
return self->GetItem()->Name;
}
XS(XS_QuestItem_SetScale);
XS(XS_QuestItem_SetScale) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: QuestItem::SetScale(THIS, float scale_multiplier)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
float Mult;
VALIDATE_THIS_IS_ITEM;
Mult = (float) SvNV(ST(1));
if (THIS->IsScaling()) {
THIS->SetExp((int) (Mult * 10000 + .5));
}
void Perl_QuestItem_SetScale(EQ::ItemInstance* self, float scale_multiplier) // @categories Inventory and Items
{
if (self->IsScaling()) {
self->SetExp((int) (scale_multiplier * 10000 + .5));
}
XSRETURN_EMPTY;
}
XS(XS_QuestItem_ItemSay);
XS(XS_QuestItem_ItemSay) {
dXSARGS;
if (items != 2 && items != 3)
Perl_croak(aTHX_ "Usage: QuestItem::ItemSay(THIS, string text [int language_id])"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
Const_char *text;
int lang = 0;
VALIDATE_THIS_IS_ITEM;
text = SvPV_nolen(ST(1));
if (items == 3)
lang = (int) SvUV(ST(2));
quest_manager.GetInitiator()->ChannelMessageSend(THIS->GetItem()->Name, 0, 8, lang, 100, text);
}
XSRETURN_EMPTY;
void Perl_QuestItem_ItemSay(EQ::ItemInstance* self, const char* text) // @categories Inventory and Items
{
quest_manager.GetInitiator()->ChannelMessageSend(self->GetItem()->Name, 0, 8, 0, 100, text);
}
XS(XS_QuestItem_IsType); /* prototype to pass -Wmissing-prototypes */
XS(XS_QuestItem_IsType) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: QuestItem::IsType(THIS, type)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
bool RETVAL;
uint32 type = (int32) SvIV(ST(1));
VALIDATE_THIS_IS_ITEM;
RETVAL = THIS->IsType((EQ::item::ItemClass) type);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
void Perl_QuestItem_ItemSay(EQ::ItemInstance* self, const char* text, int language_id) // @categories Inventory and Items
{
quest_manager.GetInitiator()->ChannelMessageSend(self->GetItem()->Name, 0, 8, language_id, 100, text);
}
XS(XS_QuestItem_IsAttuned); /* prototype to pass -Wmissing-prototypes */
XS(XS_QuestItem_IsAttuned) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: QuestItem::IsAttuned(THIS)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
bool RETVAL;
VALIDATE_THIS_IS_ITEM;
RETVAL = THIS->IsAttuned();
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_QuestItem_IsType(EQ::ItemInstance* self, EQ::item::ItemClass type) // @categories Inventory and Items
{
return self->IsType(type);
}
XS(XS_QuestItem_GetCharges); /* prototype to pass -Wmissing-prototypes */
XS(XS_QuestItem_GetCharges) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: QuestItem::GetCharges(THIS)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
int16 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_ITEM;
RETVAL = THIS->GetCharges();
XSprePUSH;
PUSHi((IV) RETVAL);
}
XSRETURN(1);
bool Perl_QuestItem_IsAttuned(EQ::ItemInstance* self) // @categories Inventory and Items
{
return self->IsAttuned();
}
XS(XS_QuestItem_GetAugment); /* prototype to pass -Wmissing-prototypes */
XS(XS_QuestItem_GetAugment) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: QuestItem::GetAugment(THIS, int16 slot_id)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
int16 slot_id = (int16) SvIV(ST(1));
EQ::ItemInstance *RETVAL;
VALIDATE_THIS_IS_ITEM;
RETVAL = THIS->GetAugment(slot_id);
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "QuestItem", (void *) RETVAL);
}
XSRETURN(1);
int Perl_QuestItem_GetCharges(EQ::ItemInstance* self) // @categories Inventory and Items
{
return self->GetCharges();
}
XS(XS_QuestItem_GetID); /* prototype to pass -Wmissing-prototypes */
XS(XS_QuestItem_GetID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: QuestItem::GetID(THIS)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_ITEM;
RETVAL = THIS->GetItem()->ID;
XSprePUSH;
PUSHi((IV) RETVAL);
}
XSRETURN(1);
EQ::ItemInstance* Perl_QuestItem_GetAugment(EQ::ItemInstance* self, int slot_id) // @categories Inventory and Items
{
return self->GetAugment(slot_id);
}
XS(XS_QuestItem_ContainsAugmentByID); /* prototype to pass -Wmissing-prototypes */
XS(XS_QuestItem_ContainsAugmentByID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: QuestItem::ContainsAugmentByID(THIS, uint32 item_id)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
uint32 item_id = (uint32) SvUV(ST(1));
bool contains_augment = false;
VALIDATE_THIS_IS_ITEM;
contains_augment = THIS->ContainsAugmentByID(item_id);
ST(0) = boolSV(contains_augment);
sv_2mortal(ST(0));
}
XSRETURN(1);
uint32_t Perl_QuestItem_GetID(EQ::ItemInstance* self) // @categories Inventory and Items
{
return self->GetItem()->ID;
}
XS(XS_QuestItem_CountAugmentByID); /* prototype to pass -Wmissing-prototypes */
XS(XS_QuestItem_CountAugmentByID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: QuestItem::CountAugmentByID(THIS, uint32 item_id)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
int quantity = 0;
uint32 item_id = (uint32) SvUV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_ITEM;
quantity = THIS->CountAugmentByID(item_id);
XSprePUSH;
PUSHi((IV) quantity);
}
XSRETURN(1);
bool Perl_QuestItem_ContainsAugmentByID(EQ::ItemInstance* self, uint32_t item_id) // @categories Inventory and Items
{
return self->ContainsAugmentByID(item_id);
}
#ifdef __cplusplus
extern "C"
#endif
int Perl_QuestItem_CountAugmentByID(EQ::ItemInstance* self, uint32_t item_id) // @categories Inventory and Items
{
return self->CountAugmentByID(item_id);
}
XS(boot_QuestItem);
XS(boot_QuestItem) {
dXSARGS;
char file[256];
strncpy(file, __FILE__, 256);
file[255] = 0;
void perl_register_questitem()
{
perl::interpreter perl(PERL_GET_THX);
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, "ContainsAugmentByID"), XS_QuestItem_ContainsAugmentByID, file, "$$");
newXSproto(strcpy(buf, "CountAugmentByID"), XS_QuestItem_CountAugmentByID, file, "$$");
newXSproto(strcpy(buf, "GetAugment"), XS_QuestItem_GetAugment, file, "$$");
newXSproto(strcpy(buf, "GetCharges"), XS_QuestItem_GetCharges, file, "$");
newXSproto(strcpy(buf, "GetID"), XS_QuestItem_GetID, file, "$");
newXSproto(strcpy(buf, "GetName"), XS_QuestItem_GetName, file, "$");
newXSproto(strcpy(buf, "IsAttuned"), XS_QuestItem_IsAttuned, file, "$");
newXSproto(strcpy(buf, "IsType"), XS_QuestItem_IsType, file, "$$");
newXSproto(strcpy(buf, "ItemSay"), XS_QuestItem_ItemSay, file, "$");
newXSproto(strcpy(buf, "SetScale"), XS_QuestItem_SetScale, file, "$");
XSRETURN_YES;
auto package = perl.new_class<EQ::ItemInstance>("QuestItem");
package.add("ContainsAugmentByID", &Perl_QuestItem_ContainsAugmentByID);
package.add("CountAugmentByID", &Perl_QuestItem_CountAugmentByID);
package.add("GetAugment", &Perl_QuestItem_GetAugment);
package.add("GetCharges", &Perl_QuestItem_GetCharges);
package.add("GetID", &Perl_QuestItem_GetID);
package.add("GetName", &Perl_QuestItem_GetName);
package.add("IsAttuned", &Perl_QuestItem_IsAttuned);
package.add("IsType", &Perl_QuestItem_IsType);
package.add("ItemSay", (void(*)(EQ::ItemInstance*, const char*))&Perl_QuestItem_ItemSay);
package.add("ItemSay", (void(*)(EQ::ItemInstance*, const char*, int))&Perl_QuestItem_ItemSay);
package.add("SetScale", &Perl_QuestItem_SetScale);
}
#endif //EMBPERL_XS_CLASSES

541
zone/perl_raids.cpp
View File

@ -4,443 +4,138 @@
#include "../common/global_define.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "raids.h"
#include "client.h"
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
bool Perl_Raid_IsRaidMember(Raid* self, const char* name) // @categories Raid
{
return self->IsRaidMember(name);
}
#define VALIDATE_THIS_IS_RAID \
do { \
if (sv_derived_from(ST(0), "Raid")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(Raid*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type Raid"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
void Perl_Raid_CastGroupSpell(Raid* self, Mob* caster, uint16 spell_id, uint32 group_id) // @categories Group, Raid
{
self->CastGroupSpell(caster, spell_id, group_id);
}
XS(XS_Raid_IsRaidMember); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_IsRaidMember) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Raid::IsRaidMember(THIS, string name)"); // @categories Raid
int Perl_Raid_GroupCount(Raid* self, uint32_t group_id) // @categories Group, Raid
{
return self->GroupCount(group_id);
}
int Perl_Raid_RaidCount(Raid* self) // @categories Raid
{
return self->RaidCount();
}
uint32_t Perl_Raid_GetGroup(Raid* self, const char* name) // @categories Group, Raid
{
return self->GetGroup(name);
}
void Perl_Raid_SplitExp(Raid* self, uint32 experience, Mob* other) // @categories Experience and Level, Raid
{
self->SplitExp(experience, other);
}
uint32_t Perl_Raid_GetTotalRaidDamage(Raid* self, Mob* other) // @categories Raid
{
return self->GetTotalRaidDamage(other);
}
void Perl_Raid_SplitMoney(Raid* self, uint32 gid, uint32 copper, uint32 silver, uint32 gold, uint32 platinum) // @categories Currency and Points, Raid
{
self->SplitMoney(gid, copper, silver, gold, platinum);
}
void Perl_Raid_BalanceHP(Raid* self, int32_t penalty, uint32_t group_id) // @categories Raid
{
self->BalanceHP(penalty, group_id);
}
bool Perl_Raid_IsLeader(Raid* self, const char* name) // @categories Raid
{
return self->IsLeader(name);
}
bool Perl_Raid_IsGroupLeader(Raid* self, const char* who) // @categories Group, Raid
{
return self->IsGroupLeader(who);
}
uint32_t Perl_Raid_GetHighestLevel(Raid* self) // @categories Raid
{
return self->GetHighestLevel();
}
uint32_t Perl_Raid_GetLowestLevel(Raid* self) // @categories Raid
{
return self->GetLowestLevel();
}
Client* Perl_Raid_GetClientByIndex(Raid* self, uint16_t raid_index) // @categories Raid
{
return self->GetClientByIndex(raid_index);
}
void Perl_Raid_TeleportGroup(Raid* self, Mob* sender, uint32 zone_id, float x, float y, float z, float heading, uint32 group_id) // @categories Group, Raid
{
self->TeleportGroup(sender, zone_id, 0, x, y, z, heading, group_id);
}
void Perl_Raid_TeleportRaid(Raid* self, Mob* sender, uint32 zone_id, float x, float y, float z, float heading) // @categories Raid
{
self->TeleportRaid(sender, zone_id, 0, x, y, z, heading);
}
uint32_t Perl_Raid_GetID(Raid* self) // @categories Raid
{
return self->GetID();
}
Client* Perl_Raid_GetMember(Raid* self, int raid_index) // @categories Raid
{
if (self->members[raid_index].member != nullptr)
{
Raid *THIS;
bool RETVAL;
const char *name = (char *) SvPV_nolen(ST(1));
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->IsRaidMember(name);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
return self->members[raid_index].member->CastToClient();
}
XSRETURN(1);
return nullptr;
}
XS(XS_Raid_CastGroupSpell); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_CastGroupSpell) {
dXSARGS;
if (items != 4)
Perl_croak(aTHX_ "Usage: Raid::CastGroupSpell(THIS, Mob* caster, uint16 spell_id, uint32 group_id)"); // @categories Group, Raid
{
Raid *THIS;
Mob *caster;
uint16 spellid = (uint16) SvUV(ST(2));
uint32 gid = (uint32) SvUV(ST(3));
VALIDATE_THIS_IS_RAID;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
caster = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "caster is not of type Mob");
if (caster == nullptr)
Perl_croak(aTHX_ "caster is nullptr, avoiding crash.");
THIS->CastGroupSpell(caster, spellid, gid);
}
XSRETURN_EMPTY;
bool Perl_Raid_DoesAnyMemberHaveExpeditionLockout(Raid* self, std::string expedition_name, std::string event_name)
{
return self->DoesAnyMemberHaveExpeditionLockout(expedition_name, event_name);
}
XS(XS_Raid_GroupCount); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_GroupCount) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Raid::GroupCount(THIS, uint32 group_id)"); // @categories Group, Raid
{
Raid *THIS;
uint8 RETVAL;
dXSTARG;
uint32 gid = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->GroupCount(gid);
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
bool Perl_Raid_DoesAnyMemberHaveExpeditionLockout(Raid* self, std::string expedition_name, std::string event_name, int max_check_count)
{
return self->DoesAnyMemberHaveExpeditionLockout(expedition_name, event_name, max_check_count);
}
XS(XS_Raid_RaidCount); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_RaidCount) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Raid::RaidCount(THIS)"); // @categories Raid
{
Raid *THIS;
uint8 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->RaidCount();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
void perl_register_raid()
{
perl::interpreter perl(PERL_GET_THX);
XS(XS_Raid_GetGroup); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_GetGroup) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Raid::GetGroup(THIS, string name)"); // @categories Group, Raid
{
Raid *THIS;
uint32 RETVAL;
dXSTARG;
const char *name = (char *) SvPV_nolen(ST(1));
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->GetGroup(name);
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Raid_SplitExp); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_SplitExp) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Raid::SplitExp(THIS, uint32 experience, [Mob* other = nullptr])"); // @categories Experience and Level, Raid
{
Raid *THIS;
uint32 exp = (uint32) SvUV(ST(1));
Mob *other;
VALIDATE_THIS_IS_RAID;
if (sv_derived_from(ST(2), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(2)));
other = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "other is not of type Mob");
if (other == nullptr)
Perl_croak(aTHX_ "other is nullptr, avoiding crash.");
THIS->SplitExp(exp, other);
}
XSRETURN_EMPTY;
}
XS(XS_Raid_GetTotalRaidDamage); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_GetTotalRaidDamage) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Raid::GetTotalRaidDamage(THIS, [Mob* other = nullptr])"); // @categories Raid
{
Raid *THIS;
uint32 RETVAL;
dXSTARG;
Mob *other;
VALIDATE_THIS_IS_RAID;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
other = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "other is not of type Mob");
if (other == nullptr)
Perl_croak(aTHX_ "other is nullptr, avoiding crash.");
RETVAL = THIS->GetTotalRaidDamage(other);
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Raid_SplitMoney); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_SplitMoney) {
dXSARGS;
if (items != 5)
Perl_croak(aTHX_ "Usage: Raid::SplitMoney(THIS, uint32 gid, uint32 copper, uint32 silver, uint32 gold, uint32 platinum)"); // @categories Currency and Points, Raid
{
Raid *THIS;
uint32 gid = (uint32) SvUV(ST(1));
uint32 copper = (uint32) SvUV(ST(2));
uint32 silver = (uint32) SvUV(ST(3));
uint32 gold = (uint32) SvUV(ST(4));
uint32 platinum = (uint32) SvUV(ST(5));
VALIDATE_THIS_IS_RAID;
THIS->SplitMoney(gid, copper, silver, gold, platinum);
}
XSRETURN_EMPTY;
}
XS(XS_Raid_BalanceHP); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_BalanceHP) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Raid::BalanceHP(THIS, int32 penalty, uint32 group_id)"); // @categories Raid
{
Raid *THIS;
int32 penalty = (int32) SvUV(ST(1));
uint32 gid = (uint32) SvUV(ST(2));
VALIDATE_THIS_IS_RAID;
THIS->BalanceHP(penalty, gid);
}
XSRETURN_EMPTY;
}
XS(XS_Raid_IsLeader); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_IsLeader) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Raid::IsLeader(THIS, string name)"); // @categories Raid
{
Raid *THIS;
bool RETVAL;
const char *name = (char *) SvPV_nolen(ST(1));
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->IsLeader(name);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
}
XS(XS_Raid_IsGroupLeader); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_IsGroupLeader) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Raid::IsGroupLeader(THIS, string name)"); // @categories Group, Raid
{
Raid *THIS;
bool RETVAL;
const char *who = (char *) SvPV_nolen(ST(1));
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->IsGroupLeader(who);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
}
XS(XS_Raid_GetHighestLevel); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_GetHighestLevel) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Raid::GetHighestLevel(THIS)"); // @categories Raid
{
Raid *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->GetHighestLevel();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Raid_GetLowestLevel); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_GetLowestLevel) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Raid::GetLowestLevel(THIS)"); // @categories Raid
{
Raid *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->GetLowestLevel();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Raid_GetClientByIndex); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_GetClientByIndex) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Raid::GetClientByIndex(THIS, uint16 raid_index)"); // @categories Raid
{
Raid *THIS;
Client *RETVAL;
uint16 index = (uint16) SvUV(ST(1));
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->GetClientByIndex(index);
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "Client", (void *) RETVAL);
}
XSRETURN(1);
}
XS(XS_Raid_TeleportGroup); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_TeleportGroup) {
dXSARGS;
if (items != 8)
Perl_croak(aTHX_ "Usage: Raid::TeleportGroup(THIS, Mob* sender, uint32 zone_id, float x, float y, float z, float heading, uint32 group_id)"); // @categories Group, Raid
{
Raid *THIS;
Mob *sender;
uint32 zoneID = (uint32) SvUV(ST(2));
float x = (float) SvNV(ST(3));
float y = (float) SvNV(ST(4));
float z = (float) SvNV(ST(5));
float heading = (float) SvNV(ST(6));
uint32 gid = (uint32) SvUV(ST(7));
VALIDATE_THIS_IS_RAID;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
sender = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "sender is not of type Mob");
if (sender == nullptr)
Perl_croak(aTHX_ "sender is nullptr, avoiding crash.");
THIS->TeleportGroup(sender, zoneID, 0, x, y, z, heading, gid);
}
XSRETURN_EMPTY;
}
XS(XS_Raid_TeleportRaid); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_TeleportRaid) {
dXSARGS;
if (items != 7)
Perl_croak(aTHX_ "Usage: Raid::TeleportRaid(THIS, Mob* sender, uint32 zone_id, float x, float y, float z, float heading)"); // @categories Raid
{
Raid *THIS;
Mob *sender;
uint32 zoneID = (uint32) SvUV(ST(2));
float x = (float) SvNV(ST(3));
float y = (float) SvNV(ST(4));
float z = (float) SvNV(ST(5));
float heading = (float) SvNV(ST(6));
VALIDATE_THIS_IS_RAID;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
sender = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "sender is not of type Mob");
if (sender == nullptr)
Perl_croak(aTHX_ "sender is nullptr, avoiding crash.");
THIS->TeleportRaid(sender, zoneID, 0, x, y, z, heading);
}
XSRETURN_EMPTY;
}
XS(XS_Raid_GetID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_GetID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Raid::GetID(THIS)"); // @categories Raid
{
Raid *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->GetID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Raid_GetMember);
XS(XS_Raid_GetMember) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Raid::GetMember(THIS, int raid_index)"); // @categories Raid
{
Raid *THIS;
Client *RETVAL = nullptr;
dXSTARG;
VALIDATE_THIS_IS_RAID;
int index = (int) SvUV(ST(1));
if (index < 0 || index > 71)
RETVAL = nullptr;
else {
if (THIS->members[index].member != nullptr)
RETVAL = THIS->members[index].member->CastToClient();
}
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "Client", (void *) RETVAL);
}
XSRETURN(1);
}
XS(XS_Raid_DoesAnyMemberHaveExpeditionLockout);
XS(XS_Raid_DoesAnyMemberHaveExpeditionLockout) {
dXSARGS;
if (items != 3 && items != 4) {
Perl_croak(aTHX_ "Usage: Raid::DoesAnyMemberHaveExpeditionLockout(THIS, string expedition_name, string event_name, [int max_check_count = 0])");
}
Raid* THIS = nullptr;
VALIDATE_THIS_IS_RAID;
std::string expedition_name(SvPV_nolen(ST(1)));
std::string event_name(SvPV_nolen(ST(2)));
int max_check_count = (items == 4) ? static_cast<int>(SvIV(ST(3))) : 0;
bool result = THIS->DoesAnyMemberHaveExpeditionLockout(expedition_name, event_name, max_check_count);
ST(0) = boolSV(result);
XSRETURN(1);
}
#ifdef __cplusplus
extern "C"
#endif
XS(boot_Raid); /* prototype to pass -Wmissing-prototypes */
XS(boot_Raid) {
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, "BalanceHP"), XS_Raid_BalanceHP, file, "$$$");
newXSproto(strcpy(buf, "CastGroupSpell"), XS_Raid_CastGroupSpell, file, "$$$$");
newXSproto(strcpy(buf, "DoesAnyMemberHaveExpeditionLockout"), XS_Raid_DoesAnyMemberHaveExpeditionLockout, file, "$$$;$");
newXSproto(strcpy(buf, "GetClientByIndex"), XS_Raid_GetClientByIndex, file, "$$");
newXSproto(strcpy(buf, "GetGroup"), XS_Raid_GetGroup, file, "$$");
newXSproto(strcpy(buf, "GetHighestLevel"), XS_Raid_GetHighestLevel, file, "$");
newXSproto(strcpy(buf, "GetID"), XS_Raid_GetID, file, "$");
newXSproto(strcpy(buf, "GetLowestLevel"), XS_Raid_GetLowestLevel, file, "$");
newXSproto(strcpy(buf, "GetMember"), XS_Raid_GetMember, file, "$$");
newXSproto(strcpy(buf, "GetTotalRaidDamage"), XS_Raid_GetTotalRaidDamage, file, "$$");
newXSproto(strcpy(buf, "GroupCount"), XS_Raid_GroupCount, file, "$$");
newXSproto(strcpy(buf, "IsGroupLeader"), XS_Raid_IsGroupLeader, file, "$$");
newXSproto(strcpy(buf, "IsLeader"), XS_Raid_IsLeader, file, "$$");
newXSproto(strcpy(buf, "IsRaidMember"), XS_Raid_IsRaidMember, file, "$$");
newXSproto(strcpy(buf, "RaidCount"), XS_Raid_RaidCount, file, "$");
newXSproto(strcpy(buf, "SplitExp"), XS_Raid_SplitExp, file, "$$$");
newXSproto(strcpy(buf, "SplitMoney"), XS_Raid_SplitMoney, file, "$$$$$$");
newXSproto(strcpy(buf, "TeleportGroup"), XS_Raid_TeleportGroup, file, "$$$$$$$$");
newXSproto(strcpy(buf, "TeleportRaid"), XS_Raid_TeleportRaid, file, "$$$$$$$");
XSRETURN_YES;
auto package = perl.new_class<Raid>("Raid");
package.add("BalanceHP", &Perl_Raid_BalanceHP);
package.add("CastGroupSpell", &Perl_Raid_CastGroupSpell);
package.add("DoesAnyMemberHaveExpeditionLockout", (bool(*)(Raid*, std::string, std::string))&Perl_Raid_DoesAnyMemberHaveExpeditionLockout);
package.add("DoesAnyMemberHaveExpeditionLockout", (bool(*)(Raid*, std::string, std::string, int))&Perl_Raid_DoesAnyMemberHaveExpeditionLockout);
package.add("GetClientByIndex", &Perl_Raid_GetClientByIndex);
package.add("GetGroup", &Perl_Raid_GetGroup);
package.add("GetHighestLevel", &Perl_Raid_GetHighestLevel);
package.add("GetID", &Perl_Raid_GetID);
package.add("GetLowestLevel", &Perl_Raid_GetLowestLevel);
package.add("GetMember", &Perl_Raid_GetMember);
package.add("GetTotalRaidDamage", &Perl_Raid_GetTotalRaidDamage);
package.add("GroupCount", &Perl_Raid_GroupCount);
package.add("IsGroupLeader", &Perl_Raid_IsGroupLeader);
package.add("IsLeader", &Perl_Raid_IsLeader);
package.add("IsRaidMember", &Perl_Raid_IsRaidMember);
package.add("RaidCount", &Perl_Raid_RaidCount);
package.add("SplitExp", &Perl_Raid_SplitExp);
package.add("SplitMoney", &Perl_Raid_SplitMoney);
package.add("TeleportGroup", &Perl_Raid_TeleportGroup);
package.add("TeleportRaid", &Perl_Raid_TeleportRaid);
}
#endif //EMBPERL_XS_CLASSES

2788
zone/perl_spell.cpp
View File

File diff suppressed because it is too large Load Diff