server/server/cfperl.xs

/*
 * This file is part of Crossfire TRT, the Roguelike Realtime MORPG.
 * 
 * Copyright (©) 2006,2007 Marc Alexander Lehmann / Robin Redeker / the Crossfire TRT team
 * Copyright (©) 2001-2005,2007 by Chachkoff Yann                               
 * Copyright (©) 2006,2007 by Marc Lehmann <cf@schmorp.de>
 * 
 * Crossfire TRT is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 * 
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this program. If not, see <http://www.gnu.org/licenses/>.
 * 
 * The authors can be reached via e-mail to <crossfire@schmorp.de>
 */

#include "autoconf.h"

#define PLUGIN_NAME    "perl"
#define PLUGIN_VERSION "cfperl 0.5"

#define CEDES_PER_TICK 5

#if HAVE_EXECINFO_H
# include <execinfo.h>
#endif

#include <cstdarg>

#include "global.h"
#include "loader.h"
#include "../random_maps/random_map.h"
#include <sproto.h>

#include <unistd.h>
#if _POSIX_MEMLOCK
# include <sys/mman.h>
#endif

#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>

#include "CoroAPI.h"
#include "perlxsi.c"

extern sint64 *levels; // the experience table

typedef object_thawer  &object_thawer_ref;
typedef object_freezer &object_freezer_ref;

typedef std::string std__string;

#if IVSIZE >= 8
  typedef IV val64;
# define newSVval64 newSViv
# define SvVAL64 SvIV
#else
  typedef double val64;
# define newSVval64 newSVnv
# define SvVAL64 SvNV
#endif

static PerlInterpreter *perl;

tstamp NOW, runtime;

global gbl_ev;
static AV *cb_global, *cb_attachable, *cb_object, *cb_player, *cb_client, *cb_type, *cb_map;
static SV *sv_runtime, *sv_next_tick;

bitset<NUM_EVENT_TYPES> ev_want_event;
bitset<NUM_TYPES>       ev_want_type;

static HV
   *stash_cf,
   *stash_cf_object_wrap,
   *stash_cf_object_player_wrap,
   *stash_cf_player_wrap,
   *stash_cf_map_wrap,
   *stash_cf_client_wrap,
   *stash_cf_arch_wrap,
   *stash_cf_party_wrap,
   *stash_cf_region_wrap,
   *stash_cf_living_wrap;

static inline SV *
newSVpv_utf8 (const char *s)
{
  if (!s)
    return newSV (0);

  SV *sv = newSVpv (s, 0);
  SvUTF8_on (sv);
  return sv;
}

static inline SV *
newSVpvn_utf8 (const char *s, STRLEN l)
{
  if (!s)
    return newSV (0);

  SV *sv = newSVpvn (s, l);
  SvUTF8_on (sv);
  return sv;
}

// helper cast function, returns super class * or 0
template<class super>
static super *
is_a (attachable *at)
{
  //return dynamic_cast<super *>(at); // slower, safer
  if (typeid (*at) == typeid (super))
    return static_cast<super *>(at);
  else
    return 0;
}

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

unordered_vector<attachable *> attachable::mortals;

attachable::~attachable ()
{
  assert (!self);
  assert (!cb);
}

int
attachable::refcnt_cnt () const
{
  return refcnt + (self ? SvREFCNT (self) - 1 : 0);
}

void
attachable::sever_self ()
{
  if (HV *self = this->self)
    {
      // keep a refcount because sv_unmagic might call attachable_free,
      // which might clear self, causing sv_unmagic to crash on a now
      // invalid object.
      SvREFCNT_inc (self);
      hv_clear (self);
      sv_unmagic ((SV *)self, PERL_MAGIC_ext);
      SvREFCNT_dec (self);

      // self *must* be null now because thats sv_unmagic's job.
      assert (!this->self);
    }
}

void
attachable::optimise ()
{
  if (self
      && SvREFCNT (self) == 1
      && !HvTOTALKEYS (self))
    sever_self ();
}

// check wether the object really is dead
void
attachable::do_check ()
{
  if (refcnt_cnt () > 0)
    return;

  destroy ();
}

void
attachable::do_destroy ()
{
  INVOKE_ATTACHABLE (DESTROY, this);

  if (cb)
    {
      SvREFCNT_dec (cb);
      cb = 0;
    }

  mortals.push_back (this);
}

void
attachable::destroy ()
{
  if (destroyed ())
    return;

  flags |= F_DESTROYED;
  do_destroy ();
  sever_self ();
}

void
attachable::check_mortals ()
{
  static int i = 0;

  for (;;)
    {
      if (i >= mortals.size ())
        {
          i = 0;

          if (mortals.size () >= 512)
            {
              static int last_mortalcount;
              if (mortals.size () != last_mortalcount)
                {
                  last_mortalcount = mortals.size ();
                  LOG (llevInfo, "%d mortals.\n", (int)mortals.size ());

                  if (0)
                    {
                      for (int j = 0; j < mortals.size (); ++j)//D
                        fprintf (stderr, "%d:%s %p ", j, &((object *)mortals[j])->name, mortals[j]);//D
                      fprintf (stderr, "\n");//D
                    }
                }
            }

          break;
        }

      attachable *obj = mortals [i];

#if 0
      if (obj->self)//D make this an assert later
        {
          LOG (llevError, "check_mortals: object '%s' still has self\n", typeid (obj).name ());
          obj->sever_self ();
        }
#endif

      if (obj->refcnt)
        {
          ++i; // further delay freeing

          if (!(i & 0x3ff))
            break;
        }
      else
        {
          mortals.erase (i);
          obj->sever_self ();
          delete obj;
        }
    }
}

void
attachable::set_key (const char *key, const char *value, bool is_utf8)
{
  if (!self)
    self = newHV ();

  if (value)
    hv_store (self, key, strlen (key), is_utf8 ? newSVpv_utf8 (value) : newSVpv (value, 0), 0);
  else
    hv_delete (self, key, strlen (key), G_DISCARD);
}

attachable &
attachable::operator =(const attachable &src)
{
  //if (self || cb)
    //INVOKE_OBJECT (CLONE, this, ARG_OBJECT (dst));

  attach = src.attach;
  return *this;
}

template<typename T>
static bool
find_backref (void *ptr, T *obj)
{
  char *s = (char *)obj;
  while (s < (char *)obj + sizeof (T))
    {
      if (ptr == *(void **)s)
        return true;

      s += sizeof (void *); // assume natural alignment
    }

  return false;
}

// for debugging, find "live" objects containing this ptr
void
find_backref (void *ptr)
{
  for_all_objects (op)
    if (find_backref (ptr, op))
      fprintf (stderr, "O %p %d:'%s'\n", op, op->count, &op->name);

  for_all_players (pl)
    if (find_backref (ptr, pl))
      fprintf (stderr, "P %p\n", pl);
  
  for_all_clients (ns)
    if (find_backref (ptr, ns))
      fprintf (stderr, "C %p\n", ns);
  
}

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

static SV *
newSVptr (void *ptr, HV *stash, HV *hv = newHV ())
{
  SV *sv;

  if (!ptr)
    return newSV (0);

  sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, 0, (char *)ptr, 0);
  return sv_bless (newRV_noinc ((SV *)hv), stash);
}

static int
attachable_free (pTHX_ SV *sv, MAGIC *mg)
{
  attachable *at = (attachable *)mg->mg_ptr;

  //TODO: check if transaction behaviour is really required here
  if (SV *self = (SV *)at->self)
    {
      at->self = 0;
      SvREFCNT_dec (self);
    }

  // next line makes sense, but most objects still have refcnt 0 by default
  //at->refcnt_chk ();
  return 0;
}

MGVTBL attachable::vtbl = {0, 0, 0, 0, attachable_free};

static SV *
newSVattachable (attachable *obj, HV *stash)
{
  if (!obj)
    return newSV (0);

  if (!obj->self)
    obj->self = newHV ();

  if (!SvOBJECT (obj->self))
    {
      sv_magicext ((SV *)obj->self, 0, PERL_MAGIC_ext, &attachable::vtbl, (char *)obj, 0);

      // now bless the object _once_
      //TODO: create a class registry with c++ type<=>perl name<=>stash and use it here and elsewhere
      return sv_bless (newRV_inc ((SV *)obj->self), stash);
    }
  else
    {
      SV *sv = newRV_inc ((SV *)obj->self);

      if (Gv_AMG (stash)) // handle overload correctly, as the perl core does not
        SvAMAGIC_on (sv);

      return sv;
    }
}

static void
clearSVptr (SV *sv)
{
  if (SvROK (sv))
    sv = SvRV (sv);

  hv_clear ((HV *)sv);
  sv_unmagic (sv, PERL_MAGIC_ext);
}

static long
SvPTR (SV *sv, const char *klass)
{
  if (!sv_derived_from (sv, klass))
    croak ("object of type %s expected", klass);

  MAGIC *mg = mg_find (SvRV (sv), PERL_MAGIC_ext);

  if (!mg)
    croak ("perl code used %s object, but C object is already destroyed, caught", klass);

  return (long)mg->mg_ptr;
}

static long
SvPTR_ornull (SV *sv, const char *klass)
{
  if (SvOK (sv))
    return SvPTR (sv, klass);
  else
    return 0;
}

inline SV *to_sv (const shstr &  v) { return newSVpvn_utf8 ((const char *)v, v.length ()); }
inline SV *to_sv (const char *   v) { return v ? newSVpv (v, 0) : newSV (0); }
inline SV *to_sv (bool           v) { return newSViv (v); }
inline SV *to_sv (  signed char  v) { return newSViv (v); }
inline SV *to_sv (unsigned char  v) { return newSViv (v); }
inline SV *to_sv (  signed short v) { return newSViv (v); }
inline SV *to_sv (unsigned short v) { return newSVuv (v); }
inline SV *to_sv (  signed int   v) { return newSViv (v); }
inline SV *to_sv (unsigned int   v) { return newSVuv (v); }
inline SV *to_sv (  signed long  v) { return newSViv (v); }
inline SV *to_sv (unsigned long  v) { return newSVuv (v); }
inline SV *to_sv (  signed long long v) { return newSVval64 (v); }
inline SV *to_sv (unsigned long long v) { return newSVval64 (v); }
inline SV *to_sv (float          v) { return newSVnv (v); }
inline SV *to_sv (double         v) { return newSVnv (v); }
inline SV *to_sv (client *       v) { return newSVattachable (v, stash_cf_client_wrap); }
inline SV *to_sv (player *       v) { return newSVattachable (v, stash_cf_player_wrap); }
inline SV *to_sv (object *       v) { return newSVattachable (v, v && v->type == PLAYER ? stash_cf_object_player_wrap : stash_cf_object_wrap); }
inline SV *to_sv (maptile *      v) { return newSVattachable (v, stash_cf_map_wrap); }
inline SV *to_sv (archetype *    v) { return newSVattachable (v, stash_cf_arch_wrap); }
inline SV *to_sv (region *       v) { return newSVattachable (v, stash_cf_region_wrap); }
inline SV *to_sv (partylist *    v) { return newSVptr (v, stash_cf_party_wrap); }
inline SV *to_sv (living *       v) { return newSVptr (v, stash_cf_living_wrap); }

inline SV *to_sv (object &       v) { return to_sv (&v); }
inline SV *to_sv (living &       v) { return to_sv (&v); }

inline SV *to_sv (const std::string & v) { return newSVpvn (v.data (), v.size ()); }
inline SV *to_sv (const treasurelist *v) { return to_sv (v->name); }

inline SV *to_sv (UUID           v)
{
  char buf[128];
  snprintf (buf, 128, "<1.%" PRIx64 ">", v.seq);
  return newSVpv (buf, 0);
}

