Add `-jameson' option.

[rocl] / elite.c

/* -*-c-*-
 *
 * $Id: elite.c,v 1.1 2003/02/24 01:13:12 mdw Exp $
 *
 * Elite planet data
 *
 * (c) 2003 Mark Wooding
 */

/*----- Licensing notice --------------------------------------------------* 
 *
 * 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 */

/*----- Revision history --------------------------------------------------* 
 *
 * $Log: elite.c,v $
 * Revision 1.1  2003/02/24 01:13:12  mdw
 * Initial import.
 *
 */

/*----- Header files ------------------------------------------------------*/

#include <ctype.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include <tcl.h>

/*----- Data structures ---------------------------------------------------*/

typedef struct world {
  unsigned char x[6];
} world;

typedef struct worldinfo {
  unsigned x, y, gov, eco, tech, pop, prod, rad;
} worldinfo;

/*----- The world type ----------------------------------------------------*/

static void world_fir(Tcl_Obj *o)
{
  Tcl_Free(o->internalRep.otherValuePtr);
}

static int xtoi(unsigned x)
{
  if (x >= '0' && x <= '9')
    return (x - '0');
  else if (x >= 'a' && x <= 'f')
    return (x - 'a' + 10);
  else if (x >= 'A' && x <= 'F')
    return (x - 'A' + 10);
  else
    abort();
}

static Tcl_ObjType world_type;

static int world_sfa(Tcl_Interp *ti, Tcl_Obj *o)
{
  int l;
  world ww, *w;
  int i;
  char *p = Tcl_GetStringFromObj(o, &l);
  if (l != 12)
    goto bad;
  for (i = 0; i < 12; i += 2) {
    if (!isxdigit((unsigned char)p[i]) ||
	!isxdigit((unsigned char)p[i + 1]))
      goto bad;
    ww.x[i >> 1] = (xtoi(p[i]) << 4) | (xtoi(p[i + 1]));
  }
  w = (world *)Tcl_Alloc(sizeof(*w));
  *w = ww;
  o->internalRep.otherValuePtr = w;
  o->typePtr = &world_type;
  return (TCL_OK);

bad:
  if (ti)
    Tcl_SetResult(ti, "bad world seed string", TCL_STATIC);
  return (TCL_ERROR);
}

static void world_us(Tcl_Obj *o)
{
  char *p;
  world *w = o->internalRep.otherValuePtr;
  int i;

  p = Tcl_Alloc(13);
  p[12] = 0;
  o->bytes = p;
  o->length = 12;
  for (i = 0; i < 6; i++, p += 2)
    sprintf(p, "%02x", w->x[i]);  
}

static void world_dir(Tcl_Obj *o, Tcl_Obj *oo)
{
  world *w = (world *)Tcl_Alloc(sizeof(*w));
  memcpy(w, o->internalRep.otherValuePtr, sizeof(world));
  oo->internalRep.otherValuePtr = w;
  oo->typePtr = &world_type;
  Tcl_InvalidateStringRep(oo);
}

static /*const*/ Tcl_ObjType world_type = {
  "elite-world", world_fir, world_dir, world_us, world_sfa
};

static world *world_get(Tcl_Interp *ti, Tcl_Obj *o)
{
  if (Tcl_ConvertToType(ti, o, &world_type) != TCL_OK)
    return (0);
  return (o->internalRep.otherValuePtr);
}

static Tcl_Obj *world_new(const world *w)
{
  world *ww;
  Tcl_Obj *o = Tcl_NewObj();
  ww = (world *)Tcl_Alloc(sizeof(*ww));
  *ww = *w;
  o->internalRep.otherValuePtr = ww;
  o->typePtr = &world_type;
  Tcl_InvalidateStringRep(o);
  return (o);
}

/*----- Elite-specific hacking --------------------------------------------*
 *
 * Taken from `Elite: The New Kind' by Christian Pinder.
 */

