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