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 | |
38 | typedef struct world { |
39 | unsigned char x[6]; |
40 | } world; |
41 | |
42 | typedef struct worldinfo { |
43 | unsigned x, y, gov, eco, tech, pop, prod, rad; |
44 | } worldinfo; |
45 | |
46 | /*----- The world type ----------------------------------------------------*/ |
47 | |
48 | static void world_fir(Tcl_Obj *o) |
49 | { |
50 | Tcl_Free(o->internalRep.otherValuePtr); |
51 | } |
52 | |
53 | static 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 | |
65 | static Tcl_ObjType world_type; |
66 | |
67 | static 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 | |
87 | bad: |
88 | if (ti) |
89 | Tcl_SetResult(ti, "bad world seed string", TCL_STATIC); |
90 | return (TCL_ERROR); |
91 | } |
92 | |
93 | static 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 | |
107 | static 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 | |
116 | static /*const*/ Tcl_ObjType world_type = { |
117 | "elite-world", world_fir, world_dir, world_us, world_sfa |
118 | }; |
119 | |
120 | static 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 | |
127 | static 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 | |
144 | static 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 | |
169 | static 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 | |
177 | static 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 | |
195 | static 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 | |
213 | static 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 | |
228 | static const char digrams[] = |
229 | "abouseitiletstonlonuthnoallexegezacebisouses" |
230 | "armaindirea?eratenberalavetiedorquanteisrion"; |
231 | |
232 | static 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 | |
279 | static 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 | |
297 | static 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 | |
352 | static 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 | |
460 | static 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 | |
487 | static 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 | |
524 | static 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 | |
541 | struct 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 | |
551 | static 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 | |
558 | static 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 | |
568 | static 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 | |
579 | static 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 | |
588 | static 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 | |
595 | static 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 | |
610 | static 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 | |
623 | static 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 | |
639 | static 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 | |
653 | static 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 | |
660 | static 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 | |
673 | static 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 | |
686 | static 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 | |
704 | static 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 | |
737 | static 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 | |
795 | static 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 | |
827 | static 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 | |
857 | static 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 | |
882 | static 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 | |
963 | done: |
964 | Tcl_DeleteHashTable(&done); |
965 | return (rc); |
966 | } |
967 | |
1304202a |
968 | /*----- Initialization ----------------------------------------------------*/ |
969 | |
970 | int 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 | |
997 | int Elite_Init(Tcl_Interp *ti) |
998 | { |
999 | return (Elite_SafeInit(ti)); |
1000 | } |
1001 | |
1002 | /*----- That's all, folks -------------------------------------------------*/ |