static void waggle(world *w, world *ww)
{
  unsigned int h, l;

  /* --- What goes on --- *
   *
   * 16-bit add of all three words, shift up, and insert the new value at the
   * end.
   */

  l = w->x[0];
  h = w->x[1];
  l += w->x[2];
  h += w->x[3] + (l >= 0x100);
  l &= 0xff; h &= 0xff;
  l += w->x[4];
  h += w->x[5] + (l >= 0x100);
  l &= 0xff; h &= 0xff;
  ww->x[0] = w->x[2]; ww->x[1] = w->x[3];
  ww->x[2] = w->x[4]; ww->x[3] = w->x[5];
  ww->x[4] = l; ww->x[5] = h;
}

/*----- Tcl commands ------------------------------------------------------*/

static int err(Tcl_Interp *ti, /*const*/ char *p)
{
  Tcl_SetResult(ti, p, TCL_STATIC);
  return (TCL_ERROR);
}

/* --- elite-nextworld SEED --- */

static int cmd_nextworld(ClientData cd, Tcl_Interp *ti,
			 int objc, Tcl_Obj *const *objv)
{
  world *w, ww;
  if (objc != 2)
    return (err(ti, "usage: elite-nextworld SEED"));
  if ((w = world_get(ti, objv[1])) == 0)
    return (TCL_ERROR);
  waggle(w, &ww);
  waggle(&ww, &ww);
  waggle(&ww, &ww);
  waggle(&ww, &ww);
  Tcl_SetObjResult(ti, world_new(&ww));
  return (TCL_OK);
}

/* --- elite-nextgalaxy SEED --- */

static int cmd_nextgalaxy(ClientData cd, Tcl_Interp *ti,
			  int objc, Tcl_Obj *const *objv)
{
  world *w, ww;
  int i;

  if (objc != 2)
    return (err(ti, "usage: elite-nextgalaxy SEED"));
  if ((w = world_get(ti, objv[1])) == 0)
    return (TCL_ERROR);
  for (i = 0; i < 6; i++)
    ww.x[i] = ((w->x[i] << 1) | (w->x[i] >> 7)) & 0xff;
  Tcl_SetObjResult(ti, world_new(&ww));
  return (TCL_OK);
}

/* --- elite-worldinfo ARR SEED --- */

static void getworldinfo(worldinfo *wi, world *w)
{
  wi->x = w->x[3];
  wi->y = w->x[1];
  wi->gov = (w->x[2] >> 3) & 0x07;
  wi->eco = w->x[1] & 0x07;
  if (wi->gov < 2)
    wi->eco |= 0x02;
  wi->tech = ((wi->eco ^ 7) + (w->x[3] & 0x03) +
	      (wi->gov >> 1) + (wi->gov & 0x01) + 1);
  wi->pop = wi->tech * 4 + wi->gov + wi->eco - 3;
  wi->prod = ((wi->eco ^ 7) + 3) * (wi->gov + 4) * wi->pop * 8;
  wi->rad = (((w->x[5] & 0x0f) + 11) << 8) + w->x[3];
}

static const char digrams[] =
  "abouseitiletstonlonuthnoallexegezacebisouses"
  "armaindirea?eratenberalavetiedorquanteisrion";

