chiark / gitweb /
Track Elite package interface change. Fix bug which failed to show the
[rocl] / elite.c
CommitLineData
1304202a 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
46typedef struct world {
47 unsigned char x[6];
48} world;
49
50typedef struct worldinfo {
51 unsigned x, y, gov, eco, tech, pop, prod, rad;
52} worldinfo;
53
54/*----- The world type ----------------------------------------------------*/
55
56static void world_fir(Tcl_Obj *o)
57{
58 Tcl_Free(o->internalRep.otherValuePtr);
59}
60
61static 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
73static Tcl_ObjType world_type;
74
75static 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
95bad:
96 if (ti)
97 Tcl_SetResult(ti, "bad world seed string", TCL_STATIC);
98 return (TCL_ERROR);
99}
100
101static 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
115static 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
124static /*const*/ Tcl_ObjType world_type = {
125 "elite-world", world_fir, world_dir, world_us, world_sfa
126};
127
128static 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
135static 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
152static 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
177static 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
185static 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
203static 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
221static 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
236static const char digrams[] =
237 "abouseitiletstonlonuthnoallexegezacebisouses"
238 "armaindirea?eratenberalavetiedorquanteisrion";
239
240static 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
287static 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
305static 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
360static 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
467static 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
494static 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
530static 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
547struct 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
557static 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
564static 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
574static 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
585static 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
594static 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
601static 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
616static 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
629static 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
645static 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
659static 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
666static 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
679static 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
692static 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
710static 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
743static 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
800static 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
827int 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
851int Elite_Init(Tcl_Interp *ti)
852{
853 return (Elite_SafeInit(ti));
854}
855
856/*----- That's all, folks -------------------------------------------------*/