inline void sv_to (SV *sv, shstr              &v) { v = SvOK (sv) ? SvPVutf8_nolen (sv) : 0; }
inline void sv_to (SV *sv, char *             &v) { free (v); v = SvOK (sv) ? strdup (SvPV_nolen (sv)) : 0; }
inline void sv_to (SV *sv, bool               &v) { v = SvIV (sv); }
inline void sv_to (SV *sv,   signed char      &v) { v = SvIV (sv); }
inline void sv_to (SV *sv, unsigned char      &v) { v = SvIV (sv); }
inline void sv_to (SV *sv,   signed short     &v) { v = SvIV (sv); }
inline void sv_to (SV *sv, unsigned short     &v) { v = SvIV (sv); }
inline void sv_to (SV *sv,   signed int       &v) { v = SvIV (sv); }
inline void sv_to (SV *sv, unsigned int       &v) { v = SvUV (sv); }
inline void sv_to (SV *sv,   signed long      &v) { v = SvIV (sv); }
inline void sv_to (SV *sv, unsigned long      &v) { v = SvUV (sv); }
inline void sv_to (SV *sv,   signed long long &v) { v = (  signed long long)SvVAL64 (sv); }
inline void sv_to (SV *sv, unsigned long long &v) { v = (unsigned long long)SvVAL64 (sv); }
inline void sv_to (SV *sv, float              &v) { v = SvNV (sv); }
inline void sv_to (SV *sv, double             &v) { v = SvNV (sv); }
inline void sv_to (SV *sv, client *           &v) { v = (client *)(attachable *)SvPTR_ornull (sv, "cf::client"); }
inline void sv_to (SV *sv, player *           &v) { v = (player *)(attachable *)SvPTR_ornull (sv, "cf::player"); }
inline void sv_to (SV *sv, object *           &v) { v = (object *)(attachable *)SvPTR_ornull (sv, "cf::object"); }
inline void sv_to (SV *sv, archetype *        &v) { v = (archetype *)(attachable *)SvPTR_ornull (sv, "cf::arch"); }
inline void sv_to (SV *sv, maptile *          &v) { v = (maptile *)(attachable *)SvPTR_ornull (sv, "cf::map"); }
inline void sv_to (SV *sv, region *           &v) { v = (region *)(attachable *)SvPTR_ornull (sv, "cf::region"); }
inline void sv_to (SV *sv, attachable *       &v) { v = (attachable *)SvPTR_ornull (sv, "cf::attachable"); }
inline void sv_to (SV *sv, partylist *        &v) { v = (partylist *)SvPTR_ornull (sv, "cf::party"); }
inline void sv_to (SV *sv, living *           &v) { v = (living *)SvPTR_ornull (sv, "cf::living"); }
inline void sv_to (SV *sv, object_freezer *   &v) { v = (object_freezer *)SvPTR_ornull (sv, "cf::object::freezer"); }
inline void sv_to (SV *sv, object_thawer *    &v) { v = (object_thawer  *)SvPTR_ornull (sv, "cf::object::thawer" ); }

//inline void sv_to (SV *sv, faceinfo *         &v) { v = &faces [face_find (SvPV_nolen (sv), 0)]; }
inline void sv_to (SV *sv, treasurelist *     &v) { v = treasurelist::find (SvPV_nolen (sv)); }

template<class T>
inline void sv_to (SV *sv, refptr<T>          &v) { T *tmp; sv_to (sv, tmp); v = tmp; }

template<int N>
inline void sv_to (SV *sv, char      (&v)[N]) { assign (v, SvPV_nolen (sv)); }

inline void sv_to (SV *sv, bowtype_t          &v) { v = (bowtype_t)   SvIV (sv); }
inline void sv_to (SV *sv, petmode_t          &v) { v = (petmode_t)   SvIV (sv); }
inline void sv_to (SV *sv, usekeytype         &v) { v = (usekeytype)  SvIV (sv); }
inline void sv_to (SV *sv, unapplymode        &v) { v = (unapplymode) SvIV (sv); }

inline void sv_to (SV *sv, std::string        &v)
{
  STRLEN len;
  char *data = SvPVbyte (sv, len);
  v.assign (data, len);
}

inline void sv_to (SV *sv, UUID               &v)
{
  unsigned int version;

  if (2 != sscanf (SvPV_nolen (sv), "<%d.%" SCNx64 ">", &version, &v.seq) || 1 != version)
    croak ("unparsable uuid: %s", SvPV_nolen (sv));
}

inline void sv_to (SV *sv, object::flags_t::reference v) { v = SvTRUE (sv); }

static SV *
newSVdt_va (va_list &ap, data_type type)
{
  SV *sv;

  switch (type)
    {
      case DT_INT:
        sv = newSViv (va_arg (ap, int));
        break;

      case DT_INT64:
        sv = newSVval64 ((val64)va_arg (ap, sint64));
        break;

      case DT_DOUBLE:
        sv = newSVnv (va_arg (ap, double));
        break;

      case DT_STRING:
        {
          char *str = (char *)va_arg (ap, const char *);
          sv = str ? newSVpv (str, 0) : newSV (0);
        }
        break;

      case DT_DATA:
        {
          char *str = (char *)va_arg (ap, const void *);
          int len = va_arg (ap, int);
          sv = str ? newSVpv (str, len) : newSV (0);
        }
        break;

      case DT_OBJECT:
        sv = to_sv (va_arg (ap, object *));
        break;

      case DT_MAP:
        // va_arg (object *) when void * is passed is an XSI extension
        sv = to_sv (va_arg (ap, maptile *));
        break;

      case DT_CLIENT:
        sv = to_sv (va_arg (ap, client *));
        break;

      case DT_PLAYER:
        sv = to_sv (va_arg (ap, player *));
        break;

      case DT_ARCH:
        sv = to_sv (va_arg (ap, archetype *));
        break;

      case DT_PARTY:
        sv = to_sv (va_arg (ap, partylist *));
        break;

      case DT_REGION:
        sv = to_sv (va_arg (ap, region *));
        break;

      default:
        assert (("unhandled type in newSVdt_va", 0));
    }

  return sv;
}

static SV *
newSVdt (data_type type, ...)
{
  va_list ap;

  va_start (ap, type);
  SV *sv = newSVdt_va (ap, type);
  va_end (ap);

  return sv;
}

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

SV *
registry (attachable *ext)
{
  if (!ext->cb)
    ext->cb = newAV ();

  return newRV_inc ((SV *)ext->cb);
}

/////////////////////////////////////////////////////////////////////////////

void
cfperl_init ()
{
  PERL_SYS_INIT3 (&settings.argc, &settings.argv, 0);
  perl = perl_alloc ();
  perl_construct (perl);

  PL_exit_flags |= PERL_EXIT_DESTRUCT_END;

  const char *argv[] = {
    settings.argv [0],
    "-e"
    "use Event; use Coro;" // required for bootstrap
    "cf->bootstrap;"       // required for datadir :*>
    "unshift @INC, cf::datadir ();"
    "require cf;"
  };

  if (perl_parse (perl, xs_init, 2, (char **)argv, (char **)NULL)
      || perl_run (perl))
    {
      printf ("unable to initialize perl-interpreter, aborting.\n");
      exit (EXIT_FAILURE);
    }

  {
    dSP;

    PUSHMARK (SP);
    PUTBACK;
    call_pv ("cf::init", G_DISCARD | G_VOID);
  }
}

void cfperl_main ()
{
  dSP;

  PUSHMARK (SP);
  PUTBACK;
  call_pv ("cf::main", G_DISCARD | G_VOID);
}

void
attachable::instantiate ()
{
  if (attach)
    {
      INVOKE_ATTACHABLE (INSTANTIATE, this, ARG_STRING (attach));
      attach = 0;
    }
}

void
attachable::reattach ()
{
  optimise ();
  //TODO: check for _attachment's, very important for restarts
  INVOKE_ATTACHABLE (REATTACH, this);
}

static event_klass klass_of[NUM_EVENT_TYPES] = {
# define def(type,name) KLASS_ ## type,
#  include "eventinc.h"
# undef def
};

#define KLASS_OF(event) (((unsigned int)event) < NUM_EVENT_TYPES ? klass_of [event] : KLASS_NONE)

static void
gather_callbacks (AV *&callbacks, AV *registry, event_type event)
{
  // event must be in array
  if (event >= 0 && event <= AvFILLp (registry))
    {
      SV *cbs_ = AvARRAY (registry)[event];

      // element must be list of callback entries
      if (cbs_ && SvROK (cbs_) && SvTYPE (SvRV (cbs_)) == SVt_PVAV)
        {
          AV *cbs = (AV *)SvRV (cbs_);

          // no callback entries, no callbacks to call
          if (AvFILLp (cbs) >= 0)
            {
              if (!callbacks)
                {
                  callbacks = newAV ();
                  av_extend (callbacks, 16);
                }
              
              // never use SvREFCNT_inc to copy values, but its ok here :)
              for (int i = 0; i <= AvFILLp (cbs); ++i)
                av_push (callbacks, SvREFCNT_inc (AvARRAY (cbs)[i]));
            }
        }
    }
}

void
attachable::gather_callbacks (AV *&callbacks, event_type event) const
{
  ::gather_callbacks (callbacks, cb_attachable, event);

  if (cb)
    ::gather_callbacks (callbacks, cb, event);
}

void
global::gather_callbacks (AV *&callbacks, event_type event) const
{
  ::gather_callbacks (callbacks, cb_global, event);
}

void
object::gather_callbacks (AV *&callbacks, event_type event) const
{
  if (subtype && type + subtype * NUM_TYPES <= AvFILLp (cb_type))
    {
      SV *registry = AvARRAY (cb_type)[type + subtype * NUM_TYPES];

      if (registry && SvROK (registry) && SvTYPE (SvRV (registry)) == SVt_PVAV)
        ::gather_callbacks (callbacks, (AV *)SvRV (registry), event);
    }

  if (type <= AvFILLp (cb_type))
    {
      SV *registry = AvARRAY (cb_type)[type];

      if (registry && SvROK (registry) && SvTYPE (SvRV (registry)) == SVt_PVAV)
        ::gather_callbacks (callbacks, (AV *)SvRV (registry), event);
    }

  attachable::gather_callbacks (callbacks, event);
  ::gather_callbacks (callbacks, cb_object, event);
}

void
archetype::gather_callbacks (AV *&callbacks, event_type event) const
{
  attachable::gather_callbacks (callbacks, event);
  //TODO//::gather_callbacks (callbacks, cb_archetype, event);
}

void
client::gather_callbacks (AV *&callbacks, event_type event) const
{
  attachable::gather_callbacks (callbacks, event);
  ::gather_callbacks (callbacks, cb_client, event);
}

void
player::gather_callbacks (AV *&callbacks, event_type event) const
{
  attachable::gather_callbacks (callbacks, event);
  ::gather_callbacks (callbacks, cb_player, event);
}

void
maptile::gather_callbacks (AV *&callbacks, event_type event) const
{
  attachable::gather_callbacks (callbacks, event);
  ::gather_callbacks (callbacks, cb_map, event);
}

void
_recalc_want (bitset<NUM_EVENT_TYPES> &set, AV *registry)
{
  for (int event = 0; event <= AvFILLp (registry); ++event)
    {
      SV *cbs_ = AvARRAY (registry)[event];

      // element must be list of callback entries
      if (cbs_ && SvROK (cbs_) && SvTYPE (SvRV (cbs_)) == SVt_PVAV)
        {
          AV *cbs = (AV *)SvRV (cbs_);

          // no callback entries, no callbacks to call
          if (AvFILLp (cbs) >= 0)
            set.set (event);
        }
    }
}

// very slow and inefficient way to recalculate the global want bitsets
void
_recalc_want ()
{
  ev_want_event.reset ();

  _recalc_want (ev_want_event, cb_global);
  _recalc_want (ev_want_event, cb_attachable);
  _recalc_want (ev_want_event, cb_object);
  _recalc_want (ev_want_event, cb_client);
  _recalc_want (ev_want_event, cb_player);
  _recalc_want (ev_want_event, cb_map);

  ev_want_type.reset ();

  for (int type = 0; type <= AvFILLp (cb_type); ++type)
    {
      SV *cbs_ = AvARRAY (cb_type)[type];

      // element must be list of callback entries
      if (cbs_ && SvROK (cbs_) && SvTYPE (SvRV (cbs_)) == SVt_PVAV)
        {
          AV *cbs = (AV *)SvRV (cbs_);

          // no callback entries, no callbacks to call
          if (AvFILLp (cbs) >= 0)
            ev_want_type.set (type % NUM_TYPES);
        }
    }
}

