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 <plugin_common.h>
#include <sounds.h>
#include <cstdarg>
#include <sproto.h>

#include "loader.h"
#include "cfperl.h"
#include "shstr.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  object_ornull;
typedef maptile maptile_ornull;

typedef char *octet_string;
typedef char *utf8_string;
typedef const char *const_octet_string;
typedef const char *const_utf8_string;

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 f_plug_api gethook             = cfapi_get_hooks;
static f_plug_api object_insert       = cfapi_object_insert;

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;

// 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;
        }
    }
}

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 &PL_sv_undef;

  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 &PL_sv_undef;

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

      // now bless the object _once_
      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;
}

static inline SV *
newSVpv_utf8 (const char *s)
{
  SV *sv = newSVpv (s, 0);
  SvUTF8_on (sv);
  return sv;
}

static inline SV *
newSVpvn_utf8 (const char *s, STRLEN l)
{
  SV *sv = newSVpvn (s, l);
  SvUTF8_on (sv);
  return sv;
}

inline SV *to_sv (const shstr &  v) { return v ? newSVpvn_utf8 ((const char *)v, v.length ()) : &PL_sv_undef; }
inline SV *to_sv (const char *   v) { return newSVpv (v, 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 (partylist *    v) { return newSVptr (v, stash_cf_party_wrap); }
inline SV *to_sv (region *       v) { return newSVptr (v, stash_cf_region_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, 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, region *       &v) { v = (region *)SvPTR_ornull (sv, "cf::region"); }
inline void sv_to (SV *sv, living *       &v) { v = (living *)SvPTR_ornull (sv, "cf::living"); }

//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) : &PL_sv_undef;
        }
        break;

      case DT_DATA:
        {
          char *str = (char *)va_arg (ap, const void *);
          int len = va_arg (ap, int);
          sv = str ? newSVpv (str, len) : &PL_sv_undef;
        }
        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;
}

static SV *
newSVcfapi (int type, ...)
{
  SV *sv;

  va_list ap;
  va_start (ap, type);

  switch (type)
    {
      case CFAPI_INT:     sv = newSViv    (*va_arg (ap, int *   )); break;
      case CFAPI_LONG:    sv = newSVval64 (*va_arg (ap, sint64 *)); break;
      case CFAPI_DOUBLE:  sv = newSVnv    (*va_arg (ap, double *)); break;
      case CFAPI_STRING:  sv = newSVdt_va (ap, DT_STRING); break;
      case CFAPI_POBJECT: sv = newSVdt_va (ap, DT_OBJECT); break;
      case CFAPI_PMAP:    sv = newSVdt_va (ap, DT_MAP   ); break;
      case CFAPI_PPLAYER: sv = newSVdt_va (ap, DT_PLAYER); break;
      case CFAPI_PARCH:   sv = newSVdt_va (ap, DT_ARCH  ); break;
      case CFAPI_PPARTY:  sv = newSVdt_va (ap, DT_PARTY ); break;
      case CFAPI_PREGION: sv = newSVdt_va (ap, DT_REGION); break;

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

  va_end (ap);

  return sv;
}

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

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

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

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

extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)
{
  return 0;
}

static CommArray_s rtn_cmd;

static int
runPluginCommand (object *obj, char *params)
{
  return -1;
}

extern "C" void *cfperl_getPluginProperty (int *type, ...)
{
  va_list args;
  char *propname;
  int i;
  va_start (args, type);
  propname = va_arg (args, char *);
  //printf ("Property name: %s\n", propname);
 
  if (!strcmp (propname, "command?"))
    return NULL;
  else if (!strcmp (propname, "Identification"))
    {
      va_end (args);
      return (void *)PLUGIN_NAME;
    }
  else if (!strcmp (propname, "FullName"))
    {
      va_end (args);
      return (void *)PLUGIN_VERSION;
    }
  else
    va_end (args);

  return NULL;
}

extern "C" int cfperl_postInitPlugin ()
{
  int hooktype = 1;
  int rtype = 0;

  cf_init_plugin (gethook);

  return 0;
}

extern "C" int cfperl_closePlugin ()
{
  return 0;
}

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 ("cfperl::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));
}

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

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 (color);
  CALL_ARG (type);
  CALL_ARG_SV (newSVpv_utf8 (msg));
  CALL_CALL ("cf::client::send_msg", G_VOID);
  CALL_END;
}

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)
{
  CALL_BEGIN (2);
  CALL_ARG (path);
  CALL_ARG (origin);
  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;
}

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 (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_OBJ_SAVE_ON_OVL)     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 (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 (INS_MAP_LOAD)

    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 (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)               
  };

  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 ();
}

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

