server/server/cfperl.xs

/*****************************************************************************/
/*  CrossFire, A Multiplayer game for the X Window System                    */
/*****************************************************************************/

/*
 *  This code is placed under the GNU General Public Licence (GPL)
 *
 *  Copyright (C) 2001-2005 by Chachkoff Yann                               
 *  Copyright (C) 2006,2007 by Marc Lehmann <cf@schmorp.de>
 *                                                                          
 *  This program 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 2 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, write to the Free Software             
 *  Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301 USA 
 */

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

#define CEDES_PER_TICK 5

#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_set_property = cfapi_object_set_property;
static f_plug_api object_insert       = cfapi_object_insert;

static PerlInterpreter *perl;

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

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 ()
{
  flags |=0x3300;//D
  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);
      flags |= 0x80; // severed //D
    }
}

void
attachable::optimise ()
{
  if (self
      && SvREFCNT (self) == 1
      && !HvTOTALKEYS (self))
    flags |= 0x40,//D
    sever_self ();
}

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

  destroy ();
}

void
attachable::do_destroy ()
{
  invoke (EVENT_ATTACHABLE_DESTROY, DT_END);

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

  if (self)
    sever_self ();

  flags |= 0x20; //D
  mortals.push_back (this);
}

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

  flags |= F_DESTROYED;
  do_destroy ();
}

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

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

          if (mortals.size () > 1000)
            fprintf (stderr, "mortal queue size (%d) exceeds 1000.\n", (int)mortals.size ());

          break;
        }

      attachable *obj = mortals [i];

      obj->refcnt_chk (); // unborrow from perl, if necessary

      //if (obj->refcnt > 0 || obj->self)
      if (obj->refcnt || obj->self)
        {
//printf ("%p rc %d\n", obj, obj->refcnt_cnt ());//D
          ++i; // further delay freeing

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

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

  attach = src.attach;
  return *this;
}

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

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);
      obj->flags |= (obj->flags & 0xc0) << 8;
      obj->flags &= ~0xc0;//D
      obj->flags |= 0x10;//D

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

inline SV *to_sv (const shstr &  v) { return v ? newSVpvn ((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) ? SvPV_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, rangetype      &v) { v = (rangetype)   SvIV (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[] = {
    "",
    "-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 (EVENT_ATTACHABLE_INSTANTIATE, ARG_STRING (attach), DT_END);
      attach = 0;
    }
}

void
attachable::reattach ()
{
  optimise ();
  //TODO: check for _attachment's, very important for restarts
  invoke (EVENT_ATTACHABLE_REATTACH, DT_END);
}

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_object, event);
}

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

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

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

  va_start (ap, event);

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

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

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

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

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

int coroapi::cede_counter;
double (*coroapi::time)();
double 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 (Map0Cmd) const_iv (Map1Cmd) const_iv (Map1aCmd)

    const_iv (MAP_CLIENT_X) const_iv (MAP_CLIENT_Y)

    const_iv (MAX_TIME)

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

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

void
LOG (int level, utf8_string msg)
        PROTOTYPE: $$
        C_ARGS: (LogLevel)level, "%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 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

# missing properties

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

int is_head (object *op)
        PROTOTYPE: $
        CODE:
        RETVAL = op->head_ () == op;
        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

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) : cf_create_object ();
        OUTPUT:
        RETVAL

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

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

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

object *cf_player_send_inventory (object *op)

octet_string cf_player_get_ip (object *op)
        ALIAS: ip = 0

object *cf_player_get_marked_item (object *op)
        ALIAS: marked_item = 0

void cf_player_set_marked_item (object *op, object *ob)

partylist *cf_player_get_party (object *op)
        ALIAS: party = 0

void cf_player_set_party (object *op, partylist *party)

void kill_player (object *op)

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

void clear_los (object *op)

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

              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        = 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

archetype *first()
        PROTOTYPE:
        CODE:
        RETVAL = first_archetype;
        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.195
Committed:	Tue Apr 24 00:42:02 2007 UTC (17 years, 1 month ago) by root
Branch:	MAIN
Changes since 1.194:	+4 -2 lines
Log Message:	- implement a rudimentary framework for a "msg" command that replaces drawinfo and drawextinfo and allows for simpler usage in simple cases and extensibility for the less complex uses. - moved the character race choosing logic into perl, making use of the new msg command if the client supports it.