bool
attachable::invoke (event_type event, ...)
{
  data_type dt;

  // callback call ordering should be:
  // 1. per-object callback
  // 2. per-class object
  // 3. per-type callback
  // 4. global callbacks

  AV *callbacks = 0;
  gather_callbacks (callbacks, event);

  // short-circuit processing if no callbacks found/defined
  if (!callbacks)
    return 0;

  va_list ap;
  va_start (ap, event);

  CALL_BEGIN (3);
  CALL_ARG_SV (newSViv (event)); // only used for debugging nowadays
  CALL_ARG_SV (newRV_noinc ((SV *)callbacks));

  //TODO: unhack
  if (object *op = is_a<object>(this))       CALL_ARG_SV (newSVdt (DT_OBJECT, op));
  else if (player *pl = is_a<player>(this))  CALL_ARG_SV (newSVdt (DT_PLAYER, pl));
  else if (client *ns = is_a<client>(this))  CALL_ARG_SV (newSVdt (DT_CLIENT, ns));
  else if (maptile *m = is_a<maptile>(this)) CALL_ARG_SV (newSVdt (DT_MAP, m));
  else if (global *gl = is_a<global>(this))  /*nop*/;
  else
    abort (); //TODO

  for (;;)
    {
      dt = (data_type) va_arg (ap, int);

      if (dt == DT_END)
        break;
      else if (dt == DT_AV)
        {
          AV *av = va_arg (ap, AV *);

          for (int i = 0; i <= av_len (av); ++i)
            XPUSHs (*av_fetch (av, i, 1));
        }
      else
        XPUSHs (sv_2mortal (newSVdt_va (ap, dt)));
    }

  va_end (ap);

  CALL_CALL ("cf::do_invoke", G_SCALAR);
  count = count > 0 ? POPi : 0;

  CALL_END;

  return count;
}

SV *
cfperl_result (int idx)
{
  AV *av = get_av ("cf::INVOKE_RESULTS", 0);
  if (!av)
    return &PL_sv_undef;

  SV **sv = av_fetch (av, idx, 0);
  if (!sv)
    return &PL_sv_undef;

  return *sv;
}

int
cfperl_result_INT (int idx)
{
  return SvIV (cfperl_result (idx));
}

double
cfperl_result_DOUBLE (int idx)
{
  return SvNV (cfperl_result (idx));
}

/////////////////////////////////////////////////////////////////////////////
// various c++ => perl glue functions

void
cfperl_emergency_save ()
{
  CALL_BEGIN (0);
  CALL_CALL ("cf::emergency_save", G_VOID);
  CALL_END;
}

void
cfperl_cleanup (int make_core)
{
  CALL_BEGIN (1);
  CALL_ARG (make_core);
  CALL_CALL ("cf::post_cleanup", G_VOID);
  CALL_END;
}

void
cfperl_make_book (object *book, int level)
{
  CALL_BEGIN (2);
  CALL_ARG (book);
  CALL_ARG (level);
  CALL_CALL ("ext::books::make_book", G_VOID);
  CALL_END;
}

void
cfperl_send_msg (client *ns, int color, const char *type, const char *msg)
{
  CALL_BEGIN (4);
  CALL_ARG (ns);
  CALL_ARG (type);
  CALL_ARG_SV (newSVpv_utf8 (msg));
  CALL_ARG (color);
  CALL_CALL ("cf::client::send_msg", G_VOID);
  CALL_END;
}

int
cfperl_can_merge (object *ob1, object *ob2)
{
  int can;

  CALL_BEGIN (2);
  CALL_ARG (ob1);
  CALL_ARG (ob2);
  CALL_CALL ("cf::_can_merge", G_SCALAR);
  can = count && SvTRUE (TOPs);
  CALL_END;

  return can;
}

player *
player::find (const char *name)
{
  CALL_BEGIN (1);
  CALL_ARG (name);
  CALL_CALL ("cf::player::find", G_SCALAR);

  player *retval;

  if (count)
    sv_to (POPs, retval);
  else
    retval = 0;

  CALL_END;

  return retval;
}

maptile *
maptile::find_sync (const char *path, maptile *origin)
{
  CALL_BEGIN (2);
  CALL_ARG (path);
  CALL_ARG (origin);
  CALL_CALL ("cf::map::find_sync", G_SCALAR);

  maptile *retval;

  if (count)
    sv_to (POPs, retval);
  else
    retval = 0;

  CALL_END;

  return retval;
}

maptile *
maptile::find_async (const char *path, maptile *origin, bool load)
{
  CALL_BEGIN (3);
  CALL_ARG (path);
  CALL_ARG (origin);
  CALL_ARG (load);
  CALL_CALL ("cf::map::find_async", G_SCALAR);

  maptile *retval;

  if (count)
    sv_to (POPs, retval);
  else
    retval = 0;

  CALL_END;

  return retval;
}

void
maptile::do_load_sync ()
{
  CALL_BEGIN (1);
  CALL_ARG (this);
  CALL_CALL ("cf::map::do_load_sync", G_SCALAR);
  CALL_END;
}

void
maptile::change_all_map_light (int change)
{
  CALL_BEGIN (1);
  CALL_ARG (change);
  CALL_CALL ("cf::map::change_all_map_light", G_VOID);
  CALL_END;
}

void
object::enter_exit (object *exit)
{
  if (type != PLAYER)
    return;

  CALL_BEGIN (2);
  CALL_ARG (this);
  CALL_ARG (exit);
  CALL_CALL ("cf::object::player::enter_exit", G_VOID);
  CALL_END;
}

const char *
object::ref () const
{
  if (type == PLAYER)
    return format ("player/<1.%llx>/%s", (unsigned long long)uuid.seq, &name);
  else
    return 0;
}

object *
object::deref (const char *ref)
{
  object *retval = 0;

  if (ref)
    {
      CALL_BEGIN (1);
      CALL_ARG (ref);
      CALL_CALL ("cf::object::deref", G_SCALAR);

      if (count)
        sv_to (POPs, retval);

      CALL_END;
    }

  return retval;
}

void
log_backtrace (const char *msg)
{
#if HAVE_BACKTRACE
  void *addr [20];
  int size = backtrace (addr, 20);

  CALL_BEGIN (size);
  CALL_ARG (msg);
  for (int i = 0; i < size; ++i)
    CALL_ARG ((IV)addr [i]);
  CALL_CALL ("cf::_log_backtrace", G_VOID);
  CALL_END;
#endif
}

/////////////////////////////////////////////////////////////////////////////

struct EventAPI *watcher_base::GEventAPI;
struct CoroAPI  *coroapi::GCoroAPI;

int coroapi::cede_counter;
tstamp coroapi::next_cede;

void coroapi::do_cede_to_tick ()
{
  cede_counter = 0;

  cede ();

  next_cede += (TICK / CEDES_PER_TICK) * 0.99;
  if (next_cede > SvNV (sv_next_tick) - 0.02)
    next_cede = SvNV (sv_next_tick);
}

void coroapi::do_cede_every ()
{
  cede_counter = 0;

  if (coroapi::nready ())
    coroapi::cede ();
}

void coroapi::do_cede_to_tick_every ()
{
  cede_counter = 0;

  cede_to_tick ();
}

void
coroapi::wait_for_tick ()
{
  CALL_BEGIN (0);
  CALL_CALL ("cf::wait_for_tick", G_DISCARD);
  CALL_END;
}

void
coroapi::wait_for_tick_begin ()
{
  CALL_BEGIN (0);
  CALL_CALL ("cf::wait_for_tick_begin", G_DISCARD);
  CALL_END;
}

static void
iw_dispatch (pe_event *ev)
{
  iw *w = (iw *)ev->ext_data;
  w->call (*w);
}

void
iw::alloc ()
{
  pe = GEventAPI->new_idle (0, 0);

  WaREENTRANT_off (pe);
  pe->base.callback = (void *)iw_dispatch;
  pe->base.ext_data = (void *)this;
}

static void iow_dispatch (pe_event *ev)
{
  iow *w = (iow *)ev->ext_data;
  w->call (*w, ((pe_ioevent *)ev)->got);
}

void
iow::alloc ()
{
  pe = GEventAPI->new_io (0, 0);

  WaREENTRANT_off (pe);
  pe->base.callback = (void *)iow_dispatch;
  pe->base.ext_data = (void *)this;

  pe->fd   = -1;
  pe->poll = 0;
}

void
iow::fd (int fd)
{
  pe->fd = fd;
}

int
iow::poll ()
{
  return pe->poll;
}

void
iow::poll (int events)
{
  if (pe->poll != events)
    {
      if (pe->poll) stop  ();
      pe->poll = events;
      if (pe->poll) start ();
    }
}

void
_connect_to_perl ()
{
  stash_cf = gv_stashpv ("cf"        , 1);

  stash_cf_object_wrap        = gv_stashpv ("cf::object::wrap", 1);
  stash_cf_object_player_wrap = gv_stashpv ("cf::object::player::wrap", 1);
  stash_cf_player_wrap        = gv_stashpv ("cf::player::wrap", 1);
  stash_cf_map_wrap           = gv_stashpv ("cf::map::wrap"   , 1);
  stash_cf_client_wrap        = gv_stashpv ("cf::client::wrap", 1);
  stash_cf_arch_wrap          = gv_stashpv ("cf::arch::wrap"  , 1);
  stash_cf_party_wrap         = gv_stashpv ("cf::party::wrap" , 1);
  stash_cf_region_wrap        = gv_stashpv ("cf::region::wrap", 1);
  stash_cf_living_wrap        = gv_stashpv ("cf::living::wrap", 1);

  sv_runtime   = get_sv ("cf::RUNTIME"  , 1); sv_upgrade (sv_runtime  , SVt_NV);
  sv_next_tick = get_sv ("cf::NEXT_TICK", 1); sv_upgrade (sv_next_tick, SVt_NV);

  cb_global      = get_av ("cf::CB_GLOBAL", 1);
  cb_attachable  = get_av ("cf::CB_ATTACHABLE", 1);
  cb_object      = get_av ("cf::CB_OBJECT", 1);
  cb_player      = get_av ("cf::CB_PLAYER", 1);
  cb_client      = get_av ("cf::CB_CLIENT", 1);
  cb_type        = get_av ("cf::CB_TYPE"  , 1);
  cb_map         = get_av ("cf::CB_MAP"   , 1);
}

MODULE = cf             PACKAGE = cf         PREFIX = cf_

