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 | |
40 | typedef struct world { |
41 | unsigned char x[6]; |
42 | } world; |
43 | |
44 | typedef struct worldinfo { |
45 | unsigned x, y, gov, eco, tech, pop, prod, rad; |
46 | } worldinfo; |
47 | |
48 | /*----- The world type ----------------------------------------------------*/ |
49 | |
50 | static void world_fir(Tcl_Obj *o) |
51 | { |
52 | Tcl_Free(o->internalRep.otherValuePtr); |
53 | } |
54 | |
55 | static 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 | |
67 | static Tcl_ObjType world_type; |
68 | |
69 | static 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 | |
89 | bad: |
90 | if (ti) |
91 | Tcl_SetResult(ti, "bad world seed string", TCL_STATIC); |
92 | return (TCL_ERROR); |
93 | } |
94 | |
95 | static 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 | |
109 | static 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 | |
118 | static /*const*/ Tcl_ObjType world_type = { |
119 | "elite-world", world_fir, world_dir, world_us, world_sfa |
120 | }; |
121 | |
122 | static 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 | |
129 | static 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 | |
146 | static 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 | |
171 | static 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 | |
179 | static 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 | |
197 | static 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 | |
215 | static 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 | |
230 | static const char digrams[] = |
231 | "abouseitiletstonlonuthnoallexegezacebisouses" |
232 | "armaindirea?eratenberalavetiedorquanteisrion"; |
233 | |
234 | static 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 | |
281 | static 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 | |
299 | static 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 | |
354 | static 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 | |
462 | static 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 | |
489 | static 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 | |
526 | static 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 | |
543 | struct 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 | |
553 | static 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 | |
560 | static 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 | |
570 | static 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 | |
581 | static 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 | |
590 | static 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 | |
597 | static 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 | |
612 | static 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 | |
625 | static 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 | |
641 | static 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 | |
655 | static 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 | |
662 | static 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 | |
675 | static 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 | |
688 | static 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 | |
706 | static 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 | |
739 | static 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 | |
797 | static 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 | |
829 | static 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 | |
859 | static 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 | |
884 | static 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 | |
965 | done: |
966 | Tcl_DeleteHashTable(&done); |
967 | return (rc); |
968 | } |
969 | |
1304202a |
970 | /*----- Initialization ----------------------------------------------------*/ |
971 | |
972 | int 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 | |
999 | int Elite_Init(Tcl_Interp *ti) |
1000 | { |
1001 | return (Elite_SafeInit(ti)); |
1002 | } |
1003 | |
1004 | /*----- That's all, folks -------------------------------------------------*/ |