# 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));
}

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: $$

const_octet_string
get_maps_directory (octet_string path)
        PROTOTYPE: $
        ALIAS: maps_directory = 0
        CODE:
        RETVAL = create_pathname (path);
        OUTPUT: RETVAL

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/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:
{
        object *o;
        for (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_player (object *op, int dir)
        CODE:
        RETVAL = move_player (op, dir);
        OUTPUT:
        RETVAL

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)

object *cf_object_present_archname_inside (object *op, utf8_string whatstr)

int cf_object_transfer (object *op, int x, int y, int r = 0, object_ornull *orig = 0)

int cf_object_change_map (object *op, int x, int y, maptile *map)

#//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)

int cf_object_teleport (object *op, maptile *map, int x, int y)

void update_object (object *op, int action)

object *cf_create_object_by_name (utf8_string name)

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);


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

object *cf_insert_ob_in_ob (object *ob, object *where)

# 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:
{
        int unused_type;
        RETVAL = (object *)object_insert (&unused_type, ob, 0, 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 (newSVcfapi (CFAPI_POBJECT, 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)

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

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

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_update_item (object *op, int what, object *item)
        C_ARGS: what, op, item

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)

void cf_player_move (player *pl, int dir)

void play_sound_player_only (player *pl, int soundnum, int x = 0, int y = 0);

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 (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)

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 **regionmap = (region **)malloc (
                                (av_len ((AV *)palette) + 1) * sizeof (region *));
        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 ());
        free (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 ();
}

void play_sound_map (maptile *map, int x, int y, int sound_num)

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 (newSVcfapi (CFAPI_POBJECT, (object *)ol->ob)));

object *cf_map_insert_object_there (maptile *where, object *op, object *originator, int flags)

object *cf_map_insert_object (maptile *where, object* op, int x, int y)

object* cf_map_present_arch_by_name (maptile *map, const char* str, int nx, int ny)
        C_ARGS: str, map, nx, ny

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 (newSVcfapi (CFAPI_PMAP, 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 (newSVcfapi (CFAPI_POBJECT, 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 = newSVcfapi (CFAPI_POBJECT, GET_MAP_OB         (obj, x, y)); break;
            case 1: RETVAL = newSVcfapi (CFAPI_POBJECT, 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

archetype *find (utf8_string name)
        CODE:
        RETVAL = archetype::find (name);
        OUTPUT:
        RETVAL

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);

        THIS->send_packet (buf, len);
}

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 (faceidx idx, int visibility, int magicmap)
        CODE:
        faceinfo *f = face_info (idx);
        assert (f);
        f->visibility = visibility;
        f->magicmap   = magicmap;

void set_smooth (faceidx idx, faceidx smooth, int smoothlevel)
        CODE:
        faceinfo *f = face_info (idx); assert (f);
        f->smooth      = smooth;
        f->smoothlevel = smoothlevel;

void set_data (faceidx idx, int faceset, SV *data, SV *chksum)
        CODE:
{
        facedata *d = face_data (idx, faceset);
        assert (d);
        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;
                }
          }
}

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 ();

Revision:	1.226
Committed:	Sun Jul 1 05:00:19 2007 UTC (16 years, 11 months ago) by root
Branch:	MAIN
Changes since 1.225:	+10 -11 lines
Log Message:	- upgrade crossfire trt to the GPL version 3 (hopefully correctly). - add a single file covered by the GNU Affero General Public License (which is not yet released, so I used the current draft, which is legally a bit wavy, but its likely better than nothing as it expresses direct intent by the authors, and we can upgrade as soon as it has been released). * this should ensure availability of source code for the server at least and hopefully also archetypes and maps even when modified versions are not being distributed, in accordance of section 13 of the agplv3.