static const char *const desc[][5] = {
/*  0 */ { "fabled", "notable", "well known", "famous", "noted" },
/*  1 */ { "very ", "mildly ", "most ", "reasonably ", "" },
/*  2 */ { "ancient", "<20>", "great", "vast", "pink" },
/*  3 */ { "<29> <28> plantations", "mountains", "<27>",
	   "<19> forests", "oceans" },
/*  4 */ { "shyness", "silliness", "mating traditions",
	   "loathing of <5>", "love for <5>" },
/*  5 */ { "food blenders", "tourists", "poetry", "discos", "<13>" },
/*  6 */ { "talking tree", "crab", "bat", "lobst", "%R" },
/*  7 */ { "beset", "plagued", "ravaged", "cursed", "scourged" },
/*  8 */ { "<21> civil war", "<26> <23> <24>s",
	   "a <26> disease", "<21> earthquakes", "<21> solar activity" },
/*  9 */ { "its <2> <3>", "the %I <23> <24>",
	   "its inhabitants' <25> <4>", "<32>", "its <12> <13>" },
/* 10 */ { "juice", "brandy", "water", "brew", "gargle blasters" },
/* 11 */ { "%R", "%I <24>", "%I %R", "%I <26>", "<26> %R" },
/* 12 */ { "fabulous", "exotic", "hoopy", "unusual", "exciting" },
/* 13 */ { "cuisine", "night life", "casinos", "sit coms", " <32>" },
/* 14 */ { "%H", "The planet %H", "The world %H",
	   "This planet", "This world" },
/* 15 */ { "n unremarkable", " boring", " dull", " tedious", " revolting" },
/* 16 */ { "planet", "world", "place", "little planet", "dump" },
/* 17 */ { "wasp", "moth", "grub", "ant", "%R" },
/* 18 */ { "poet", "arts graduate", "yak", "snail", "slug" },
/* 19 */ { "tropical", "dense", "rain", "impenetrable", "exuberant" },
/* 20 */ { "funny", "weird", "unusual", "strange", "peculiar" },
/* 21 */ { "frequent", "occasional", "unpredictable", "dreadful", "deadly" },
/* 22 */ { "<1><0> for <9>", "<1><0> for <9> and <9>",
	   "<7> by <8>", "<1><0> for <9> but <7> by <8>","a<15> <16>" },
/* 23 */ { "<26>", "mountain", "edible", "tree", "spotted" },
/* 24 */ { "<30>", "<31>", "<6>oid", "<18>", "<17>" },
/* 25 */ { "ancient", "exceptional", "eccentric", "ingrained", "<20>" },
/* 26 */ { "killer", "deadly", "evil", "lethal", "vicious" },
/* 27 */ { "parking meters", "dust clouds", "ice bergs",
	   "rock formations", "volcanoes" },
/* 28 */ { "plant", "tulip", "banana", "corn", "%Rweed" },
/* 29 */ { "%R", "%I %R", "%I <26>", "inhabitant", "%I %R" },
/* 30 */ { "shrew", "beast", "bison", "snake", "wolf" },
/* 31 */ { "leopard", "cat", "monkey", "goat", "fish" },
/* 32 */ { "<11> <10>", "%I <30> <33>", "its <12> <31> <33>",
	   "<34> <35>", "<11> <10>" },
/* 33 */ { "meat", "cutlet", "steak", "burgers", "soup" },
/* 34 */ { "ice", "mud", "Zero-G", "vacuum", "%I ultra" },
/* 35 */ { "hockey", "cricket", "karate", "polo", "tennis" }
};

static int mangle(world *w)
{
  unsigned a, x;

  x = (w->x[2] << 1) & 0xff;
  a = x + w->x[4];
  if (w->x[2] & 0x80)
    a++;
  w->x[2] = a & 0xff;
  w->x[4] = x;
  a >>= 8;
  x = w->x[3];
  a = (a + x + w->x[5]) & 0xff;
  w->x[3] = a;
  w->x[5] = x;
  return (a);
}

static void goatsoup(Tcl_Obj *d, const char *pn, world *w, const char *p)
{
  for (;;) {
    size_t sz = strcspn(p, "<%");
    unsigned n;
    char buf[12];
    char *q;

    Tcl_AppendToObj(d, (char *)p, sz);
    p += sz;
    switch (*p) {
      unsigned i, j;
      case 0:
	return;
      case '<':
	i = strtoul(p + 1, (char **)&p, 10);
	p++;
	j = mangle(w);
	goatsoup(d, pn, w, desc[i][(j >= 0x33) + (j >= 0x66) +
			           (j >= 0x99) + (j >= 0xcc)]);
	break;
      case '%':
	p++;
	switch (*p++) {
	  case 'H':
	    Tcl_AppendToObj(d, (char *)pn, -1);
	    break;
	  case 'I':
	    sz = strlen(pn) - 1;
	    Tcl_AppendToObj(d, (char *)pn,
			    (pn[sz] == 'i' || pn[sz] == 'e') ? sz : sz + 1);
	    Tcl_AppendToObj(d, "ian", 3);
	    break;
	  case 'R':
	    n = (mangle(w) & 0x03) + 1;
	    q = buf;
	    while (n--) {
	      unsigned i = mangle(w) & 0x3e;
	      *q++ = digrams[i++];
	      if (digrams[i] != '?')
		*q++ = digrams[i++];
	    }
	    *buf = toupper(*buf);
	    Tcl_AppendToObj(d, buf, q - buf);
	    break;
	  default:
	    abort();
	}
	break;
      default:
	abort();
    }
  }
}

