11037fbf2c94b321f75d8283569e464211310920
7 * (c) 2003 Mark Wooding
10 /*----- Licensing notice --------------------------------------------------*
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.
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.
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.
27 /*----- Header files ------------------------------------------------------*/
38 /*----- Data structures ---------------------------------------------------*/
40 typedef struct world
{
44 typedef struct worldinfo
{
45 unsigned x
, y
, gov
, eco
, tech
, pop
, prod
, rad
;
48 /*----- The world type ----------------------------------------------------*/
50 static void world_fir(Tcl_Obj
*o
)
52 Tcl_Free(o
->internalRep
.otherValuePtr
);
55 static int xtoi(unsigned x
)
57 if (x
>= '0' && x
<= '9')
59 else if (x
>= 'a' && x
<= 'f')
60 return (x
- 'a' + 10);
61 else if (x
>= 'A' && x
<= 'F')
62 return (x
- 'A' + 10);
67 static Tcl_ObjType world_type
;
69 static int world_sfa(Tcl_Interp
*ti
, Tcl_Obj
*o
)
74 char *p
= Tcl_GetStringFromObj(o
, &l
);
77 for (i
= 0; i
< 12; i
+= 2) {
78 if (!isxdigit((unsigned char)p
[i
]) ||
79 !isxdigit((unsigned char)p
[i
+ 1]))
81 ww
.x
[i
>> 1] = (xtoi(p
[i
]) << 4) | (xtoi(p
[i
+ 1]));
83 w
= (world
*)Tcl_Alloc(sizeof(*w
));
85 o
->internalRep
.otherValuePtr
= w
;
86 o
->typePtr
= &world_type
;
91 Tcl_SetResult(ti
, "bad world seed string", TCL_STATIC
);
95 static void world_us(Tcl_Obj
*o
)
98 world
*w
= o
->internalRep
.otherValuePtr
;
105 for (i
= 0; i
< 6; i
++, p
+= 2)
106 sprintf(p
, "%02x", w
->x
[i
]);
109 static void world_dir(Tcl_Obj
*o
, Tcl_Obj
*oo
)
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
);
118 static /*const*/ Tcl_ObjType world_type
= {
119 "elite-world", world_fir
, world_dir
, world_us
, world_sfa
122 static world
*world_get(Tcl_Interp
*ti
, Tcl_Obj
*o
)
124 if (Tcl_ConvertToType(ti
, o
, &world_type
) != TCL_OK
)
126 return (o
->internalRep
.otherValuePtr
);
129 static Tcl_Obj
*world_new(const world
*w
)
132 Tcl_Obj
*o
= Tcl_NewObj();
133 ww
= (world
*)Tcl_Alloc(sizeof(*ww
));
135 o
->internalRep
.otherValuePtr
= ww
;
136 o
->typePtr
= &world_type
;
137 Tcl_InvalidateStringRep(o
);
141 /*----- Elite-specific hacking --------------------------------------------*
143 * Taken from `Elite: The New Kind' by Christian Pinder.
146 static void waggle(world
*w
, world
*ww
)
150 /* --- What goes on --- *
152 * 16-bit add of all three words, shift up, and insert the new value at the
159 h
+= w
->x
[3] + (l
>= 0x100);
160 l
&= 0xff; h
&= 0xff;
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
;
169 /*----- Tcl commands ------------------------------------------------------*/
171 static int err(Tcl_Interp
*ti
, /*const*/ char *p
)
173 Tcl_SetResult(ti
, p
, TCL_STATIC
);
177 /* --- elite-nextworld SEED --- */
179 static int cmd_nextworld(ClientData cd
, Tcl_Interp
*ti
,
180 int objc
, Tcl_Obj
*const *objv
)
184 return (err(ti
, "usage: elite-nextworld SEED"));
185 if ((w
= world_get(ti
, objv
[1])) == 0)
191 Tcl_SetObjResult(ti
, world_new(&ww
));
195 /* --- elite-nextgalaxy SEED --- */
197 static int cmd_nextgalaxy(ClientData cd
, Tcl_Interp
*ti
,
198 int objc
, Tcl_Obj
*const *objv
)
204 return (err(ti
, "usage: elite-nextgalaxy SEED"));
205 if ((w
= world_get(ti
, objv
[1])) == 0)
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
));
213 /* --- elite-worldinfo ARR SEED --- */
215 static void getworldinfo(worldinfo
*wi
, world
*w
)
219 wi
->gov
= (w
->x
[2] >> 3) & 0x07;
220 wi
->eco
= w
->x
[1] & 0x07;
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];
230 static const char digrams
[] =
231 "abouseitiletstonlonuthnoallexegezacebisouses"
232 "armaindirea?eratenberalavetiedorquanteisrion";
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" }
281 static int mangle(world
*w
)
285 x
= (w
->x
[2] << 1) & 0xff;
293 a
= (a
+ x
+ w
->x
[5]) & 0xff;
299 static void goatsoup(Tcl_Obj
*d
, const char *pn
, world
*w
, const char *p
)
302 size_t sz
= strcspn(p
, "<%");
307 Tcl_AppendToObj(d
, (char *)p
, sz
);
314 i
= strtoul(p
+ 1, (char **)&p
, 10);
317 goatsoup(d
, pn
, w
, desc
[i
][(j
>= 0x33) + (j
>= 0x66) +
318 (j
>= 0x99) + (j
>= 0xcc)]);
324 Tcl_AppendToObj(d
, (char *)pn
, -1);
328 Tcl_AppendToObj(d
, (char *)pn
,
329 (pn
[sz
] == 'i' || pn
[sz
] == 'e') ? sz
: sz
+ 1);
330 Tcl_AppendToObj(d
, "ian", 3);
333 n
= (mangle(w
) & 0x03) + 1;
336 unsigned i
= mangle(w
) & 0x3e;
338 if (digrams
[i
] != '?')
341 *buf
= toupper(*buf
);
342 Tcl_AppendToObj(d
, buf
, q
- buf
);
354 static int cmd_worldinfo(ClientData cd
, Tcl_Interp
*ti
,
355 int objc
, Tcl_Obj
*const *objv
)
366 /* --- Check arguments --- */
369 return (err(ti
, "usage: elite-worldinfo ARR SEED"));
370 if ((w
= world_get(ti
, objv
[2])) == 0)
372 arr
= Tcl_GetString(objv
[1]);
374 /* --- Get the basic information --- */
376 getworldinfo(&wi
, w
);
377 Tcl_UnsetVar(ti
, arr
, 0);
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],
398 /* --- Work out the inhabitants --- */
400 if (!(w
->x
[4] & 0x80)) {
401 if (!Tcl_SetVar2(ti
, arr
, "inhabitants", "humans", TCL_LEAVE_ERR_MSG
))
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" };
413 o
= Tcl_NewListObj(0, 0);
414 j
= (w
->x
[5] >> 2) & 0x07;
416 Tcl_ListObjAppendElement(ti
, o
, Tcl_NewStringObj(id_a
[j
], -1));
417 j
= (w
->x
[5] >> 5) & 0x07;
419 Tcl_ListObjAppendElement(ti
, o
, Tcl_NewStringObj(id_b
[j
], -1));
420 j
= (w
->x
[1] ^ w
->x
[3]) & 0x07;
422 Tcl_ListObjAppendElement(ti
, o
, Tcl_NewStringObj(id_c
[j
], -1));
424 Tcl_ListObjAppendElement(ti
, o
, Tcl_NewStringObj(id_d
[j
& 0x07], -1));
425 if (!Tcl_SetVar2Ex(ti
, arr
, "inhabitants", o
, TCL_LEAVE_ERR_MSG
))
429 /* --- Work out the planet name --- */
431 n
= (w
->x
[0] & 0x40) ?
4 : 3;
439 if (digrams
[j
] != '?')
445 *buf
= toupper(*buf
);
446 if (!Tcl_SetVar2Ex(ti
, arr
, "name", Tcl_NewStringObj(buf
, -1),
450 /* --- Finally work out the goat-soup description --- */
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
))
460 /* --- elite-market ARR SEED [FLUC] --- */
462 static const struct item
{
463 /*const*/ char *name
;
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 },
489 static int cmd_market(ClientData cd
, Tcl_Interp
*ti
,
490 int objc
, Tcl_Obj
*const *objv
)
495 const struct item
*i
;
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)
502 arr
= Tcl_GetString(objv
[1]);
503 if (objc
>= 4 && Tcl_GetIntFromObj(ti
, objv
[3], &fluc
) != TCL_OK
)
505 getworldinfo(&wi
, w
);
507 Tcl_UnsetVar(ti
, arr
, 0);
508 for (i
= items
; i
->name
; i
++) {
511 pr
= (i
->base
+ (fluc
& i
->mask
) + (wi
.eco
* i
->var
)) & 0xff;
512 qt
= (i
->qty
+ (fluc
& i
->mask
) - (wi
.eco
* i
->var
)) & 0xff;
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
),
524 /*----- Commander file decomposition --------------------------------------*/
526 static unsigned cksum(const unsigned char *p
, size_t sz
)
528 unsigned a
= 0x49, c
= 0;
541 /* --- The big translation table --- */
544 /*const*/ char *name
;
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
*);
553 static int get_byte(Tcl_Interp
*ti
, /*const*/ char *arr
,
554 const unsigned char *p
, const struct cmddata
*cd
)
556 return (!Tcl_SetVar2Ex(ti
, arr
, cd
->name
,
557 Tcl_NewIntObj(*p
- cd
->x
), TCL_LEAVE_ERR_MSG
));
560 static int get_seed(Tcl_Interp
*ti
, /*const*/ char *arr
,
561 const unsigned char *p
, const struct cmddata
*cd
)
566 return (!Tcl_SetVar2Ex(ti
, arr
, cd
->name
,
567 world_new(&w
), TCL_LEAVE_ERR_MSG
));
570 static int get_word(Tcl_Interp
*ti
, /*const*/ char *arr
,
571 const unsigned char *p
, const struct cmddata
*cd
)
573 return (!Tcl_SetVar2Ex(ti
, arr
, cd
->name
,
574 Tcl_NewLongObj((p
[0] & 0xff) << 24 |
575 (p
[1] & 0xff) << 16 |
581 static int get_hword(Tcl_Interp
*ti
, /*const*/ char *arr
,
582 const unsigned char *p
, const struct cmddata
*cd
)
584 return (!Tcl_SetVar2Ex(ti
, arr
, cd
->name
,
585 Tcl_NewLongObj((p
[0] & 0xff) << 0 |
590 static int get_bool(Tcl_Interp
*ti
, /*const*/ char *arr
,
591 const unsigned char *p
, const struct cmddata
*cd
)
593 return (!Tcl_SetVar2Ex(ti
, arr
, cd
->name
,
594 Tcl_NewBooleanObj(*p
), TCL_LEAVE_ERR_MSG
));
597 static int get_items(Tcl_Interp
*ti
, /*const*/ char *arr
,
598 const unsigned char *p
, const struct cmddata
*cd
)
601 const struct item
*i
;
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
))
612 static int put_byte(Tcl_Interp
*ti
, /*const*/ char *arr
,
613 unsigned char *p
, const struct cmddata
*cd
)
618 if ((o
= Tcl_GetVar2Ex(ti
, arr
, cd
->name
, TCL_LEAVE_ERR_MSG
)) == 0 ||
619 Tcl_GetIntFromObj(ti
, o
, &i
) != TCL_OK
)
625 static int put_word(Tcl_Interp
*ti
, /*const*/ char *arr
,
626 unsigned char *p
, const struct cmddata
*cd
)
631 if ((o
= Tcl_GetVar2Ex(ti
, arr
, cd
->name
, TCL_LEAVE_ERR_MSG
)) == 0 ||
632 Tcl_GetLongFromObj(ti
, o
, &l
) != TCL_OK
)
634 p
[0] = (l
>> 24) & 0xff;
635 p
[1] = (l
>> 16) & 0xff;
636 p
[2] = (l
>> 8) & 0xff;
637 p
[3] = (l
>> 0) & 0xff;
641 static int put_hword(Tcl_Interp
*ti
, /*const*/ char *arr
,
642 unsigned char *p
, const struct cmddata
*cd
)
647 if ((o
= Tcl_GetVar2Ex(ti
, arr
, cd
->name
, TCL_LEAVE_ERR_MSG
)) == 0 ||
648 Tcl_GetLongFromObj(ti
, o
, &l
) != TCL_OK
)
650 p
[0] = (l
>> 0) & 0xff;
651 p
[1] = (l
>> 8) & 0xff;
655 static int put_const(Tcl_Interp
*ti
, /*const*/ char *arr
,
656 unsigned char *p
, const struct cmddata
*cd
)
662 static int put_seed(Tcl_Interp
*ti
, /*const*/ char *arr
,
663 unsigned char *p
, const struct cmddata
*cd
)
668 if ((o
= Tcl_GetVar2Ex(ti
, arr
, cd
->name
, TCL_LEAVE_ERR_MSG
)) == 0 ||
669 (w
= world_get(ti
, o
)) == 0)
675 static int put_bool(Tcl_Interp
*ti
, /*const*/ char *arr
,
676 unsigned char *p
, const struct cmddata
*cd
)
681 if ((o
= Tcl_GetVar2Ex(ti
, arr
, cd
->name
, TCL_LEAVE_ERR_MSG
)) == 0 ||
682 Tcl_GetBooleanFromObj(ti
, o
, &b
) != TCL_OK
)
688 static int put_items(Tcl_Interp
*ti
, /*const*/ char *arr
,
689 unsigned char *p
, const struct cmddata
*cd
)
694 const struct item
*i
;
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
)
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 },
737 /* --- elite-unpackcmdr [-force] ARR DATA --- */
739 static int cmd_unpackcmdr(ClientData cd
, Tcl_Interp
*ti
,
740 int objc
, Tcl_Obj
*const *objv
)
743 unsigned char *p
, *q
;
747 const struct cmddata
*c
;
751 /* --- Read the arguments --- */
755 char *opt
= Tcl_GetString(*objv
);
756 if (strcmp(opt
, "-force") == 0)
758 else if (strcmp(opt
, "--") == 0) {
768 return (err(ti
, "usage: elite-unpackcmdr [-force] ARR DATA"));
769 arr
= Tcl_GetString(objv
[0]);
770 p
= Tcl_GetByteArrayFromObj(objv
[1], &sz
);
772 /* --- Check the data for correctness --- */
775 return (err(ti
, "bad commander data (bad length)"));
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
++)
782 return (err(ti
, "bad commander data (bad data at end)"));
785 /* --- Deconstruct the data --- */
787 Tcl_UnsetVar(ti
, arr
, 0);
788 for (c
= cmdtab
; c
->name
; c
++) {
789 if (c
->get
&& c
->get(ti
, arr
, p
+ c
->off
, c
))
795 /* --- elite-packcmdr ARR --- */
797 static int cmd_packcmdr(ClientData cd
, Tcl_Interp
*ti
,
798 int objc
, Tcl_Obj
*const *objv
)
801 unsigned char p
[256];
803 const struct cmddata
*c
;
806 return (err(ti
, "usage: elite-packcmdr ARR"));
807 arr
= Tcl_GetString(objv
[1]);
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
))
818 Tcl_SetObjResult(ti
, Tcl_NewByteArrayObj(p
, sizeof(p
)));
822 /*----- Optimizations -----------------------------------------------------*/
824 /* --- @elite-galaxylist SEED@ --- *
826 * Returns a SEED/X/Y list for the worlds in galaxy SEED.
829 static int cmd_galaxylist(ClientData cd
, Tcl_Interp
*ti
,
830 int objc
, Tcl_Obj
*const *objv
)
838 return (err(ti
, "usage: elite-galaxylist SEED"));
839 if ((w
= world_get(ti
, objv
[1])) == 0)
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
);
850 Tcl_SetObjResult(ti
, o
);
854 /* --- @elite-distance X Y XX YY@ --- *
856 * Returns the distance between two points.
859 static int cmd_distance(ClientData cd
, Tcl_Interp
*ti
,
860 int objc
, Tcl_Obj
*const *objv
)
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
)
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
));
879 /* --- @elite-adjacency ADJ LIST [DIST]@ --- *
881 * Construct an adjacency table from a world list.
884 static int cmd_adjacency(ClientData cd
, Tcl_Interp
*ti
,
885 int objc
, Tcl_Obj
*const *objv
)
890 long x
, y
, xx
, yy
, d
;
899 if (objc
< 3 || objc
> 4)
900 return (err(ti
, "usage: elite-adjacency ADJ LIST [DIST]"));
902 if (Tcl_ListObjGetElements(ti
, objv
[2], &oc
, &ov
) != TCL_OK
)
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
)
909 Tcl_InitHashTable(&done
, TCL_ONE_WORD_KEYS
);
910 Tcl_UnsetVar(ti
, Tcl_GetString(a
), 0);
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)
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
)
924 for (j
= 0; j
< oc
; j
+= 3) {
925 ss
= Tcl_GetString(ov
[j
]);
926 if (Tcl_FindHashEntry(&done
, ss
))
928 if (Tcl_GetLongFromObj(ti
, ov
[j
+ 1], &xx
) != TCL_OK
||
929 Tcl_GetLongFromObj(ti
, ov
[j
+ 2], &yy
) != TCL_OK
)
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;
935 if (Tcl_ObjSetVar2(ti
, a
, ov
[i
], ov
[j
],
938 TCL_LEAVE_ERR_MSG
)) == 0 ||
939 Tcl_ObjSetVar2(ti
, a
, ov
[i
], ov
[j
+ 1],
942 TCL_LEAVE_ERR_MSG
)) == 0 ||
943 Tcl_ObjSetVar2(ti
, a
, ov
[i
], ov
[j
+ 2],
946 TCL_LEAVE_ERR_MSG
)) == 0 ||
947 Tcl_ObjSetVar2(ti
, a
, ov
[j
], ov
[i
],
950 TCL_LEAVE_ERR_MSG
)) == 0 ||
951 Tcl_ObjSetVar2(ti
, a
, ov
[j
], ov
[i
+ 1],
954 TCL_LEAVE_ERR_MSG
)) == 0 ||
955 Tcl_ObjSetVar2(ti
, a
, ov
[j
], ov
[i
+ 2],
958 TCL_LEAVE_ERR_MSG
)) == 0)
966 Tcl_DeleteHashTable(&done
);
970 /*----- Initialization ----------------------------------------------------*/
972 int Elite_SafeInit(Tcl_Interp
*ti
)
974 static const struct cmd
{
975 /*const*/ char *name
;
976 Tcl_ObjCmdProc
*proc
;
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
},
984 { "elite-distance", cmd_distance
},
985 { "elite-galaxylist", cmd_galaxylist
},
986 { "elite-adjacency", cmd_adjacency
},
991 for (c
= cmds
; c
->name
; c
++)
992 Tcl_CreateObjCommand(ti
, c
->name
, c
->proc
, 0, 0);
993 Tcl_RegisterObjType(&world_type
);
994 if (Tcl_PkgProvide(ti
, "elite-bits", "1.0.1"))
999 int Elite_Init(Tcl_Interp
*ti
)
1001 return (Elite_SafeInit(ti
));
1004 /*----- That's all, folks -------------------------------------------------*/