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