static int cmd_worldinfo(ClientData cd, Tcl_Interp *ti,
			 int objc, Tcl_Obj *const *objv)
{
  world *w;
  worldinfo wi;
  char *arr;
  char buf[9];
  char *p;
  unsigned j, n;
  Tcl_Obj *o;
  world ww;

  /* --- Check arguments --- */
  
  if (objc != 3)
    return (err(ti, "usage: elite-worldinfo ARR SEED"));
  if ((w = world_get(ti, objv[2])) == 0)
    return (TCL_ERROR);
  arr = Tcl_GetString(objv[1]);

  /* --- Get the basic information --- */

  getworldinfo(&wi, w);
  if (!Tcl_SetVar2Ex(ti, arr, "x", Tcl_NewIntObj(wi.x * 4),
		     TCL_LEAVE_ERR_MSG) ||
      !Tcl_SetVar2Ex(ti, arr, "y", Tcl_NewIntObj(wi.y * 2),
		     TCL_LEAVE_ERR_MSG) ||
      !Tcl_SetVar2Ex(ti, arr, "government", Tcl_NewIntObj(wi.gov), 
		    TCL_LEAVE_ERR_MSG) ||
      !Tcl_SetVar2Ex(ti, arr, "economy", Tcl_NewIntObj(wi.eco),
		     TCL_LEAVE_ERR_MSG) ||
      !Tcl_SetVar2Ex(ti, arr, "techlevel", Tcl_NewIntObj(wi.tech), 
		    TCL_LEAVE_ERR_MSG) ||
      !Tcl_SetVar2Ex(ti, arr, "population", Tcl_NewIntObj(wi.pop), 
		    TCL_LEAVE_ERR_MSG) ||
      !Tcl_SetVar2Ex(ti, arr, "productivity", Tcl_NewIntObj(wi.prod), 
		    TCL_LEAVE_ERR_MSG) ||
      !Tcl_SetVar2Ex(ti, arr, "radius", Tcl_NewIntObj(wi.rad),
		     TCL_LEAVE_ERR_MSG) ||
      !Tcl_SetVar2Ex(ti, arr, "seed", objv[2],
		     TCL_LEAVE_ERR_MSG))
    return (TCL_ERROR);

  /* --- Work out the inhabitants --- */

  if (!(w->x[4] & 0x80)) {
    if (!Tcl_SetVar2(ti, arr, "inhabitants", "humans", TCL_LEAVE_ERR_MSG))
      return (TCL_ERROR);
  } else {
    static const char *const id_a[] = { "large", "fierce", "small" };
    static const char *const id_b[] = { "green", "red", "yellow", "blue",
					"black", "harmless" };
    static const char *const id_c[] = { "slimy", "bug-eyed", "horned",
					"bony", "fat", "furry" };
    static const char *const id_d[] = { "rodents", "frogs", "lizards",
					"lobsters", "birds", "humanoids",
					"felines", "insects" };

    o = Tcl_NewListObj(0, 0);
    j = (w->x[5] >> 2) & 0x07;
    if (j < 3)
      Tcl_ListObjAppendElement(ti, o, Tcl_NewStringObj(id_a[j], -1));
    j = (w->x[5] >> 5) & 0x07;
    if (j < 6)
      Tcl_ListObjAppendElement(ti, o, Tcl_NewStringObj(id_b[j], -1));
    j = (w->x[1] ^ w->x[3]) & 0x07;
    if (j < 6)
      Tcl_ListObjAppendElement(ti, o, Tcl_NewStringObj(id_c[j], -1));
    j += w->x[5] & 0x03;
      Tcl_ListObjAppendElement(ti, o, Tcl_NewStringObj(id_d[j & 0x07], -1));
    if (!Tcl_SetVar2Ex(ti, arr, "inhabitants", o, TCL_LEAVE_ERR_MSG))
      return (TCL_ERROR);
  }

  /* --- Work out the planet name --- */

  n = (w->x[0] & 0x40) ? 4 : 3;
  p = buf;
  ww = *w;
  while (n--) {
    j = ww.x[5] & 0x1f;
    if (j) {
      j = (j + 12) << 1;
      *p++ = digrams[j++];
      if (digrams[j] != '?')
	*p++ = digrams[j];
    }
    waggle(&ww, &ww);
  }
  *p++ = 0;
  *buf = toupper(*buf);
  if (!Tcl_SetVar2Ex(ti, arr, "name", Tcl_NewStringObj(buf, -1),
		     TCL_LEAVE_ERR_MSG))
    return (TCL_ERROR);

  /* --- Finally work out the goat-soup description --- */

  ww = *w;
  o = Tcl_NewStringObj(0, 0);
  goatsoup(o, buf, &ww, "<14> is <22>.");
  if (!Tcl_SetVar2Ex(ti, arr, "description", o, TCL_LEAVE_ERR_MSG))
    return (TCL_ERROR);
  return (TCL_OK);
}

