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 | |
51 | typedef struct world { |
52 | unsigned char x[6]; |
53 | } world; |
54 | |
55 | typedef struct worldinfo { |
56 | unsigned x, y, gov, eco, tech, pop, prod, rad; |
57 | } worldinfo; |
58 | |
59 | /*----- The world type ----------------------------------------------------*/ |
60 | |
61 | static void world_fir(Tcl_Obj *o) |
62 | { |
63 | Tcl_Free(o->internalRep.otherValuePtr); |
64 | } |
65 | |
66 | static 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 | |
78 | static Tcl_ObjType world_type; |
79 | |
80 | static 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 | |
100 | bad: |
101 | if (ti) |
102 | Tcl_SetResult(ti, "bad world seed string", TCL_STATIC); |
103 | return (TCL_ERROR); |
104 | } |
105 | |
106 | static 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 | |
120 | static 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 | |
129 | static /*const*/ Tcl_ObjType world_type = { |
130 | "elite-world", world_fir, world_dir, world_us, world_sfa |
131 | }; |
132 | |
133 | static 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 | |
140 | static 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 | |
157 | static 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 | |
182 | static 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 | |
190 | static 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 | |
208 | static 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 | |
226 | static 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 | |
241 | static const char digrams[] = |
242 | "abouseitiletstonlonuthnoallexegezacebisouses" |
243 | "armaindirea?eratenberalavetiedorquanteisrion"; |
244 | |
245 | static 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 | |
292 | static 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 | |
310 | static 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 | |
365 | static 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 | |
473 | static 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 | |
500 | static 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 | |
537 | static 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 | |
554 | struct 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 | |
564 | static 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 | |
571 | static 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 | |
581 | static 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 | |
592 | static 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 | |
601 | static 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 | |
608 | static 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 | |
623 | static 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 | |
636 | static 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 | |
652 | static 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 | |
666 | static 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 | |
673 | static 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 | |
686 | static 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 | |
699 | static 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 | |
717 | static 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 | |
750 | static 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 | |
808 | static 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 | |
840 | static 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 | |
870 | static 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 | |
895 | static 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 | |
976 | done: |
977 | Tcl_DeleteHashTable(&done); |
978 | return (rc); |
979 | } |
980 | |
1304202a |
981 | /*----- Initialization ----------------------------------------------------*/ |
982 | |
983 | int 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 | |
1010 | int Elite_Init(Tcl_Interp *ti) |
1011 | { |
1012 | return (Elite_SafeInit(ti)); |
1013 | } |
1014 | |
1015 | /*----- That's all, folks -------------------------------------------------*/ |