BOOT:
{
  I_EVENT_API (PACKAGE); watcher_base::GEventAPI = GEventAPI;
  I_CORO_API  (PACKAGE); coroapi::GCoroAPI       = GCoroAPI;

  _connect_to_perl ();

  newCONSTSUB (stash_cf, "VERSION", newSVpv (VERSION, sizeof (VERSION) - 1));

  //{
  //  require_pv ("Time::HiRes");
  //
  //  SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
  //  if (!svp)         croak ("Time::HiRes is required");
  //  if (!SvIOK(*svp)) croak ("Time::NVtime isn’t a function pointer");
  //  coroapi::time = INT2PTR (double(*)(), SvIV(*svp));
  //}

  static const struct {
    const char *name;
    IV iv;
  } *civ, const_iv[] = {
#   define const_iv(name) { # name, (IV)name },
    const_iv (llevError) const_iv (llevInfo) const_iv (llevDebug) const_iv (llevMonster)
    const_iv (logBacktrace)

    const_iv (Map0Cmd) const_iv (Map1Cmd) const_iv (Map1aCmd)

    const_iv (MAP_CLIENT_X) const_iv (MAP_CLIENT_Y)

    const_iv (MAX_TIME)
    const_iv (MAXSOCKBUF)

    const_iv (NUM_BODY_LOCATIONS)
    const_iv (body_range)     const_iv (body_shield)     const_iv (body_combat)
    const_iv (body_arm)       const_iv (body_torso)      const_iv (body_head)
    const_iv (body_neck)      const_iv (body_skill)      const_iv (body_finger)
    const_iv (body_shoulder)  const_iv (body_foot)       const_iv (body_hand)
    const_iv (body_wrist)     const_iv (body_waist)

    const_iv (PLAYER)         const_iv (TRANSPORT)       const_iv (ROD)              const_iv (TREASURE)
    const_iv (POTION)         const_iv (FOOD)            const_iv (POISON)           const_iv (BOOK)
    const_iv (CLOCK)          const_iv (ARROW)           const_iv (BOW)              const_iv (WEAPON)
    const_iv (ARMOUR)         const_iv (PEDESTAL)        const_iv (ALTAR)            const_iv (LOCKED_DOOR)
    const_iv (SPECIAL_KEY)    const_iv (MAP)             const_iv (DOOR)             const_iv (KEY)
    const_iv (TIMED_GATE)     const_iv (TRIGGER)         const_iv (GRIMREAPER)       const_iv (MAGIC_EAR)
    const_iv (TRIGGER_BUTTON) const_iv (TRIGGER_ALTAR)   const_iv (TRIGGER_PEDESTAL) const_iv (SHIELD)
    const_iv (HELMET)         const_iv (HORN)            const_iv (MONEY)            const_iv (CLASS)
    const_iv (GRAVESTONE)     const_iv (AMULET)          const_iv (PLAYERMOVER)      const_iv (TELEPORTER)
    const_iv (CREATOR)        const_iv (SKILL)           const_iv (EARTHWALL)        const_iv (GOLEM)
    const_iv (THROWN_OBJ)     const_iv (BLINDNESS)       const_iv (GOD)              const_iv (DETECTOR)
    const_iv (TRIGGER_MARKER) const_iv (DEAD_OBJECT)     const_iv (DRINK)            const_iv (MARKER)
    const_iv (HOLY_ALTAR)     const_iv (PLAYER_CHANGER)  const_iv (BATTLEGROUND)     const_iv (PEACEMAKER)
    const_iv (GEM)            const_iv (FIREWALL)        const_iv (ANVIL)            const_iv (CHECK_INV)
    const_iv (MOOD_FLOOR)     const_iv (EXIT)            const_iv (ENCOUNTER)        const_iv (SHOP_FLOOR)
    const_iv (SHOP_MAT)       const_iv (RING)            const_iv (FLOOR)            const_iv (FLESH)
    const_iv (INORGANIC)      const_iv (SKILL_TOOL)      const_iv (LIGHTER)          const_iv (BUILDABLE_WALL)
    const_iv (MISC_OBJECT)    const_iv (LAMP)            const_iv (DUPLICATOR)       const_iv (SPELLBOOK)
    const_iv (CLOAK)          const_iv (SPINNER)         const_iv (GATE)             const_iv (BUTTON)
    const_iv (CF_HANDLE)      const_iv (HOLE)            const_iv (TRAPDOOR)         const_iv (SIGN)
    const_iv (BOOTS)          const_iv (GLOVES)          const_iv (SPELL)            const_iv (SPELL_EFFECT)
    const_iv (CONVERTER)      const_iv (BRACERS)         const_iv (POISONING)        const_iv (SAVEBED)
    const_iv (WAND)           const_iv (SCROLL)          const_iv (DIRECTOR)         const_iv (GIRDLE)
    const_iv (FORCE)          const_iv (POTION_EFFECT)   const_iv (EVENT_CONNECTOR)  const_iv (CLOSE_CON)
    const_iv (CONTAINER)      const_iv (ARMOUR_IMPROVER) const_iv (WEAPON_IMPROVER)  const_iv (SKILLSCROLL)
    const_iv (DEEP_SWAMP)     const_iv (IDENTIFY_ALTAR)  const_iv (MENU)             const_iv (RUNE)
    const_iv (TRAP)           const_iv (POWER_CRYSTAL)   const_iv (CORPSE)           const_iv (DISEASE)
    const_iv (SYMPTOM)        const_iv (BUILDER)         const_iv (MATERIAL)         const_iv (ITEM_TRANSFORMER)

    const_iv (NUM_TYPES) const_iv (NUM_SUBTYPES)

    const_iv (ST_BD_BUILD)              const_iv (ST_BD_REMOVE)
    const_iv (ST_MAT_FLOOR)             const_iv (ST_MAT_WALL)          const_iv (ST_MAT_ITEM)

    const_iv (AT_PHYSICAL)              const_iv (AT_MAGIC)             const_iv (AT_FIRE)              const_iv (AT_ELECTRICITY)
    const_iv (AT_COLD)                  const_iv (AT_CONFUSION)         const_iv (AT_ACID)              const_iv (AT_DRAIN)
    const_iv (AT_WEAPONMAGIC)           const_iv (AT_GHOSTHIT)          const_iv (AT_POISON)            const_iv (AT_SLOW)
    const_iv (AT_PARALYZE)              const_iv (AT_TURN_UNDEAD)       const_iv (AT_FEAR)              const_iv (AT_CANCELLATION)
    const_iv (AT_DEPLETE)               const_iv (AT_DEATH)             const_iv (AT_CHAOS)             const_iv (AT_COUNTERSPELL)
    const_iv (AT_GODPOWER)              const_iv (AT_HOLYWORD)          const_iv (AT_BLIND)             const_iv (AT_INTERNAL)
    const_iv (AT_LIFE_STEALING)         const_iv (AT_DISEASE)

    const_iv (WEAP_HIT)         const_iv (WEAP_SLASH)           const_iv (WEAP_PIERCE)          const_iv (WEAP_CLEAVE)
    const_iv (WEAP_SLICE)       const_iv (WEAP_STAB)            const_iv (WEAP_WHIP)            const_iv (WEAP_CRUSH)
    const_iv (WEAP_BLUD)

    const_iv (FLAG_ALIVE)               const_iv (FLAG_WIZ)                     const_iv (FLAG_REMOVED)                 const_iv (FLAG_FREED)
                                        const_iv (FLAG_APPLIED)                 const_iv (FLAG_UNPAID)                  const_iv (FLAG_USE_SHIELD)
    const_iv (FLAG_NO_PICK)             const_iv (FLAG_ANIMATE)                 const_iv (FLAG_MONSTER)                 const_iv (FLAG_FRIENDLY)
    const_iv (FLAG_GENERATOR)           const_iv (FLAG_IS_THROWN)               const_iv (FLAG_AUTO_APPLY)              const_iv (FLAG_PLAYER_SOLD)
    const_iv (FLAG_SEE_INVISIBLE)       const_iv (FLAG_CAN_ROLL)                const_iv (FLAG_OVERLAY_FLOOR)           const_iv (FLAG_IS_TURNABLE)
    const_iv (FLAG_IS_USED_UP)          const_iv (FLAG_IDENTIFIED)              const_iv (FLAG_REFLECTING)              const_iv (FLAG_CHANGING)
    const_iv (FLAG_SPLITTING)           const_iv (FLAG_HITBACK)                 const_iv (FLAG_STARTEQUIP)              const_iv (FLAG_BLOCKSVIEW)
    const_iv (FLAG_UNDEAD)              const_iv (FLAG_SCARED)                  const_iv (FLAG_UNAGGRESSIVE)            const_iv (FLAG_REFL_MISSILE)
    const_iv (FLAG_REFL_SPELL)          const_iv (FLAG_NO_MAGIC)                const_iv (FLAG_NO_FIX_PLAYER)           const_iv (FLAG_IS_LIGHTABLE)
    const_iv (FLAG_TEAR_DOWN)           const_iv (FLAG_RUN_AWAY)                const_iv (FLAG_PICK_UP)                 const_iv (FLAG_UNIQUE)
    const_iv (FLAG_NO_DROP)             const_iv (FLAG_WIZCAST)                 const_iv (FLAG_CAST_SPELL)              const_iv (FLAG_USE_SCROLL)
    const_iv (FLAG_USE_RANGE)           const_iv (FLAG_USE_BOW)                 const_iv (FLAG_USE_ARMOUR)              const_iv (FLAG_USE_WEAPON)
    const_iv (FLAG_USE_RING)            const_iv (FLAG_READY_RANGE)             const_iv (FLAG_READY_BOW)               const_iv (FLAG_XRAYS)
    const_iv (FLAG_NO_APPLY)            const_iv (FLAG_IS_FLOOR)                const_iv (FLAG_LIFESAVE)                const_iv (FLAG_NO_STRENGTH)
    const_iv (FLAG_SLEEP)               const_iv (FLAG_STAND_STILL)             const_iv (FLAG_RANDOM_MOVE)             const_iv (FLAG_ONLY_ATTACK)
    const_iv (FLAG_CONFUSED)            const_iv (FLAG_STEALTH)                 const_iv (FLAG_WIZPASS)                 const_iv (FLAG_IS_LINKED)
    const_iv (FLAG_CURSED)              const_iv (FLAG_DAMNED)                  const_iv (FLAG_SEE_ANYWHERE)            const_iv (FLAG_KNOWN_MAGICAL)
    const_iv (FLAG_KNOWN_CURSED)        const_iv (FLAG_CAN_USE_SKILL)           const_iv (FLAG_BEEN_APPLIED)            const_iv (FLAG_READY_SCROLL)
    const_iv (FLAG_USE_ROD)             const_iv (FLAG_USE_HORN)                const_iv (FLAG_MAKE_INVIS)              const_iv (FLAG_INV_LOCKED)
    const_iv (FLAG_IS_WOODED)           const_iv (FLAG_IS_HILLY)                const_iv (FLAG_READY_SKILL)             const_iv (FLAG_READY_WEAPON)
    const_iv (FLAG_NO_SKILL_IDENT)      const_iv (FLAG_BLIND)                   const_iv (FLAG_SEE_IN_DARK)             const_iv (FLAG_IS_CAULDRON)
    const_iv (FLAG_NO_STEAL)            const_iv (FLAG_ONE_HIT)                 const_iv (FLAG_CLIENT_SENT)             const_iv (FLAG_BERSERK)
    const_iv (FLAG_NEUTRAL)             const_iv (FLAG_NO_ATTACK)               const_iv (FLAG_NO_DAMAGE)               const_iv (FLAG_OBJ_ORIGINAL)
    const_iv (FLAG_ACTIVATE_ON_PUSH)    const_iv (FLAG_ACTIVATE_ON_RELEASE)     const_iv (FLAG_IS_WATER)
    const_iv (FLAG_CONTENT_ON_GEN)      const_iv (FLAG_IS_A_TEMPLATE)           const_iv (FLAG_IS_BUILDABLE)
    const_iv (FLAG_DESTROY_ON_DEATH)    const_iv (FLAG_NO_MAP_SAVE)

    const_iv (NDI_BLACK)        const_iv (NDI_WHITE)            const_iv (NDI_NAVY)             const_iv (NDI_RED)
    const_iv (NDI_ORANGE)       const_iv (NDI_BLUE)             const_iv (NDI_DK_ORANGE)        const_iv (NDI_GREEN)
    const_iv (NDI_LT_GREEN)     const_iv (NDI_GREY)             const_iv (NDI_BROWN)            const_iv (NDI_GOLD)
    const_iv (NDI_TAN)          const_iv (NDI_MAX_COLOR)        const_iv (NDI_COLOR_MASK)       const_iv (NDI_UNIQUE)
    const_iv (NDI_ALL)          const_iv (NDI_DEF)              const_iv (NDI_REPLY)            const_iv (NDI_CLIENT_MASK)
    const_iv (NDI_NOCREATE)     const_iv (NDI_CLEAR)

    const_iv (UPD_LOCATION)     const_iv (UPD_FLAGS)    const_iv (UPD_WEIGHT)           const_iv (UPD_FACE)
    const_iv (UPD_NAME)         const_iv (UPD_ANIM)     const_iv (UPD_ANIMSPEED)        const_iv (UPD_NROF)

    const_iv (UPD_SP_MANA)      const_iv (UPD_SP_GRACE) const_iv (UPD_SP_DAMAGE)

    const_iv (SP_RAISE_DEAD)
    const_iv (SP_RUNE)
    const_iv (SP_MAKE_MARK)
    const_iv (SP_BOLT)
    const_iv (SP_BULLET)
    const_iv (SP_EXPLOSION)
    const_iv (SP_CONE)
    const_iv (SP_BOMB)
    const_iv (SP_WONDER)
    const_iv (SP_SMITE)
    const_iv (SP_MAGIC_MISSILE)
    const_iv (SP_SUMMON_GOLEM)
    const_iv (SP_DIMENSION_DOOR)
    const_iv (SP_MAGIC_MAPPING)
    const_iv (SP_MAGIC_WALL)
    const_iv (SP_DESTRUCTION)
    const_iv (SP_PERCEIVE_SELF)
    const_iv (SP_WORD_OF_RECALL)
    const_iv (SP_INVISIBLE)
    const_iv (SP_PROBE)
    const_iv (SP_HEALING)
    const_iv (SP_CREATE_FOOD)
    const_iv (SP_EARTH_TO_DUST)
    const_iv (SP_CHANGE_ABILITY)
    const_iv (SP_BLESS)
    const_iv (SP_CURSE)
    const_iv (SP_SUMMON_MONSTER)
    const_iv (SP_CHARGING)
    const_iv (SP_POLYMORPH)
    const_iv (SP_ALCHEMY)
    const_iv (SP_REMOVE_CURSE)
    const_iv (SP_IDENTIFY)
    const_iv (SP_DETECTION)
    const_iv (SP_MOOD_CHANGE)
    const_iv (SP_MOVING_BALL)
    const_iv (SP_SWARM)
    const_iv (SP_CHANGE_MANA)
    const_iv (SP_DISPEL_RUNE)
    const_iv (SP_CREATE_MISSILE)
    const_iv (SP_CONSECRATE)
    const_iv (SP_ANIMATE_WEAPON)
    const_iv (SP_LIGHT)
    const_iv (SP_CHANGE_MAP_LIGHT)
    const_iv (SP_FAERY_FIRE)
    const_iv (SP_CAUSE_DISEASE)
    const_iv (SP_AURA)
    const_iv (SP_TOWN_PORTAL)
    const_iv (SP_PARTY_SPELL)

    const_iv (F_APPLIED)        const_iv (F_LOCATION)   const_iv (F_UNPAID)     const_iv (F_MAGIC)
    const_iv (F_CURSED)         const_iv (F_DAMNED)     const_iv (F_OPEN)       const_iv (F_NOPICK)
    const_iv (F_LOCKED)

    const_iv (F_BUY)            const_iv (F_SHOP)               const_iv (F_SELL)

    const_iv (P_BLOCKSVIEW)             const_iv (P_PLAYER)             const_iv (P_NO_MAGIC)           const_iv (P_IS_ALIVE)
    const_iv (P_NO_CLERIC)              const_iv (P_OUT_OF_MAP)         const_iv (P_NEW_MAP)            const_iv (P_UPTODATE)

    const_iv (UP_OBJ_INSERT)            const_iv (UP_OBJ_REMOVE)        const_iv (UP_OBJ_CHANGE)        const_iv (UP_OBJ_FACE)

    const_iv (INS_NO_MERGE)             const_iv (INS_ABOVE_FLOOR_ONLY) const_iv (INS_NO_WALK_ON)
    const_iv (INS_ON_TOP)               const_iv (INS_BELOW_ORIGINATOR)

    const_iv (WILL_APPLY_HANDLE)        const_iv (WILL_APPLY_TREASURE)  const_iv (WILL_APPLY_EARTHWALL)
    const_iv (WILL_APPLY_DOOR)          const_iv (WILL_APPLY_FOOD)

    const_iv (SAVE_MODE)                const_iv (SAVE_DIR_MODE)

    const_iv (M_PAPER)          const_iv (M_IRON)               const_iv (M_GLASS)              const_iv (M_LEATHER)
    const_iv (M_WOOD)           const_iv (M_ORGANIC)            const_iv (M_STONE)              const_iv (M_CLOTH)
    const_iv (M_ADAMANT)        const_iv (M_LIQUID)             const_iv (M_SOFT_METAL)         const_iv (M_BONE)
    const_iv (M_ICE)            const_iv (M_SPECIAL)

    const_iv (SK_EXP_ADD_SKILL)         const_iv (SK_EXP_TOTAL)         const_iv (SK_EXP_NONE)
    const_iv (SK_SUBTRACT_SKILL_EXP)    const_iv (SK_EXP_SKILL_ONLY)

    const_iv (SK_LOCKPICKING)           const_iv (SK_HIDING)            const_iv (SK_SMITHERY)          const_iv (SK_BOWYER)
    const_iv (SK_JEWELER)               const_iv (SK_ALCHEMY)           const_iv (SK_STEALING)          const_iv (SK_LITERACY)
    const_iv (SK_BARGAINING)            const_iv (SK_JUMPING)           const_iv (SK_DET_MAGIC)         const_iv (SK_ORATORY)
    const_iv (SK_SINGING)               const_iv (SK_DET_CURSE)         const_iv (SK_FIND_TRAPS)        const_iv (SK_MEDITATION)
    const_iv (SK_PUNCHING)              const_iv (SK_FLAME_TOUCH)       const_iv (SK_KARATE)            const_iv (SK_CLIMBING)
    const_iv (SK_WOODSMAN)              const_iv (SK_INSCRIPTION)       const_iv (SK_ONE_HANDED_WEAPON) const_iv (SK_MISSILE_WEAPON)
    const_iv (SK_THROWING)              const_iv (SK_USE_MAGIC_ITEM)    const_iv (SK_DISARM_TRAPS)      const_iv (SK_SET_TRAP)
    const_iv (SK_THAUMATURGY)           const_iv (SK_PRAYING)           const_iv (SK_CLAWING)           const_iv (SK_LEVITATION)
    const_iv (SK_SUMMONING)             const_iv (SK_PYROMANCY)         const_iv (SK_EVOCATION)         const_iv (SK_SORCERY)
    const_iv (SK_TWO_HANDED_WEAPON)     const_iv (SK_SPARK_TOUCH)       const_iv (SK_SHIVER)            const_iv (SK_ACID_SPLASH)
    const_iv (SK_POISON_NAIL)

    const_iv (SOUND_NEW_PLAYER)         const_iv (SOUND_FIRE_ARROW)     const_iv (SOUND_LEARN_SPELL)    const_iv (SOUND_FUMBLE_SPELL)
    const_iv (SOUND_WAND_POOF)          const_iv (SOUND_OPEN_DOOR)      const_iv (SOUND_PUSH_PLAYER)    const_iv (SOUND_PLAYER_HITS1)
    const_iv (SOUND_PLAYER_HITS2)       const_iv (SOUND_PLAYER_HITS3)   const_iv (SOUND_PLAYER_HITS4)   const_iv (SOUND_PLAYER_IS_HIT1)
    const_iv (SOUND_PLAYER_IS_HIT2)     const_iv (SOUND_PLAYER_IS_HIT3) const_iv (SOUND_PLAYER_KILLS)   const_iv (SOUND_PET_IS_KILLED)
    const_iv (SOUND_PLAYER_DIES)        const_iv (SOUND_OB_EVAPORATE)   const_iv (SOUND_OB_EXPLODE)     const_iv (SOUND_CLOCK)
    const_iv (SOUND_TURN_HANDLE)        const_iv (SOUND_FALL_HOLE)      const_iv (SOUND_DRINK_POISON)   const_iv (SOUND_CAST_SPELL_0)

    const_iv (PREFER_LOW)               const_iv (PREFER_HIGH)

    const_iv (ATNR_PHYSICAL)            const_iv (ATNR_MAGIC)           const_iv (ATNR_FIRE)            const_iv (ATNR_ELECTRICITY)
    const_iv (ATNR_COLD)                const_iv (ATNR_CONFUSION)       const_iv (ATNR_ACID)            const_iv (ATNR_DRAIN)
    const_iv (ATNR_WEAPONMAGIC)         const_iv (ATNR_GHOSTHIT)        const_iv (ATNR_POISON)          const_iv (ATNR_SLOW)
    const_iv (ATNR_PARALYZE)            const_iv (ATNR_TURN_UNDEAD)     const_iv (ATNR_FEAR)            const_iv (ATNR_CANCELLATION)
    const_iv (ATNR_DEPLETE)             const_iv (ATNR_DEATH)           const_iv (ATNR_CHAOS)           const_iv (ATNR_COUNTERSPELL)
    const_iv (ATNR_GODPOWER)            const_iv (ATNR_HOLYWORD)        const_iv (ATNR_BLIND)           const_iv (ATNR_INTERNAL)
    const_iv (ATNR_LIFE_STEALING)       const_iv (ATNR_DISEASE)

    const_iv (MAP_IN_MEMORY)            const_iv (MAP_SWAPPED)          const_iv (MAP_LOADING)          const_iv (MAP_SAVING)

    const_iv (KLASS_ATTACHABLE)         const_iv (KLASS_GLOBAL)         const_iv (KLASS_OBJECT)
    const_iv (KLASS_CLIENT)             const_iv (KLASS_PLAYER)         const_iv (KLASS_MAP)

    const_iv (VERSION_CS)               const_iv (VERSION_SC)

    const_iv (CS_QUERY_YESNO)           const_iv (CS_QUERY_SINGLECHAR)  const_iv (CS_QUERY_HIDEINPUT)

    const_iv (ST_DEAD)                  const_iv (ST_SETUP)             const_iv (ST_PLAYING)           const_iv (ST_CUSTOM)

    const_iv (IO_HEADER)                const_iv (IO_OBJECTS)           const_iv (IO_UNIQUES)

    // random map generator
    const_iv (LAYOUT_NONE)              const_iv (LAYOUT_ONION)         const_iv (LAYOUT_MAZE)          const_iv (LAYOUT_SPIRAL)
    const_iv (LAYOUT_ROGUELIKE)         const_iv (LAYOUT_SNAKE)         const_iv (LAYOUT_SQUARE_SPIRAL)

    const_iv (RMOPT_RANDOM)             const_iv (RMOPT_CENTERED)       const_iv (RMOPT_LINEAR)
    const_iv (RMOPT_BOTTOM_C)           const_iv (RMOPT_BOTTOM_R)       const_iv (RMOPT_IRR_SPACE)
    const_iv (RMOPT_WALL_OFF)           const_iv (RMOPT_WALLS_ONLY)     const_iv (RMOPT_NO_DOORS)

    const_iv (SYMMETRY_RANDOM)          const_iv (SYMMETRY_NONE)        const_iv (SYMMETRY_X)
    const_iv (SYMMETRY_Y)               const_iv (SYMMETRY_XY)

    const_iv (GT_ENVIRONMENT)           const_iv (GT_INVISIBLE)         const_iv (GT_STARTEQUIP)                
    const_iv (GT_APPLY)                 const_iv (GT_ONLY_GOOD)         const_iv (GT_UPDATE_INV)                
    const_iv (GT_MINIMAL)               

    const_iv (FT_FACE)                  const_iv (FT_MUSIC)             const_iv (FT_SOUND)
    const_iv (FT_RSRC)                  const_iv (FT_NUM)
  };

  for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ-- > const_iv; )
    newCONSTSUB (stash_cf, (char *)civ->name, newSViv (civ->iv));

  static const struct {
    const char *name;
    int skip;
    IV klass;
    IV iv;
  } *eiv, event_iv[] = {
#  define def(klass,name) { "EVENT_" # klass "_" # name, sizeof ("EVENT_" # klass), (IV)KLASS_ ## klass, (IV)EVENT_ ## klass ## _ ## name },
#   include "eventinc.h"
#  undef def
  };

  AV *av = get_av ("cf::EVENT", 1);

  for (eiv = event_iv + sizeof (event_iv) / sizeof (event_iv [0]); eiv-- > event_iv; )
    {
      AV *event = newAV ();
      av_push (event, newSVpv ((char *)eiv->name + eiv->skip, 0));
      av_push (event, newSViv (eiv->klass));
      av_store (av, eiv->iv, newRV_noinc ((SV *)event));
      newCONSTSUB (stash_cf, (char *)eiv->name, newSViv (eiv->iv));
    }
}