/* --- elite-market ARR SEED [FLUC] --- */

static const struct item {
  /*const*/ char *name;
  unsigned base;
  int var;
  unsigned qty;
  unsigned mask;
} items[] = {
  { "food",		 19, -2,   6, 0x01 },
  { "textiles",		 20, -1,  10, 0x03 },
  { "radioactives",	 65, -3,   2, 0x07 },
  { "slaves",		 40, -5, 226, 0x1f },
  { "liquor-wines",	 83, -5, 251, 0x0f },
  { "luxuries",		196,  8,  54, 0x03 },
  { "narcotics",	235, 29,   8, 0x78 },
  { "computers",	154, 14,  56, 0x03 },
  { "machinery",	117,  6,  40, 0x07 },
  { "alloys",		 78,  1,  17, 0x1f },
  { "firearms",		124, 13,  29, 0x07 },
  { "furs",		176, -9, 220, 0x3f },
  { "minerals",		 32, -1,  53, 0x03 },
  { "gold",		 97, -1,  66, 0x07 },
  { "platinum",		171, -2,  55, 0x1f },
  { "gem-stones",	 45, -1, 250, 0x0f },
  { "alien-items",	 53, 15, 192, 0x07 },
  { 0,			  0,  0,   0, 0x00 }
};

static int cmd_market(ClientData cd, Tcl_Interp *ti,
		      int objc, Tcl_Obj *const *objv)
{
  int fluc = 0;
  world *w;
  worldinfo wi;
  const struct item *i;
  char *arr;

  if (objc < 3 || objc > 5)
    return (err(ti, "usage: elite-market ARR SEED [FLUC]"));
  if ((w = world_get(ti, objv[2])) == 0)
    return (TCL_ERROR);
  arr = Tcl_GetString(objv[1]);
  if (objc >= 4 && Tcl_GetIntFromObj(ti, objv[3], &fluc) != TCL_OK)
    return (TCL_ERROR);
  getworldinfo(&wi, w);

  for (i = items; i->name; i++) {
    unsigned pr, qt;
    Tcl_Obj *oo[2];
    pr = (i->base + (fluc & i->mask) + (wi.eco * i->var)) & 0xff;
    qt = (i->qty + (fluc & i->mask) - (wi.eco * i->var)) & 0xff;
    if (qt & 0x80)
      qt = 0;
    oo[0] = Tcl_NewIntObj(pr << 2);
    oo[1] = Tcl_NewIntObj(qt & 0x3f);
    if (!Tcl_SetVar2Ex(ti, arr, i->name, Tcl_NewListObj(2, oo),
		      TCL_LEAVE_ERR_MSG))
      return (TCL_ERROR);
  }
  return (TCL_OK);
}

