+/* -*-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 -------------------------------------------------*/