void _connect_to_perl ()

void _recalc_want ()

void _global_reattach ()
        CODE:
{
        // reattach to all attachable objects in the game.
        for_all_clients (ns)
          ns->reattach ();
        
        for_all_objects (op)
          op->reattach ();
}

# support function for map-world.ext
void _quantise (SV *data_sv, SV *plt_sv)
        CODE:
{
        if (!SvROK (plt_sv) || SvTYPE (SvRV (plt_sv)) != SVt_PVAV)
          croak ("_quantise called with invalid agruments");

        plt_sv = SvRV (plt_sv);
        SV **plt = AvARRAY (plt_sv);
        int plt_count = AvFILL (plt_sv) + 1;

        STRLEN len;
        char *data = SvPVbyte (data_sv, len);
        char *dst = data;

        while (len >= 3)
          {
            for (SV **val_sv = plt + plt_count; val_sv-- > plt; )
              {
                char *val = SvPVX (*val_sv);

                if (val [0] == data [0]
                    && val [1] == data [1]
                    && val [2] == data [2])
                  {
                    *dst++ = val [3];
                    goto next;
                  }
              }

            croak ("_quantise: color not found in palette: #%02x%02x%02x, at offset %d %d",
                   (uint8_t)data [0], (uint8_t)data [1], (uint8_t)data [2],
                   dst - SvPVX (data_sv), len);

            next:
            data += 3;
            len  -= 3;
          }

        SvCUR_set (data_sv, dst - SvPVX (data_sv));
}