/*----- Commander file decomposition --------------------------------------*/

static unsigned cksum(const unsigned char *p, size_t sz)
{
  unsigned a = 0x49, c = 0;

  p += sz - 1;
  while (--sz) {
    a += *--p + c;
    c = a >> 8;
    a &= 0xff;
    a ^= p[1];
  }
  fflush(stdout);
  return (a);
}

/* --- The big translation table --- */

struct cmddata {
  /*const*/ char *name;
  unsigned off;
  int (*get)(Tcl_Interp *, /*const*/ char *,
	     const unsigned char *, const struct cmddata *);
  int (*put)(Tcl_Interp *, /*const*/ char *,
	     unsigned char *, const struct cmddata *);
  int x;
};

static int get_byte(Tcl_Interp *ti, /*const*/ char *arr,
		    const unsigned char *p, const struct cmddata *cd)
{
  return (!Tcl_SetVar2Ex(ti, arr, cd->name,
			 Tcl_NewIntObj(*p - cd->x), TCL_LEAVE_ERR_MSG));
}

static int get_seed(Tcl_Interp *ti, /*const*/ char *arr,
		    const unsigned char *p, const struct cmddata *cd)
{
  world w;

  memcpy(w.x, p, 6);
  return (!Tcl_SetVar2Ex(ti, arr, cd->name,
			 world_new(&w), TCL_LEAVE_ERR_MSG));
}

static int get_word(Tcl_Interp *ti, /*const*/ char *arr,
		    const unsigned char *p, const struct cmddata *cd)
{
  return (!Tcl_SetVar2Ex(ti, arr, cd->name,
			 Tcl_NewLongObj((p[0] & 0xff) << 24 |
					(p[1] & 0xff) << 16 |
					(p[2] & 0xff) <<  8 |
					(p[3] & 0xff) <<  0),
			 TCL_LEAVE_ERR_MSG));
}

static int get_hword(Tcl_Interp *ti, /*const*/ char *arr,
		     const unsigned char *p, const struct cmddata *cd)
{
  return (!Tcl_SetVar2Ex(ti, arr, cd->name,
			 Tcl_NewLongObj((p[0] & 0xff) << 0 |
					(p[1] & 0xff) << 8),
			 TCL_LEAVE_ERR_MSG));
}

static int get_bool(Tcl_Interp *ti, /*const*/ char *arr,
		    const unsigned char *p, const struct cmddata *cd)
{
  return (!Tcl_SetVar2Ex(ti, arr, cd->name,
			 Tcl_NewBooleanObj(*p), TCL_LEAVE_ERR_MSG));
}

static int get_items(Tcl_Interp *ti, /*const*/ char *arr,
		     const unsigned char *p, const struct cmddata *cd)
{
  char buf[32];
  const struct item *i;

  for (i = items; i->name; i++) {
    sprintf(buf, "%s-%s", cd->name, i->name);
    if (!Tcl_SetVar2Ex(ti, arr, buf,
		       Tcl_NewIntObj(*p++), TCL_LEAVE_ERR_MSG))
      return (-1);
  }
  return (0);
}

static int put_byte(Tcl_Interp *ti, /*const*/ char *arr,
		    unsigned char *p, const struct cmddata *cd)
{
  Tcl_Obj *o;
  int i;

  if ((o = Tcl_GetVar2Ex(ti, arr, cd->name, TCL_LEAVE_ERR_MSG)) == 0 ||
      Tcl_GetIntFromObj(ti, o, &i) != TCL_OK)
    return (-1);
  *p = i + cd->x;
  return (0);
}

static int put_word(Tcl_Interp *ti, /*const*/ char *arr,
		    unsigned char *p, const struct cmddata *cd)
{
  Tcl_Obj *o;
  long l;

  if ((o = Tcl_GetVar2Ex(ti, arr, cd->name, TCL_LEAVE_ERR_MSG)) == 0 ||
      Tcl_GetLongFromObj(ti, o, &l) != TCL_OK)
    return (-1);
  p[0] = (l >> 24) & 0xff;
  p[1] = (l >> 16) & 0xff;
  p[2] = (l >>  8) & 0xff;
  p[3] = (l >>  0) & 0xff;
  return (0);
}

