chiark - git - mdw - rocl/blob - elite.c

   1 /* -*-c-*-
   2  *
   3  * $Id: elite.c,v 1.1 2003/02/24 01:13:12 mdw Exp $
   4  *
   5  * Elite planet data
   6  *
   7  * (c) 2003 Mark Wooding
   8  */
   9
  10 /*----- Licensing notice --------------------------------------------------*
  11  *
  12  * This program is free software; you can redistribute it and/or modify
  13  * it under the terms of the GNU General Public License as published by
  14  * the Free Software Foundation; either version 2 of the License, or
  15  * (at your option) any later version.
  16  *
  17  * This program is distributed in the hope that it will be useful,
  18  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  19  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20  * GNU General Public License for more details.
  21  *
  22  * You should have received a copy of the GNU General Public License
  23  * along with this program; if not, write to the Free Software Foundation,
  24  * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  25  */
  26
  27 /*----- Revision history --------------------------------------------------*
  28  *
  29  * $Log: elite.c,v $
  30  * Revision 1.1  2003/02/24 01:13:12  mdw
  31  * Initial import.
  32  *
  33  */
  34
  35 /*----- Header files ------------------------------------------------------*/
  36
  37 #include <ctype.h>
  38 #include <stdio.h>
  39 #include <stdlib.h>
  40 #include <string.h>
  41
  42 #include <tcl.h>
  43
  44 /*----- Data structures ---------------------------------------------------*/
  45
  46 typedef struct world {
  47   unsigned char x[6];
  48 } world;
  49
  50 typedef struct worldinfo {
  51   unsigned x, y, gov, eco, tech, pop, prod, rad;
  52 } worldinfo;
  53
  54 /*----- The world type ----------------------------------------------------*/
  55
  56 static void world_fir(Tcl_Obj *o)
  57 {
  58   Tcl_Free(o->internalRep.otherValuePtr);
  59 }
  60
  61 static int xtoi(unsigned x)
  62 {
  63   if (x >= '0' && x <= '9')
  64     return (x - '0');
  65   else if (x >= 'a' && x <= 'f')
  66     return (x - 'a' + 10);
  67   else if (x >= 'A' && x <= 'F')
  68     return (x - 'A' + 10);
  69   else
  70     abort();
  71 }
  72
  73 static Tcl_ObjType world_type;
  74
  75 static int world_sfa(Tcl_Interp *ti, Tcl_Obj *o)
  76 {
  77   int l;
  78   world ww, *w;
  79   int i;
  80   char *p = Tcl_GetStringFromObj(o, &l);
  81   if (l != 12)
  82     goto bad;
  83   for (i = 0; i < 12; i += 2) {
  84     if (!isxdigit((unsigned char)p[i]) ||
  85         !isxdigit((unsigned char)p[i + 1]))
  86       goto bad;
  87     ww.x[i >> 1] = (xtoi(p[i]) << 4) | (xtoi(p[i + 1]));
  88   }
  89   w = (world *)Tcl_Alloc(sizeof(*w));
  90   *w = ww;
  91   o->internalRep.otherValuePtr = w;
  92   o->typePtr = &world_type;
  93   return (TCL_OK);
  94
  95 bad:
  96   if (ti)
  97     Tcl_SetResult(ti, "bad world seed string", TCL_STATIC);
  98   return (TCL_ERROR);
  99 }
 100
 101 static void world_us(Tcl_Obj *o)
 102 {
 103   char *p;
 104   world *w = o->internalRep.otherValuePtr;
 105   int i;
 106
 107   p = Tcl_Alloc(13);
 108   p[12] = 0;
 109   o->bytes = p;
 110   o->length = 12;
 111   for (i = 0; i < 6; i++, p += 2)
 112     sprintf(p, "%02x", w->x[i]);
 113 }
 114
 115 static void world_dir(Tcl_Obj *o, Tcl_Obj *oo)
 116 {
 117   world *w = (world *)Tcl_Alloc(sizeof(*w));
 118   memcpy(w, o->internalRep.otherValuePtr, sizeof(world));
 119   oo->internalRep.otherValuePtr = w;
 120   oo->typePtr = &world_type;
 121   Tcl_InvalidateStringRep(oo);
 122 }
 123
 124 static /*const*/ Tcl_ObjType world_type = {
 125   "elite-world", world_fir, world_dir, world_us, world_sfa
 126 };
 127
 128 static world *world_get(Tcl_Interp *ti, Tcl_Obj *o)
 129 {
 130   if (Tcl_ConvertToType(ti, o, &world_type) != TCL_OK)
 131     return (0);
 132   return (o->internalRep.otherValuePtr);
 133 }
 134
 135 static Tcl_Obj *world_new(const world *w)
 136 {
 137   world *ww;
 138   Tcl_Obj *o = Tcl_NewObj();
 139   ww = (world *)Tcl_Alloc(sizeof(*ww));
 140   *ww = *w;
 141   o->internalRep.otherValuePtr = ww;
 142   o->typePtr = &world_type;
 143   Tcl_InvalidateStringRep(o);
 144   return (o);
 145 }
 146
 147 /*----- Elite-specific hacking --------------------------------------------*
 148  *
 149  * Taken from `Elite: The New Kind' by Christian Pinder.
 150  */
 151
 152 static void waggle(world *w, world *ww)
 153 {
 154   unsigned int h, l;
 155
 156   /* --- What goes on --- *
 157    *
 158    * 16-bit add of all three words, shift up, and insert the new value at the
 159    * end.
 160    */
 161
 162   l = w->x[0];
 163   h = w->x[1];
 164   l += w->x[2];
 165   h += w->x[3] + (l >= 0x100);
 166   l &= 0xff; h &= 0xff;
 167   l += w->x[4];
 168   h += w->x[5] + (l >= 0x100);
 169   l &= 0xff; h &= 0xff;
 170   ww->x[0] = w->x[2]; ww->x[1] = w->x[3];
 171   ww->x[2] = w->x[4]; ww->x[3] = w->x[5];
 172   ww->x[4] = l; ww->x[5] = h;
 173 }
 174
 175 /*----- Tcl commands ------------------------------------------------------*/
 176
 177 static int err(Tcl_Interp *ti, /*const*/ char *p)
 178 {
 179   Tcl_SetResult(ti, p, TCL_STATIC);
 180   return (TCL_ERROR);
 181 }
 182
 183 /* --- elite-nextworld SEED --- */
 184
 185 static int cmd_nextworld(ClientData cd, Tcl_Interp *ti,
 186                          int objc, Tcl_Obj *const *objv)
 187 {
 188   world *w, ww;
 189   if (objc != 2)
 190     return (err(ti, "usage: elite-nextworld SEED"));
 191   if ((w = world_get(ti, objv[1])) == 0)
 192     return (TCL_ERROR);
 193   waggle(w, &ww);
 194   waggle(&ww, &ww);
 195   waggle(&ww, &ww);
 196   waggle(&ww, &ww);
 197   Tcl_SetObjResult(ti, world_new(&ww));
 198   return (TCL_OK);
 199 }
 200
 201 /* --- elite-nextgalaxy SEED --- */
 202
 203 static int cmd_nextgalaxy(ClientData cd, Tcl_Interp *ti,
 204                           int objc, Tcl_Obj *const *objv)
 205 {
 206   world *w, ww;
 207   int i;
 208
 209   if (objc != 2)
 210     return (err(ti, "usage: elite-nextgalaxy SEED"));
 211   if ((w = world_get(ti, objv[1])) == 0)
 212     return (TCL_ERROR);
 213   for (i = 0; i < 6; i++)
 214     ww.x[i] = ((w->x[i] << 1) | (w->x[i] >> 7)) & 0xff;
 215   Tcl_SetObjResult(ti, world_new(&ww));
 216   return (TCL_OK);
 217 }
 218
 219 /* --- elite-worldinfo ARR SEED --- */
 220
 221 static void getworldinfo(worldinfo *wi, world *w)
 222 {
 223   wi->x = w->x[3];
 224   wi->y = w->x[1];
 225   wi->gov = (w->x[2] >> 3) & 0x07;
 226   wi->eco = w->x[1] & 0x07;
 227   if (wi->gov < 2)
 228     wi->eco |= 0x02;
 229   wi->tech = ((wi->eco ^ 7) + (w->x[3] & 0x03) +
 230               (wi->gov >> 1) + (wi->gov & 0x01) + 1);
 231   wi->pop = wi->tech * 4 + wi->gov + wi->eco - 3;
 232   wi->prod = ((wi->eco ^ 7) + 3) * (wi->gov + 4) * wi->pop * 8;
 233   wi->rad = (((w->x[5] & 0x0f) + 11) << 8) + w->x[3];
 234 }
 235
 236 static const char digrams[] =
 237   "abouseitiletstonlonuthnoallexegezacebisouses"
 238   "armaindirea?eratenberalavetiedorquanteisrion";
 239
 240 static const char *const desc[][5] = {
 241 /*  0 */ { "fabled", "notable", "well known", "famous", "noted" },
 242 /*  1 */ { "very ", "mildly ", "most ", "reasonably ", "" },
 243 /*  2 */ { "ancient", "<20>", "great", "vast", "pink" },
 244 /*  3 */ { "<29> <28> plantations", "mountains", "<27>",
 245            "<19> forests", "oceans" },
 246 /*  4 */ { "shyness", "silliness", "mating traditions",
 247            "loathing of <5>", "love for <5>" },
 248 /*  5 */ { "food blenders", "tourists", "poetry", "discos", "<13>" },
 249 /*  6 */ { "talking tree", "crab", "bat", "lobst", "%R" },
 250 /*  7 */ { "beset", "plagued", "ravaged", "cursed", "scourged" },
 251 /*  8 */ { "<21> civil war", "<26> <23> <24>s",
 252            "a <26> disease", "<21> earthquakes", "<21> solar activity" },
 253 /*  9 */ { "its <2> <3>", "the %I <23> <24>",
 254            "its inhabitants' <25> <4>", "<32>", "its <12> <13>" },
 255 /* 10 */ { "juice", "brandy", "water", "brew", "gargle blasters" },
 256 /* 11 */ { "%R", "%I <24>", "%I %R", "%I <26>", "<26> %R" },
 257 /* 12 */ { "fabulous", "exotic", "hoopy", "unusual", "exciting" },
 258 /* 13 */ { "cuisine", "night life", "casinos", "sit coms", " <32>" },
 259 /* 14 */ { "%H", "The planet %H", "The world %H",
 260            "This planet", "This world" },
 261 /* 15 */ { "n unremarkable", " boring", " dull", " tedious", " revolting" },
 262 /* 16 */ { "planet", "world", "place", "little planet", "dump" },
 263 /* 17 */ { "wasp", "moth", "grub", "ant", "%R" },
 264 /* 18 */ { "poet", "arts graduate", "yak", "snail", "slug" },
 265 /* 19 */ { "tropical", "dense", "rain", "impenetrable", "exuberant" },
 266 /* 20 */ { "funny", "weird", "unusual", "strange", "peculiar" },
 267 /* 21 */ { "frequent", "occasional", "unpredictable", "dreadful", "deadly" },
 268 /* 22 */ { "<1><0> for <9>", "<1><0> for <9> and <9>",
 269            "<7> by <8>", "<1><0> for <9> but <7> by <8>","a<15> <16>" },
 270 /* 23 */ { "<26>", "mountain", "edible", "tree", "spotted" },
 271 /* 24 */ { "<30>", "<31>", "<6>oid", "<18>", "<17>" },
 272 /* 25 */ { "ancient", "exceptional", "eccentric", "ingrained", "<20>" },
 273 /* 26 */ { "killer", "deadly", "evil", "lethal", "vicious" },
 274 /* 27 */ { "parking meters", "dust clouds", "ice bergs",
 275            "rock formations", "volcanoes" },
 276 /* 28 */ { "plant", "tulip", "banana", "corn", "%Rweed" },
 277 /* 29 */ { "%R", "%I %R", "%I <26>", "inhabitant", "%I %R" },
 278 /* 30 */ { "shrew", "beast", "bison", "snake", "wolf" },
 279 /* 31 */ { "leopard", "cat", "monkey", "goat", "fish" },
 280 /* 32 */ { "<11> <10>", "%I <30> <33>", "its <12> <31> <33>",
 281            "<34> <35>", "<11> <10>" },
 282 /* 33 */ { "meat", "cutlet", "steak", "burgers", "soup" },
 283 /* 34 */ { "ice", "mud", "Zero-G", "vacuum", "%I ultra" },
 284 /* 35 */ { "hockey", "cricket", "karate", "polo", "tennis" }
 285 };
 286
 287 static int mangle(world *w)
 288 {
 289   unsigned a, x;
 290
 291   x = (w->x[2] << 1) & 0xff;
 292   a = x + w->x[4];
 293   if (w->x[2] & 0x80)
 294     a++;
 295   w->x[2] = a & 0xff;
 296   w->x[4] = x;
 297   a >>= 8;
 298   x = w->x[3];
 299   a = (a + x + w->x[5]) & 0xff;
 300   w->x[3] = a;
 301   w->x[5] = x;
 302   return (a);
 303 }
 304
 305 static void goatsoup(Tcl_Obj *d, const char *pn, world *w, const char *p)
 306 {
 307   for (;;) {
 308     size_t sz = strcspn(p, "<%");
 309     unsigned n;
 310     char buf[12];
 311     char *q;
 312
 313     Tcl_AppendToObj(d, (char *)p, sz);
 314     p += sz;
 315     switch (*p) {
 316       unsigned i, j;
 317       case 0:
 318         return;
 319       case '<':
 320         i = strtoul(p + 1, (char **)&p, 10);
 321         p++;
 322         j = mangle(w);
 323         goatsoup(d, pn, w, desc[i][(j >= 0x33) + (j >= 0x66) +
 324                                    (j >= 0x99) + (j >= 0xcc)]);
 325         break;
 326       case '%':
 327         p++;
 328         switch (*p++) {
 329           case 'H':
 330             Tcl_AppendToObj(d, (char *)pn, -1);
 331             break;
 332           case 'I':
 333             sz = strlen(pn) - 1;
 334             Tcl_AppendToObj(d, (char *)pn,
 335                             (pn[sz] == 'i' || pn[sz] == 'e') ? sz : sz + 1);
 336             Tcl_AppendToObj(d, "ian", 3);
 337             break;
 338           case 'R':
 339             n = (mangle(w) & 0x03) + 1;
 340             q = buf;
 341             while (n--) {
 342               unsigned i = mangle(w) & 0x3e;
 343               *q++ = digrams[i++];
 344               if (digrams[i] != '?')
 345                 *q++ = digrams[i++];
 346             }
 347             *buf = toupper(*buf);
 348             Tcl_AppendToObj(d, buf, q - buf);
 349             break;
 350           default:
 351             abort();
 352         }
 353         break;
 354       default:
 355         abort();
 356     }
 357   }
 358 }
 359
 360 static int cmd_worldinfo(ClientData cd, Tcl_Interp *ti,
 361                          int objc, Tcl_Obj *const *objv)
 362 {
 363   world *w;
 364   worldinfo wi;
 365   char *arr;
 366   char buf[9];
 367   char *p;
 368   unsigned j, n;
 369   Tcl_Obj *o;
 370   world ww;
 371
 372   /* --- Check arguments --- */
 373
 374   if (objc != 3)
 375     return (err(ti, "usage: elite-worldinfo ARR SEED"));
 376   if ((w = world_get(ti, objv[2])) == 0)
 377     return (TCL_ERROR);
 378   arr = Tcl_GetString(objv[1]);
 379
 380   /* --- Get the basic information --- */
 381
 382   getworldinfo(&wi, w);
 383   if (!Tcl_SetVar2Ex(ti, arr, "x", Tcl_NewIntObj(wi.x * 4),
 384                      TCL_LEAVE_ERR_MSG) ||
 385       !Tcl_SetVar2Ex(ti, arr, "y", Tcl_NewIntObj(wi.y * 2),
 386                      TCL_LEAVE_ERR_MSG) ||
 387       !Tcl_SetVar2Ex(ti, arr, "government", Tcl_NewIntObj(wi.gov),
 388                     TCL_LEAVE_ERR_MSG) ||
 389       !Tcl_SetVar2Ex(ti, arr, "economy", Tcl_NewIntObj(wi.eco),
 390                      TCL_LEAVE_ERR_MSG) ||
 391       !Tcl_SetVar2Ex(ti, arr, "techlevel", Tcl_NewIntObj(wi.tech),
 392                     TCL_LEAVE_ERR_MSG) ||
 393       !Tcl_SetVar2Ex(ti, arr, "population", Tcl_NewIntObj(wi.pop),
 394                     TCL_LEAVE_ERR_MSG) ||
 395       !Tcl_SetVar2Ex(ti, arr, "productivity", Tcl_NewIntObj(wi.prod),
 396                     TCL_LEAVE_ERR_MSG) ||
 397       !Tcl_SetVar2Ex(ti, arr, "radius", Tcl_NewIntObj(wi.rad),
 398                      TCL_LEAVE_ERR_MSG) ||
 399       !Tcl_SetVar2Ex(ti, arr, "seed", objv[2],
 400                      TCL_LEAVE_ERR_MSG))
 401     return (TCL_ERROR);
 402
 403   /* --- Work out the inhabitants --- */
 404
 405   if (!(w->x[4] & 0x80)) {
 406     if (!Tcl_SetVar2(ti, arr, "inhabitants", "humans", TCL_LEAVE_ERR_MSG))
 407       return (TCL_ERROR);
 408   } else {
 409     static const char *const id_a[] = { "large", "fierce", "small" };
 410     static const char *const id_b[] = { "green", "red", "yellow", "blue",
 411                                         "black", "harmless" };
 412     static const char *const id_c[] = { "slimy", "bug-eyed", "horned",
 413                                         "bony", "fat", "furry" };
 414     static const char *const id_d[] = { "rodents", "frogs", "lizards",
 415                                         "lobsters", "birds", "humanoids",
 416                                         "felines", "insects" };
 417
 418     o = Tcl_NewListObj(0, 0);
 419     j = (w->x[5] >> 2) & 0x07;
 420     if (j < 3)
 421       Tcl_ListObjAppendElement(ti, o, Tcl_NewStringObj(id_a[j], -1));
 422     j = (w->x[5] >> 5) & 0x07;
 423     if (j < 6)
 424       Tcl_ListObjAppendElement(ti, o, Tcl_NewStringObj(id_b[j], -1));
 425     j = (w->x[1] ^ w->x[3]) & 0x07;
 426     if (j < 6)
 427       Tcl_ListObjAppendElement(ti, o, Tcl_NewStringObj(id_c[j], -1));
 428     j += w->x[5] & 0x03;
 429       Tcl_ListObjAppendElement(ti, o, Tcl_NewStringObj(id_d[j & 0x07], -1));
 430     if (!Tcl_SetVar2Ex(ti, arr, "inhabitants", o, TCL_LEAVE_ERR_MSG))
 431       return (TCL_ERROR);
 432   }
 433
 434   /* --- Work out the planet name --- */
 435
 436   n = (w->x[0] & 0x40) ? 4 : 3;
 437   p = buf;
 438   ww = *w;
 439   while (n--) {
 440     j = ww.x[5] & 0x1f;
 441     if (j) {
 442       j = (j + 12) << 1;
 443       *p++ = digrams[j++];
 444       if (digrams[j] != '?')
 445         *p++ = digrams[j];
 446     }
 447     waggle(&ww, &ww);
 448   }
 449   *p++ = 0;
 450   *buf = toupper(*buf);
 451   if (!Tcl_SetVar2Ex(ti, arr, "name", Tcl_NewStringObj(buf, -1),
 452                      TCL_LEAVE_ERR_MSG))
 453     return (TCL_ERROR);
 454
 455   /* --- Finally work out the goat-soup description --- */
 456
 457   ww = *w;
 458   o = Tcl_NewStringObj(0, 0);
 459   goatsoup(o, buf, &ww, "<14> is <22>.");
 460   if (!Tcl_SetVar2Ex(ti, arr, "description", o, TCL_LEAVE_ERR_MSG))
 461     return (TCL_ERROR);
 462   return (TCL_OK);
 463 }
 464
 465 /* --- elite-market ARR SEED [FLUC] --- */
 466
 467 static const struct item {
 468   /*const*/ char *name;
 469   unsigned base;
 470   int var;
 471   unsigned qty;
 472   unsigned mask;
 473 } items[] = {
 474   { "food",              19, -2,   6, 0x01 },
 475   { "textiles",          20, -1,  10, 0x03 },
 476   { "radioactives",      65, -3,   2, 0x07 },
 477   { "slaves",            40, -5, 226, 0x1f },
 478   { "liquor-wines",      83, -5, 251, 0x0f },
 479   { "luxuries",         196,  8,  54, 0x03 },
 480   { "narcotics",        235, 29,   8, 0x78 },
 481   { "computers",        154, 14,  56, 0x03 },
 482   { "machinery",        117,  6,  40, 0x07 },
 483   { "alloys",            78,  1,  17, 0x1f },
 484   { "firearms",         124, 13,  29, 0x07 },
 485   { "furs",             176, -9, 220, 0x3f },
 486   { "minerals",          32, -1,  53, 0x03 },
 487   { "gold",              97, -1,  66, 0x07 },
 488   { "platinum",         171, -2,  55, 0x1f },
 489   { "gem-stones",        45, -1, 250, 0x0f },
 490   { "alien-items",       53, 15, 192, 0x07 },
 491   { 0,                    0,  0,   0, 0x00 }
 492 };
 493
 494 static int cmd_market(ClientData cd, Tcl_Interp *ti,
 495                       int objc, Tcl_Obj *const *objv)
 496 {
 497   int fluc = 0;
 498   world *w;
 499   worldinfo wi;
 500   const struct item *i;
 501   char *arr;
 502
 503   if (objc < 3 || objc > 5)
 504     return (err(ti, "usage: elite-market ARR SEED [FLUC]"));
 505   if ((w = world_get(ti, objv[2])) == 0)
 506     return (TCL_ERROR);
 507   arr = Tcl_GetString(objv[1]);
 508   if (objc >= 4 && Tcl_GetIntFromObj(ti, objv[3], &fluc) != TCL_OK)
 509     return (TCL_ERROR);
 510   getworldinfo(&wi, w);
 511
 512   for (i = items; i->name; i++) {
 513     unsigned pr, qt;
 514     Tcl_Obj *oo[2];
 515     pr = (i->base + (fluc & i->mask) + (wi.eco * i->var)) & 0xff;
 516     qt = (i->qty + (fluc & i->mask) - (wi.eco * i->var)) & 0xff;
 517     if (qt & 0x80)
 518       qt = 0;
 519     oo[0] = Tcl_NewIntObj(pr << 2);
 520     oo[1] = Tcl_NewIntObj(qt & 0x3f);
 521     if (!Tcl_SetVar2Ex(ti, arr, i->name, Tcl_NewListObj(2, oo),
 522                       TCL_LEAVE_ERR_MSG))
 523       return (TCL_ERROR);
 524   }
 525   return (TCL_OK);
 526 }
 527
 528 /*----- Commander file decomposition --------------------------------------*/
 529
 530 static unsigned cksum(const unsigned char *p, size_t sz)
 531 {
 532   unsigned a = 0x49, c = 0;
 533
 534   p += sz - 1;
 535   while (--sz) {
 536     a += *--p + c;
 537     c = a >> 8;
 538     a &= 0xff;
 539     a ^= p[1];
 540   }
 541   fflush(stdout);
 542   return (a);
 543 }
 544
 545 /* --- The big translation table --- */
 546
 547 struct cmddata {
 548   /*const*/ char *name;
 549   unsigned off;
 550   int (*get)(Tcl_Interp *, /*const*/ char *,
 551              const unsigned char *, const struct cmddata *);
 552   int (*put)(Tcl_Interp *, /*const*/ char *,
 553              unsigned char *, const struct cmddata *);
 554   int x;
 555 };
 556
 557 static int get_byte(Tcl_Interp *ti, /*const*/ char *arr,
 558                     const unsigned char *p, const struct cmddata *cd)
 559 {
 560   return (!Tcl_SetVar2Ex(ti, arr, cd->name,
 561                          Tcl_NewIntObj(*p - cd->x), TCL_LEAVE_ERR_MSG));
 562 }
 563
 564 static int get_seed(Tcl_Interp *ti, /*const*/ char *arr,
 565                     const unsigned char *p, const struct cmddata *cd)
 566 {
 567   world w;
 568
 569   memcpy(w.x, p, 6);
 570   return (!Tcl_SetVar2Ex(ti, arr, cd->name,
 571                          world_new(&w), TCL_LEAVE_ERR_MSG));
 572 }
 573
 574 static int get_word(Tcl_Interp *ti, /*const*/ char *arr,
 575                     const unsigned char *p, const struct cmddata *cd)
 576 {
 577   return (!Tcl_SetVar2Ex(ti, arr, cd->name,
 578                          Tcl_NewLongObj((p[0] & 0xff) << 24 |
 579                                         (p[1] & 0xff) << 16 |
 580                                         (p[2] & 0xff) <<  8 |
 581                                         (p[3] & 0xff) <<  0),
 582                          TCL_LEAVE_ERR_MSG));
 583 }
 584
 585 static int get_hword(Tcl_Interp *ti, /*const*/ char *arr,
 586                      const unsigned char *p, const struct cmddata *cd)
 587 {
 588   return (!Tcl_SetVar2Ex(ti, arr, cd->name,
 589                          Tcl_NewLongObj((p[0] & 0xff) << 0 |
 590                                         (p[1] & 0xff) << 8),
 591                          TCL_LEAVE_ERR_MSG));
 592 }
 593
 594 static int get_bool(Tcl_Interp *ti, /*const*/ char *arr,
 595                     const unsigned char *p, const struct cmddata *cd)
 596 {
 597   return (!Tcl_SetVar2Ex(ti, arr, cd->name,
 598                          Tcl_NewBooleanObj(*p), TCL_LEAVE_ERR_MSG));
 599 }
 600
 601 static int get_items(Tcl_Interp *ti, /*const*/ char *arr,
 602                      const unsigned char *p, const struct cmddata *cd)
 603 {
 604   char buf[32];
 605   const struct item *i;
 606
 607   for (i = items; i->name; i++) {
 608     sprintf(buf, "%s-%s", cd->name, i->name);
 609     if (!Tcl_SetVar2Ex(ti, arr, buf,
 610                        Tcl_NewIntObj(*p++), TCL_LEAVE_ERR_MSG))
 611       return (-1);
 612   }
 613   return (0);
 614 }
 615
 616 static int put_byte(Tcl_Interp *ti, /*const*/ char *arr,
 617                     unsigned char *p, const struct cmddata *cd)
 618 {
 619   Tcl_Obj *o;
 620   int i;
 621
 622   if ((o = Tcl_GetVar2Ex(ti, arr, cd->name, TCL_LEAVE_ERR_MSG)) == 0 ||
 623       Tcl_GetIntFromObj(ti, o, &i) != TCL_OK)
 624     return (-1);
 625   *p = i + cd->x;
 626   return (0);
 627 }
 628
 629 static int put_word(Tcl_Interp *ti, /*const*/ char *arr,
 630                     unsigned char *p, const struct cmddata *cd)
 631 {
 632   Tcl_Obj *o;
 633   long l;
 634
 635   if ((o = Tcl_GetVar2Ex(ti, arr, cd->name, TCL_LEAVE_ERR_MSG)) == 0 ||
 636       Tcl_GetLongFromObj(ti, o, &l) != TCL_OK)
 637     return (-1);
 638   p[0] = (l >> 24) & 0xff;
 639   p[1] = (l >> 16) & 0xff;
 640   p[2] = (l >>  8) & 0xff;
 641   p[3] = (l >>  0) & 0xff;
 642   return (0);
 643 }
 644
 645 static int put_hword(Tcl_Interp *ti, /*const*/ char *arr,
 646                      unsigned char *p, const struct cmddata *cd)
 647 {
 648   Tcl_Obj *o;
 649   long l;
 650
 651   if ((o = Tcl_GetVar2Ex(ti, arr, cd->name, TCL_LEAVE_ERR_MSG)) == 0 ||
 652       Tcl_GetLongFromObj(ti, o, &l) != TCL_OK)
 653     return (-1);
 654   p[0] = (l >> 0) & 0xff;
 655   p[1] = (l >> 8) & 0xff;
 656   return (0);
 657 }
 658
 659 static int put_const(Tcl_Interp *ti, /*const*/ char *arr,
 660                      unsigned char *p, const struct cmddata *cd)
 661 {
 662   *p = cd->x;
 663   return (0);
 664 }
 665
 666 static int put_seed(Tcl_Interp *ti, /*const*/ char *arr,
 667                     unsigned char *p, const struct cmddata *cd)
 668 {
 669   Tcl_Obj *o;
 670   world *w;
 671
 672   if ((o = Tcl_GetVar2Ex(ti, arr, cd->name, TCL_LEAVE_ERR_MSG)) == 0 ||
 673       (w = world_get(ti, o)) == 0)
 674     return (-1);
 675   memcpy(p, w->x, 6);
 676   return (0);
 677 }
 678
 679 static int put_bool(Tcl_Interp *ti, /*const*/ char *arr,
 680                     unsigned char *p, const struct cmddata *cd)
 681 {
 682   Tcl_Obj *o;
 683   int b;
 684
 685   if ((o = Tcl_GetVar2Ex(ti, arr, cd->name, TCL_LEAVE_ERR_MSG)) == 0 ||
 686       Tcl_GetBooleanFromObj(ti, o, &b) != TCL_OK)
 687     return (-1);
 688   *p = b ? cd->x : 0;
 689   return (0);
 690 }
 691
 692 static int put_items(Tcl_Interp *ti, /*const*/ char *arr,
 693                      unsigned char *p, const struct cmddata *cd)
 694 {
 695   char buf[32];
 696   int ii;
 697   Tcl_Obj *o;
 698   const struct item *i;
 699
 700   for (i = items; i->name; i++) {
 701     sprintf(buf, "%s-%s", cd->name, i->name);
 702     if ((o = Tcl_GetVar2Ex(ti, arr, buf, TCL_LEAVE_ERR_MSG)) == 0 ||
 703         Tcl_GetIntFromObj(ti, o, &ii) != TCL_OK)
 704       return (-1);
 705     *p++ = ii;
 706   }
 707   return (0);
 708 }
 709
 710 static struct cmddata cmdtab[] = {
 711   { "mission",           0,     get_byte,       put_byte,         0 },
 712   { "world-x",           1,     get_byte,       put_byte,         0 },
 713   { "world-y",           2,     get_byte,       put_byte,         0 },
 714   { "gal-seed",          3,     get_seed,       put_seed,         0 },
 715   { "credits",           9,     get_word,       put_word,         0 },
 716   { "fuel",             13,     get_byte,       put_byte,         0 },
 717   { "",                 14,     0,              put_const,        4 },
 718   { "gal-number",       15,     get_byte,       put_byte,        -1 },
 719   { "front-laser",      16,     get_byte,       put_byte,         0 },
 720   { "rear-laser",       17,     get_byte,       put_byte,         0 },
 721   { "left-laser",       18,     get_byte,       put_byte,         0 },
 722   { "right-laser",      19,     get_byte,       put_byte,         0 },
 723   { "cargo",            22,     get_byte,       put_byte,         2 },
 724   { "hold",             23,     get_items,      put_items,        0 },
 725   { "ecm",              40,     get_bool,       put_bool,       255 },
 726   { "fuel-scoop",       41,     get_bool,       put_bool,       255 },
 727   { "energy-bomb",      42,     get_bool,       put_bool,       127 },
 728   { "energy-unit",      43,     get_byte,       put_byte,         0 },
 729   { "docking-computer", 44,     get_bool,       put_bool,       255 },
 730   { "gal-hyperdrive",   45,     get_bool,       put_bool,       255 },
 731   { "escape-pod",       46,     get_bool,       put_bool,       255 },
 732   { "missiles",         51,     get_byte,       put_byte,         0 },
 733   { "legal-status",     52,     get_byte,       put_byte,         0 },
 734   { "station",          53,     get_items,      put_items,        0 },
 735   { "market-fluc",      70,     get_byte,       put_byte,         0 },
 736   { "score",            71,     get_hword,      put_hword,        0 },
 737   { "",                 74,     0,              put_const,       32 },
 738   { 0,                   0,     0,              0,                0 }
 739 };
 740
 741 /* --- elite-unpackcmdr [-force] ARR DATA --- */
 742
 743 static int cmd_unpackcmdr(ClientData cd, Tcl_Interp *ti,
 744                           int objc, Tcl_Obj *const *objv)
 745 {
 746   char *arr;
 747   unsigned char *p, *q;
 748   int sz;
 749   unsigned f = 0;
 750   unsigned ck;
 751   const struct cmddata *c;
 752
 753 #define f_force 1u
 754
 755   /* --- Read the arguments --- */
 756
 757   objc--; objv++;
 758   while (objc) {
 759     char *opt = Tcl_GetString(*objv);
 760     if (strcmp(opt, "-force") == 0)
 761       f |= f_force;
 762     else if (strcmp(opt, "--") == 0) {
 763       objc--;
 764       objv++;
 765       break;
 766     } else
 767       break;
 768     objc--;
 769     objv++;
 770   }
 771   if (objc != 2)
 772     return (err(ti, "usage: elite-unpackcmdr [-force] ARR DATA"));
 773   arr = Tcl_GetString(objv[0]);
 774   p = Tcl_GetByteArrayFromObj(objv[1], &sz);
 775
 776   /* --- Check the data for correctness --- */
 777
 778   if (sz < 74)
 779     return (err(ti, "bad commander data (bad length)"));
 780   ck = cksum(p, 74);
 781   if (!(f & f_force)) {
 782     if (sz < 76 || p[74] != (ck ^ 0xa9) || p[75] != ck)
 783       return (err(ti, "bad commander data (bad checksum)"));
 784     for (q = p + 77; q < p + sz; q++)
 785       if (*q)
 786         return (err(ti, "bad commander data (bad data at end)"));
 787   }
 788
 789   /* --- Deconstruct the data --- */
 790
 791   for (c = cmdtab; c->name; c++) {
 792     if (c->get && c->get(ti, arr, p + c->off, c))
 793       return (TCL_ERROR);
 794   }
 795   return (0);
 796 }
 797
 798 /* --- elite-packcmdr ARR --- */
 799
 800 static int cmd_packcmdr(ClientData cd, Tcl_Interp *ti,
 801                        int objc, Tcl_Obj *const *objv)
 802 {
 803   char *arr;
 804   unsigned char p[256];
 805   unsigned ck;
 806   const struct cmddata *c;
 807
 808   if (objc != 2)
 809     return (err(ti, "usage: elite-packcmdr ARR"));
 810   arr = Tcl_GetString(objv[1]);
 811
 812   memset(p, 0, sizeof(p));
 813   for (c = cmdtab; c->name; c++) {
 814     if (c->put && c->put(ti, arr, p + c->off, c))
 815       return (TCL_ERROR);
 816   }
 817
 818   ck = cksum(p, 74);
 819   p[74] = ck ^ 0xa9;
 820   p[75] = ck;
 821   Tcl_SetObjResult(ti, Tcl_NewByteArrayObj(p, sizeof(p)));
 822   return (0);
 823 }
 824
 825 /*----- Initialization ----------------------------------------------------*/
 826
 827 int Elite_SafeInit(Tcl_Interp *ti)
 828 {
 829   static const struct cmd {
 830     /*const*/ char *name;
 831     Tcl_ObjCmdProc *proc;
 832   } cmds[] = {
 833     { "elite-nextworld",        cmd_nextworld },
 834     { "elite-nextgalaxy",       cmd_nextgalaxy },
 835     { "elite-worldinfo",        cmd_worldinfo },
 836     { "elite-market",           cmd_market },
 837     { "elite-unpackcmdr",       cmd_unpackcmdr },
 838     { "elite-packcmdr",         cmd_packcmdr },
 839     { 0,                        0 }
 840   };
 841
 842   const struct cmd *c;
 843   for (c = cmds; c->name; c++)
 844     Tcl_CreateObjCommand(ti, c->name, c->proc, 0, 0);
 845   Tcl_RegisterObjType(&world_type);
 846   if (Tcl_PkgProvide(ti, "elite-bits", "1.0.0"))
 847     return (TCL_ERROR);
 848   return (TCL_OK);
 849 }
 850
 851 int Elite_Init(Tcl_Interp *ti)
 852 {
 853   return (Elite_SafeInit(ti));
 854 }
 855
 856 /*----- That's all, folks -------------------------------------------------*/