void _post_tick ()
        CODE:
        coroapi::next_cede = SvNV (sv_next_tick) - TICK * (1. - 1. / CEDES_PER_TICK);

NV till_cede ()
        CODE:
        RETVAL = coroapi::next_cede - now ();
        OUTPUT:
        RETVAL

NV till_tick ()
        CODE:
        RETVAL = SvNV (sv_next_tick) - now ();
        OUTPUT:
        RETVAL

NV floor (NV x)

NV ceil (NV x)

NV rndm (...)
        CODE:
        switch (items)
          {
            case 0: RETVAL = rndm (); break;
            case 1: RETVAL = rndm (SvUV (ST (0))); break;
            case 2: RETVAL = rndm (SvIV (ST (0)), SvIV (ST (1))); break;
            default: croak ("cf::rndm requires none, one or two parameters."); break;
          }
        OUTPUT:
        RETVAL

NV clamp (NV value, NV min_value, NV max_value)
        CODE:
        RETVAL = clamp (value, min_value, max_value);
        OUTPUT:
        RETVAL

NV lerp (NV value, NV min_in, NV max_in, NV min_out, NV max_out)
        CODE:
        RETVAL = lerp (value, min_in, max_in, min_out, max_out);
        OUTPUT:
        RETVAL

void cede_to_tick ()
        CODE:
        coroapi::cede_to_tick ();

void server_tick ()
        CODE:
        NOW     = now ();
        runtime = SvNVx (sv_runtime);
        server_tick ();

void
log_backtrace (utf8_string msg)

void
LOG (int flags, utf8_string msg)
        PROTOTYPE: $$
        C_ARGS: flags, "%s", msg

octet_string path_combine (octet_string base, octet_string path)
        PROTOTYPE: $$

octet_string path_combine_and_normalize (octet_string base, octet_string path)
        PROTOTYPE: $$

void
sub_generation_inc ()
        CODE:
        PL_sub_generation++;

const_octet_string
mapdir ()
        PROTOTYPE:
        ALIAS:
        mapdir    = 0
        uniquedir = 1
        tmpdir    = 2
        confdir   = 3
        localdir  = 4
        playerdir = 5
        datadir   = 6
        CODE:
        switch (ix)
          {
            case 0: RETVAL = settings.mapdir   ; break; 
            case 1: RETVAL = settings.uniquedir; break; 
            case 2: RETVAL = settings.tmpdir   ; break; 
            case 3: RETVAL = settings.confdir  ; break; 
            case 4: RETVAL = settings.localdir ; break; 
            case 5: RETVAL = settings.playerdir; break; 
            case 6: RETVAL = settings.datadir  ; break;
          }
        OUTPUT: RETVAL

void abort ()

void reset_signals ()

void fork_abort (octet_string cause = "cf::fork_abort")

void cleanup (octet_string cause, bool make_core = false)

void emergency_save ()

void _exit (int status = EXIT_SUCCESS)

UV sv_2watcher (SV *w)
        CODE:
        RETVAL = (UV)GEventAPI->sv_2watcher (w);
        OUTPUT:
        RETVAL

#if _POSIX_MEMLOCK

int mlockall (int flags = MCL_CURRENT | MCL_FUTURE)

int munlockall ()

#endif

int find_animation (utf8_string text)
        PROTOTYPE: $

int random_roll (int min, int max, object *op, int goodbad);

const_utf8_string cost_string_from_value(uint64 cost, int approx = 0)

int
exp_to_level (val64 exp)
        CODE:
{
        int i = 0;

        RETVAL = settings.max_level;

        for (i = 1; i <= settings.max_level; i++)
          {
            if (levels[i] > exp)
              {
                RETVAL = i - 1;
                break;
              }
          }
}
        OUTPUT: RETVAL

val64
level_to_min_exp (int level)
       CODE:
       if (level > settings.max_level)
         RETVAL = levels[settings.max_level];
       else if (level < 1)
         RETVAL = 0;
       else
         RETVAL = levels[level];
       OUTPUT: RETVAL

SV *
resistance_to_string (int atnr)
        CODE:
        if (atnr >= 0 && atnr < NROFATTACKS)
          RETVAL = newSVpv (resist_plus[atnr], 0);
        else
          XSRETURN_UNDEF;
        OUTPUT: RETVAL

bool
load_resource_file (octet_string filename)

MODULE = cf        PACKAGE = cf::attachable

int
valid (SV *obj)
        CODE:
        RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);
        OUTPUT:
        RETVAL

void
debug_trace (attachable *obj, bool on = true)
        CODE:
        obj->flags &= ~attachable::F_DEBUG_TRACE;
        if (on)
          obj->flags |= attachable::F_DEBUG_TRACE;

int mortals_size ()
        CODE:
        RETVAL = attachable::mortals.size ();
        OUTPUT: RETVAL

#object *mortals (U32 index)
#       CODE:
#        RETVAL = index < attachable::mortals.size () ? attachable::mortals [index] : 0;
#       OUTPUT: RETVAL

INCLUDE: $PERL $srcdir/genacc attachable ../include/util.h ../include/cfperl.h |

MODULE = cf        PACKAGE = cf::global