static int put_hword(Tcl_Interp *ti, /*const*/ char *arr,
		     unsigned char *p, const struct cmddata *cd)
{
  Tcl_Obj *o;
  long l;

  if ((o = Tcl_GetVar2Ex(ti, arr, cd->name, TCL_LEAVE_ERR_MSG)) == 0 ||
      Tcl_GetLongFromObj(ti, o, &l) != TCL_OK)
    return (-1);
  p[0] = (l >> 0) & 0xff;
  p[1] = (l >> 8) & 0xff;
  return (0);
}

static int put_const(Tcl_Interp *ti, /*const*/ char *arr,
		     unsigned char *p, const struct cmddata *cd)
{
  *p = cd->x;
  return (0);
}

static int put_seed(Tcl_Interp *ti, /*const*/ char *arr,
		    unsigned char *p, const struct cmddata *cd)
{
  Tcl_Obj *o;
  world *w;

  if ((o = Tcl_GetVar2Ex(ti, arr, cd->name, TCL_LEAVE_ERR_MSG)) == 0 ||
      (w = world_get(ti, o)) == 0)
    return (-1);
  memcpy(p, w->x, 6);
  return (0);
}

static int put_bool(Tcl_Interp *ti, /*const*/ char *arr,
		    unsigned char *p, const struct cmddata *cd)
{
  Tcl_Obj *o;
  int b;

  if ((o = Tcl_GetVar2Ex(ti, arr, cd->name, TCL_LEAVE_ERR_MSG)) == 0 ||
      Tcl_GetBooleanFromObj(ti, o, &b) != TCL_OK)
    return (-1);
  *p = b ? cd->x : 0;
  return (0);
}

static int put_items(Tcl_Interp *ti, /*const*/ char *arr,
		     unsigned char *p, const struct cmddata *cd)
{
  char buf[32];
  int ii;
  Tcl_Obj *o;
  const struct item *i;

  for (i = items; i->name; i++) {
    sprintf(buf, "%s-%s", cd->name, i->name);
    if ((o = Tcl_GetVar2Ex(ti, arr, buf, TCL_LEAVE_ERR_MSG)) == 0 ||
	Tcl_GetIntFromObj(ti, o, &ii) != TCL_OK)
      return (-1);
    *p++ = ii;
  }
  return (0);  
}

static struct cmddata cmdtab[] = {
  { "mission",		 0,	get_byte,	put_byte,	  0 },
  { "world-x",		 1,	get_byte,	put_byte,	  0 },
  { "world-y",		 2,	get_byte,	put_byte,	  0 },
  { "gal-seed",		 3,	get_seed,	put_seed,	  0 },
  { "credits",		 9,	get_word,	put_word,	  0 },
  { "fuel",		13,	get_byte,	put_byte,	  0 },
  { "",			14,	0,		put_const,	  4 },
  { "gal-number",	15,	get_byte,	put_byte,	 -1 },
  { "front-laser",	16,	get_byte,	put_byte,	  0 },
  { "rear-laser",	17,	get_byte,	put_byte,	  0 },
  { "left-laser",	18,	get_byte,	put_byte,	  0 },
  { "right-laser",	19,	get_byte,	put_byte,	  0 },
  { "cargo",		22,	get_byte,	put_byte,	  2 },
  { "hold",		23,	get_items,	put_items,	  0 },
  { "ecm",		40,	get_bool,	put_bool,	255 },
  { "fuel-scoop",	41,	get_bool,	put_bool,	255 },
  { "energy-bomb",	42,	get_bool,	put_bool,	127 },
  { "energy-unit",	43,	get_byte,	put_byte,	  0 },
  { "docking-computer",	44,	get_bool,	put_bool,	255 },
  { "gal-hyperdrive",	45,	get_bool,	put_bool,	255 },
  { "escape-pod",	46,	get_bool,	put_bool,	255 },
  { "missiles",		51,	get_byte,	put_byte,	  0 },
  { "legal-status",	52,	get_byte,	put_byte,	  0 },
  { "station",		53,	get_items,	put_items,	  0 },
  { "market-fluc",	70,	get_byte,	put_byte,	  0 },
  { "score",		71,	get_hword,	put_hword,	  0 },
  { "",			74,	0,		put_const,	 32 },
  { 0,			 0,	0,		0,		  0 }
};

