1 /* File: interp.c */
2
3 /* Purpose: general script commands */
4
5 /*
6 * Copyright (c) 1997-2001 Tim Baker
7 *
8 * This software may be copied and distributed for educational, research, and
9 * not for profit purposes provided that this copyright and statement are
10 * included in all such copies.
11 */
12
13 #include "tnb.h"
14 #include "icon.h"
15
16
17 /* TRUE if current command is repeated */
18 bool command_repeating = FALSE;
19
20 int inkey_flags = 0;
21 int inkey_book;
22 int exit_skip_save = FALSE;
23
24
25 /*
26 * Return a Tcl list of m_list[] indexes of pets
27 */
DumpPets(void)28 static Tcl_Obj *DumpPets(void)
29 {
30 int i;
31 Tcl_Obj *listObjPtr;
32
33 /* Create a new Tcl list object */
34 listObjPtr = Tcl_NewListObj(0, NULL);
35
36 /* Process the monsters */
37 for (i = 1; i < m_max; i++)
38 {
39 /* Access the monster */
40 monster_type *m_ptr = &m_list[i];
41
42 /* Ignore "dead" monsters */
43 if (!m_ptr->r_idx) continue;
44
45 /* Append m_list[] index of friendly monster */
46 if (is_pet(m_ptr))
47 {
48 Tcl_ListObjAppendElement(g_interp, listObjPtr,
49 Tcl_NewIntObj(i));
50 }
51 }
52
53 return listObjPtr;
54 }
55
56 static int s_status_value;
57
58 /*
59 * Prints status of hunger
60 */
state_hunger(void)61 static cptr state_hunger(void)
62 {
63 /* Fainting / Starving */
64 if (p_ptr->food < PY_FOOD_FAINT)
65 {
66 return "Weak";
67 }
68
69 /* Weak */
70 else if (p_ptr->food < PY_FOOD_WEAK)
71 {
72 return "Weak";
73 }
74
75 /* Hungry */
76 else if (p_ptr->food < PY_FOOD_ALERT)
77 {
78 return "Hungry";
79 }
80
81 /* Normal */
82 else if (p_ptr->food < PY_FOOD_FULL)
83 {
84 return "";
85 }
86
87 /* Full */
88 else if (p_ptr->food < PY_FOOD_MAX)
89 {
90 return "Full";
91 }
92
93 /* Gorged */
94 else
95 {
96 return "Gorged";
97 }
98 }
99
100 /*
101 * Prints Blind status
102 */
state_blind(void)103 static cptr state_blind(void)
104 {
105 if (p_ptr->tim.blind)
106 {
107 return "Blind";
108 }
109 else
110 {
111 return "";
112 }
113 }
114
115 /*
116 * Prints Confusion status
117 */
state_confused(void)118 static cptr state_confused(void)
119 {
120 if (p_ptr->tim.confused)
121 {
122 return "Confused";
123 }
124 else
125 {
126 return "";
127 }
128 }
129
130 /*
131 * Prints Fear status
132 */
state_afraid(void)133 static cptr state_afraid(void)
134 {
135 if (p_ptr->tim.afraid)
136 {
137 return "Afraid";
138 }
139 else
140 {
141 return "";
142 }
143 }
144
145 /*
146 * Prints Poisoned status
147 */
state_poisoned(void)148 static cptr state_poisoned(void)
149 {
150 if (p_ptr->tim.poisoned)
151 {
152 return "Poisoned";
153 }
154 else
155 {
156 return "";
157 }
158 }
159
trunc_num(int n)160 static int trunc_num(int n)
161 {
162 /* Only 4 digits are allowed */
163 if (n > 9999) n = 9999;
164
165 /* Extensive */
166 if (n >= 1000)
167 {
168 return (n / 100) * 100;
169 }
170
171 /* Long */
172 else if (n >= 100)
173 {
174 return (n / 10) * 10;
175 }
176
177 /* Medium */
178 else if (n >= 10)
179 {
180 return (n / 5) * 5;
181 }
182
183 /* Short */
184 return n;
185 }
186
187 /*
188 * Prints Searching, Resting, Paralysis, or 'count' status
189 * Display is always exactly 10 characters wide (see below)
190 *
191 * This function was a major bottleneck when resting, so a lot of
192 * the text formatting code was optimized in place below.
193 */
state_state(void)194 static cptr state_state(void)
195 {
196 /* Paralysis */
197 if (p_ptr->tim.paralyzed)
198 {
199 return "Paralyzed!";
200 }
201
202 /* Resting */
203 else if (p_ptr->state.resting)
204 {
205 int n = p_ptr->state.resting;
206
207 /* Rest until healed */
208 if (n == -1)
209 {
210 return "Rest *****";
211 }
212
213 /* Rest until done */
214 else if (n == -2)
215 {
216 return "Rest &&&&&";
217 }
218 else
219 {
220 s_status_value = trunc_num(n);
221 return "Rest %d";
222 }
223 }
224
225 /* Repeating */
226 else if (p_ptr->cmd.rep)
227 {
228 int n = p_ptr->cmd.rep;
229
230 s_status_value = trunc_num(n);
231
232 if (n > 999)
233 {
234 return "Rep. %d";
235 }
236 else
237 {
238 return "Repeat %d";
239 }
240 }
241
242 /* Searching */
243 else if (p_ptr->state.searching)
244 {
245 return "Searching";
246 }
247
248 /* Nothing interesting */
249 else
250 {
251 return "";
252 }
253 }
254
255 /*
256 * Prints the speed of a character. -CJS-
257 */
state_speed(void)258 static cptr state_speed(void)
259 {
260 int n = p_ptr->pspeed;
261
262 /* Hack -- Visually "undo" the Search Mode Slowdown */
263 if (p_ptr->state.searching) n += 10;
264
265 /* Fast */
266 if (n > 110)
267 {
268 s_status_value = n - 110;
269 return "Fast (%+d)";
270 }
271
272 /* Slow */
273 else if (n < 110)
274 {
275 s_status_value = -(110 - n);
276 return "Slow (%+d)";
277 }
278
279 /* Normal */
280 return "";
281 }
282
state_study(void)283 static cptr state_study(void)
284 {
285 if (p_ptr->new_spells)
286 {
287 return "Study";
288 }
289 else
290 {
291 return "";
292 }
293 }
294
state_cut(void)295 static cptr state_cut(void)
296 {
297 int c = p_ptr->tim.cut;
298
299 if (c > 1000)
300 {
301 return "Mortal wound";
302 }
303 else if (c > 200)
304 {
305 return "Deep gash";
306 }
307 else if (c > 100)
308 {
309 return "Severe cut";
310 }
311 else if (c > 50)
312 {
313 return "Nasty cut";
314 }
315 else if (c > 25)
316 {
317 return "Bad cut";
318 }
319 else if (c > 10)
320 {
321 return "Light cut";
322 }
323 else if (c)
324 {
325 return "Graze";
326 }
327 else
328 {
329 return "";
330 }
331 }
332
state_stun(void)333 static cptr state_stun(void)
334 {
335 int s = p_ptr->tim.stun;
336
337 if (s > 100)
338 {
339 return "Knocked out";
340 }
341 else if (s > 50)
342 {
343 return "Heavy stun";
344 }
345 else if (s)
346 {
347 return "Stun";
348 }
349 else
350 {
351 return "";
352 }
353 }
354
state_winner(void)355 static cptr state_winner(void)
356 {
357 /* Wizard */
358 if (p_ptr->state.wizard)
359 {
360 return "Wizard";
361 }
362
363 /* Winner */
364 else if (p_ptr->state.total_winner || (p_ptr->lev > PY_MAX_LEVEL))
365 {
366 return "Winner";
367 }
368
369 /* Normal */
370 else
371 {
372 return "";
373 }
374 }
375
player_status(int status,int * value)376 cptr player_status(int status, int *value)
377 {
378 cptr format;
379
380 typedef cptr (status_proc)(void);
381 static status_proc *status_info[] = {
382 state_cut,
383 state_stun,
384 state_hunger,
385 state_blind,
386 state_confused,
387 state_afraid,
388 state_poisoned,
389 state_state,
390 state_speed,
391 state_study,
392 state_winner
393 };
394
395 s_status_value = 0;
396
397 format = (*status_info[status])();
398 (*value) = s_status_value;
399 return format;
400 }
401
blows_per_round(int * _blows,int * _muta_att)402 static void blows_per_round(int *_blows, int *_muta_att)
403 {
404 int muta_att = 0;
405
406 if (p_ptr->muta2 & MUT2_HORNS)
407 muta_att++;
408 if (p_ptr->muta2 & MUT2_SCOR_TAIL)
409 muta_att++;
410 if (p_ptr->muta2 & MUT2_BEAK)
411 muta_att++;
412 if (p_ptr->muta2 & MUT2_TRUNK)
413 muta_att++;
414 if (p_ptr->muta2 & MUT2_TENTACLES)
415 muta_att++;
416
417 (*_blows) = p_ptr->num_blow;
418 (*_muta_att) = muta_att;
419 }
420
shots_per_round(int * _shots,int * _shots_frac)421 static void shots_per_round(int *_shots, int *_shots_frac)
422 {
423 int energy_fire = 100;
424 int shots, shots_frac;
425 object_type *o_ptr = &p_ptr->equipment[EQUIP_BOW];
426
427 if (o_ptr->k_idx)
428 {
429 switch (o_ptr->sval)
430 {
431 case SV_SLING:
432 {
433 energy_fire = 50;
434 break;
435 }
436 case SV_SHORT_BOW:
437 {
438 energy_fire = 100;
439 break;
440 }
441 case SV_LONG_BOW:
442 {
443 energy_fire = 100;
444 break;
445 }
446 case SV_LIGHT_XBOW:
447 {
448 energy_fire = 120;
449 break;
450 }
451 case SV_HEAVY_XBOW:
452 {
453 if (p_ptr->stat[A_DEX].use >= 16)
454 {
455 energy_fire = 150;
456 }
457 else
458 {
459 /* players with low dex will take longer to load */
460 energy_fire = 200;
461 }
462 }
463 break;
464 }
465 }
466
467 shots = p_ptr->num_fire * 100;
468 shots_frac = (shots * 100 / energy_fire) % 100;
469 shots = shots / energy_fire;
470
471 (*_shots) = shots;
472 (*_shots_frac) = shots_frac;
473 }
474
475 /*
476 *--------------------------------------------------------------
477 *
478 * objcmd_player --
479 *
480 * Implements the "player" script command.
481 *
482 *--------------------------------------------------------------
483 */
484
485 int
objcmd_player(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])486 objcmd_player(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
487 {
488 CommandInfo *infoCmd = (CommandInfo *) clientData;
489 int objC = objc - infoCmd->depth;
490 Tcl_Obj *CONST *objV = objv + infoCmd->depth;
491
492 static cptr cmdOptions[] = {"ability", "age", "armor_class",
493 "blows_per_round", "died_from",
494 "exp", "food", "gold", "height", "hitpoints",
495 "infravision", "level", "mana", "position",
496 "sex", "shots_per_round", "social_class",
497 "title", "to_dam", "to_hit", "weight",
498 "total_weight", "preserve", "base_name",
499 "is_dead", "turn", "max_level", "disturb", "new_spells",
500 "command_rep", "running", "prayer_or_spell", "health_who",
501 "monster_race_idx", "life_rating",
502 "pets", "realm1", "realm2", "patron",
503 NULL};
504 enum {IDX_ABILITY, IDX_AGE, IDX_ARMOR_CLASS,
505 IDX_BLOWS_PER_ROUND, IDX_DIED_FROM,
506 IDX_EXP, IDX_FOOD, IDX_GOLD, IDX_HEIGHT, IDX_HITPOINTS,
507 IDX_INFRAVISION, IDX_LEVEL, IDX_MANA, IDX_POSITION,
508 IDX_SEX, IDX_SHOTS_PER_ROUND, IDX_SOCIAL_CLASS,
509 IDX_TITLE, IDX_TO_DAM, IDX_TO_HIT, IDX_WEIGHT,
510 IDX_TOTAL_WEIGHT, IDX_PRESERVE, IDX_BASE_NAME,
511 IDX_IS_DEAD, IDX_TURN, IDX_MAX_LEVEL, IDX_DISTURB, IDX_NEW_SPELLS,
512 IDX_COMMAND_REP, IDX_RUNNING, IDX_PRAYER_OR_SPELL, IDX_HEALTH_WHO,
513 IDX_MONSTER_RACE_IDX, IDX_LIFE_RATING,
514 IDX_PETS, IDX_REALM1, IDX_REALM2, IDX_PATRON
515 };
516 int option;
517 Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
518 int index;
519
520 object_type *o_ptr;
521 int i, tmp;
522 long expadv;
523 cptr t;
524
525 static cptr abilityOptions[] = {"fighting", "bows_throw", "saving_throw",
526 "stealth", "perception", "searching", "disarming", "magic_device",
527 NULL};
528
529 static struct {int rating; int max;} ability[] = {
530 {0, 10}, /* fighting */
531 {0, 10}, /* bows_throw */
532 {0, 6}, /* saving_throw */
533 {0, 1}, /* stealth */
534 {0, 6}, /* perception */
535 {0, 6}, /* searching */
536 {0, 8}, /* disarming */
537 {0, 6} /* magic_device */
538 };
539
540 /* Required number of arguments */
541 if (objC < 2)
542 {
543 Tcl_WrongNumArgs(interp, infoCmd->depth + 1, objv, "option ?arg ...?");
544 return TCL_ERROR;
545 }
546
547 /* Get requested option */
548 if (Tcl_GetIndexFromObj(interp, objV[1], cmdOptions, "option", 0,
549 &option) != TCL_OK)
550 {
551 return TCL_ERROR;
552 }
553
554 switch (option)
555 {
556 case IDX_ABILITY: /* ability */
557
558 if (objC != 3)
559 {
560 Tcl_WrongNumArgs(interp, infoCmd->depth + 2, objv, "ability");
561 return TCL_ERROR;
562 }
563
564 if (Tcl_GetIndexFromObj(interp, objV[2], abilityOptions, "ability", 0,
565 &index) != TCL_OK)
566 {
567 return TCL_ERROR;
568 }
569
570 /* Fighting Skill (with current weapon) */
571 o_ptr = &p_ptr->equipment[EQUIP_WIELD];
572 tmp = p_ptr->to_h + o_ptr->to_h;
573 ability[0].rating = p_ptr->skills[SKILL_THN] + (tmp * BTH_PLUS_ADJ);
574
575 /* Shooting Skill (with current bow and normal missile) */
576 o_ptr = &p_ptr->equipment[EQUIP_BOW];
577 tmp = p_ptr->to_h + o_ptr->to_h;
578 ability[1].rating = p_ptr->skills[SKILL_THB] + (tmp * BTH_PLUS_ADJ);
579
580 ability[2].rating = p_ptr->skills[SKILL_SAV];
581 ability[3].rating = p_ptr->skills[SKILL_STL];
582 ability[4].rating = p_ptr->skills[SKILL_FOS];
583 ability[5].rating = p_ptr->skills[SKILL_SNS];
584 ability[6].rating = p_ptr->skills[SKILL_DIS];
585 ability[7].rating = p_ptr->skills[SKILL_DEV];
586
587 Tcl_SetStringObj(resultPtr, format("%d %d",
588 ability[index].rating, ability[index].max), -1);
589 break;
590
591 case IDX_AGE: /* age */
592 Tcl_SetIntObj(resultPtr, p_ptr->rp.age);
593 break;
594
595 case IDX_ARMOR_CLASS: /* armor_class */
596 Tcl_SetStringObj(resultPtr,
597 format("%d %d", p_ptr->dis_ac, p_ptr->dis_to_a), -1);
598 break;
599
600 case IDX_BLOWS_PER_ROUND: /* blows_per_round */
601 {
602 int blows, muta_att;
603 blows_per_round(&blows, &muta_att);
604 Tcl_SetStringObj(resultPtr,
605 format(muta_att ? "%d+%d" : "%d", blows, muta_att), -1);
606 break;
607 }
608
609 case IDX_DIED_FROM: /* died_from */
610 if (!p_ptr->state.is_dead)
611 {
612 Tcl_SetStringObj(resultPtr, "character is not dead", -1);
613 return TCL_ERROR;
614 }
615 ExtToUtf_SetResult(interp, p_ptr->state.died_from);
616 break;
617
618 case IDX_EXP: /* exp */
619 if (p_ptr->lev >= PY_MAX_LEVEL) expadv = 999999999;
620 else expadv = (s32b)(player_exp[p_ptr->lev - 1] * p_ptr->expfact / 100L);
621 Tcl_SetStringObj(resultPtr, format("%ld %ld %ld", p_ptr->exp,
622 p_ptr->max_exp, expadv), -1);
623 break;
624
625 case IDX_FOOD: /* food */
626 Tcl_SetStringObj(resultPtr,
627 format("%d %d", p_ptr->food, PY_FOOD_MAX), -1);
628 break;
629
630 case IDX_GOLD: /* gold */
631 Tcl_SetStringObj(resultPtr, format("%ld", p_ptr->au), -1);
632 break;
633
634 case IDX_HEIGHT: /* height */
635 Tcl_SetIntObj(resultPtr, p_ptr->rp.ht);
636 break;
637
638 case IDX_HITPOINTS: /* hitpoints */
639 Tcl_SetStringObj(resultPtr,
640 format("%d %d", p_ptr->chp, p_ptr->mhp), -1);
641 break;
642
643 case IDX_INFRAVISION: /* infravision */
644 Tcl_SetIntObj(resultPtr, p_ptr->see_infra * 10);
645 break;
646
647 case IDX_LEVEL: /* level */
648 Tcl_SetIntObj(resultPtr, p_ptr->lev);
649 break;
650
651 case IDX_MANA: /* mana */
652 Tcl_SetStringObj(resultPtr,
653 format("%d %d", p_ptr->csp, p_ptr->msp), -1);
654 break;
655
656 case IDX_POSITION: /* position */
657 Tcl_SetStringObj(resultPtr, format("%d %d", p_ptr->py, p_ptr->px),
658 -1);
659 break;
660
661 case IDX_SEX: /* sex */
662 Tcl_SetStringObj(resultPtr, sp_ptr->title, -1);
663 break;
664
665 case IDX_SHOTS_PER_ROUND: /* shots_per_round */
666 {
667 int shots, shots_frac;
668 shots_per_round(&shots, &shots_frac);
669 Tcl_SetStringObj(resultPtr,
670 format("%d.%d", shots, shots_frac), -1);
671 break;
672 }
673
674 case IDX_SOCIAL_CLASS: /* social_class */
675 Tcl_SetIntObj(resultPtr, p_ptr->rp.sc);
676 break;
677
678 case IDX_TITLE: /* title */
679 ExtToUtf_SetResult(interp,
680 player_title[p_ptr->rp.pclass][(p_ptr->lev-1)/5]);
681 break;
682
683 case IDX_TO_DAM: /* to_dam */
684 Tcl_SetIntObj(resultPtr, p_ptr->dis_to_d);
685 break;
686
687 case IDX_TO_HIT: /* to_hit */
688 Tcl_SetIntObj(resultPtr, p_ptr->dis_to_h);
689 break;
690
691 case IDX_WEIGHT: /* weight */
692 Tcl_SetIntObj(resultPtr, p_ptr->rp.wt);
693 break;
694
695 case IDX_TOTAL_WEIGHT: /* total_weight */
696 Tcl_SetIntObj(resultPtr, p_ptr->total_weight);
697 break;
698
699 case IDX_PRESERVE: /* preserve */
700 Tcl_SetIntObj(resultPtr, preserve_mode);
701 break;
702
703 case IDX_BASE_NAME: /* base_name */
704 ExtToUtf_SetResult(interp, player_base);
705 break;
706
707 case IDX_IS_DEAD: /* is_dead */
708 Tcl_SetBooleanObj(resultPtr, p_ptr->state.is_dead);
709 break;
710
711 case IDX_TURN: /* turn */
712 Tcl_SetLongObj(resultPtr, turn);
713 break;
714
715 case IDX_MAX_LEVEL: /* max_level */
716 Tcl_SetIntObj(resultPtr, p_ptr->max_lev);
717 break;
718
719 case IDX_DISTURB: /* disturb */
720 /* When is this allowed? */
721 if (inkey_flags == 0)
722 {
723 disturb(FALSE);
724 }
725 break;
726
727 case IDX_NEW_SPELLS: /* new_spells */
728 if (!p_ptr->spell.r[0].realm)
729 {
730 Tcl_SetStringObj(resultPtr, "character cannot read books", -1);
731 return TCL_ERROR;
732 }
733 Tcl_SetIntObj(resultPtr, p_ptr->new_spells);
734 break;
735
736 case IDX_COMMAND_REP: /* command_rep */
737 Tcl_SetIntObj(resultPtr, p_ptr->cmd.rep);
738 break;
739
740 case IDX_RUNNING: /* running */
741 Tcl_SetIntObj(resultPtr, p_ptr->state.running);
742 break;
743
744 case IDX_PRAYER_OR_SPELL: /* prayer_or_spell */
745 if (!p_ptr->spell.r[0].realm)
746 {
747 Tcl_SetStringObj(resultPtr, "character cannot read books", -1);
748 return TCL_ERROR;
749 }
750 switch (mp_ptr->spell_book)
751 {
752 case TV_LIFE_BOOK: t = "prayer"; break;
753 default: t = "spell"; break;
754 }
755 if (t == NULL)
756 {
757 quit_fmt("unhandled mp_ptr->spell_book %d",
758 mp_ptr->spell_book);
759 }
760 Tcl_SetStringObj(resultPtr, t, -1);
761 break;
762
763 case IDX_HEALTH_WHO: /* health_who */
764 /*
765 * Should I call health_track() to set PW_HEALTH?
766 * Should I call handle_stuff() to update the display?
767 */
768 if (objC == 3)
769 {
770 int m_idx;
771 if (Tcl_GetIntFromObj(interp, objV[2], &m_idx) != TCL_OK)
772 {
773 return TCL_ERROR;
774 }
775 if ((m_idx < 0) || (m_idx >= m_max))
776 {
777 Tcl_SetStringObj(resultPtr,
778 format("bad m_list index \"%d\": must be between 0 and %d",
779 m_idx, (int) m_max - 1), -1);
780 }
781 p_ptr->health_who = m_idx;
782 break;
783 }
784 Tcl_SetIntObj(resultPtr, p_ptr->health_who);
785 break;
786
787 case IDX_MONSTER_RACE_IDX: /* monster_race_idx */
788 /*
789 * Should I call monster_race_track() to set PW_MONSTER?
790 * Should I call handle_stuff() to update the display?
791 */
792 if (objC == 3)
793 {
794 int r_idx;
795 if (Tcl_GetIntFromObj(interp, objV[2], &r_idx) != TCL_OK)
796 {
797 return TCL_ERROR;
798 }
799 if (!((r_idx >= 0) && (r_idx < z_info->r_max)))
800 {
801 Tcl_SetStringObj(resultPtr,
802 format("bad r_info index \"%d\": must be between 0 and %d",
803 r_idx, (int) z_info->r_max - 1), -1);
804 return TCL_ERROR;
805 }
806 p_ptr->monster_race_idx = r_idx;
807 break;
808 }
809 Tcl_SetIntObj(resultPtr, p_ptr->monster_race_idx);
810 break;
811
812 case IDX_LIFE_RATING: /* life_rating */
813 i = (int) (((long) p_ptr->player_hp[PY_MAX_LEVEL - 1] * 200L) /
814 (2 * p_ptr->rp.hitdie + ((PY_MAX_LEVEL - 1) *
815 (p_ptr->rp.hitdie + 1))));
816 Tcl_SetIntObj(resultPtr, i);
817 break;
818
819 case IDX_PETS: /* pets */
820 Tcl_SetObjResult(interp, DumpPets());
821 break;
822
823 case IDX_REALM1: /* realm1 */
824 Tcl_SetStringObj(resultPtr,
825 realm_names[p_ptr->spell.r[0].realm], -1);
826 break;
827
828 case IDX_REALM2: /* realm2 */
829 Tcl_SetStringObj(resultPtr,
830 realm_names[p_ptr->spell.r[1].realm], -1);
831 break;
832
833 case IDX_PATRON: /* patron */
834 ExtToUtf_SetResult(interp,
835 chaos_patrons[p_ptr->chaos_patron]);
836 break;
837
838 }
839
840 return TCL_OK;
841 }
842
843 /*
844 *--------------------------------------------------------------
845 *
846 * angtk_eval --
847 *
848 * Eval() a command with arguments.
849 *
850 *--------------------------------------------------------------
851 */
852
angtk_eval(cptr command,...)853 void angtk_eval(cptr command, ...)
854 {
855 cptr s = command;
856 va_list vp;
857 int objc = 0;
858 Tcl_Obj *objv[40];
859 int i, result;
860
861 /* Start processing variable argument list */
862 va_start(vp, command);
863
864 /* Process each string argument */
865 while (s)
866 {
867 /* Append a new string object to the command object */
868 /* XXX Some args are already ASCII, safe to translate? */
869 objv[objc++] = ExtToUtf_NewStringObj(s, -1);
870 Tcl_IncrRefCount(objv[objc - 1]);
871
872 /* Get the next string argument */
873 s = va_arg(vp, cptr);
874 }
875
876 /* Finish processing variable argument list */
877 va_end(vp);
878
879 result = Tcl_EvalObjv(g_interp, objc, objv, TCL_EVAL_GLOBAL);
880
881 for (i = 0; i < objc; i++)
882 {
883 Tcl_DecrRefCount(objv[i]);
884 }
885
886 if (result == TCL_ERROR)
887 {
888 /* Report the error */
889 Tcl_AddErrorInfo(g_interp,
890 "\n (inside angtk_eval)");
891 Tcl_BackgroundError(g_interp);
892 }
893 }
894
895
HandleError(void)896 static void HandleError(void)
897 {
898 char path[1024];
899 cptr errorInfo;
900 FILE *fp;
901
902 /* Dump the stack to errors.txt */
903 path_make(path, ANGBAND_DIR_TK, "errors.txt");
904 fp = fopen(path, "a");
905 if (fp != NULL)
906 {
907 errorInfo = Tcl_GetVar(g_interp, "errorInfo", TCL_GLOBAL_ONLY);
908 fprintf(fp, "***** (inside HandleError)\n\n%s\n\n", errorInfo);
909 fclose(fp);
910 }
911
912 /* Display a message and quit */
913 quit_fmt("The following error occurred:\n\n%s\n\n"
914 "Please examine the errors.txt file to see what happened.",
915 Tcl_GetStringResult(g_interp));
916 }
917
918
919 static CommandInit commandInit[] = {
920 {0, "angband", 0, 0, NULL, NULL, (ClientData) 0},
921 {1, "cave", 0, 0, NULL, objcmd_cave, (ClientData) 0},
922 {1, "game", 0, 0, NULL, objcmd_game, (ClientData) 0},
923 {1, "inkey_flags", 1, 1, NULL, objcmd_inkey_flags, (ClientData) 0},
924 {1, "inventory", 0, 0, NULL, objcmd_inventory, (ClientData) 0},
925 {1, "keypress", 2, 2, "string", objcmd_keypress, (ClientData) 0},
926 {1, "message", 0, 0, NULL, objcmd_message, (ClientData) 0},
927 {1, "player", 0, 0, NULL, objcmd_player, (ClientData) 0},
928 {1, "equipinfo", 3, 3, "slot arrayName", objcmd_equipinfo, (ClientData) 0},
929 {1, "inveninfo", 3, 3, "slot arrayName", objcmd_inveninfo, (ClientData) 0},
930 {1, "init_icons", 3, 3, "size depth", objcmd_init_icons, (ClientData) 0},
931 {1, "floor", 0, 0, NULL, objcmd_floor, (ClientData) 0},
932 {1, "keycount", 0, 0, NULL, objcmd_keycount, (ClientData) 0},
933 {0, "fontdesc", 2, 2, "font", objcmd_fontdesc, (ClientData) 0},
934 {0, NULL, 0, 0, NULL, NULL, (ClientData) 0}
935 };
936
937 /*
938 * Initialize stuff after Tcl/Tk but before a game is started.
939 */
angtk_init(void)940 void angtk_init(void)
941 {
942 char path[1024];
943
944 /* Tcl commands */
945 CommandInfo_Init(g_interp, commandInit, NULL);
946
947 /* Standard color palette */
948 init_palette();
949
950 /* Source the "startup script" */
951 path_make(path, ANGBAND_DIR_TK, "init-startup.tcl");
952 if (angtk_eval_file(path) == TCL_ERROR)
953 {
954 HandleError();
955 }
956 }
957
958 /*
959 * Initialize stuff after init_angband().
960 */
angtk_angband_initialized(void)961 void angtk_angband_initialized(void)
962 {
963 char path[1024];
964
965 /* Program is intialized */
966 if (Tcl_EvalEx(g_interp, "angband_initialized", -1, TCL_EVAL_GLOBAL) != TCL_OK)
967 {
968 HandleError();
969 }
970
971 /* Source a file to create the interface */
972 path_make(path, ANGBAND_DIR_TK, "init-other.tcl");
973 if (angtk_eval_file(path) == TCL_ERROR)
974 {
975 HandleError();
976 }
977
978 /* The icon environment must be initialized by a script. */
979 if (g_icon_size == 0)
980 {
981 quit_fmt("Fatal error:\nIcons were not initialized.\n"
982 "You must call \"angband init_icons\"");
983 }
984 }
985
986 /*
987 * Tcl_Eval() a file, assuming the given filename is not UTF-8.
988 */
angtk_eval_file(cptr extFileName)989 int angtk_eval_file(cptr extFileName)
990 {
991 cptr utfFileName;
992 Tcl_DString dString;
993 int result;
994
995 utfFileName = Tcl_ExternalToUtfDString(NULL, extFileName, -1, &dString);
996 result = Tcl_EvalFile(g_interp, utfFileName);
997 Tcl_DStringFree(&dString);
998 return result;
999 }
1000
1001 /*
1002 *--------------------------------------------------------------
1003 *
1004 * objcmd_cave --
1005 *
1006 * Implements the "cave" script command.
1007 * Syntax:
1008 * cave blocked y x -- can player move there
1009 * cave examine y x -- describe what's there
1010 * cave height -- height of cave
1011 * cave width -- width of cave
1012 * cave info -- get info about a grid
1013 * cave wild_name -- get name of wilderness area
1014 *
1015 *--------------------------------------------------------------
1016 */
1017
1018 int
objcmd_cave(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1019 objcmd_cave(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1020 {
1021 CommandInfo *infoCmd = (CommandInfo *) clientData;
1022 int objC = objc - infoCmd->depth;
1023 Tcl_Obj *CONST *objV = objv + infoCmd->depth;
1024
1025 static cptr cmdOptions[] = {"wild_name", NULL};
1026 enum {IDX_WILD_NAME};
1027 int option;
1028 Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
1029
1030 if (objC < 2)
1031 {
1032 Tcl_WrongNumArgs(interp, infoCmd->depth + 1, objv, "option ?arg ...?");
1033 return TCL_ERROR;
1034 }
1035
1036 if (Tcl_GetIndexFromObj(interp, objV[1], cmdOptions, "option", 0,
1037 &option) != TCL_OK)
1038 {
1039 return TCL_ERROR;
1040 }
1041
1042 switch (option)
1043 {
1044
1045 case IDX_WILD_NAME: /* wild_name */
1046 if (!character_dungeon)
1047 {
1048 /* Set the error */
1049 Tcl_SetStringObj(resultPtr, "dungeon has not been generated yet", -1);
1050 goto error;
1051 }
1052 if (!p_ptr->depth)
1053 {
1054 if (p_ptr->place_num)
1055 {
1056 ExtToUtf_SetResult(interp, place[p_ptr->place_num].name);
1057 }
1058 else
1059 {
1060 Tcl_SetStringObj(resultPtr, "Wilderness", -1);
1061 }
1062 }
1063 break;
1064 }
1065
1066 /* Success */
1067 return TCL_OK;
1068
1069 error:
1070
1071 /* Failure */
1072 return TCL_ERROR;
1073 }
1074
1075
1076 /*
1077 *--------------------------------------------------------------
1078 *
1079 * objcmd_floor --
1080 *
1081 * Implements the "floor" script command.
1082 * Syntax:
1083 *
1084 * floor find SEARCHCOMMAND ?arg arg ...?
1085 * Return list of indexes of matching objects
1086 * floor info INDEX arrayName
1087 * floor memory INDEX
1088 *
1089 *--------------------------------------------------------------
1090 */
1091
1092 int
objcmd_floor(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1093 objcmd_floor(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1094 {
1095 CommandInfo *infoCmd = (CommandInfo *) clientData;
1096 int objC = objc - infoCmd->depth;
1097 Tcl_Obj *CONST *objV = objv + infoCmd->depth;
1098
1099 static cptr cmdOptions[] = {"find", "memory",
1100 NULL};
1101 enum {IDX_FIND, IDX_MEMORY};
1102 int option;
1103 Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
1104 int index;
1105
1106 Tcl_Obj *listObjPtr;
1107 char *buffer;
1108 int i;
1109 long length;
1110 object_type *o_ptr;
1111 int fy, fx;
1112
1113 /* Default to finding all matches */
1114 int request_limit = 0, match_limit = 0, cnt = 0;
1115
1116 /* Default to ignoring item_tester_okay() hook */
1117 int request_tester = 0, match_tester = 0;
1118
1119 /* Default to no restriction on tval */
1120 int request_tval = 0, match_tval[10], tval_cnt = 0;
1121
1122 if (objC < 2)
1123 {
1124 Tcl_WrongNumArgs(interp, infoCmd->depth + 1, objv, "option ?arg ...?");
1125 return TCL_ERROR;
1126 }
1127
1128 if (Tcl_GetIndexFromObj(interp, objV[1], cmdOptions, "option", 0,
1129 &option) != TCL_OK)
1130 {
1131 return TCL_ERROR;
1132 }
1133
1134 /* XXX Hack -- Determine the location to display */
1135 fy = p_ptr->py;
1136 fx = p_ptr->px;
1137
1138 switch (option)
1139 {
1140 case IDX_FIND: /* find */
1141 {
1142 bool (*old_tester_hook)(const object_type *) = item_tester_hook;
1143 bool (*temp_tester_hook)(const object_type *) = NULL;
1144
1145 /* Scan arguments for options */
1146 for (i = 2; i < objC; )
1147 {
1148 static cptr cmdOptions[] = {"-limit", "-tester", NULL};
1149
1150 /* Get the sub-option */
1151 if (Tcl_GetIndexFromObj(interp, objV[i], cmdOptions, "option",
1152 0, &index) != TCL_OK)
1153 {
1154 return TCL_ERROR;
1155 }
1156
1157 switch (index)
1158 {
1159 case 0: /* Limit */
1160 {
1161 if (Tcl_GetIntFromObj(interp, objV[i+1], &match_limit)
1162 != TCL_OK)
1163 {
1164 return TCL_ERROR;
1165 }
1166 request_limit = 1;
1167 i += 2;
1168 break;
1169 }
1170
1171 case 1: /* Tester */
1172 {
1173 if (Tcl_GetBooleanFromObj(interp, objV[i+1],
1174 &match_tester) != TCL_OK)
1175 {
1176 return TCL_ERROR;
1177 }
1178 request_tester = 1;
1179 i += 2;
1180 break;
1181 }
1182 }
1183 }
1184
1185 if (temp_tester_hook) item_tester_hook = temp_tester_hook;
1186
1187 /* Return a list of o_list[] indexes */
1188 listObjPtr = Tcl_NewListObj(0, NULL);
1189
1190 /* Scan all objects in the grid */
1191 OBJ_ITT_START (area(fx, fy)->o_idx, o_ptr)
1192 {
1193 if (request_tester && match_tester)
1194 {
1195 /* Accept TV_GOLD if no tester */
1196 if ((o_ptr->tval == TV_GOLD) && !item_tester_hook &&
1197 !item_tester_tval)
1198 {
1199 /* Nothing */
1200 }
1201 else if (!item_tester_okay(o_ptr))
1202 {
1203 continue;
1204 }
1205 }
1206 if (request_tval)
1207 {
1208 for (i = 0; i < tval_cnt; i++)
1209 {
1210 if (match_tval[0] == o_ptr->tval) break;
1211 }
1212 if (i == tval_cnt) continue;
1213 }
1214
1215 /* Found a match */
1216 Tcl_ListObjAppendElement(interp, listObjPtr,
1217 Tcl_NewIntObj(_this_o_idx));
1218
1219 /* Return x matches */
1220 if (request_limit && (++cnt >= match_limit)) break;
1221 }
1222 OBJ_ITT_END;
1223
1224 /* XXX Hack -- Restore the hook */
1225 item_tester_hook = old_tester_hook;
1226
1227 /* Return a list of o_list[] indexes */
1228 Tcl_SetObjResult(interp, listObjPtr);
1229 break;
1230 }
1231
1232 case IDX_MEMORY: /* memory */
1233
1234 if (Tcl_GetIntFromObj(interp, objV[2], &i) != TCL_OK)
1235 {
1236 return TCL_ERROR;
1237 }
1238 if (i <= 0 || i > o_max) goto bad_index;
1239
1240 /* Get item info */
1241 o_ptr = &o_list[i];
1242
1243 /* Illegal */
1244 if (!o_ptr->k_idx || (o_ptr->iy != fy) || (o_ptr->ix != fx))
1245 {
1246 goto bad_index;
1247 }
1248
1249 C_MAKE(buffer, 5 * 1024L, char);
1250 length = angtk_describe_object(o_ptr, buffer, FALSE);
1251 Tcl_SetObjResult(interp, ExtToUtf_NewStringObj(buffer, length));
1252 FREE(buffer);
1253 break;
1254 }
1255
1256 return TCL_OK;
1257
1258 bad_index:
1259 Tcl_SetStringObj(resultPtr, format("bad floor index \"%d\"", i), -1);
1260 return TCL_ERROR;
1261 }
1262
1263
1264 /*
1265 *--------------------------------------------------------------
1266 *
1267 * objcmd_game --
1268 *
1269 * Implements the "game" script command.
1270 * Syntax:
1271 * game abort ?confirm? -- Quit without saving
1272 * game directory -- Get a directory pathname
1273 * game keymap_dump -- Dump a keymap file
1274 * game new -- Start a new game
1275 * game open -- Open a save file
1276 * game process_pref_file -- Process a preference file
1277 * game quit -- Quit with save
1278 *
1279 *--------------------------------------------------------------
1280 */
1281
1282
1283 /* List of directory keywords */
1284 cptr keyword_path[] = {
1285 "ANGBAND_DIR_ROOT",
1286 "ANGBAND_DIR_USER",
1287 "ANGBAND_DIR_TK",
1288 NULL
1289 };
1290
1291
1292 int
objcmd_game(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1293 objcmd_game(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1294 {
1295 CommandInfo *infoCmd = (CommandInfo *) clientData;
1296 int objC = objc - infoCmd->depth;
1297 Tcl_Obj *CONST *objV = objv + infoCmd->depth;
1298
1299 static cptr cmdOptions[] = {"abort", "tkdir" "version", NULL};
1300 enum {IDX_ABORT, IDX_TKDIR, IDX_VERSION};
1301 int option;
1302 Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
1303 int index;
1304
1305 if (objC < 2)
1306 {
1307 Tcl_WrongNumArgs(interp, infoCmd->depth + 1, objv, "option ?arg ...?");
1308 return TCL_ERROR;
1309 }
1310
1311 if (Tcl_GetIndexFromObj(interp, objV[1], cmdOptions, "option", 0,
1312 &option) != TCL_OK)
1313 {
1314 return TCL_ERROR;
1315 }
1316
1317 switch (option)
1318 {
1319 case IDX_ABORT: /* abort */
1320 {
1321 int confirm = 1;
1322 if (objC == 3)
1323 {
1324 static cptr abortSwitch[] = {"-noask", NULL};
1325 if (Tcl_GetIndexFromObj(interp, objV[2], abortSwitch,
1326 "switch", 0, &index) != TCL_OK)
1327 {
1328 return TCL_ERROR;
1329 }
1330 confirm = 0;
1331 }
1332 if (confirm && game_in_progress && character_generated)
1333 {
1334 int result;
1335
1336 result = Tcl_EvalEx(g_interp,
1337 "tk_messageBox -icon warning -type okcancel -message \"Your character will not be saved!\" -title \"Quit Without Saving\"",
1338 -1, TCL_EVAL_GLOBAL);
1339 if (result == TCL_OK)
1340 {
1341 cptr s = Tcl_GetStringResult(g_interp);
1342 if (!strcmp(s, "cancel")) break;
1343 }
1344 }
1345 quit(NULL);
1346 break;
1347 }
1348
1349 case IDX_TKDIR: /* Tk directory for game .tcl files */
1350 {
1351 /* Return the current directory path */
1352 ExtToUtf_SetResult(interp, ANGBAND_DIR_TK);
1353 break;
1354 }
1355
1356 case IDX_VERSION: /* version */
1357 Tcl_SetStringObj(resultPtr, format("%d.%d.%d", VER_MAJOR,
1358 VER_MINOR, VER_PATCH), -1);
1359 break;
1360 }
1361
1362 return TCL_OK;
1363 }
1364
1365
1366 /* init_icons $size $depth */
1367 int
objcmd_init_icons(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1368 objcmd_init_icons(ClientData clientData, Tcl_Interp *interp, int objc,
1369 Tcl_Obj *CONST objv[])
1370 {
1371 CommandInfo *infoCmd = (CommandInfo *) clientData;
1372 /* int objC = objc - infoCmd->depth; */
1373 Tcl_Obj *CONST *objV = objv + infoCmd->depth;
1374
1375 int size, depth;
1376
1377 /* Hack - ignore parameter */
1378 (void) objc;
1379
1380 if (g_icon_size)
1381 {
1382 Tcl_SetResult(interp, (char *) "icons were already initialized", TCL_VOLATILE);
1383 return TCL_ERROR;
1384 }
1385
1386 /* Get the size */
1387 if (Tcl_GetIntFromObj(interp, objV[1], &size) != TCL_OK)
1388 {
1389 return TCL_ERROR;
1390 }
1391
1392 /* Get the depth */
1393 if (Tcl_GetIntFromObj(interp, objV[2], &depth) != TCL_OK)
1394 {
1395 return TCL_ERROR;
1396 }
1397
1398 /* Initialize (quit on failure) */
1399 init_icons(size, depth);
1400
1401 return TCL_OK;
1402 }
1403
1404 /* Strings returned by "inkey_flags" command, indexed by INKEY_XXX defines. */
1405 cptr inkey_to_str[] = {"", "INKEY_CMD", "INKEY_DIR", "INKEY_DISTURB",
1406 "INKEY_ITEM", "INKEY_ITEM_STORE", "INKEY_MORE", "INKEY_SPELL",
1407 "INKEY_TARGET", "INKEY_POWER", "INKEY_CMD_PET",
1408 NULL};
1409
1410 /* (inkey) flags */
1411 int
objcmd_inkey_flags(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1412 objcmd_inkey_flags(ClientData clientData, Tcl_Interp *interp, int objc,
1413 Tcl_Obj *CONST objv[])
1414 {
1415 /* Hack - ignore parameters */
1416 (void) objc;
1417 (void) objv;
1418 (void) clientData;
1419
1420 Tcl_SetResult(interp, (char *) inkey_to_str[inkey_flags], TCL_VOLATILE);
1421 return TCL_OK;
1422 }
1423
1424
1425 /*
1426 *--------------------------------------------------------------
1427 *
1428 * objcmd_inventory --
1429 *
1430 * Implements the "inventory" script command.
1431 * Syntax:
1432 *
1433 * inventory count
1434 * Return number of inventory items carried
1435 *
1436 * inventory find SEARCHCOMMAND ?arg arg ...?
1437 * Return list of indexes of matching objects
1438 *
1439 * inventory info INDEX VARNAME
1440 * Return info about specific object
1441 *
1442 * inventory memory INDEX
1443 * Return memory about about specific object
1444 *
1445 * inventory total_weight
1446 * Return total weight carried
1447 *
1448 * inventory weight_limit
1449 * Return carrying capacity in 10ths of pounds
1450 *
1451 *--------------------------------------------------------------
1452 */
1453
1454 int
objcmd_inventory(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1455 objcmd_inventory(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1456 {
1457 CommandInfo *infoCmd = (CommandInfo *) clientData;
1458 int objC = objc - infoCmd->depth;
1459 Tcl_Obj *CONST *objV = objv + infoCmd->depth;
1460
1461 static cptr cmdOptions[] = {
1462 "total_weight", "weight_limit",
1463 NULL};
1464 enum {IDX_TOTAL_WEIGHT, IDX_WEIGHT_LIMIT};
1465 int option;
1466 Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
1467
1468 int i;
1469
1470 if (objC < 2)
1471 {
1472 Tcl_WrongNumArgs(interp, infoCmd->depth + 1, objv, "option ?arg ...?");
1473 return TCL_ERROR;
1474 }
1475
1476 if (Tcl_GetIndexFromObj(interp, objV[1], cmdOptions, "option", 0,
1477 &option) != TCL_OK)
1478 {
1479 return TCL_ERROR;
1480 }
1481
1482 switch (option)
1483 {
1484 case IDX_TOTAL_WEIGHT: /* total_weight */
1485 Tcl_SetIntObj(resultPtr, p_ptr->total_weight);
1486 break;
1487
1488 case IDX_WEIGHT_LIMIT: /* weight_limit */
1489
1490 /* Max carrying capacity in 10ths of pounds */
1491 i = adj_str_wgt[p_ptr->stat[A_STR].ind] * 100;
1492 Tcl_SetIntObj(resultPtr, i);
1493 break;
1494 }
1495
1496 return TCL_OK;
1497 }
1498
1499 /* keycount */
1500 int
objcmd_keycount(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1501 objcmd_keycount(ClientData clientData, Tcl_Interp *interp, int objc,
1502 Tcl_Obj *CONST objv[])
1503 {
1504 /* Hack - ignore parameters */
1505 (void) objc;
1506 (void) objv;
1507 (void) clientData;
1508
1509 Tcl_SetObjResult(interp,
1510 Tcl_NewBooleanObj(Term->key_head != Term->key_tail));
1511 return TCL_OK;
1512 }
1513
1514 /* keypress $string */
1515 int
objcmd_keypress(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1516 objcmd_keypress(ClientData clientData, Tcl_Interp *interp, int objc,
1517 Tcl_Obj *CONST objv[])
1518 {
1519 CommandInfo *infoCmd = (CommandInfo *) clientData;
1520 /* int objC = objc - infoCmd->depth; */
1521 Tcl_Obj *CONST *objV = objv + infoCmd->depth;
1522
1523 char *t;
1524 int i;
1525
1526 /* Hack - ignore parameters */
1527 (void) objc;
1528 (void) interp;
1529
1530 t = Tcl_GetStringFromObj(objV[1], NULL);
1531 for (i = 0; t[i]; i++)
1532 {
1533 Term_keypress(t[i]);
1534 }
1535 return TCL_OK;
1536 }
1537
1538
1539 /*
1540 *--------------------------------------------------------------
1541 *
1542 * objcmd_message --
1543 *
1544 * Implements the "message" script command.
1545 * Syntax:
1546 * message color -- Return color for message $index
1547 * message count -- Return number of saved messages
1548 * message get $index -- Return most-recent number of messages
1549 * message sound $index -- Return sound for message $index
1550 *
1551 *--------------------------------------------------------------
1552 */
1553
1554 int
objcmd_message(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1555 objcmd_message(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1556 {
1557 CommandInfo *infoCmd = (CommandInfo *) clientData;
1558 int objC = objc - infoCmd->depth;
1559 Tcl_Obj *CONST *objV = objv + infoCmd->depth;
1560
1561 static cptr cmdOption[] = {"color", "count", "get", NULL};
1562 enum {IDX_COLOR, IDX_COUNT, IDX_GET};
1563 int option;
1564 Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
1565
1566 int i, k;
1567 byte attr;
1568
1569 if (objC < 2)
1570 {
1571 Tcl_WrongNumArgs(interp, infoCmd->depth + 1, objv, "option ?arg ...?");
1572 return TCL_ERROR;
1573 }
1574
1575 if (Tcl_GetIndexFromObj(interp, objV[1], cmdOption, "option", 0,
1576 &option) != TCL_OK)
1577 {
1578 return TCL_ERROR;
1579 }
1580
1581 if (!character_generated)
1582 {
1583 Tcl_AppendStringsToObj(resultPtr,
1584 "character has not been generated yet", NULL);
1585 return TCL_ERROR;
1586 }
1587
1588 switch (option)
1589 {
1590 case IDX_COLOR: /* color */
1591 if (Tcl_GetIntFromObj(interp, objV[2], &i) != TCL_OK)
1592 {
1593 return TCL_ERROR;
1594 }
1595 k = message_num();
1596 if (i < 0 || i >= k)
1597 {
1598 Tcl_SetStringObj(resultPtr, format("invalid message index \"%d\": "
1599 "must be from 0 to %d", i, k - 1), -1);
1600 return TCL_ERROR;
1601 }
1602 attr = TERM_WHITE;
1603 Tcl_SetStringObj(resultPtr, keyword_term_color[attr], -1);
1604 break;
1605
1606 case IDX_COUNT: /* count */
1607 Tcl_SetIntObj(resultPtr, message_num());
1608 break;
1609
1610 case IDX_GET: /* get */
1611 if (Tcl_GetIntFromObj(interp, objV[2], &i) != TCL_OK)
1612 {
1613 return TCL_ERROR;
1614 }
1615 k = message_num();
1616 if (i < 0 || i >= k)
1617 {
1618 Tcl_SetStringObj(resultPtr, format("invalid message index \"%d\": "
1619 "must be from 0 to %d", i, k - 1), -1);
1620 return TCL_ERROR;
1621 }
1622 ExtToUtf_SetResult(interp, message_str(i));
1623 break;
1624 }
1625
1626 return TCL_OK;
1627 }
1628