int invoke (SV *klass, int event, ...)
        CODE:
        if (KLASS_OF (event) != KLASS_GLOBAL) croak ("event class must be GLOBAL");
        AV *av = (AV *)sv_2mortal ((SV *)newAV ());
        for (int i = 1; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
        RETVAL = gbl_ev.invoke ((event_type)event, ARG_AV (av), DT_END);
        OUTPUT: RETVAL

MODULE = cf        PACKAGE = cf::object         PREFIX = cf_object_

INCLUDE: $PERL $srcdir/genacc object ../include/object.h |

int invoke (object *op, int event, ...)
        CODE:
        if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT");
        AV *av = (AV *)sv_2mortal ((SV *)newAV ());
        for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
        RETVAL = op->invoke ((event_type)event, ARG_AV (av), DT_END);
        OUTPUT: RETVAL

SV *registry (object *op)

int objects_size ()
        CODE:
        RETVAL = objects.size ();
        OUTPUT: RETVAL

object *objects (U32 index)
        CODE:
        RETVAL = index < objects.size () ? objects [index] : 0;
        OUTPUT: RETVAL

int actives_size ()
        CODE:
        RETVAL = actives.size ();
        OUTPUT: RETVAL

object *actives (U32 index)
        CODE:
        RETVAL = index < actives.size () ? actives [index] : 0;
        OUTPUT: RETVAL

const char *slot_use_name (U32 slot)
        ALIAS:
        slot_nonuse_name = 1
        CODE:
{
        if (slot >= NUM_BODY_LOCATIONS)
          croak ("body slot index out of range");

        switch (ix)
          {
            case 0: RETVAL = body_locations[slot].use_name;    break;
            case 1: RETVAL = body_locations[slot].nonuse_name; break;
          }
}
        OUTPUT:
        RETVAL

# missing properties

object *head (object *op)
        PROTOTYPE: $
        CODE:
        RETVAL = op->head_ ();
        OUTPUT: RETVAL

void
inv (object *obj)
        PROTOTYPE: $
        PPCODE:
{
        for (object *o = obj->inv; o; o = o->below)
          XPUSHs (sv_2mortal (to_sv (o)));
}

void
set_animation (object *op, int idx)
        CODE:
        SET_ANIMATION (op, idx);

int
num_animations (object *op)
        CODE:
        RETVAL = NUM_ANIMATIONS (op);
        OUTPUT: RETVAL

int slot_info (object *op, UV slot, int value = 0)
        ALIAS:
        slot_used = 1
        CODE:
{
        if (slot >= NUM_BODY_LOCATIONS)
          croak ("body slot index out of range");

        RETVAL = ix ? op->slot[slot].used : op->slot[slot].info;

        if (items > 2)
          if (ix)
            op->slot[slot].used = value;
          else
            op->slot[slot].info = value;
}
        OUTPUT:
        RETVAL

object *find_best_object_match (object *op, utf8_string match)

object *find_marked_object (object *op)

int need_identify (object *obj);

int apply_shop_mat (object *shop_mat, object *op);

int move (object *op, int dir, object *originator = op)
        CODE:
        RETVAL = move_ob (op, dir, originator);
        OUTPUT:
        RETVAL

void apply (object *applier, object *applied, int flags = 0)
        CODE:
        manual_apply (applied, applier, flags);

void apply_below (object *op)
        CODE:
        player_apply_below (op);

int cast_heal (object *op, object *caster, object *spell, int dir = 0)

#//TODO
object *clone_ (object *op, int recursive = 0)
        CODE:
        if (recursive)
          RETVAL = object_create_clone (op);
        else
          {
            RETVAL = object::create ();
            op->copy_to (RETVAL);
          }
        OUTPUT: RETVAL

int pay_item (object *op, object *buyer)
        CODE:
        RETVAL = pay_for_item (op, buyer);
        OUTPUT: RETVAL

int pay_amount (object *op, uint64 amount)
        CODE:
        RETVAL = pay_for_amount (amount, op);
        OUTPUT: RETVAL

void pay_player (object *op, uint64 amount)

val64 pay_player_arch (object *op, utf8_string arch, uint64 amount)

int cast_spell (object *op, object *caster, int dir, object *spell_ob, utf8_string stringarg = 0)

void learn_spell (object *op, object *sp, int special_prayer = 0)
        CODE:
        do_learn_spell (op, sp, special_prayer);

void forget_spell (object *op, object *sp)
        CODE:
        do_forget_spell (op, query_name (sp));

object *check_for_spell (object *op, utf8_string spellname)
        CODE:
        RETVAL = check_spell_known (op, spellname);
        OUTPUT: RETVAL

int query_money (object *op)
        ALIAS: money = 0

val64 query_cost (object *op, object *who, int flags)
        ALIAS: cost = 0

void spring_trap (object *op, object *victim)

int check_trigger (object *op, object *cause)

void drop (object *who, object *op)

void pick_up (object *who, object *op)

void update_object (object *op, int action)

void change_exp (object *op, uint64 exp, utf8_string skill_name = 0, int flag = 0)

void player_lvl_adj (object *who, object *skill = 0)

int kill_object (object *op, int dam = 0, object *hitter = 0, int type = AT_PHYSICAL)

int calc_skill_exp (object *who, object *op, object *skill);

void push_button (object *op);

void use_trigger (object *op);

void add_button_link (object *button, maptile *map, int connected);

void remove_button_link (object *op);

void handle_apply_yield (object *op);


MODULE = cf        PACKAGE = cf::object         PREFIX = cf_

# no clean way to get an object from an archetype - stupid idiotic
# dumb kludgy misdesigned plug-in api slowly gets on my nerves.

object *new (utf8_string archetype = 0)
        PROTOTYPE: ;$
        CODE:
        RETVAL = archetype ? get_archetype (archetype) : object::create ();
        OUTPUT:
        RETVAL

object *find_object (U32 tag)

# TODO: nuke
object *insert_ob_in_map_at (object *ob, maptile *where, object_ornull *orig, int flag, int x, int y)
        PROTOTYPE: $$$$$$
        CODE:
{
        RETVAL = insert_ob_in_map_at (ob, where, orig, flag, x, y);
}

const_utf8_string get_ob_key_value (object *op, utf8_string key)

bool set_ob_key_value (object *op, utf8_string key, utf8_string value = 0, int add_key = 1)

object *get_nearest_player (object *ob)
        ALIAS: nearest_player = 0
        PREINIT:
        extern object *get_nearest_player (object *);

void rangevector (object *ob, object *other, int flags = 0)
        PROTOTYPE: $$;$
        PPCODE:
{
        rv_vector rv;
        get_rangevector (ob, other, &rv, flags);
        EXTEND (SP, 5);
        PUSHs (newSVuv (rv.distance));
        PUSHs (newSViv (rv.distance_x));
        PUSHs (newSViv (rv.distance_y));
        PUSHs (newSViv (rv.direction));
        PUSHs (to_sv (rv.part));
}

bool on_same_map_as (object *ob, object *other)
        CODE:
        RETVAL = on_same_map (ob, other);
        OUTPUT: RETVAL

const_utf8_string
base_name (object *op, int plural = op->nrof > 1)
        CODE:
        RETVAL = query_base_name (op, plural);
        OUTPUT: RETVAL

object *decrease_ob_nr (object *op, unsigned long i)

# return the tail of an object, excluding itself
void
tail (object *op)
        PPCODE:
        while ((op = op->more))
          XPUSHs (sv_2mortal (to_sv (op)));

MODULE = cf        PACKAGE = cf::object::player PREFIX = cf_player_

player *player (object *op)
        CODE:
        RETVAL = op->contr;
        OUTPUT: RETVAL

bool move_player (object *op, int dir)

void check_score (object *op)

void message (object *op, utf8_string txt, int flags = NDI_ORANGE | NDI_UNIQUE)
        CODE:
        new_draw_info (flags, 0, op, txt);

void kill_player (object *op)

void esrv_send_item (object *pl, object *item)

void esrv_update_item (object *pl, int what, object *item)
        C_ARGS: what, pl, item

void esrv_del_item (object *pl, int tag)
        C_ARGS: pl->contr, tag

int command_summon (object *op, utf8_string params)

int command_arrest (object *op, utf8_string params)


MODULE = cf        PACKAGE = cf::player         PREFIX = cf_player_

INCLUDE: $PERL $srcdir/genacc player ../include/player.h |

int invoke (player *pl, int event, ...)
        CODE:
        if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER");
        AV *av = (AV *)sv_2mortal ((SV *)newAV ());
        for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
        RETVAL = pl->invoke ((event_type)event, ARG_AV (av), DT_END);
        OUTPUT: RETVAL

SV *registry (player *pl)

void
save_stats (player *pl)
        CODE:
        pl->ob->stats.hp    = pl->ob->stats.maxhp;
        pl->ob->stats.sp    = pl->ob->stats.maxsp;
        pl->ob->stats.grace = pl->ob->stats.maxgrace;
        pl->orig_stats      = pl->ob->stats;

void clear_los (player *pl)

bool
cell_visible (player *pl, int dx, int dy)
        CODE:
        RETVAL = FABS (dx) <= pl->ns->mapx / 2 && FABS (dy) <= pl->ns->mapy / 2
                 && !pl->blocked_los [dx + pl->ns->mapx / 2][dy + pl->ns->mapy / 2];
        OUTPUT:
        RETVAL

void
send (player *pl, SV *packet)
        CODE:
{
        STRLEN len;
        char *buf = SvPVbyte (packet, len);

        if (len > MAXSOCKBUF)
          pl->failmsg ("[packet too long for client]");
        else if (pl->ns)
          pl->ns->send_packet (buf, len);
}

int
listening (player *pl, int new_value = -1)
        CODE:
        RETVAL = pl->listening;
        if (new_value >= 0)
          pl->listening = new_value;
        OUTPUT:
        RETVAL

void savebed (player *pl, SV *map_path = 0, SV *x = 0, SV *y = 0)
        PROTOTYPE: $;$$$
        PPCODE:
        if (GIMME_V != G_VOID)
          {
            EXTEND (SP, 3);
            PUSHs (sv_2mortal (newSVpv (pl->savebed_map, 0)));
            PUSHs (sv_2mortal (newSViv (pl->bed_x)));
            PUSHs (sv_2mortal (newSViv (pl->bed_y)));
          }
        if (map_path) sv_to (map_path, pl->savebed_map);
        if (x)        sv_to (x,        pl->bed_x);
        if (y)        sv_to (y,        pl->bed_y);

void
list ()
        PPCODE:
        for_all_players (pl)
          XPUSHs (sv_2mortal (to_sv (pl)));


MODULE = cf        PACKAGE = cf::map            PREFIX = cf_map_

int invoke (maptile *map, int event, ...)
        CODE:
        if (KLASS_OF (event) != KLASS_MAP) croak ("event class must be MAP");
        AV *av = (AV *)sv_2mortal ((SV *)newAV ());
        for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
        RETVAL = map->invoke ((event_type)event, ARG_AV (av), DT_END);
        OUTPUT: RETVAL

SV *registry (maptile *map)

void
find_tagged_objects (maptile *map, utf8_string tag = 0)
        PPCODE:
{
        if (!map->spaces)
          XSRETURN_EMPTY;

        if (tag)
          {
            shstr_cmp tag_ (tag);

            for (mapspace *ms = map->spaces + map->size (); ms-- > map->spaces; )
              for (object *op = ms->bot; op; op = op->above)
                if (op->tag == tag_)
                  XPUSHs (sv_2mortal (to_sv (op)));
          }
        else
          {
            for (mapspace *ms = map->spaces + map->size (); ms-- > map->spaces; )
              for (object *op = ms->bot; op; op = op->above)
                if (op->tag)
                  XPUSHs (sv_2mortal (to_sv (op)));
          }
}

INCLUDE: $PERL $srcdir/genacc maptile ../include/map.h |

void
maptile::instantiate ()

maptile *new ()
        PROTOTYPE:
        CODE:
        RETVAL = new maptile;
        OUTPUT:
        RETVAL

void
maptile::players ()
        PPCODE:
        if (GIMME_V == G_SCALAR)
          XPUSHs (sv_2mortal (to_sv (THIS->players)));
        else if (GIMME_V == G_ARRAY)
          {
            EXTEND (SP, THIS->players);
            for_all_players (pl)
              if (pl->ob && pl->ob->map == THIS)
                PUSHs (sv_2mortal (to_sv (pl->ob)));
          }

void
maptile::add_underlay (SV *data, int offset, int stride, SV *palette)
        CODE:
{
        if (!SvROK (palette) || SvTYPE (SvRV (palette)) != SVt_PVAV)
          croak ("maptile::add_underlay: palette must be arrayref");

        palette = SvRV (palette);

        STRLEN idxlen;
        const uint8_t *idx = (const uint8_t *)SvPVbyte (data, idxlen);

        for (int x = 0; x < THIS->width; ++x)
          for (int y = 0; y < THIS->height; ++y)
            {
              for (object *op = THIS->at (x, y).bot; op; op = op->above)
                if (op->flag [FLAG_IS_FLOOR])
                  goto skip_space;

              {
                int offs = offset + y * stride + x;
                if (IN_RANGE_EXC (offs, 0, idxlen))
                  {
                    if (SV **elem = av_fetch ((AV *)palette, idx [offs], 0))
                      {
                        object *ob = get_archetype (SvPVutf8_nolen (*elem));
                        ob->flag [FLAG_NO_MAP_SAVE] = true;
                        THIS->insert (ob, x, y, 0, INS_ABOVE_FLOOR_ONLY);

                        if (ob->randomitems)
                          {
                            if (!ob->above)
                              {
                                ob->create_treasure (ob->randomitems);

                                for (object *op = ob->above; op; op = op->above)
                                  op->flag [FLAG_NO_MAP_SAVE] = true;
                              }

                            ob->randomitems = 0;
                          }
                      }
                  }
              }

              skip_space: ;
            }
}

void
maptile::set_regiondata (SV *data, int offset, int stride, SV *palette)
        CODE:
{
        if (!SvROK (palette) || SvTYPE (SvRV (palette)) != SVt_PVAV)
          croak ("maptile::set_regiondata: palette must be arrayref");

        palette = SvRV (palette);

        STRLEN idxlen;
        const uint8_t *idx = (const uint8_t *)SvPVbyte (data, idxlen);

        region_ptr *regionmap = new region_ptr [av_len ((AV *)palette) + 1];
        uint8_t *regions = salloc<uint8_t> (THIS->size ());

        for (int i = av_len ((AV *)palette) + 1; i--; )
          regionmap [i] = region::find (SvPVutf8_nolen (*av_fetch ((AV *)palette, i, 1)));

        for (int y = 0; y < THIS->height; ++y)
          memcpy (regions + y * THIS->width, idx + offset + y * stride, THIS->width);

        sfree (THIS->regions, THIS->size ());
        delete [] THIS->regionmap;

        THIS->regions   = regions;
        THIS->regionmap = regionmap;
}

void
maptile::create_region_treasure ()
        CODE:
{
        object *op = object::create ();
        op->type = FLOOR;
        op->map  = THIS;

        for (int x = 0; x < THIS->width; ++x)
          for (int y = 0; y < THIS->height; ++y)
            {
              region *rgn = THIS->region (x, y);

              //fprintf (stderr, "%d,%d %f %p\n", x, y, rgn->treasure_density,rgn->treasure);//D
              if (rgn->treasure && rndm () < rgn->treasure_density)
                {
                  op->x = x;
                  op->y = y;
                  create_treasure (rgn->treasure, op, GT_ENVIRONMENT, THIS->difficulty);
                }
            }

        op->destroy ();
}

int out_of_map (maptile *map, int x, int y)

void
trigger (maptile *map, long connection, bool state = true)
        CODE:
        activate_connection (map, connection, state);

void
get_connection (maptile *map, long connection)
       PPCODE:
       oblinkpt *obp = get_connection_links (map, connection);
       if (obp)
         for (objectlink *ol = obp->link; ol; ol = ol->next)
           XPUSHs (sv_2mortal (to_sv ((object *)ol->ob)));

void
get_map_flags (maptile *map, int x, int y)
        PPCODE:
{
        maptile *nmap = 0;
        I16 nx = 0, ny = 0;
        int flags = get_map_flags (map, &nmap, x, y, &nx, &ny);

        EXTEND (SP, 4);
        PUSHs (sv_2mortal (newSViv (flags)));

        if (GIMME_V == G_ARRAY)
          {
            PUSHs (sv_2mortal (to_sv (nmap)));
            PUSHs (sv_2mortal (newSViv (nx)));
            PUSHs (sv_2mortal (newSViv (ny)));
          }
}

void
at (maptile *map, unsigned int x, unsigned int y)
        PROTOTYPE: $$$
        PPCODE:
{
        object *o;
        maptile *nmap = 0;
        I16 nx, ny;

        get_map_flags (map, &nmap, x, y, &nx, &ny);

        if (nmap)
          for (o = GET_MAP_OB (nmap, nx, ny); o; o = o->above)
            XPUSHs (sv_2mortal (to_sv (o)));
}

SV *
bot_at (maptile *obj, unsigned int x, unsigned int y)
        PROTOTYPE: $$$
        ALIAS:
          top_at        = 1
          flags_at      = 2
          light_at      = 3
          move_block_at = 4
          move_slow_at  = 5
          move_on_at    = 6
          move_off_at   = 7
        INIT:
        if (x >= obj->width || y >= obj->height) XSRETURN_UNDEF;
        CODE:
        switch (ix)
          {
            case 0: RETVAL = to_sv   (GET_MAP_OB         (obj, x, y)); break;
            case 1: RETVAL = to_sv   (GET_MAP_TOP        (obj, x, y)); break;
            case 2: RETVAL = newSVuv (GET_MAP_FLAGS      (obj, x, y)); break;
            case 3: RETVAL = newSViv (GET_MAP_LIGHT      (obj, x, y)); break;
            case 4: RETVAL = newSVuv (GET_MAP_MOVE_BLOCK (obj, x, y)); break;
            case 5: RETVAL = newSVuv (GET_MAP_MOVE_SLOW  (obj, x, y)); break;
            case 6: RETVAL = newSVuv (GET_MAP_MOVE_ON    (obj, x, y)); break;
            case 7: RETVAL = newSVuv (GET_MAP_MOVE_OFF   (obj, x, y)); break;
          }
        OUTPUT: RETVAL

void fix_walls (maptile *map, int x, int y)

void fix_walls_around (maptile *map, int x, int y)

# worst xs function of my life
bool
_create_random_map (\
        maptile *self,\
        utf8_string wallstyle,\
        utf8_string wall_name,\
        utf8_string floorstyle,\
        utf8_string monsterstyle,\
        utf8_string treasurestyle,\
        utf8_string layoutstyle,\
        utf8_string doorstyle,\
        utf8_string decorstyle,\
        utf8_string origin_map,\
        utf8_string final_map,\
        utf8_string exitstyle,\
        utf8_string this_map,\
        utf8_string exit_on_final_map,\
        int xsize,\
        int ysize,\
        int expand2x,\
        int layoutoptions1,\
        int layoutoptions2,\
        int layoutoptions3,\
        int symmetry,\
        int difficulty,\
        int difficulty_given,\
        float difficulty_increase,\
        int dungeon_level,\
        int dungeon_depth,\
        int decoroptions,\
        int orientation,\
        int origin_y,\
        int origin_x,\
        U32 random_seed,\
        val64 total_map_hp,\
        int map_layout_style,\
        int treasureoptions,\
        int symmetry_used,\
        region *region,\
        utf8_string custom\
)
        CODE:
{
        random_map_params rmp;

        assign (rmp.wallstyle        , wallstyle);
        assign (rmp.wall_name        , wall_name);
        assign (rmp.floorstyle       , floorstyle);
        assign (rmp.monsterstyle     , monsterstyle);
        assign (rmp.treasurestyle    , treasurestyle);
        assign (rmp.layoutstyle      , layoutstyle);
        assign (rmp.doorstyle        , doorstyle);
        assign (rmp.decorstyle       , decorstyle);
        assign (rmp.exitstyle        , exitstyle);
        assign (rmp.exit_on_final_map, exit_on_final_map);

        rmp.origin_map          = origin_map;
        rmp.final_map           = final_map;
        rmp.this_map            = this_map;
        rmp.xsize               = xsize;
        rmp.ysize               = ysize;
        rmp.expand2x            = expand2x;
        rmp.layoutoptions1      = layoutoptions1;
        rmp.layoutoptions2      = layoutoptions2;
        rmp.layoutoptions3      = layoutoptions3;
        rmp.symmetry            = symmetry;
        rmp.difficulty          = difficulty;
        rmp.difficulty_given    = difficulty_given;
        rmp.difficulty_increase = difficulty_increase;
        rmp.dungeon_level       = dungeon_level;
        rmp.dungeon_depth       = dungeon_depth;
        rmp.decoroptions        = decoroptions;
        rmp.orientation         = orientation;
        rmp.origin_y            = origin_y;
        rmp.origin_x            = origin_x;
        rmp.random_seed         = random_seed;
        rmp.total_map_hp        = (uint64_t) total_map_hp;
        rmp.map_layout_style    = map_layout_style;
        rmp.treasureoptions     = treasureoptions;
        rmp.symmetry_used       = symmetry_used;
        rmp.region              = region;
        rmp.custom              = custom;

        RETVAL = self->generate_random_map (&rmp);
}
        OUTPUT:
        RETVAL

MODULE = cf        PACKAGE = cf::arch

int archetypes_size ()
        CODE:
        RETVAL = archetypes.size ();
        OUTPUT: RETVAL

archetype *archetypes (U32 index)
        CODE:
        RETVAL = index < archetypes.size () ? archetypes [index] : 0;
        OUTPUT: RETVAL

object *instantiate (archetype *arch)
        CODE:
        RETVAL = arch_to_object (arch);
        OUTPUT:
        RETVAL

INCLUDE: $PERL $srcdir/genacc archetype ../include/object.h |

MODULE = cf        PACKAGE = cf::party

partylist *first ()
        PROTOTYPE:
        CODE:
        RETVAL = get_firstparty ();
        OUTPUT: RETVAL

INCLUDE: $PERL $srcdir/genacc partylist ../include/player.h |

MODULE = cf        PACKAGE = cf::region

void
list ()
        PPCODE:
        for_all_regions (rgn)
          XPUSHs (sv_2mortal (to_sv (rgn)));

region *find (utf8_string name)
        PROTOTYPE: $
        CODE:
        RETVAL = region::find (name);
        OUTPUT: RETVAL

region *find_fuzzy (utf8_string name)
        PROTOTYPE: $
        CODE:
        RETVAL = region::find_fuzzy (name);
        OUTPUT: RETVAL

int specificity (region *rgn)
        CODE:
        RETVAL = 0;
        while (rgn = rgn->parent)
          RETVAL++;
        OUTPUT: RETVAL

INCLUDE: $PERL $srcdir/genacc region ../include/region.h |

MODULE = cf        PACKAGE = cf::living

INCLUDE: $PERL $srcdir/genacc living ../include/living.h |

MODULE = cf        PACKAGE = cf::settings

INCLUDE: $PERL $srcdir/genacc Settings ../include/global.h |

MODULE = cf        PACKAGE = cf::client

INCLUDE: $PERL $srcdir/genacc client ../include/client.h |

int invoke (client *ns, int event, ...)
        CODE:
        if (KLASS_OF (event) != KLASS_CLIENT) croak ("event class must be CLIENT");
        AV *av = (AV *)sv_2mortal ((SV *)newAV ());
        for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
        RETVAL = ns->invoke ((event_type)event, ARG_AV (av), DT_END);
        OUTPUT: RETVAL

SV *registry (client *ns)

void
list ()
        PPCODE:
        EXTEND (SP, clients.size ());
        for (sockvec::iterator i = clients.begin (); i != clients.end (); ++i)
          PUSHs (sv_2mortal (to_sv (*i)));

void
client::send_packet (SV *packet)
        CODE:
{
        STRLEN len;
        char *buf = SvPVbyte (packet, len);

        if (len > MAXSOCKBUF)
          {
            // ugly
            if (THIS->pl)
              THIS->pl->failmsg ("[packet too long for client]");
          }
        else
          THIS->send_packet (buf, len);
}

faceidx
client::need_face (utf8_string name, int pri = 0)
        CODE:
        RETVAL = face_find (name, 0);
        if (RETVAL)
          {
            THIS->send_face (RETVAL, pri);
            THIS->flush_fx ();
          }
        OUTPUT:
        RETVAL

int
client::fx_want (int idx, int value = -1)
        CODE:
        if (0 < idx && idx < FT_NUM)
          {
            RETVAL = THIS->fx_want [idx];
            if (items > 2)
              THIS->fx_want [idx] = value;
          }
        else
          RETVAL = 0;
        OUTPUT:
        RETVAL

MODULE = cf        PACKAGE = cf::sound  PREFIX = sound_

faceidx sound_find (utf8_string name)

void sound_set (utf8_string str, faceidx face)

# dire hack
void old_sound_index (int idx, faceidx face)
        CODE:
        extern faceidx old_sound_index [SOUND_CAST_SPELL_0];
        old_sound_index [idx] = face;

MODULE = cf        PACKAGE = cf::face   PREFIX = face_

#INCLUDE: $PERL $srcdir/genacc faceset ../include/face.h |

faceidx face_find (utf8_string name, faceidx defidx = 0)

faceidx alloc (utf8_string name)
        CODE:
{
        do
          {
            RETVAL = faces.size ();
            faces.resize (RETVAL + 1);
          }
        while (!RETVAL); // crude way to leave index 0

        faces [RETVAL].name = name;
        facehash.insert (std::make_pair (faces [RETVAL].name, RETVAL));

        if (!strcmp (name, BLANK_FACE_NAME)) blank_face = RETVAL;
        if (!strcmp (name, EMPTY_FACE_NAME)) empty_face = RETVAL;
}
        OUTPUT: RETVAL

void set_type (faceidx idx, int value)
        ALIAS:
        set_type        = 0
        set_visibility  = 1
        set_magicmap    = 2
        set_smooth      = 3
        set_smoothlevel = 4
        CODE:
        faceinfo *f = face_info (idx); assert (f);
        switch (ix)
          {
            case 0: f->type        = value; break;
            case 1: f->visibility  = value; break;
            case 2: f->magicmap    = value; break;
            case 3: f->smooth      = value; break;
            case 4: f->smoothlevel = value; break;
          }

void set_data (faceidx idx, int faceset, SV *data, SV *chksum)
        CODE:
{
        faceinfo *f = face_info (idx); assert (f);
        facedata *d = &(faceset ? f->data64 : f->data32);
        sv_to (data, d->data);
        STRLEN clen;
        char *cdata = SvPVbyte (chksum, clen);
        clen = min (CHKSUM_SIZE, clen);

        if (memcmp (d->chksum, cdata, clen))
          {
            memcpy (d->chksum, cdata, clen);

            // invalidate existing client face info
            for_all_clients (ns)
              if (ns->faceset == faceset)
                {
                  ns->faces_sent [idx] = false;
                  ns->force_newmap = true;
                }
          }
}

int get_data_size (faceidx idx, int faceset = 0)
        CODE:
        facedata *d = face_data (idx, faceset); assert (d);
        RETVAL = d->data.size ();
        OUTPUT:
        RETVAL

SV *get_chksum (faceidx idx, int faceset = 0)
        CODE:
        facedata *d = face_data (idx, faceset); assert (d);
        RETVAL = newSVpvn ((char *)d->chksum, CHKSUM_SIZE);
        OUTPUT:
        RETVAL

void invalidate (faceidx idx)
        CODE:
        for_all_clients (ns)
          {
            ns->faces_sent [idx] = false;
            ns->force_newmap = true;
          }

void invalidate_all ()
        CODE:
        for_all_clients (ns)
          {
            ns->faces_sent.reset ();
            ns->force_newmap = true;
          }

MODULE = cf        PACKAGE = cf::anim   PREFIX = anim_

#INCLUDE: $PERL $srcdir/genacc faceset ../include/anim.h |

animidx anim_find (utf8_string name)
        CODE:
        RETVAL = animation::find (name).number;
        OUTPUT: RETVAL

animidx set (utf8_string name, SV *frames, int facings = 1)
        CODE:
{
        if (!SvROK (frames) && SvTYPE (SvRV (frames)) != SVt_PVAV)
          croak ("frames must be an arrayref");

        AV *av = (AV *)SvRV (frames);

        animation *anim = &animation::find (name);
        if (anim->number)
          {
            anim->resize (av_len (av) + 1);
            anim->facings = facings;
          }
        else
          anim = &animation::create (name, av_len (av) + 1, facings);

        for (int i = 0; i < anim->num_animations; ++i)
          anim->faces [i] = face_find (SvPVutf8_nolen (*av_fetch (av, i, 1)));
}
        OUTPUT: RETVAL

void invalidate_all ()
        CODE:
        for_all_clients (ns)
          ns->anims_sent.reset ();

MODULE = cf        PACKAGE = cf::object::freezer

INCLUDE: $PERL $srcdir/genacc object_freezer ../include/cfperl.h |

SV *
new (char *klass)
        CODE:
        RETVAL = newSVptr (new object_freezer, gv_stashpv ("cf::object::freezer", 1));
        OUTPUT: RETVAL

void
DESTROY (SV *sv)
        CODE:
        object_freezer *self;
        sv_to (sv, self);
        delete self;

MODULE = cf        PACKAGE = cf::object::thawer

INCLUDE: $PERL $srcdir/genacc object_thawer ../include/cfperl.h |

SV *
new_from_file (char *klass, octet_string path)
        CODE:
        object_thawer *f = new object_thawer (path);
        if (!*f)
          {
            delete f;
            XSRETURN_UNDEF;
          }
        RETVAL = newSVptr (f, gv_stashpv ("cf::object::thawer", 1));
        OUTPUT: RETVAL

void
DESTROY (SV *sv)
        CODE:
        object_thawer *self;
        sv_to (sv, self);
        delete self;

void
extract_tags (object_thawer *self)
        PPCODE:
        while (self->kw != KW_EOF)
          {
            PUTBACK;
            coroapi::cede_to_tick_every (5000);
            SPAGAIN;

            if (self->kw == KW_tag)
              XPUSHs (sv_2mortal (newSVpv_utf8 (self->get_str ())));

            self->skip ();
          }

Revision:	1.258
Committed:	Sun Sep 30 20:22:24 2007 UTC (16 years, 8 months ago) by root
Branch:	MAIN
Changes since 1.257:	+13 -3 lines
Log Message:	- clean up message system, combine all boxes into one. - suppress too long messages (we need a more robust solution to this problem). - get rid of INS_MAP_LOAD, leading to slightly cleaner/faster code and certainly one special case less. - insert objects manually at load time, this is both faster and also more correct, as loading a map is never supposed to trigger anything (and also for symmetry to the save code).