/* --- elite-unpackcmdr [-force] ARR DATA --- */

static int cmd_unpackcmdr(ClientData cd, Tcl_Interp *ti,
			  int objc, Tcl_Obj *const *objv)
{
  char *arr;
  unsigned char *p, *q;
  int sz;
  unsigned f = 0;
  unsigned ck;
  const struct cmddata *c;

#define f_force 1u

  /* --- Read the arguments --- */

  objc--; objv++;
  while (objc) {
    char *opt = Tcl_GetString(*objv);
    if (strcmp(opt, "-force") == 0)
      f |= f_force;
    else if (strcmp(opt, "--") == 0) {
      objc--;
      objv++;
      break;
    } else
      break;
    objc--;
    objv++;
  }
  if (objc != 2)
    return (err(ti, "usage: elite-unpackcmdr [-force] ARR DATA"));
  arr = Tcl_GetString(objv[0]);
  p = Tcl_GetByteArrayFromObj(objv[1], &sz);

  /* --- Check the data for correctness --- */

  if (sz < 74)
    return (err(ti, "bad commander data (bad length)"));
  ck = cksum(p, 74);
  if (!(f & f_force)) {
    if (sz < 76 || p[74] != (ck ^ 0xa9) || p[75] != ck)
      return (err(ti, "bad commander data (bad checksum)"));
    for (q = p + 77; q < p + sz; q++)
      if (*q)
	return (err(ti, "bad commander data (bad data at end)"));
  }

  /* --- Deconstruct the data --- */

  for (c = cmdtab; c->name; c++) {
    if (c->get && c->get(ti, arr, p + c->off, c))
      return (TCL_ERROR);
  }
  return (0);
}

/* --- elite-packcmdr ARR --- */

static int cmd_packcmdr(ClientData cd, Tcl_Interp *ti,
		       int objc, Tcl_Obj *const *objv)
{
  char *arr;
  unsigned char p[256];
  unsigned ck;
  const struct cmddata *c;

  if (objc != 2)
    return (err(ti, "usage: elite-packcmdr ARR"));
  arr = Tcl_GetString(objv[1]);

  memset(p, 0, sizeof(p));
  for (c = cmdtab; c->name; c++) {
    if (c->put && c->put(ti, arr, p + c->off, c))
      return (TCL_ERROR);
  }

  ck = cksum(p, 74);
  p[74] = ck ^ 0xa9;
  p[75] = ck;
  Tcl_SetObjResult(ti, Tcl_NewByteArrayObj(p, sizeof(p)));
  return (0);
}

/*----- Initialization ----------------------------------------------------*/

int Elite_SafeInit(Tcl_Interp *ti)
{
  static const struct cmd {
    /*const*/ char *name;
    Tcl_ObjCmdProc *proc;
  } cmds[] = {
    { "elite-nextworld",	cmd_nextworld },
    { "elite-nextgalaxy",	cmd_nextgalaxy },
    { "elite-worldinfo", 	cmd_worldinfo },
    { "elite-market",		cmd_market },
    { "elite-unpackcmdr",	cmd_unpackcmdr },
    { "elite-packcmdr",		cmd_packcmdr },
    { 0,			0 }
  };

  const struct cmd *c;
  for (c = cmds; c->name; c++)
    Tcl_CreateObjCommand(ti, c->name, c->proc, 0, 0);
  Tcl_RegisterObjType(&world_type);
  if (Tcl_PkgProvide(ti, "elite-bits", "1.0.0"))
    return (TCL_ERROR);
  return (TCL_OK);
}

int Elite_Init(Tcl_Interp *ti)
{
  return (Elite_SafeInit(ti));
}

/*----- That's all, folks -------------------------------------------------*/