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