1 #ifdef RCSID
2 static char RCSid[] =
3 "$Header: d:/cvsroot/tads/TADS2/BIF.C,v 1.4 1999/07/11 00:46:29 MJRoberts Exp $";
4 #endif
5
6 /*
7 * Copyright (c) 1991, 2002 Michael J. Roberts. All Rights Reserved.
8 *
9 * Please see the accompanying license file, LICENSE.TXT, for information
10 * on using and copying this software.
11 */
12 /*
13 Name
14 bif.c - built-in function implementation
15 Function
16 Implements built-in functions for TADS
17 Notes
18 None
19 Modified
20 04/11/99 CNebel - fix signed/unsigned mismatches
21 12/16/92 MJRoberts - add TADS/Graphic functions
22 12/26/91 MJRoberts - creation
23 */
24
25 #include <ctype.h>
26 #include <string.h>
27 #include <stdlib.h>
28 #include <stdio.h>
29 #include <math.h>
30 #include <time.h>
31 #include "os.h"
32 #include "std.h"
33 #include "bif.h"
34 #include "tio.h"
35 #include "run.h"
36 #include "voc.h"
37 #include "fio.h"
38 #include "dbg.h"
39 #include "prp.h"
40 #include "lst.h"
41 #include "trd.h"
42 #include "regex.h"
43 #include "res.h"
44
45
46 /* yorn - yes or no */
bifyon(bifcxdef * ctx,int argc)47 void bifyon(bifcxdef *ctx, int argc)
48 {
49 char rsp[128];
50 char *p;
51 runsdef val;
52 char yesbuf[64];
53 char nobuf[64];
54 re_context rectx;
55 int match_yes;
56 int match_no;
57
58 bifcntargs(ctx, 0, argc); /* check for proper argument count */
59
60 /* load the "yes" and "no" reply patterns */
61 if (os_get_str_rsc(RESID_YORN_YES, yesbuf, sizeof(yesbuf)))
62 strcpy(yesbuf, "[Yy].*");
63 if (os_get_str_rsc(RESID_YORN_NO, nobuf, sizeof(nobuf)))
64 strcpy(nobuf, "[Nn].*");
65
66 /* if we're in HTML mode, switch to input font */
67 if (tio_is_html_mode())
68 tioputs(ctx->bifcxtio, "<font face='TADS-Input'>");
69
70 /* ensure the prompt is displayed */
71 tioflushn(ctx->bifcxtio, 0);
72
73 /* reset count of lines since the last keyboard input */
74 tioreset(ctx->bifcxtio);
75
76 /* read a line of text */
77 if (tiogets(ctx->bifcxtio, (char *)0, rsp, (int)sizeof(rsp)))
78 runsig(ctx->bifcxrun, ERR_RUNQUIT);
79
80 /* if we're in HTML mode, close the input font tag */
81 if (tio_is_html_mode())
82 tioputs(ctx->bifcxtio, "</font>");
83
84 /* scan off leading spaces */
85 for (p = rsp ; t_isspace(*p) ; ++p) ;
86
87 /* set up our regex context */
88 re_init(&rectx, ctx->bifcxerr);
89
90 /* check for a "yes" response */
91 match_yes = re_compile_and_match(&rectx, yesbuf, strlen(yesbuf),
92 p, strlen(p));
93
94 /* check for a "no" response */
95 match_no = re_compile_and_match(&rectx, nobuf, strlen(nobuf),
96 p, strlen(p));
97
98 /* check the result */
99 if (match_yes == (int)strlen(p))
100 val.runsv.runsvnum = 1;
101 else if (match_no == (int)strlen(p))
102 val.runsv.runsvnum = 0;
103 else
104 val.runsv.runsvnum = -1;
105
106 /* delete our regex context */
107 re_delete(&rectx);
108
109 /* push the result */
110 runpush(ctx->bifcxrun, DAT_NUMBER, &val);
111 }
112
113 /* setfuse */
bifsfs(bifcxdef * ctx,int argc)114 void bifsfs(bifcxdef *ctx, int argc)
115 {
116 objnum func;
117 uint tm;
118 runsdef val;
119 voccxdef *voc = ctx->bifcxrun->runcxvoc;
120
121 bifcntargs(ctx, 3, argc); /* check for proper argument count */
122 func = runpopfn(ctx->bifcxrun);
123 tm = runpopnum(ctx->bifcxrun);
124 runpop(ctx->bifcxrun, &val);
125
126 /* limitation: don't allow string or list for value */
127 if (val.runstyp == DAT_LIST || val.runstyp == DAT_SSTRING)
128 runsig(ctx->bifcxrun, ERR_FUSEVAL);
129
130 vocsetfd(voc, voc->voccxfus, func, (prpnum)0,
131 tm, &val, ERR_MANYFUS);
132 }
133
134 /* remfuse */
bifrfs(bifcxdef * ctx,int argc)135 void bifrfs(bifcxdef *ctx, int argc)
136 {
137 objnum func;
138 runsdef val;
139 voccxdef *voc = ctx->bifcxrun->runcxvoc;
140
141 bifcntargs(ctx, 2, argc);
142 func = runpopfn(ctx->bifcxrun);
143 runpop(ctx->bifcxrun, &val);
144 vocremfd(voc, voc->voccxfus, func, (prpnum)0,
145 &val, ERR_NOFUSE);
146 }
147
148 /* setdaemon */
bifsdm(bifcxdef * ctx,int argc)149 void bifsdm(bifcxdef *ctx, int argc)
150 {
151 objnum func;
152 runsdef val;
153 voccxdef *voc = ctx->bifcxrun->runcxvoc;
154
155 bifcntargs(ctx, 2, argc); /* check for proper argument count */
156 func = runpopfn(ctx->bifcxrun);
157 runpop(ctx->bifcxrun, &val);
158
159 /* limitation: don't allow string or list for value */
160 if (val.runstyp == DAT_LIST || val.runstyp == DAT_SSTRING)
161 runsig(ctx->bifcxrun, ERR_FUSEVAL);
162
163 vocsetfd(voc, voc->voccxdmn, func, (prpnum)0, 0,
164 &val, ERR_MANYDMN);
165 }
166
167 /* remdaemon */
bifrdm(bifcxdef * ctx,int argc)168 void bifrdm(bifcxdef *ctx, int argc)
169 {
170 objnum func;
171 runsdef val;
172 voccxdef *voc = ctx->bifcxrun->runcxvoc;
173
174 bifcntargs(ctx, 2, argc);
175 func = runpopfn(ctx->bifcxrun);
176 runpop(ctx->bifcxrun, &val);
177 vocremfd(voc, voc->voccxdmn, func, (prpnum)0,
178 &val, ERR_NODMN);
179 }
180
181 /* incturn */
bifinc(bifcxdef * ctx,int argc)182 void bifinc(bifcxdef *ctx, int argc)
183 {
184 int turncnt;
185
186 if (argc == 1)
187 {
188 /* get the number of turns to skip */
189 turncnt = runpopnum(ctx->bifcxrun);
190 if (turncnt < 1)
191 runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "incturn");
192 }
193 else
194 {
195 /* no arguments -> increment by one turn */
196 bifcntargs(ctx, 0, argc);
197 turncnt = 1;
198 }
199
200 /* skip the given number of turns */
201 vocturn(ctx->bifcxrun->runcxvoc, turncnt, TRUE);
202 }
203
204 /* skipturn */
bifskt(bifcxdef * ctx,int argc)205 void bifskt(bifcxdef *ctx, int argc)
206 {
207 int turncnt;
208
209 bifcntargs(ctx, 1, argc);
210 turncnt = runpopnum(ctx->bifcxrun);
211 if (turncnt < 1)
212 runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "skipturn");
213 vocturn(ctx->bifcxrun->runcxvoc, turncnt, FALSE);
214 }
215
216 /* quit */
bifqui(bifcxdef * ctx,int argc)217 void bifqui(bifcxdef *ctx, int argc)
218 {
219 /* check for proper argument count */
220 bifcntargs(ctx, 0, argc);
221
222 /* flush output buffer, and signal the end of the game */
223 tioflush(ctx->bifcxtio);
224 errsig(ctx->bifcxerr, ERR_RUNQUIT);
225 }
226
227 /* internal function to convert a TADS string into a C-string */
bifcstr(bifcxdef * ctx,char * buf,size_t bufsiz,uchar * str)228 static void bifcstr(bifcxdef *ctx, char *buf, size_t bufsiz, uchar *str)
229 {
230 size_t srcrem;
231 size_t dstrem;
232 uchar *src;
233 char *dst;
234
235 /* get the length and text portion of the string */
236 srcrem = osrp2(str) - 2;
237 str += 2;
238
239 /* scan the string, and convert escapes */
240 for (src = str, dst = buf, dstrem = bufsiz ;
241 srcrem != 0 && dstrem != 0 ; ++src, --srcrem)
242 {
243 /* if we have an escape sequence, convert it */
244 if (*src == '\\')
245 {
246 /* skip the backslash in the input */
247 ++src;
248 --srcrem;
249
250 /* if there's nothing left, store the backslash */
251 if (srcrem == 0)
252 {
253 /* store the backslash */
254 *dst++ = '\\';
255 --dstrem;
256
257 /* there's nothing left to scan */
258 break;
259 }
260
261 /* see what the second half of the escape sequence is */
262 switch(*src)
263 {
264 case 'n':
265 /* store a C-style newline character */
266 *dst++ = '\n';
267 --dstrem;
268 break;
269
270 case 't':
271 /* store a C-style tab */
272 *dst++ = '\t';
273 --dstrem;
274 break;
275
276 case '(':
277 case ')':
278 /* entirely omit the highlighting sequences */
279 break;
280
281 default:
282 /* store everything else unchanged */
283 *dst++ = *src;
284 --dstrem;
285 break;
286 }
287 }
288 else
289 {
290 /* copy this character unchanged */
291 *dst++ = *src;
292 --dstrem;
293 }
294 }
295
296 /* if the buffer wasn't big enough, signal an error */
297 if (dstrem == 0)
298 runsig(ctx->bifcxrun, ERR_BIFCSTR);
299
300 /* null-terminate the result string */
301 *dst = '\0';
302 }
303
304 /* save */
bifsav(bifcxdef * ctx,int argc)305 void bifsav(bifcxdef *ctx, int argc)
306 {
307 uchar *fn;
308 char buf[OSFNMAX];
309 int err;
310 runsdef val;
311
312 bifcntargs(ctx, 1, argc);
313 fn = runpopstr(ctx->bifcxrun);
314 bifcstr(ctx, buf, (size_t)sizeof(buf), fn);
315 os_defext(buf, ctx->bifcxsavext != 0 ? ctx->bifcxsavext : "sav");
316 err = fiosav(ctx->bifcxrun->runcxvoc, buf, ctx->bifcxrun->runcxgamename);
317 runpush(ctx->bifcxrun, runclog(err), &val);
318 }
319
320 /* restore */
bifrso(bifcxdef * ctx,int argc)321 void bifrso(bifcxdef *ctx, int argc)
322 {
323 uchar *fn;
324 char buf[OSFNMAX];
325 int err;
326 voccxdef *vctx = ctx->bifcxrun->runcxvoc;
327
328 bifcntargs(ctx, 1, argc);
329
330 /* check for special restore(nil) - restore game given as parameter */
331 if (runtostyp(ctx->bifcxrun) == DAT_NIL)
332 {
333 /* get filename from startup parameter, if any */
334 if (!os_paramfile(buf))
335 {
336 /* no startup parameter */
337 runpnum(ctx->bifcxrun, FIORSO_NO_PARAM_FILE);
338 return;
339 }
340 }
341 else
342 {
343 /* get string parameter - it's the filename */
344 fn = runpopstr(ctx->bifcxrun);
345 bifcstr(ctx, buf, (size_t)sizeof(buf), fn);
346 os_defext(buf, ctx->bifcxsavext != 0 ? ctx->bifcxsavext : "sav");
347 }
348
349 /* try restoring the file */
350 err = fiorso(vctx, buf);
351
352 /* blow away all undo records */
353 objulose(vctx->voccxundo);
354
355 /* return the result code from fiorso */
356 runpnum(ctx->bifcxrun, err);
357
358 /* note that the rest of the command line is to be ignored */
359 vctx->voccxflg |= VOCCXFCLEAR;
360 }
361
362 /* logging */
biflog(bifcxdef * ctx,int argc)363 void biflog(bifcxdef *ctx, int argc)
364 {
365 char buf[OSFNMAX];
366 uchar *str;
367
368 bifcntargs(ctx, 1, argc);
369 if (runtostyp(ctx->bifcxrun) == DAT_NIL)
370 {
371 rundisc(ctx->bifcxrun);
372 tiologcls(ctx->bifcxtio);
373 }
374 else
375 {
376 str = runpopstr(ctx->bifcxrun);
377 bifcstr(ctx, buf, (size_t)sizeof(buf), str);
378 tiologopn(ctx->bifcxtio, buf);
379 }
380 }
381
382 /* restart */
bifres(bifcxdef * ctx,int argc)383 void bifres(bifcxdef *ctx, int argc)
384 {
385 voccxdef *vctx = ctx->bifcxrun->runcxvoc;
386 objnum fn;
387
388 if (argc == 2)
389 fn = runpopfn(ctx->bifcxrun); /* get function if present */
390 else
391 {
392 bifcntargs(ctx, 0, argc); /* check for proper argument count */
393 fn = MCMONINV; /* no function was specified */
394 }
395
396 objulose(vctx->voccxundo); /* blow away all undo records */
397 vocrevert(vctx); /* revert all objects to original state */
398 vocdmnclr(vctx); /* clear out fuses/deamons/notifiers */
399
400 /* restore the original "Me" object */
401 vctx->voccxme = vctx->voccxme_init;
402
403 /* call preinit if necessary (call it before invoking the user callback) */
404 if (vctx->voccxpreinit != MCMONINV)
405 runfn(ctx->bifcxrun, vctx->voccxpreinit, 0);
406
407 /*
408 * If a restart function was provided, call it. Note that we left
409 * the argument for the function on the stack, so there's no need to
410 * re-push it!
411 */
412 if (fn != MCMONINV) runfn(ctx->bifcxrun, fn, 1);
413
414 /* restart the game */
415 errsig(ctx->bifcxerr, ERR_RUNRESTART);
416 }
417
418 /* input - get a line of input from the keyboard */
bifinp(bifcxdef * ctx,int argc)419 void bifinp(bifcxdef *ctx, int argc)
420 {
421 char inbuf[128];
422
423 /* check for proper argument count */
424 bifcntargs(ctx, 0, argc);
425
426 /* make sure the prompt is displayed */
427 tioflushn(ctx->bifcxtio, 0);
428
429 /* reset count of lines since the last keyboard input */
430 tioreset(ctx->bifcxtio);
431
432 /* read a line of text */
433 if (tiogets(ctx->bifcxtio, (char *)0, inbuf, (int)sizeof(inbuf)))
434 runsig(ctx->bifcxrun, ERR_RUNQUIT);
435
436 /* push the string, converting escapes */
437 runpushcstr(ctx->bifcxrun, inbuf, strlen(inbuf), 0);
438 }
439
440 /* notify */
bifnfy(bifcxdef * ctx,int argc)441 void bifnfy(bifcxdef *ctx, int argc)
442 {
443 objnum objn;
444 prpnum prp;
445 uint tm;
446 voccxdef *voc = ctx->bifcxrun->runcxvoc;
447
448 bifcntargs(ctx, 3, argc); /* check for proper argument count */
449 objn = runpopobj(ctx->bifcxrun);
450 prp = runpopprp(ctx->bifcxrun);
451 tm = runpopnum(ctx->bifcxrun);
452
453 /* a time of zero means every turn */
454 if (tm == 0)
455 tm = VOCDTIM_EACH_TURN;
456
457 vocsetfd(voc, voc->voccxalm, objn, prp, tm,
458 (runsdef *)0, ERR_MANYNFY);
459 }
460
461
462 /* unnotify */
bifunn(bifcxdef * ctx,int argc)463 void bifunn(bifcxdef *ctx, int argc)
464 {
465 objnum objn;
466 prpnum prop;
467 voccxdef *voc = ctx->bifcxrun->runcxvoc;
468
469 bifcntargs(ctx, 2, argc);
470 objn = runpopobj(ctx->bifcxrun);
471 prop = runpopprp(ctx->bifcxrun);
472 vocremfd(voc, voc->voccxalm, objn, prop,
473 (runsdef *)0, ERR_NONFY);
474 }
475
476 /* trace on/off */
biftrc(bifcxdef * ctx,int argc)477 void biftrc(bifcxdef *ctx, int argc)
478 {
479 runsdef val;
480 int n;
481 int flag;
482
483 if (argc == 2)
484 {
485 /* get the type indicator and the on/off status */
486 n = runpopnum(ctx->bifcxrun);
487 flag = runpoplog(ctx->bifcxrun);
488
489 /* see what type of debugging they want to turn on or off */
490 switch(n)
491 {
492 case 1:
493 /* turn on parser tracing */
494 if (flag)
495 ctx->bifcxrun->runcxvoc->voccxflg |= VOCCXFDBG;
496 else
497 ctx->bifcxrun->runcxvoc->voccxflg &= ~VOCCXFDBG;
498 break;
499
500 default:
501 /* ignore other requests */
502 runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "debugTrace");
503 }
504 }
505 else
506 {
507 /* break into debugger; return whether debugger is present */
508 bifcntargs(ctx, 0, argc);
509 runpush(ctx->bifcxrun, runclog(dbgstart(ctx->bifcxrun->runcxdbg)),
510 &val);
511 }
512 }
513
514 /* say */
bifsay(bifcxdef * ctx,int argc)515 void bifsay(bifcxdef *ctx, int argc)
516 {
517 uchar *str;
518 long num;
519 char numbuf[30];
520
521 if (argc != 2) bifcntargs(ctx, 1, argc);
522
523 switch(runtostyp(ctx->bifcxrun))
524 {
525 case DAT_NUMBER:
526 num = runpopnum(ctx->bifcxrun);
527 sprintf(numbuf, "%ld", num);
528 tioputs(ctx->bifcxtio, numbuf);
529 break;
530
531 case DAT_SSTRING:
532 str = runpopstr(ctx->bifcxrun);
533 outfmt(ctx->bifcxtio, str);
534 break;
535
536 case DAT_NIL:
537 (void)runpoplog(ctx->bifcxrun);
538 break;
539
540 default:
541 runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "say");
542 }
543 }
544
545 /* car */
bifcar(bifcxdef * ctx,int argc)546 void bifcar(bifcxdef *ctx, int argc)
547 {
548 uchar *lstp;
549 uint lstsiz;
550 runsdef val;
551
552 bifcntargs(ctx, 1, argc);
553 bifchkarg(ctx, DAT_LIST);
554
555 lstp = runpoplst(ctx->bifcxrun);
556
557 /* get list's size, and point to its data string */
558 lstsiz = osrp2(lstp) - 2;
559 lstp += 2;
560
561 /* push first element if one is present, otherwise push nil */
562 if (lstsiz)
563 runpbuf(ctx->bifcxrun, *lstp, lstp+1);
564 else
565 runpush(ctx->bifcxrun, DAT_NIL, &val);
566 }
567
568 /* cdr */
bifcdr(bifcxdef * ctx,int argc)569 void bifcdr(bifcxdef *ctx, int argc)
570 {
571 uchar *lstp;
572 uint siz;
573 uint lstsiz;
574 runsdef val;
575 runsdef stkval;
576
577 bifcntargs(ctx, 1, argc);
578 bifchkarg(ctx, DAT_LIST);
579
580 lstp = runpoplst(ctx->bifcxrun);
581 stkval.runstyp = DAT_LIST;
582 stkval.runsv.runsvstr = lstp;
583
584 /* get list's size, and point to its data string */
585 lstsiz = osrp2(lstp) - 2;
586 lstp += 2;
587
588 if (lstsiz != 0)
589 {
590 /* deduct size of first element from size of list */
591 siz = datsiz(*lstp, lstp+1) + 1;
592 lstsiz -= siz;
593
594 /* add in the size prefix for our new list size */
595 lstsiz += 2;
596
597 /* allocate space for new list containing rest of list */
598 runhres1(ctx->bifcxrun, lstsiz, 1, &stkval);
599 lstp = stkval.runsv.runsvstr + siz + 2;
600
601 /* write out size followed by list value string */
602 oswp2(ctx->bifcxrun->runcxhp, lstsiz);
603 memcpy(ctx->bifcxrun->runcxhp+2, lstp, (size_t)(lstsiz-2));
604
605 val.runsv.runsvstr = ctx->bifcxrun->runcxhp;
606 val.runstyp = DAT_LIST;
607 ctx->bifcxrun->runcxhp += lstsiz;
608 runrepush(ctx->bifcxrun, &val);
609 }
610 else
611 runpush(ctx->bifcxrun, DAT_NIL, &val); /* empty list - cdr is nil */
612 }
613
614 /* caps */
bifcap(bifcxdef * ctx,int argc)615 void bifcap(bifcxdef *ctx, int argc)
616 {
617 bifcntargs(ctx, 0, argc);
618 tiocaps(ctx->bifxtio); /* set output driver next-char-capitalized flag */
619 }
620
621 /* nocaps */
bifnoc(bifcxdef * ctx,int argc)622 void bifnoc(bifcxdef *ctx, int argc)
623 {
624 bifcntargs(ctx, 0, argc);
625 tionocaps(ctx->bifxtio); /* set next-not-capitalized flag */
626 }
627
628 /* length */
biflen(bifcxdef * ctx,int argc)629 void biflen(bifcxdef *ctx, int argc)
630 {
631 uchar *p;
632 runsdef val;
633 long len;
634 int l;
635
636 bifcntargs(ctx, 1, argc);
637 switch(runtostyp(ctx->bifcxrun))
638 {
639 case DAT_SSTRING:
640 p = (uchar *)runpopstr(ctx->bifcxrun);
641 len = osrp2(p) - 2;
642 break;
643
644 case DAT_LIST:
645 p = runpoplst(ctx->bifcxrun);
646 l = osrp2(p) - 2;
647 p += 2;
648
649 /* count all elements in list */
650 for (len = 0 ; l ; ++len)
651 {
652 int cursiz;
653
654 /* get size of this element, and move past it */
655 cursiz = datsiz(*p, p+1) + 1;
656 l -= cursiz;
657 p += cursiz;
658 }
659 break;
660
661 default:
662 runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "length");
663 }
664
665 val.runsv.runsvnum = len;
666 runpush(ctx->bifcxrun, DAT_NUMBER, &val);
667 }
668
669 /* find */
biffnd(bifcxdef * ctx,int argc)670 void biffnd(bifcxdef *ctx, int argc)
671 {
672 uchar *p1, *p2;
673 int len1, len2;
674 int outv;
675 runsdef val;
676 int typ;
677 int siz;
678
679 bifcntargs(ctx, 2, argc);
680 switch(runtostyp(ctx->bifcxrun))
681 {
682 case DAT_SSTRING:
683 p1 = runpopstr(ctx->bifcxrun);
684 len1 = osrp2(p1) - 2;
685 p1 += 2;
686
687 p2 = runpopstr(ctx->bifcxrun);
688 len2 = osrp2(p2) - 2;
689 p2 += 2;
690
691 /* look for p2 within p1 */
692 for (typ = DAT_NIL, outv = 1 ; len1 >= len2 ; ++p1, --len1, ++outv)
693 {
694 if (!memcmp(p1, p2, (size_t)len2))
695 {
696 typ = DAT_NUMBER; /* use number in outv after all */
697 break; /* that's it - we've found it */
698 }
699 }
700 break;
701
702 case DAT_LIST:
703 p1 = runpoplst(ctx->bifcxrun);
704 len1 = osrp2(p1) - 2;
705 p1 += 2;
706
707 /* get second item: any old datatype */
708 runpop(ctx->bifcxrun, &val);
709
710 for (typ = DAT_NIL, outv = 1 ; len1 ; ++outv, p1 += siz, len1 -= siz)
711 {
712 siz = datsiz(*p1, p1 + 1) + 1; /* get size of this element */
713 if (val.runstyp != *p1) continue; /* types don't match */
714
715 switch(val.runstyp)
716 {
717 case DAT_NUMBER:
718 if (val.runsv.runsvnum != osrp4(p1 + 1)) continue;
719 break;
720
721 case DAT_SSTRING:
722 case DAT_LIST:
723 if (osrp2(p1 + 1) != osrp2(val.runsv.runsvstr) ||
724 memcmp(p1 + 3, val.runsv.runsvstr + 2,
725 (size_t)(osrp2(p1 + 1) - 2)))
726 continue;
727 break;
728
729 case DAT_PROPNUM:
730 if (osrp2(p1 + 1) != val.runsv.runsvprp) continue;
731 break;
732
733 case DAT_OBJECT:
734 case DAT_FNADDR:
735 if (osrp2(p1 + 1) != val.runsv.runsvobj) continue;
736 break;
737
738 default:
739 break;
740 }
741
742 /* if we got here, it means we found a match */
743 typ = DAT_NUMBER; /* use the value in outv */
744 break; /* that's it - we've found it */
745 }
746 break;
747
748 default:
749 runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "find");
750 }
751
752 /* push the value given by typ and outv */
753 val.runsv.runsvnum = outv;
754 runpush(ctx->bifcxrun, typ, &val);
755 }
756
757 /* setit - set current 'it' */
bifsit(bifcxdef * ctx,int argc)758 void bifsit(bifcxdef *ctx, int argc)
759 {
760 objnum obj;
761 int typ;
762 voccxdef *vcx = ctx->bifcxrun->runcxvoc;
763
764 /* check for extended version that allows setting him/her */
765 if (argc == 2)
766 {
767 if (runtostyp(ctx->bifcxrun) == DAT_NIL)
768 {
769 rundisc(ctx->bifcxrun); /* discard the nil */
770 obj = MCMONINV; /* use invalid object */
771 }
772 else
773 obj = runpopobj(ctx->bifcxrun); /* get the object */
774
775 typ = runpopnum(ctx->bifcxrun); /* get the code */
776 vcx->voccxthc = 0; /* clear the 'them' list */
777
778 switch(typ)
779 {
780 case 0: /* set "it" */
781 vcx->voccxit = obj;
782 break;
783
784 case 1: /* set "him" */
785 vcx->voccxhim = obj;
786 break;
787
788 case 2: /* set "her" */
789 vcx->voccxher = obj;
790 break;
791 }
792 return;
793 }
794
795 /* "setit classic" has one argument only */
796 bifcntargs(ctx, 1, argc);
797
798 /* check to see if we're setting 'it' or 'them' */
799 if (runtostyp(ctx->bifcxrun) == DAT_LIST)
800 {
801 uchar *lst;
802 uint siz;
803 int cnt;
804
805 lst = runpoplst(ctx->bifcxrun);
806 siz = osrp2(lst);
807 lst += 2;
808 siz -= 2;
809
810 for (cnt = 0 ; siz ; )
811 {
812 /* if this is an object, add to 'them' list (otherwise ignore) */
813 if (*lst == DAT_OBJECT)
814 vcx->voccxthm[cnt++] = osrp2(lst+1);
815
816 lstadv(&lst, &siz);
817 }
818 vcx->voccxthc = cnt;
819 vcx->voccxit = MCMONINV;
820 }
821 else
822 {
823 /* set 'it', and delete 'them' list */
824 if (runtostyp(ctx->bifcxrun) == DAT_NIL)
825 {
826 vcx->voccxit = MCMONINV;
827 rundisc(ctx->bifcxrun);
828 }
829 else
830 vcx->voccxit = runpopobj(ctx->bifcxrun);
831 vcx->voccxthc = 0;
832 }
833 }
834
835 /* randomize - seed random number generator */
bifsrn(bifcxdef * ctx,int argc)836 void bifsrn(bifcxdef *ctx, int argc)
837 {
838 bifcntargs(ctx, 0, argc);
839 os_rand(&ctx->bifcxrnd);
840 ctx->bifcxrndset = TRUE;
841 }
842
843 /* rand - get a random number */
bifrnd(bifcxdef * ctx,int argc)844 void bifrnd(bifcxdef *ctx, int argc)
845 {
846 unsigned long result, max, randseed;
847 int tmp;
848 runsdef val;
849
850 /* get argument - number giving upper bound of generated number */
851 bifcntargs(ctx, 1, argc);
852 bifchkarg(ctx, DAT_NUMBER);
853 max = runpopnum(ctx->bifcxrun);
854
855 /* if the max is zero, just return zero */
856 if (max == 0)
857 {
858 runpnum(ctx->bifcxrun, 0);
859 return;
860 }
861
862 /*
863 * If the random number generator has been seeded by a call to
864 * randomize(), use the new, improved random number generator. If
865 * not, use the old random number generator to ensure that the same
866 * sequence of numbers is generated as always (to prevent breaking
867 * existing test scripts based on the old sequence).
868 */
869 if (!ctx->bifcxrndset)
870 {
871 /* compute the next number in sequence, using old cheesy generator */
872 randseed = ctx->bifcxrnd;
873 randseed *= 1033;
874 randseed += 5;
875 tmp = randseed / 16384;
876 randseed %= 16384;
877 result = tmp / 7;
878
879 /* adjust the result to be in the requested range */
880 result = ( randseed % max ) + 1;
881
882 /* save the new seed value, and return the value */
883 ctx->bifcxrnd = randseed;
884 val.runsv.runsvnum = result;
885 runpush(ctx->bifcxrun, DAT_NUMBER, &val);
886 }
887 else
888 {
889 #define BIF_RAND_M ((ulong)2147483647)
890 #define BIF_RAND_Q ((ulong)127773)
891 #define BIF_RAND_A ((ulong)16807)
892 #define BIF_RAND_R ((ulong)2836)
893
894 long lo, hi, test;
895
896 lo = ctx->bifcxrnd / BIF_RAND_Q;
897 hi = ctx->bifcxrnd % BIF_RAND_Q;
898 test = BIF_RAND_A*lo - BIF_RAND_R*hi;
899 ctx->bifcxrnd = test;
900 if (test > 0)
901 ctx->bifcxrnd = test;
902 else
903 ctx->bifcxrnd = test + BIF_RAND_M;
904 runpnum(ctx->bifcxrun, (((ulong)ctx->bifcxrnd) % max) + 1);
905 }
906 }
907
908 /*
909 * case-insensitive substring matching
910 */
bif_stristr(const char * s1,const char * s2)911 static char *bif_stristr(const char *s1, const char *s2)
912 {
913 size_t s1len;
914 size_t s2len;
915
916 /* scan for a match */
917 for (s1len = strlen(s1), s2len = strlen(s2) ; s1len >= s2len ;
918 ++s1, --s1len)
919 {
920 /* if this is a match, return this substring */
921 if (memicmp(s1, s2, s2len) == 0)
922 return (char *)s1;
923 }
924
925 return 0;
926 }
927
928 /*
929 * askfile flags
930 */
931 #define BIF_ASKF_EXT_RET 1 /* extended return codes */
932
933 /*
934 * askfile
935 */
bifask(bifcxdef * ctx,int argc)936 void bifask(bifcxdef *ctx, int argc)
937 {
938 uchar *prompt;
939 char buf[OSFNMAX + 2];
940 char pbuf[128];
941 int err;
942 int prompt_type;
943 int file_type;
944 ulong flags;
945
946 /* make sure we have an acceptable number of arguments */
947 if (argc != 1 && argc != 3 && argc != 4)
948 runsig(ctx->bifcxrun, ERR_BIFARGC);
949
950 /* get the first argument - the prompt string */
951 prompt = runpopstr(ctx->bifcxrun);
952 bifcstr(ctx, pbuf, (size_t)sizeof(pbuf), prompt);
953
954 /* presume we will have no flags */
955 flags = 0;
956
957 /* if we have the prompt type and file type parameters, get them */
958 if (argc >= 3)
959 {
960 /* get the prompt-type and the file-type arguments */
961 prompt_type = (int)runpopnum(ctx->bifcxrun);
962 file_type = (int)runpopnum(ctx->bifcxrun);
963
964 /* if we have a fourth argument, it's the flags */
965 if (argc == 4)
966 flags = runpopnum(ctx->bifcxrun);
967 }
968 else
969 {
970 static const char *save_strs[] =
971 {
972 "save",
973 "write",
974 0
975 };
976 static const char *game_strs[] =
977 {
978 "restore",
979 "game",
980 0
981 };
982 const char **sp;
983
984 /*
985 * No prompt type or file type were specified. Try to infer the
986 * dialog type and file type from the text of the prompt. (This
987 * is mostly to support older games, in particular those based
988 * on older versions of adv.t, since newer games should always
989 * provide explicit values for the file type and dialog type.
990 * We are thus inferring the types based on the prompt strings
991 * that older adv.t's used when calling askfile.)
992 *
993 * If the prompt contains any substring such as "save" or
994 * "write", specify that we're saving; otherwise, assume that
995 * we're opening an existing file for reading.
996 *
997 * If the prompt contains the substrings "restore" AND "game",
998 * assume that we're opening a game file; otherwise, don't make
999 * any assumptions, and use the "unknown" file type.
1000 */
1001
1002 /* presume we're going to open a saved-game file */
1003 prompt_type = OS_AFP_OPEN;
1004 file_type = OSFTSAVE;
1005
1006 /* look for any one of the "save" substrings */
1007 for (sp = save_strs ; *sp != 0 ; ++sp)
1008 {
1009 /* check to see if this substring matches */
1010 if (bif_stristr(pbuf, *sp))
1011 {
1012 /* found it - use the "save" prompt */
1013 prompt_type = OS_AFP_SAVE;
1014
1015 /* no need to look any further */
1016 break;
1017 }
1018 }
1019
1020 /*
1021 * look for *all* of the "restore game" strings - if we fail to
1022 * find any of them, be conservative and make no assumptions
1023 * about the file type
1024 */
1025 for (sp = game_strs ; *sp != 0 ; ++sp)
1026 {
1027 if (bif_stristr(pbuf, *sp) == 0)
1028 {
1029 /*
1030 * this one doesn't match - don't make assumptions about
1031 * the file type
1032 */
1033 file_type = OSFTUNK;
1034
1035 /* no need to look any further */
1036 break;
1037 }
1038 }
1039 }
1040
1041 /* ask for a file */
1042 err = tio_askfile(pbuf, buf, (int)sizeof(buf), prompt_type, file_type);
1043
1044 /*
1045 * if the caller requested extended return codes, return a list
1046 * containing the return code as the first element and, if
1047 * successful, the string as the second element
1048 */
1049 if ((flags & BIF_ASKF_EXT_RET) != 0)
1050 {
1051 ushort len;
1052 runsdef val;
1053 uchar *p;
1054
1055 /*
1056 * Allocate space for the starter list - if we have a string to
1057 * return, just allocate space for the number element for now;
1058 * otherwise, allocate space for the number plus a nil second
1059 * element (one byte).
1060 */
1061 len = 2 + (1 + 4);
1062 if (err != OS_AFE_SUCCESS)
1063 ++len;
1064
1065 /* allocate the space */
1066 runhres(ctx->bifcxrun, len, 0);
1067
1068 /* set up our list pointer */
1069 val.runstyp = DAT_LIST;
1070 val.runsv.runsvstr = p = ctx->bifcxrun->runcxhp;
1071
1072 /* write the length prefix */
1073 oswp2(p, len);
1074 p += 2;
1075
1076 /* write the return code as the first element */
1077 *p++ = DAT_NUMBER;
1078 oswp4(p, err);
1079 p += 4;
1080
1081 /* write the 'nil' second element if there's an error */
1082 if (err != OS_AFE_SUCCESS)
1083 *p++ = DAT_NIL;
1084
1085 /* commit the list's memory */
1086 ctx->bifcxrun->runcxhp = p;
1087
1088 /* push the list */
1089 runrepush(ctx->bifcxrun, &val);
1090
1091 /* if we were successful, add the string to the list */
1092 if (err == OS_AFE_SUCCESS)
1093 {
1094 runsdef val2;
1095
1096 /* push the string value, converting to our string format */
1097 runpushcstr(ctx->bifcxrun, buf, strlen(buf), 1);
1098
1099 /* add it to the list already on the stack */
1100 runpop(ctx->bifcxrun, &val2);
1101 runpop(ctx->bifcxrun, &val);
1102 runadd(ctx->bifcxrun, &val, &val2, 2);
1103
1104 /* re-push the result */
1105 runrepush(ctx->bifcxrun, &val);
1106 }
1107 }
1108 else
1109 {
1110 /*
1111 * use the traditional return codes - if askfile failed, return
1112 * nil; otherwise, return the filename
1113 */
1114 if (err)
1115 runpnil(ctx->bifcxrun);
1116 else
1117 runpushcstr(ctx->bifcxrun, buf, strlen(buf), 0);
1118 }
1119 }
1120
1121 /* setscore */
bifssc(bifcxdef * ctx,int argc)1122 void bifssc(bifcxdef *ctx, int argc)
1123 {
1124 int s1, s2;
1125
1126 /* optional new way - string argument */
1127 if (argc == 1 && runtostyp(ctx->bifcxrun) == DAT_SSTRING)
1128 {
1129 char buf[80];
1130 uchar *p;
1131
1132 p = runpopstr(ctx->bifcxrun);
1133 bifcstr(ctx, buf, (size_t)sizeof(buf), p);
1134 tiostrsc(ctx->bifcxtio, buf);
1135 }
1136 else
1137 {
1138 /* old way - two numeric arguments (displays: x/y) */
1139 bifcntargs(ctx, 2, argc);
1140 s1 = runpopnum(ctx->bifcxrun);
1141 s2 = runpopnum(ctx->bifcxrun);
1142 tioscore(ctx->bifcxtio, s1, s2);
1143 }
1144 }
1145
1146 /* substr */
bifsub(bifcxdef * ctx,int argc)1147 void bifsub(bifcxdef *ctx, int argc)
1148 {
1149 uchar *p;
1150 int ofs;
1151 int asklen;
1152 int outlen;
1153 int len;
1154
1155 bifcntargs(ctx, 3, argc);
1156
1157 /* get the string argument */
1158 bifchkarg(ctx, DAT_SSTRING);
1159 p = runpopstr(ctx->bifcxrun);
1160 len = osrp2(p) - 2;
1161 p += 2;
1162
1163 /* get the offset argument */
1164 bifchkarg(ctx, DAT_NUMBER);
1165 ofs = runpopnum(ctx->bifcxrun);
1166 if (ofs < 1) runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "substr");
1167
1168 /* get the length argument */
1169 bifchkarg(ctx, DAT_NUMBER);
1170 asklen = runpopnum(ctx->bifcxrun);
1171 if (asklen < 0) runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "substr");
1172
1173 --ofs; /* convert offset to a zero bias (user provided 1-bias) */
1174 p += ofs; /* advance string pointer by offset */
1175
1176 if (ofs >= len)
1177 outlen = 0; /* offset is past end of string */
1178 else if (asklen > len - ofs)
1179 outlen = len - ofs; /* just use rest of string */
1180 else
1181 outlen = asklen; /* requested length can be provided */
1182
1183 runpstr(ctx->bifcxrun, (char *)p, outlen, 3);
1184 }
1185
1186 /* cvtstr - convert value to a string */
bifcvs(bifcxdef * ctx,int argc)1187 void bifcvs(bifcxdef *ctx, int argc)
1188 {
1189 char *p;
1190 int len;
1191 char buf[30];
1192
1193 bifcntargs(ctx, 1, argc);
1194 switch(runtostyp(ctx->bifcxrun))
1195 {
1196 case DAT_NIL:
1197 p = "nil";
1198 len = 3;
1199 (void)runpoplog(ctx->bifcxrun);
1200 break;
1201
1202 case DAT_TRUE:
1203 p = "true";
1204 len = 4;
1205 (void)runpoplog(ctx->bifcxrun);
1206 break;
1207
1208 case DAT_NUMBER:
1209 sprintf(buf, "%ld", runpopnum(ctx->bifcxrun));
1210 p = buf;
1211 len = strlen(buf);
1212 break;
1213
1214 case DAT_SSTRING:
1215 /* leave the string value on the stack unchanged */
1216 return;
1217
1218 default:
1219 /* throw the RUNEXITOBJ error */
1220 runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "cvtstr");
1221 }
1222
1223 runpstr(ctx->bifcxrun, p, len, 0);
1224 }
1225
1226 /* cvtnum - convert a value to a number */
bifcvn(bifcxdef * ctx,int argc)1227 void bifcvn(bifcxdef *ctx, int argc)
1228 {
1229 runsdef val;
1230 uchar *p;
1231 int len;
1232 int typ;
1233 long acc;
1234 int neg;
1235
1236 bifcntargs(ctx, 1, argc);
1237 p = runpopstr(ctx->bifcxrun);
1238 len = osrp2(p) - 2;
1239 p += 2;
1240
1241 if (len == 3 && !memcmp(p, "nil", (size_t)3))
1242 typ = DAT_NIL;
1243 else if (len == 4 && !memcmp(p, "true", (size_t)4))
1244 typ = DAT_TRUE;
1245 else
1246 {
1247 typ = DAT_NUMBER;
1248 while (*p && t_isspace(*p)) ++p;
1249 if (*p == '-')
1250 {
1251 neg = TRUE;
1252 for (++p ; *p && t_isspace(*p) ; ++p) ;
1253 }
1254 else neg = FALSE;
1255
1256 /* accumulate the number digit by digit */
1257 for (acc = 0 ; len && isdigit(*p) ; ++p, --len)
1258 acc = (acc << 3) + (acc << 1) + ((*p) - '0');
1259
1260 if (neg) acc = -acc;
1261 val.runsv.runsvnum = acc;
1262 }
1263
1264 runpush(ctx->bifcxrun, typ, &val);
1265 }
1266
1267 /* general string conversion function */
bifcvtstr(bifcxdef * ctx,void (* cvtfn)(uchar *,int),int argc)1268 static void bifcvtstr(bifcxdef *ctx, void (*cvtfn)(uchar *, int), int argc)
1269 {
1270 uchar *p;
1271 int len;
1272 runsdef val;
1273 runsdef stkval;
1274
1275 bifcntargs(ctx, 1, argc);
1276 bifchkarg(ctx, DAT_SSTRING);
1277
1278 p = runpopstr(ctx->bifcxrun);
1279 stkval.runstyp = DAT_SSTRING;
1280 stkval.runsv.runsvstr = p;
1281 len = osrp2(p);
1282
1283 /* allocate space in heap for the string and convert */
1284 runhres1(ctx->bifcxrun, len, 1, &stkval);
1285 p = stkval.runsv.runsvstr;
1286 memcpy(ctx->bifcxrun->runcxhp, p, (size_t)len);
1287 (*cvtfn)(ctx->bifcxrun->runcxhp + 2, len - 2);
1288
1289 val.runsv.runsvstr = ctx->bifcxrun->runcxhp;
1290 val.runstyp = DAT_SSTRING;
1291 ctx->bifcxrun->runcxhp += len;
1292 runrepush(ctx->bifcxrun, &val);
1293 }
1294
1295 /* routine to convert a counted-length string to uppercase */
bifstrupr(uchar * str,int len)1296 static void bifstrupr(uchar *str, int len)
1297 {
1298 for ( ; len ; --len, ++str)
1299 {
1300 if (*str == '\\' && len > 1)
1301 --len, ++str;
1302 else if (islower(*str))
1303 *str = toupper(*str);
1304 }
1305 }
1306
1307 /* upper */
bifupr(bifcxdef * ctx,int argc)1308 void bifupr(bifcxdef *ctx, int argc)
1309 {
1310 bifcvtstr(ctx, bifstrupr, argc);
1311 }
1312
1313 /* convert a counted-length string to lowercase */
bifstrlwr(uchar * str,int len)1314 static void bifstrlwr(uchar *str, int len)
1315 {
1316 for ( ; len ; --len, ++str)
1317 {
1318 if (*str == '\\' && len > 1)
1319 --len, ++str;
1320 else if (isupper(*str))
1321 *str = tolower(*str);
1322 }
1323 }
1324
1325 /* lower */
biflwr(bifcxdef * ctx,int argc)1326 void biflwr(bifcxdef *ctx, int argc)
1327 {
1328 bifcvtstr(ctx, bifstrlwr, argc);
1329 }
1330
1331 /* internal check to determine if object is of a class */
bifinh(voccxdef * voc,vocidef * v,objnum cls)1332 int bifinh(voccxdef *voc, vocidef *v, objnum cls)
1333 {
1334 int i;
1335 objnum *sc;
1336
1337 if (!v) return(FALSE);
1338 for (i = v->vocinsc, sc = v->vocisc ; i ; ++sc, --i)
1339 {
1340 if (*sc == cls
1341 || bifinh(voc, vocinh(voc, *sc), cls))
1342 return(TRUE);
1343 }
1344 return(FALSE);
1345 }
1346
1347 /* isclass(obj, cls) */
bifisc(bifcxdef * ctx,int argc)1348 void bifisc(bifcxdef *ctx, int argc)
1349 {
1350 objnum obj;
1351 objnum cls;
1352 runsdef val;
1353 voccxdef *voc = ctx->bifcxrun->runcxvoc;
1354
1355 bifcntargs(ctx, 2, argc);
1356
1357 /* if checking for nil, return nil */
1358 if (runtostyp(ctx->bifcxrun) == DAT_NIL)
1359 {
1360 rundisc(ctx->bifcxrun);
1361 rundisc(ctx->bifcxrun);
1362 runpnil(ctx->bifcxrun);
1363 return;
1364 }
1365
1366 /* get the arguments: object, class */
1367 obj = runpopobj(ctx->bifcxrun);
1368 cls = runpopobj(ctx->bifcxrun);
1369
1370 /* return the result from bifinh() */
1371 runpush(ctx->bifcxrun, runclog(bifinh(voc, vocinh(voc, obj), cls)), &val);
1372 }
1373
1374 /* firstsc(obj) - get the first superclass of an object */
bif1sc(bifcxdef * ctx,int argc)1375 void bif1sc(bifcxdef *ctx, int argc)
1376 {
1377 objnum obj;
1378 objnum sc;
1379
1380 bifcntargs(ctx, 1, argc);
1381 obj = runpopobj(ctx->bifcxrun);
1382 sc = objget1sc(ctx->bifcxrun->runcxmem, obj);
1383 runpobj(ctx->bifcxrun, sc);
1384 }
1385
1386 /* firstobj */
biffob(bifcxdef * ctx,int argc)1387 void biffob(bifcxdef *ctx, int argc)
1388 {
1389 vocidef ***vpg;
1390 vocidef **v;
1391 objnum obj;
1392 int i;
1393 int j;
1394 objnum cls;
1395 voccxdef *voc = ctx->bifcxrun->runcxvoc;
1396
1397 /* get class to search for, if one is specified */
1398 if (argc == 0)
1399 cls = MCMONINV;
1400 else if (argc == 1)
1401 cls = runpopobj(ctx->bifcxrun);
1402 else
1403 runsig(ctx->bifcxrun, ERR_BIFARGC);
1404
1405 for (vpg = voc->voccxinh, i = 0 ; i < VOCINHMAX ; ++vpg, ++i)
1406 {
1407 if (!*vpg) continue;
1408 for (v = *vpg, obj = (i << 8), j = 0 ; j < 256 ; ++v, ++obj, ++j)
1409 {
1410 if (!*v || ((*v)->vociflg & VOCIFCLASS)
1411 || (cls != MCMONINV && !bifinh(voc, *v, cls)))
1412 continue;
1413
1414 /* this is an object we can use - push it */
1415 runpobj(ctx->bifcxrun, obj);
1416 return;
1417 }
1418 }
1419
1420 /* no objects found at all - return nil */
1421 runpnil(ctx->bifcxrun);
1422 }
1423
1424 /* nextobj */
bifnob(bifcxdef * ctx,int argc)1425 void bifnob(bifcxdef *ctx, int argc)
1426 {
1427 objnum prv;
1428 vocidef ***vpg;
1429 vocidef **v;
1430 objnum obj;
1431 int i;
1432 int j;
1433 objnum cls;
1434 voccxdef *voc = ctx->bifcxrun->runcxvoc;
1435
1436 /* get last position in search */
1437 prv = runpopobj(ctx->bifcxrun);
1438
1439 /* get class to search for, if one is specified */
1440 if (argc == 1)
1441 cls = MCMONINV;
1442 else if (argc == 2)
1443 cls = runpopobj(ctx->bifcxrun);
1444 else
1445 runsig(ctx->bifcxrun, ERR_BIFARGC);
1446
1447 /* start at previous object plus 1 */
1448 i = (prv >> 8);
1449 vpg = voc->voccxinh + i;
1450 j = (prv & 255);
1451 obj = prv;
1452 v = (*vpg) + j;
1453
1454 for (;;)
1455 {
1456 ++j;
1457 ++obj;
1458 ++v;
1459 if (j == 256)
1460 {
1461 j = 0;
1462 ++i;
1463 ++vpg;
1464 if (!*vpg)
1465 {
1466 obj += 255;
1467 j += 255;
1468 continue;
1469 }
1470 v = (*vpg);
1471 }
1472 if (i >= VOCINHMAX)
1473 {
1474 runpnil(ctx->bifcxrun);
1475 return;
1476 }
1477
1478 if (!*v || ((*v)->vociflg & VOCIFCLASS)
1479 || (cls != MCMONINV && !bifinh(voc, *v, cls)))
1480 continue;
1481
1482 /* this is an object we can use - push it */
1483 runpobj(ctx->bifcxrun, obj);
1484 return;
1485 }
1486 }
1487
1488 /* setversion */
bifsvn(bifcxdef * ctx,int argc)1489 void bifsvn(bifcxdef *ctx, int argc)
1490 {
1491 bifcntargs(ctx, 1, argc);
1492 (void)runpopstr(ctx->bifcxrun);
1493 /* note - setversion doesn't do anything in v2; uses timestamp instead */
1494 }
1495
1496 /* getarg */
bifarg(bifcxdef * ctx,int argc)1497 void bifarg(bifcxdef *ctx, int argc)
1498 {
1499 int argnum;
1500
1501 bifcntargs(ctx, 1, argc);
1502 bifchkarg(ctx, DAT_NUMBER);
1503
1504 /* get and verify argument number */
1505 argnum = runpopnum(ctx->bifcxrun);
1506 if (argnum < 1) runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "getarg");
1507
1508 runrepush(ctx->bifcxrun, ctx->bifcxrun->runcxbp - argnum - 1);
1509 }
1510
1511 /* datatype */
biftyp(bifcxdef * ctx,int argc)1512 void biftyp(bifcxdef *ctx, int argc)
1513 {
1514 runsdef val;
1515
1516 bifcntargs(ctx, 1, argc);
1517
1518 /* get whatever it is, and push the type */
1519 runpop(ctx->bifcxrun, &val);
1520 val.runsv.runsvnum = val.runstyp; /* new value is the datatype */
1521 runpush(ctx->bifcxrun, DAT_NUMBER, &val);
1522 }
1523
1524 /* undo */
bifund(bifcxdef * ctx,int argc)1525 void bifund(bifcxdef *ctx, int argc)
1526 {
1527 objucxdef *ucx = ctx->bifcxrun->runcxvoc->voccxundo;
1528 mcmcxdef *mcx = ctx->bifcxrun->runcxmem;
1529 errcxdef *ec = ctx->bifcxerr;
1530 int err;
1531 int undone;
1532 runsdef val;
1533
1534 bifcntargs(ctx, 0, argc); /* no arguments */
1535
1536 ERRBEGIN(ec)
1537 if (ucx)
1538 {
1539 objundo(mcx, ucx); /* try to undo to previous savepoint */
1540 undone = TRUE; /* looks like we succeeded */
1541 }
1542 else
1543 undone = FALSE; /* no undo context; can't undo */
1544 ERRCATCH(ec, err)
1545 if (err == ERR_NOUNDO || err == ERR_ICUNDO)
1546 undone = FALSE;
1547 else
1548 errrse(ec); /* don't know how to handle other errors */
1549 ERREND(ec)
1550
1551 /* return a value indicating whether the undo operation succeeded */
1552 runpush(ctx->bifcxrun, runclog(undone), &val);
1553
1554 /* note that the rest of the command line is to be ignored */
1555 ctx->bifcxrun->runcxvoc->voccxflg |= VOCCXFCLEAR;
1556 }
1557
1558 /* flags for defined() function */
1559 #define BIFDEF_DEFINED_ANY 1
1560 #define BIFDEF_DEFINED_DIRECTLY 2
1561 #define BIFDEF_DEFINED_INHERITS 3
1562 #define BIFDEF_DEFINED_GET_CLASS 4
1563
1564 /* defined */
bifdef(bifcxdef * ctx,int argc)1565 void bifdef(bifcxdef *ctx, int argc)
1566 {
1567 prpnum prpn;
1568 objnum objn;
1569 uint ofs;
1570 runsdef val;
1571 objnum def_objn;
1572 int flag;
1573
1574 /* get object and property arguments */
1575 objn = runpopobj(ctx->bifcxrun);
1576 prpn = runpopprp(ctx->bifcxrun);
1577
1578 /* if there's a flag argument, get it as well */
1579 if (argc == 3)
1580 {
1581 /* get the flag */
1582 flag = (int)runpopnum(ctx->bifcxrun);
1583 }
1584 else
1585 {
1586 /* check the argument count */
1587 bifcntargs(ctx, 2, argc);
1588
1589 /* use the default flag value (DEFINES_OR_INHERITS) */
1590 flag = BIFDEF_DEFINED_ANY;
1591 }
1592
1593 /* get the offset of the property and the defining object */
1594 ofs = objgetap(ctx->bifcxrun->runcxmem, objn, prpn, &def_objn, FALSE);
1595
1596 /* determine the type of information they want */
1597 switch(flag)
1598 {
1599 case BIFDEF_DEFINED_ANY:
1600 /* if the property is defined, return true, else return nil */
1601 runpush(ctx->bifcxrun, runclog(ofs != 0), &val);
1602 break;
1603
1604 case BIFDEF_DEFINED_DIRECTLY:
1605 /* if the property is defined directly by the object, return true */
1606 runpush(ctx->bifcxrun, runclog(ofs != 0 && def_objn == objn), &val);
1607 break;
1608
1609 case BIFDEF_DEFINED_INHERITS:
1610 /* if the property is inherited, return true */
1611 runpush(ctx->bifcxrun, runclog(ofs != 0 && def_objn != objn), &val);
1612 break;
1613
1614 case BIFDEF_DEFINED_GET_CLASS:
1615 /* if it's defined, return the defining object, otherwise nil */
1616 if (ofs == 0)
1617 runpnil(ctx->bifcxrun);
1618 else
1619 runpobj(ctx->bifcxrun, def_objn);
1620 break;
1621
1622 default:
1623 /* invalid flag value */
1624 runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "defined");
1625 }
1626 }
1627
1628 /* proptype */
bifpty(bifcxdef * ctx,int argc)1629 void bifpty(bifcxdef *ctx, int argc)
1630 {
1631 prpnum prpn;
1632 objnum objn;
1633 uint ofs;
1634 runsdef val;
1635 objnum orn;
1636 objdef *objptr;
1637 prpdef *propptr;
1638
1639 bifcntargs(ctx, 2, argc);
1640
1641 /* get offset of obj.prop */
1642 objn = runpopobj(ctx->bifcxrun);
1643 prpn = runpopprp(ctx->bifcxrun);
1644 ofs = objgetap(ctx->bifcxrun->runcxmem, objn, prpn, &orn, FALSE);
1645
1646 if (ofs)
1647 {
1648 /* lock the object, read the prpdef, and unlock it */
1649 objptr = (objdef *)mcmlck(ctx->bifcxrun->runcxmem, (mcmon)orn);
1650 propptr = objofsp(objptr, ofs);
1651 val.runsv.runsvnum = prptype(propptr);
1652 mcmunlck(ctx->bifcxrun->runcxmem, (mcmon)orn);
1653 }
1654 else
1655 {
1656 /* property is not defined by object - indicate that type is nil */
1657 val.runsv.runsvnum = DAT_NIL;
1658 }
1659
1660 /* special case: DAT_DEMAND -> DAT_LIST (for contents properties) */
1661 if (val.runsv.runsvnum == DAT_DEMAND)
1662 val.runsv.runsvnum = DAT_LIST;
1663
1664 /* return the property type as a number */
1665 runpush(ctx->bifcxrun, DAT_NUMBER, &val);
1666 }
1667
1668 /* outhide */
bifoph(bifcxdef * ctx,int argc)1669 void bifoph(bifcxdef *ctx, int argc)
1670 {
1671 runsdef val;
1672 int hidden, output_occurred;
1673
1674 bifcntargs(ctx, 1, argc);
1675 outstat(&hidden, &output_occurred);
1676 if (runtostyp(ctx->bifcxrun) == DAT_TRUE)
1677 {
1678 /* throw away the flag */
1679 rundisc(ctx->bifcxrun);
1680
1681 /* figure out appropriate return value */
1682 if (!hidden)
1683 val.runsv.runsvnum = 0;
1684 else if (!output_occurred)
1685 val.runsv.runsvnum = 1;
1686 else
1687 val.runsv.runsvnum = 2;
1688 runpush(ctx->bifcxrun, DAT_NUMBER, &val);
1689
1690 /* actually hide the output, resetting count flag */
1691 outhide();
1692 }
1693 else if (runtostyp(ctx->bifcxrun) == DAT_NIL)
1694 {
1695 /* throw away the flag */
1696 rundisc(ctx->bifcxrun);
1697
1698 /* show output, returning status */
1699 runpush(ctx->bifcxrun, runclog(outshow()), &val);
1700 }
1701 else if (runtostyp(ctx->bifcxrun) == DAT_NUMBER)
1702 {
1703 int n = runpopnum(ctx->bifcxrun);
1704
1705 if (n == 0)
1706 {
1707 /* output was not hidden - show output and return status */
1708 runpush(ctx->bifcxrun, runclog(outshow()), &val);
1709 }
1710 else if (n == 1)
1711 {
1712 /*
1713 * Output was hidden, but no output had occurred yet.
1714 * Leave output hidden and return whether any output has
1715 * occurred.
1716 */
1717 runpush(ctx->bifcxrun, runclog(output_occurred), &val);
1718 }
1719 else if (n == 2)
1720 {
1721 /*
1722 * Output was hidden, and output had already occurred. If
1723 * more output has occurred, return true, else return nil.
1724 * In either case, set the output_occurred flag back to
1725 * true, since it was true before the outhide(true).
1726 */
1727 runpush(ctx->bifcxrun, runclog(output_occurred), &val);
1728 outsethidden();
1729 }
1730 else
1731 errsig1(ctx->bifcxerr, ERR_INVVBIF, ERRTSTR, "outhide");
1732 }
1733 else
1734 errsig(ctx->bifcxerr, ERR_REQNUM);
1735 }
1736
1737 /* put a numeric value in a list */
bifputnum(uchar * lstp,uint val)1738 static uchar *bifputnum(uchar *lstp, uint val)
1739 {
1740 *lstp++ = DAT_NUMBER;
1741 oswp4(lstp, (long)val);
1742 return(lstp + 4);
1743 }
1744
1745 /* gettime */
biftim(bifcxdef * ctx,int argc)1746 void biftim(bifcxdef *ctx, int argc)
1747 {
1748 time_t timer;
1749 struct tm *tblock;
1750 uchar ret[80];
1751 uchar *p;
1752 runsdef val;
1753 int typ;
1754
1755 if (argc == 1)
1756 {
1757 /* get the time type */
1758 typ = (int)runpopnum(ctx->bifcxrun);
1759 }
1760 else
1761 {
1762 /* make sure no arguments are specified */
1763 bifcntargs(ctx, 0, argc);
1764
1765 /* use the default time type */
1766 typ = 1;
1767 }
1768
1769 switch(typ)
1770 {
1771 case 1:
1772 /*
1773 * default information format - list format with current system
1774 * time and date
1775 */
1776
1777 /* make sure the time zone is set up properly */
1778 os_tzset();
1779
1780 /* get the local time information */
1781 timer = time(NULL);
1782 tblock = localtime(&timer);
1783
1784 /* adjust values for return format */
1785 tblock->tm_year += 1900;
1786 tblock->tm_mon++;
1787 tblock->tm_wday++;
1788 tblock->tm_yday++;
1789
1790 /* build return list value */
1791 oswp2(ret, 47);
1792 p = ret + 2;
1793 p = bifputnum(p, tblock->tm_year);
1794 p = bifputnum(p, tblock->tm_mon);
1795 p = bifputnum(p, tblock->tm_mday);
1796 p = bifputnum(p, tblock->tm_wday);
1797 p = bifputnum(p, tblock->tm_yday);
1798 p = bifputnum(p, tblock->tm_hour);
1799 p = bifputnum(p, tblock->tm_min);
1800 p = bifputnum(p, tblock->tm_sec);
1801 *p++ = DAT_NUMBER;
1802 oswp4(p, (long)timer);
1803
1804 val.runstyp = DAT_LIST;
1805 val.runsv.runsvstr = ret;
1806 runpush(ctx->bifcxrun, DAT_LIST, &val);
1807 break;
1808
1809 case 2:
1810 /*
1811 * High-precision system timer value - returns the system time
1812 * in milliseconds, relative to an arbitrary zero point
1813 */
1814 runpnum(ctx->bifcxrun, os_get_sys_clock_ms());
1815 break;
1816
1817 default:
1818 /* other types are invalid */
1819 runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "gettime");
1820 break;
1821 }
1822 }
1823
1824 /* getfuse */
bifgfu(bifcxdef * ctx,int argc)1825 void bifgfu(bifcxdef *ctx, int argc)
1826 {
1827 vocddef *daem;
1828 objnum func;
1829 runsdef val;
1830 runcxdef *rcx = ctx->bifcxrun;
1831 int slots;
1832 prpnum prop;
1833 voccxdef *vcx = ctx->bifcxrun->runcxvoc;
1834
1835 bifcntargs(ctx, 2, argc);
1836
1837 if (runtostyp(rcx) == DAT_FNADDR)
1838 {
1839 /* check on a setfuse()-style fuse: get fnaddr, parm */
1840 func = runpopfn(rcx);
1841 runpop(rcx, &val);
1842
1843 for (slots = vcx->voccxfuc, daem = vcx->voccxfus ;
1844 slots ; ++daem, --slots)
1845 {
1846 if (daem->vocdfn == func
1847 && daem->vocdarg.runstyp == val.runstyp
1848 && !memcmp(&val.runsv, &daem->vocdarg.runsv,
1849 (size_t)datsiz(val.runstyp, &val.runsv)))
1850 goto ret_num;
1851 }
1852 }
1853 else
1854 {
1855 /* check on a notify()-style fuse: get object, &message */
1856 func = runpopobj(rcx);
1857 prop = runpopprp(rcx);
1858
1859 for (slots = vcx->voccxalc, daem = vcx->voccxalm ;
1860 slots ; ++daem, --slots)
1861 {
1862 if (daem->vocdfn == func && daem->vocdprp == prop)
1863 goto ret_num;
1864 }
1865 }
1866
1867 /* didn't find anything - return nil */
1868 runpush(rcx, DAT_NIL, &val);
1869 return;
1870
1871 ret_num:
1872 /* return current daem->vocdtim */
1873 runpnum(rcx, (long)daem->vocdtim);
1874 return;
1875 }
1876
1877 /* runfuses */
bifruf(bifcxdef * ctx,int argc)1878 void bifruf(bifcxdef *ctx, int argc)
1879 {
1880 int ret;
1881 runsdef val;
1882
1883 bifcntargs(ctx, 0, argc);
1884 ret = exefuse(ctx->bifcxrun->runcxvoc, TRUE);
1885 runpush(ctx->bifcxrun, runclog(ret), &val);
1886 }
1887
1888 /* rundaemons */
bifrud(bifcxdef * ctx,int argc)1889 void bifrud(bifcxdef *ctx, int argc)
1890 {
1891 bifcntargs(ctx, 0, argc);
1892 exedaem(ctx->bifcxrun->runcxvoc);
1893 }
1894
1895 /* intersect */
bifsct(bifcxdef * bifctx,int argc)1896 void bifsct(bifcxdef *bifctx, int argc)
1897 {
1898 runcxdef *ctx = bifctx->bifcxrun;
1899 uchar *l1;
1900 uchar *l2;
1901 uchar *l3;
1902 uint siz1;
1903 uint siz2;
1904 uint siz3;
1905 uchar *p;
1906 uint l;
1907 uint dsz1;
1908 uint dsz2;
1909 runsdef val;
1910 runsdef stk1, stk2;
1911
1912 bifcntargs(bifctx, 2, argc);
1913 l1 = runpoplst(ctx);
1914 siz1 = osrp2(l1);
1915 l2 = runpoplst(ctx);
1916 siz2 = osrp2(l2);
1917
1918 /* make sure the first list is smaller - if not, switch them */
1919 if (siz1 > siz2)
1920 l3 = l1, l1 = l2, l2 = l3, siz3 = siz1, siz1 = siz2, siz2 = siz3;
1921
1922 /* size of result is at most size of smaller list (which is now siz1) */
1923 stk1.runstyp = stk2.runstyp = DAT_LIST;
1924 stk1.runsv.runsvstr = l1;
1925 stk2.runsv.runsvstr = l2;
1926 runhres2(ctx, siz1, 2, &stk1, &stk2);
1927 l1 = stk1.runsv.runsvstr;
1928 l2 = stk2.runsv.runsvstr;
1929 l3 = ctx->runcxhp + 2;
1930
1931 /* go through list1, and copy each element that is found in list2 */
1932 for (l1 += 2, l2 += 2, siz1 -= 2, siz2 -= 2 ; siz1 ; lstadv(&l1, &siz1))
1933 {
1934 dsz1 = datsiz(*l1, l1 + 1) + 1;
1935 for (l = siz2, p = l2 ; l ; lstadv(&p, &l))
1936 {
1937 dsz2 = datsiz(*p, p + 1) + 1;
1938 #ifndef AMIGA
1939 if (dsz1 == dsz2 && !memcmp(l1, p, (size_t)dsz1))
1940 #else /* AMIGA */
1941 if (!memcmp(l1, p, (size_t)dsz1) && (dsz1 == dsz2) )
1942 #endif /* AMIGA */
1943 {
1944 memcpy(l3, p, (size_t)dsz1);
1945 l3 += dsz1;
1946 break;
1947 }
1948 }
1949 }
1950
1951 /* set up return value, take it out of the heap, and push value */
1952 val.runsv.runsvstr = ctx->runcxhp;
1953 val.runstyp = DAT_LIST;
1954 oswp2(ctx->runcxhp, (uint)(l3 - ctx->runcxhp));
1955 ctx->runcxhp = l3;
1956 runrepush(ctx, &val);
1957 }
1958
1959 /*
1960 * Portable keystroke mappings. We map the extended key codes to these
1961 * strings, so that the TADS code can access arrow keys and the like.
1962 */
1963 static char *ext_key_names[] =
1964 {
1965 "[up]", /* CMD_UP - 1 */
1966 "[down]", /* CMD_DOWN - 2 */
1967 "[right]", /* CMD_RIGHT - 3 */
1968 "[left]", /* CMD_LEFT - 4 */
1969 "[end]", /* CMD_END - 5 */
1970 "[home]", /* CMD_HOME - 6 */
1971 "[del-eol]", /* CMD_DEOL - 7 */
1972 "[del-line]", /* CMD_KILL - 8 */
1973 "[del]", /* CMD_DEL - 9 */
1974 "[scroll]", /* CMD_SCR - 10 */
1975 "[page up]", /* CMD_PGUP - 11 */
1976 "[page down]", /* CMD_PGDN - 12 */
1977 "[top]", /* CMD_TOP - 13 */
1978 "[bottom]", /* CMD_BOT - 14 */
1979 "[f1]", /* CMD_F1 - 15 */
1980 "[f2]", /* CMD_F2 - 16 */
1981 "[f3]", /* CMD_F3 - 17 */
1982 "[f4]", /* CMD_F4 - 18 */
1983 "[f5]", /* CMD_F5 - 19 */
1984 "[f6]", /* CMD_F6 - 20 */
1985 "[f7]", /* CMD_F7 - 21 */
1986 "[f8]", /* CMD_F8 - 22 */
1987 "[f9]", /* CMD_F9 - 23 */
1988 "[f10]", /* CMD_F10 - 24 */
1989 "[?]", /* invalid key - CMD_CHOME - 25 */
1990 "[tab]", /* CMD_TAB - 26 */
1991 "[?]", /* invalid key - shift-F2 - 27 */
1992 "[?]", /* not used (obsolete) - 28 */
1993 "[word-left]", /* CMD_WORD_LEFT - 29 */
1994 "[word-right]", /* CMD_WORD_RIGHT - 30 */
1995 "[del-word]", /* CMD_WORDKILL - 31 */
1996 "[eof]", /* CMD_EOF - 32 */
1997 "[break]" /* CMD_BREAK - 33 */
1998 };
1999
2000 /*
2001 * Get the name of a keystroke. Pass in the one or two characters
2002 * returned by os_getc(), and we'll fill in the buffer with the
2003 * inputkey() name of the keystroke. Returns true if the key was valid,
2004 * false if not. 'c' is the first character returned by os_getc() for
2005 * the keystroke; if 'c' is zero, then 'extc' is the character returned
2006 * by the second call to os_getc() to get the CMD_xxx code for the
2007 * keystroke.
2008 *
2009 * The name buffer should be 20 characters long - this will ensure that
2010 * any name will fit.
2011 *
2012 * For ordinary, printable characters, we'll simply return the
2013 * character; the letter 'a', for example, is returned as the string "a".
2014 *
2015 * For extended keys, we'll look up the CMD_xxx code and return the name
2016 * of the command, enclosed in square brackets; see the ext_key_names
2017 * table for the mappings. The left-arrow cursor key, for example,
2018 * returns "[left]".
2019 *
2020 * For control characters, we'll generate a name like "[ctrl-a]", except
2021 * for the following characters:
2022 *
2023 *. ascii 10 returns "\n"
2024 *. ascii 13 returns "\n"
2025 *. ascii 9 returns "\t"
2026 *. ascii 8 returns "[bksp]"
2027 */
get_ext_key_name(char * namebuf,int c,int extc)2028 static int get_ext_key_name(char *namebuf, int c, int extc)
2029 {
2030 /* if it's a control character, translate it */
2031 if (c >= 1 && c <= 27)
2032 {
2033 switch(c)
2034 {
2035 case 10:
2036 case 13:
2037 /* return '\n' for LF and CR characters */
2038 strcpy(namebuf, "\\n");
2039 return TRUE;
2040
2041 case 9:
2042 /* return '\t' for TAB characters */
2043 strcpy(namebuf, "\\t");
2044 return TRUE;
2045
2046 case 8:
2047 /* return '[bksp]' for backspace characters */
2048 strcpy(namebuf, "[bksp]");
2049 return TRUE;
2050
2051 case 27:
2052 /* return '[esc]' for the escape key */
2053 strcpy(namebuf, "[esc]");
2054 return TRUE;
2055
2056 default:
2057 /* return '[ctrl-X]' for other control characters */
2058 strcpy(namebuf, "[ctrl-X]");
2059 namebuf[6] = (char)(c + 'a' - 1);
2060 return TRUE;
2061 }
2062 }
2063
2064 /* if it's any other non-extended key, return it as-is */
2065 if (c != 0)
2066 {
2067 namebuf[0] = c;
2068 namebuf[1] = '\0';
2069 return TRUE;
2070 }
2071
2072 /* if it's in the key name array, use the array entry */
2073 if (extc >= 1
2074 && extc <= (int)(sizeof(ext_key_names)/sizeof(ext_key_names[0])))
2075 {
2076 /* use the array name */
2077 strcpy(namebuf, ext_key_names[extc - 1]);
2078 return TRUE;
2079 }
2080
2081 /* if it's in the ALT key range, generate an ALT key name */
2082 if (extc >= CMD_ALT && extc <= CMD_ALT + 25)
2083 {
2084 /* generate an ALT key name */
2085 strcpy(namebuf, "[alt-X]");
2086 namebuf[5] = (char)(extc - CMD_ALT + 'a');
2087 return TRUE;
2088 }
2089
2090 /* it's not a valid key - use '[?]' as the name */
2091 strcpy(namebuf, "[?]");
2092 return FALSE;
2093 }
2094
2095
2096 /* inputkey */
bifink(bifcxdef * ctx,int argc)2097 void bifink(bifcxdef *ctx, int argc)
2098 {
2099 int c;
2100 int extc;
2101 char str[20];
2102 size_t len;
2103
2104 bifcntargs(ctx, 0, argc);
2105 tioflushn(ctx->bifcxtio, 0);
2106
2107 /* get a key */
2108 c = os_getc_raw();
2109
2110 /* if it's extended, get the second part of the extended sequence */
2111 extc = (c == 0 ? os_getc_raw() : 0);
2112
2113 /* map the extended key name */
2114 get_ext_key_name(str, c, extc);
2115
2116 /* get the length of the name */
2117 len = strlen(str);
2118
2119 /* reset the [more] counter */
2120 outreset();
2121
2122 /* return the string, translating escapes */
2123 runpstr(ctx->bifcxrun, str, len, 0);
2124 }
2125
2126 /* get direct/indirect object word list */
bifwrd(bifcxdef * ctx,int argc)2127 void bifwrd(bifcxdef *ctx, int argc)
2128 {
2129 int ob;
2130 vocoldef *v;
2131 uchar buf[128];
2132 uchar *dst;
2133 uchar *src;
2134 uint len;
2135 runsdef val;
2136
2137 bifcntargs(ctx, 1, argc);
2138
2139 /* figure out what word list to get */
2140 ob = runpopnum(ctx->bifcxrun);
2141 switch(ob)
2142 {
2143 case 1:
2144 v = ctx->bifcxrun->runcxvoc->voccxdobj;
2145 break;
2146
2147 case 2:
2148 v = ctx->bifcxrun->runcxvoc->voccxiobj;
2149 break;
2150
2151 default:
2152 runpnil(ctx->bifcxrun);
2153 return;
2154 }
2155
2156 /* now build a list of strings from the words, if there are any */
2157 if (v != 0 && voclistlen(v) != 0 && v->vocolfst != 0 && v->vocollst != 0)
2158 {
2159 for (dst = buf + 2, src = (uchar *)v->vocolfst ;
2160 src <= (uchar *)v->vocollst ; src += len + 1)
2161 {
2162 *dst++ = DAT_SSTRING;
2163 len = strlen((char *)src);
2164 oswp2(dst, len + 2);
2165 strcpy((char *)dst + 2, (char *)src);
2166 dst += len + 2;
2167 }
2168 }
2169 else
2170 dst = buf + 2;
2171
2172 /* finish setting up the list length and return it */
2173 len = dst - buf;
2174 oswp2(buf, len);
2175 val.runsv.runsvstr = buf;
2176 val.runstyp = DAT_LIST;
2177 runpush(ctx->bifcxrun, DAT_LIST, &val);
2178 }
2179
2180 /* add a vocabulary word to an object */
bifadw(bifcxdef * ctx,int argc)2181 void bifadw(bifcxdef *ctx, int argc)
2182 {
2183 uchar *wrd;
2184 objnum objn;
2185 prpnum prpn;
2186 vocidef *voci;
2187 int classflg;
2188 voccxdef *voc = ctx->bifcxrun->runcxvoc;
2189
2190 bifcntargs(ctx, 3, argc);
2191
2192 /* get the arguments */
2193 objn = runpopobj(ctx->bifcxrun);
2194 prpn = runpopprp(ctx->bifcxrun);
2195 wrd = runpopstr(ctx->bifcxrun);
2196
2197 /* make sure the property is a valid part of speech property */
2198 if (!prpisvoc(prpn))
2199 runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "addword");
2200
2201 /* get the vocidef for the object, and see if it's a class object */
2202 voci = vocinh(voc, objn);
2203
2204 classflg = VOCFNEW;
2205 if (voci->vociflg & VOCIFCLASS) classflg |= VOCFCLASS;
2206
2207 /* add the word */
2208 vocadd(voc, prpn, objn, classflg, (char *)wrd);
2209
2210 /* generate undo for the operation */
2211 vocdusave_addwrd(voc, objn, prpn, classflg, (char *)wrd);
2212 }
2213
2214 /* delete a vocabulary word from an object */
bifdlw(bifcxdef * ctx,int argc)2215 void bifdlw(bifcxdef *ctx, int argc)
2216 {
2217 uchar *wrd;
2218 objnum objn;
2219 prpnum prpn;
2220 voccxdef *voc = ctx->bifcxrun->runcxvoc;
2221
2222 bifcntargs(ctx, 3, argc);
2223
2224 /* get the arguments */
2225 objn = runpopobj(ctx->bifcxrun);
2226 prpn = runpopprp(ctx->bifcxrun);
2227 wrd = runpopstr(ctx->bifcxrun);
2228
2229 /* make sure the property is a valid part of speech property */
2230 if (!prpisvoc(prpn))
2231 runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "delword");
2232
2233 /* delete the word */
2234 vocdel1(voc, objn, (char *)wrd, prpn, FALSE, FALSE, TRUE);
2235 }
2236
2237 /* callback context for word list builder */
2238 struct bifgtw_cb_ctx
2239 {
2240 uchar *p;
2241 int typ;
2242 };
2243
2244 /* callback for word list builder */
bifgtw_cb(void * ctx0,vocdef * voc,vocwdef * vocw)2245 static void bifgtw_cb(void *ctx0, vocdef *voc, vocwdef *vocw)
2246 {
2247 struct bifgtw_cb_ctx *ctx = (struct bifgtw_cb_ctx *)ctx0;
2248
2249 /* ignore deleted objects */
2250 if (vocw->vocwflg & VOCFDEL)
2251 return;
2252
2253 /* ignore objects of the inappropriate type */
2254 if (vocw->vocwtyp != ctx->typ)
2255 return;
2256
2257 /* the datatype is string */
2258 *ctx->p = DAT_SSTRING;
2259
2260 /* copy the first word */
2261 memcpy(ctx->p + 3, voc->voctxt, (size_t)voc->voclen);
2262
2263 /* if there are two words, add a space and the second word */
2264 if (voc->vocln2)
2265 {
2266 *(ctx->p + 3 + voc->voclen) = ' ';
2267 memcpy(ctx->p + 4 + voc->voclen, voc->voctxt + voc->voclen,
2268 (size_t)voc->vocln2);
2269 oswp2(ctx->p + 1, voc->voclen + voc->vocln2 + 3);
2270 ctx->p += voc->voclen + voc->vocln2 + 4;
2271 }
2272 else
2273 {
2274 oswp2(ctx->p + 1, voc->voclen+2);
2275 ctx->p += voc->voclen + 3;
2276 }
2277 }
2278
2279 /* get the list of words for an object for a particular part of speech */
bifgtw(bifcxdef * ctx,int argc)2280 void bifgtw(bifcxdef *ctx, int argc)
2281 {
2282 objnum objn;
2283 prpnum prpn;
2284 voccxdef *voc = ctx->bifcxrun->runcxvoc;
2285 int cnt;
2286 int siz;
2287 runsdef val;
2288 struct bifgtw_cb_ctx fnctx;
2289
2290 bifcntargs(ctx, 2, argc);
2291
2292 /* get the arguments */
2293 objn = runpopobj(ctx->bifcxrun);
2294 prpn = runpopprp(ctx->bifcxrun);
2295
2296 /* make sure the property is a valid part of speech property */
2297 if (!prpisvoc(prpn))
2298 runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "delword");
2299
2300 /* get the size of the list we'll need to build */
2301 voc_count(voc, objn, prpn, &cnt, &siz);
2302
2303 /*
2304 * calculate how much space it will take to make a list out of all
2305 * these words: 2 bytes for the list length header; plus, for each
2306 * entry, 1 byte for the type header, 2 bytes for the string size
2307 * header, and possibly one extra byte for the two-word separator --
2308 * a total of 4 bytes extra per word.
2309 */
2310 siz += 2 + 4*cnt;
2311
2312 /* reserve the space */
2313 runhres(ctx->bifcxrun, siz, 0);
2314
2315 /* set up our callback context, and build the list */
2316 fnctx.p = ctx->bifcxrun->runcxhp + 2;
2317 fnctx.typ = prpn;
2318 voc_iterate(voc, objn, bifgtw_cb, &fnctx);
2319
2320 /* set up the return value */
2321 val.runstyp = DAT_LIST;
2322 val.runsv.runsvstr = ctx->bifcxrun->runcxhp;
2323
2324 /* write the list length, and advance past the space we used */
2325 oswp2(ctx->bifcxrun->runcxhp, fnctx.p - ctx->bifcxrun->runcxhp);
2326 ctx->bifcxrun->runcxhp = fnctx.p;
2327
2328 /* return the list */
2329 runrepush(ctx->bifcxrun, &val);
2330 }
2331
2332 /* verbinfo service routine - add an object to the output list */
bifvin_putprpn(uchar * p,prpnum prpn)2333 static uchar *bifvin_putprpn(uchar *p, prpnum prpn)
2334 {
2335 *p++ = DAT_PROPNUM;
2336 oswp2(p, prpn);
2337 return p + 2;
2338 }
2339
2340 /* verbinfo */
bifvin(bifcxdef * ctx,int argc)2341 void bifvin(bifcxdef *ctx, int argc)
2342 {
2343 objnum verb;
2344 objnum prep;
2345 uchar tplbuf[VOCTPL2SIZ];
2346 int newstyle;
2347
2348 /* get the verb */
2349 verb = runpopobj(ctx->bifcxrun);
2350
2351 /* check for the presence of a preposition */
2352 if (argc == 1)
2353 {
2354 /* no preposition */
2355 prep = MCMONINV;
2356 }
2357 else
2358 {
2359 /* the second argument is the preposition */
2360 bifcntargs(ctx, 2, argc);
2361 prep = runpopobj(ctx->bifcxrun);
2362 }
2363
2364 /* look up the template */
2365 if (voctplfnd(ctx->bifcxrun->runcxvoc, verb, prep, tplbuf, &newstyle))
2366 {
2367 prpnum prp_do, prp_verdo, prp_io, prp_verio;
2368 int flg_dis_do;
2369 ushort siz;
2370 uchar *p;
2371 runsdef val;
2372
2373 /* get the information from the template */
2374 prp_do = voctpldo(tplbuf);
2375 prp_verdo = voctplvd(tplbuf);
2376 prp_io = voctplio(tplbuf);
2377 prp_verio = voctplvi(tplbuf);
2378 flg_dis_do = (voctplflg(tplbuf) & VOCTPLFLG_DOBJ_FIRST) != 0;
2379
2380 /*
2381 * figure space for the return value: if there's a prep, three
2382 * property pointers plus a boolean, otherwise just two property
2383 * pointers
2384 */
2385 siz = 2 + 2*(2+1);
2386 if (prep != MCMONINV)
2387 siz += (2+1) + 1;
2388
2389 /* reserve the space */
2390 runhres(ctx->bifcxrun, siz, 0);
2391
2392 /* build the output list */
2393 p = ctx->bifcxrun->runcxhp;
2394 oswp2(p, siz);
2395 p += 2;
2396
2397 p = bifvin_putprpn(p, prp_verdo);
2398 if (prep == MCMONINV)
2399 {
2400 p = bifvin_putprpn(p, prp_do);
2401 }
2402 else
2403 {
2404 p = bifvin_putprpn(p, prp_verio);
2405 p = bifvin_putprpn(p, prp_io);
2406 *p++ = runclog(flg_dis_do);
2407 }
2408
2409 /* build the return value */
2410 val.runstyp = DAT_LIST;
2411 val.runsv.runsvstr = ctx->bifcxrun->runcxhp;
2412
2413 /* consume the space */
2414 ctx->bifcxrun->runcxhp += siz;
2415
2416 /* return the list */
2417 runrepush(ctx->bifcxrun, &val);
2418 }
2419 else
2420 {
2421 /* no template for this verb - return nil */
2422 runpnil(ctx->bifcxrun);
2423 }
2424 }
2425
2426
2427 /* clearscreen */
bifcls(bifcxdef * ctx,int argc)2428 void bifcls(bifcxdef *ctx, int argc)
2429 {
2430 /* this takes no arguments */
2431 bifcntargs(ctx, 0, argc);
2432
2433 /* flush any pending output */
2434 tioflushn(ctx->bifcxtio, 0);
2435
2436 /* clear the screen */
2437 oscls();
2438 }
2439
2440 /*
2441 * File operations
2442 */
2443
2444 /*
2445 * fopen(file, mode).
2446 *
2447 * Operations are allowed only if they conform to the current I/O safety
2448 * level. The safety level can be set by the user on the command line
2449 * when running the game, and some implementations may allow the setting
2450 * to be saved as a preference. The possible levels are:
2451 *
2452 *. 0 - minimum safety - read and write in any directory
2453 *. 1 - read in any directory, write in current directory
2454 *. 2 - read/write access in current directory only
2455 *. 3 - read-only access in current directory only
2456 *. 4 - maximum safety - no file I/O allowed
2457 *
2458 * When operations are allowed only in the current directory, the
2459 * operations will fail if the filename contains any sort of path
2460 * specifier (for example, on Unix, any file that contains a '/' is
2461 * considered to have a path specifier, and will always fail if
2462 * operations are only allowed in the current directory).
2463 */
biffopen(bifcxdef * ctx,int argc)2464 void biffopen(bifcxdef *ctx, int argc)
2465 {
2466 char fname[OSFNMAX];
2467 uchar *p;
2468 uchar *mode;
2469 int modelen;
2470 int fnum;
2471 osfildef *fp;
2472 int bin_mode = TRUE; /* flag: mode is binary (rather than text) */
2473 int rw_mode = FALSE; /* flag: both read and write are allowed */
2474 char main_mode; /* 'r' for read, 'w' for write */
2475 int in_same_dir; /* flag: file is in current directory */
2476 appctxdef *appctx;
2477
2478 bifcntargs(ctx, 2, argc);
2479
2480 /* get the filename */
2481 p = runpopstr(ctx->bifcxrun);
2482 bifcstr(ctx, fname, (size_t)sizeof(fname), p);
2483
2484 /* get the mode string */
2485 mode = runpopstr(ctx->bifcxrun);
2486 modelen = osrp2(mode) - 2;
2487 mode += 2;
2488 if (modelen < 1)
2489 goto bad_mode;
2490
2491 /* allocate a filenum for the file */
2492 for (fnum = 0 ; fnum < BIFFILMAX ; ++fnum)
2493 {
2494 if (ctx->bifcxfile[fnum].fp == 0)
2495 break;
2496 }
2497 if (fnum == BIFFILMAX)
2498 {
2499 /* return nil to indicate failure */
2500 runpnil(ctx->bifcxrun);
2501 return;
2502 }
2503
2504 /* parse the main mode */
2505 switch(*mode)
2506 {
2507 case 'w':
2508 case 'W':
2509 main_mode = 'w';
2510 break;
2511
2512 case 'r':
2513 case 'R':
2514 main_mode = 'r';
2515 break;
2516
2517 default:
2518 goto bad_mode;
2519 }
2520
2521 /* skip the main mode, and check for a '+' flag */
2522 ++mode;
2523 --modelen;
2524 if (modelen > 0 && *mode == '+')
2525 {
2526 /* note the read/write mode */
2527 rw_mode = TRUE;
2528
2529 /* skip the speciifer */
2530 ++mode;
2531 --modelen;
2532 }
2533
2534 /* check for a binary/text specifier */
2535 if (modelen > 0)
2536 {
2537 switch(*mode)
2538 {
2539 case 'b':
2540 case 'B':
2541 bin_mode = TRUE;
2542 break;
2543
2544 case 't':
2545 case 'T':
2546 bin_mode = FALSE;
2547 break;
2548
2549 default:
2550 goto bad_mode;
2551 }
2552
2553 /* skip the binary/text specifier */
2554 ++mode;
2555 --modelen;
2556 }
2557
2558 /* it's an error if there's anything left unparsed */
2559 if (modelen > 0)
2560 goto bad_mode;
2561
2562 /*
2563 * If we have a host application context, and it provides a file
2564 * safety level callback function, ask the host system for its
2565 * current file safety level, which overrides our current setting.
2566 */
2567 appctx = ctx->bifcxappctx;
2568 if (appctx != 0 && appctx->get_io_safety_level != 0)
2569 {
2570 /*
2571 * ask the host system for the current level, and override any
2572 * setting we previously had
2573 */
2574 ctx->bifcxsafety =
2575 (*appctx->get_io_safety_level)(appctx->io_safety_level_ctx);
2576 }
2577
2578 /*
2579 * Check to see if the file is in the current directory - if not, we
2580 * may have to disallow the operation based on safety level
2581 * settings. If the file has any sort of directory prefix, assume
2582 * it's not in the same directory; if not, it must be. This is
2583 * actually overly conservative, since the path may be a relative
2584 * path or even an absolute path that points to the current
2585 * directory, but the important thing is whether we're allowing
2586 * files to specify paths at all.
2587 */
2588 in_same_dir = (os_get_root_name(fname) == fname);
2589
2590 /* check file safety settings */
2591 switch(main_mode)
2592 {
2593 case 'w':
2594 /*
2595 * writing - we must be at a safety level no higher than 2
2596 * (read/write current directory) to write at all, and we must be
2597 * level 0 to write a file that's not in the current directory
2598 */
2599 if (ctx->bifcxsafety > 2
2600 || (!in_same_dir && ctx->bifcxsafety > 0))
2601 {
2602 /* this operation is not allowed - return failure */
2603 runpnil(ctx->bifcxrun);
2604 return;
2605 }
2606 break;
2607
2608 case 'r':
2609 /*
2610 * reading - we must be at a safety level no higher than 3 (read
2611 * current directory) to read at all, and we must be at safety
2612 * level 1 (read any directory) or lower to read a file that's not
2613 * in the current directory
2614 */
2615 if (ctx->bifcxsafety > 3
2616 || (!in_same_dir && ctx->bifcxsafety > 1))
2617 {
2618 /* this operation is not allowed - return failure */
2619 runpnil(ctx->bifcxrun);
2620 return;
2621 }
2622 break;
2623
2624 default:
2625 /*
2626 * fail the operation, as a code maintenance measure to make
2627 * sure that we add appropriate cases to this switch (even if
2628 * merely to allow the operation unconditionally) in the event
2629 * that more modes are added in the future
2630 */
2631 goto bad_mode;
2632 }
2633
2634 /* try opening the file */
2635 switch(main_mode)
2636 {
2637 case 'w':
2638 /* check for binary vs text mode */
2639 if (bin_mode)
2640 {
2641 /*
2642 * binary mode -- allow read/write or just writing, but in
2643 * either case truncate the file if it already exists, and
2644 * create a new file if it doesn't exist
2645 */
2646 if (rw_mode)
2647 fp = osfoprwtb(fname, OSFTDATA);
2648 else
2649 fp = osfopwb(fname, OSFTDATA);
2650 }
2651 else
2652 {
2653 /* text mode - don't allow read/write on a text file */
2654 if (rw_mode)
2655 goto bad_mode;
2656
2657 /* open the file */
2658 fp = osfopwt(fname, OSFTTEXT);
2659 }
2660 break;
2661
2662 case 'r':
2663 /* check for binary vs text mode */
2664 if (bin_mode)
2665 {
2666 /*
2667 * Binary mode -- allow read/write or just reading; leave
2668 * any existing file intact.
2669 */
2670 if (rw_mode)
2671 {
2672 /* open for reading and writing, keeping existing data */
2673 fp = osfoprwb(fname, OSFTDATA);
2674 }
2675 else
2676 {
2677 /* open for read-only */
2678 fp = osfoprb(fname, OSFTDATA);
2679 }
2680 }
2681 else
2682 {
2683 /* text mode -- only allow reading */
2684 if (rw_mode)
2685 goto bad_mode;
2686
2687 /* open the file */
2688 fp = osfoprt(fname, OSFTTEXT);
2689 }
2690 break;
2691
2692 default:
2693 goto bad_mode;
2694 }
2695
2696 /* if we couldn't open it, return nil */
2697 if (fp == 0)
2698 {
2699 runpnil(ctx->bifcxrun);
2700 return;
2701 }
2702
2703 /* store the flags */
2704 ctx->bifcxfile[fnum].flags = 0;
2705 if (bin_mode)
2706 ctx->bifcxfile[fnum].flags |= BIFFIL_F_BINARY;
2707
2708 /* remember the file handle */
2709 ctx->bifcxfile[fnum].fp = fp;
2710
2711 /* return the file number (i.e., the slot number) */
2712 runpnum(ctx->bifcxrun, (long)fnum);
2713 return;
2714
2715
2716 /* come here on a mode error */
2717 bad_mode:
2718 runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "fopen");
2719 }
2720
2721 /* service routine for file routines - get and validate a file number */
bif_get_file(bifcxdef * ctx,int * fnump,int * bin_modep)2722 static osfildef *bif_get_file(bifcxdef *ctx, int *fnump, int *bin_modep)
2723 {
2724 long fnum;
2725
2726 /* get the file number and make sure it's valid */
2727 fnum = runpopnum(ctx->bifcxrun);
2728 if (fnum < 0 || fnum >= BIFFILMAX || ctx->bifcxfile[fnum].fp == 0)
2729 runsig(ctx->bifcxrun, ERR_BADFILE);
2730
2731 /* put the validated file number, if the caller wants it */
2732 if (fnump != 0)
2733 *fnump = (int)fnum;
2734
2735 /* set the binary-mode flag, if the caller wants it */
2736 if (bin_modep != 0)
2737 *bin_modep = ((ctx->bifcxfile[fnum].flags & BIFFIL_F_BINARY) != 0);
2738
2739 /* return the file array pointer */
2740 return ctx->bifcxfile[fnum].fp;
2741 }
2742
biffclose(bifcxdef * ctx,int argc)2743 void biffclose(bifcxdef *ctx, int argc)
2744 {
2745 int fnum;
2746 osfildef *fp;
2747
2748 /* get the file number */
2749 bifcntargs(ctx, 1, argc);
2750 fp = bif_get_file(ctx, &fnum, 0);
2751
2752 /* close the file and release the slot */
2753 osfcls(fp);
2754 ctx->bifcxfile[fnum].fp = 0;
2755 }
2756
bifftell(bifcxdef * ctx,int argc)2757 void bifftell(bifcxdef *ctx, int argc)
2758 {
2759 osfildef *fp;
2760
2761 /* get the file number */
2762 bifcntargs(ctx, 1, argc);
2763 fp = bif_get_file(ctx, (int *)0, 0);
2764
2765 /* return the seek position */
2766 runpnum(ctx->bifcxrun, osfpos(fp));
2767 }
2768
biffseek(bifcxdef * ctx,int argc)2769 void biffseek(bifcxdef *ctx, int argc)
2770 {
2771 osfildef *fp;
2772 long pos;
2773
2774 /* get the file pointer */
2775 bifcntargs(ctx, 2, argc);
2776 fp = bif_get_file(ctx, (int *)0, 0);
2777
2778 /* get the seek position, and seek there */
2779 pos = runpopnum(ctx->bifcxrun);
2780 osfseek(fp, pos, OSFSK_SET);
2781 }
2782
biffseekeof(bifcxdef * ctx,int argc)2783 void biffseekeof(bifcxdef *ctx, int argc)
2784 {
2785 osfildef *fp;
2786
2787 /* get the file pointer */
2788 bifcntargs(ctx, 1, argc);
2789 fp = bif_get_file(ctx, (int *)0, 0);
2790
2791 /* seek to the end */
2792 osfseek(fp, 0L, OSFSK_END);
2793 }
2794
biffwrite(bifcxdef * ctx,int argc)2795 void biffwrite(bifcxdef *ctx, int argc)
2796 {
2797 osfildef *fp;
2798 char typ;
2799 char buf[32];
2800 runsdef val;
2801 int bin_mode;
2802
2803 /* get the file */
2804 bifcntargs(ctx, 2, argc);
2805 fp = bif_get_file(ctx, (int *)0, &bin_mode);
2806
2807 /* get the value to write */
2808 runpop(ctx->bifcxrun, &val);
2809 typ = val.runstyp;
2810
2811 if (bin_mode)
2812 {
2813 /* put a byte indicating the type */
2814 if (osfwb(fp, &typ, 1))
2815 goto ret_error;
2816
2817 /* see what type of data we want to put */
2818 switch(typ)
2819 {
2820 case DAT_NUMBER:
2821 oswp4(buf, val.runsv.runsvnum);
2822 if (osfwb(fp, buf, 4))
2823 goto ret_error;
2824 break;
2825
2826 case DAT_SSTRING:
2827 /* write the string, including the length prefix */
2828 if (osfwb(fp, val.runsv.runsvstr, osrp2(val.runsv.runsvstr)))
2829 goto ret_error;
2830 break;
2831
2832 case DAT_TRUE:
2833 /* all we need for this is the type prefix */
2834 break;
2835
2836 default:
2837 /* other types are not acceptable */
2838 runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "fwrite");
2839 }
2840 }
2841 else
2842 {
2843 uint rem;
2844 uchar *p;
2845
2846 switch(typ)
2847 {
2848 case DAT_SSTRING:
2849 /*
2850 * Copy and translate the string to our buffer, in pieces if
2851 * the size of the string exceeds that of our buffer. If we
2852 * encounter any escape codes, translate them.
2853 */
2854 rem = osrp2(val.runsv.runsvstr) - 2;
2855 p = val.runsv.runsvstr + 2;
2856 while (rem > 0)
2857 {
2858 uchar *dst;
2859 uchar buf[256];
2860
2861 /* fill up the buffer */
2862 for (dst = buf ;
2863 rem != 0 && (size_t)(dst - buf) < sizeof(buf) - 1 ;
2864 ++p, --rem)
2865 {
2866 /* if we have an escape character, translate it */
2867 if (*p == '\\' && rem > 1)
2868 {
2869 /* skip the opening slash */
2870 ++p;
2871 --rem;
2872
2873 /* translate it */
2874 switch(*p)
2875 {
2876 case 'n':
2877 *dst++ = '\n';
2878 break;
2879
2880 case 't':
2881 *dst++ = '\t';
2882 break;
2883
2884 default:
2885 *dst++ = *p;
2886 break;
2887 }
2888 }
2889 else
2890 {
2891 /* copy this character directly */
2892 *dst++ = *p;
2893 }
2894 }
2895
2896 /* null-terminate the buffer */
2897 *dst = '\0';
2898
2899 /* write it out */
2900 if (osfputs((char *)buf, fp) == EOF)
2901 goto ret_error;
2902 }
2903
2904 /* done */
2905 break;
2906
2907 default:
2908 /* other types are not allowed */
2909 runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "fwrite");
2910 }
2911 }
2912
2913 /* success */
2914 runpnil(ctx->bifcxrun);
2915 return;
2916
2917 ret_error:
2918 val.runstyp = DAT_TRUE;
2919 runpush(ctx->bifcxrun, DAT_TRUE, &val);
2920 }
2921
biffread(bifcxdef * ctx,int argc)2922 void biffread(bifcxdef *ctx, int argc)
2923 {
2924 osfildef *fp;
2925 char typ;
2926 char buf[32];
2927 runsdef val;
2928 ushort len;
2929 int bin_mode;
2930
2931 /* get the file pointer */
2932 bifcntargs(ctx, 1, argc);
2933 fp = bif_get_file(ctx, (int *)0, &bin_mode);
2934
2935 if (bin_mode)
2936 {
2937 /* binary file - read the type byte */
2938 if (osfrb(fp, &typ, 1))
2939 goto ret_error;
2940
2941 /* read the data according to the type */
2942 switch(typ)
2943 {
2944 case DAT_NUMBER:
2945 if (osfrb(fp, buf, 4))
2946 goto ret_error;
2947 runpnum(ctx->bifcxrun, osrp4(buf));
2948 break;
2949
2950 case DAT_SSTRING:
2951 /* get the size */
2952 if (osfrb(fp, buf, 2))
2953 goto ret_error;
2954 len = osrp2(buf);
2955
2956 /* reserve space */
2957 runhres(ctx->bifcxrun, len, 0);
2958
2959 /* read the string into the reserved space */
2960 if (osfrb(fp, ctx->bifcxrun->runcxhp + 2, len - 2))
2961 goto ret_error;
2962
2963 /* set up the string */
2964 oswp2(ctx->bifcxrun->runcxhp, len);
2965 val.runstyp = DAT_SSTRING;
2966 val.runsv.runsvstr = ctx->bifcxrun->runcxhp;
2967
2968 /* consume the space */
2969 ctx->bifcxrun->runcxhp += len;
2970
2971 /* push the value */
2972 runrepush(ctx->bifcxrun, &val);
2973 break;
2974
2975 case DAT_TRUE:
2976 val.runstyp = DAT_TRUE;
2977 runpush(ctx->bifcxrun, DAT_TRUE, &val);
2978 break;
2979
2980 default:
2981 goto ret_error;
2982 }
2983 }
2984 else
2985 {
2986 uchar buf[257];
2987 uchar *dst;
2988 uchar *src;
2989 uint len;
2990 uint res_total;
2991 int found_nl;
2992
2993 /*
2994 * reserve some space in the heap - we'll initially reserve
2995 * space for twice our buffer, in case every single character
2996 * needs to be expanded into an escape sequence
2997 */
2998 res_total = sizeof(buf) * 2;
2999 runhres(ctx->bifcxrun, res_total, 0);
3000
3001 /* set up our output value */
3002 val.runstyp = DAT_SSTRING;
3003 val.runsv.runsvstr = ctx->bifcxrun->runcxhp;
3004 dst = ctx->bifcxrun->runcxhp + 2;
3005
3006 /* keep going until we find a newline or run out of data */
3007 for (found_nl = FALSE ; !found_nl ; )
3008 {
3009 /* text-mode - read the result into our buffer */
3010 if (!osfgets((char *)buf, sizeof(buf) - 1, fp))
3011 {
3012 /*
3013 * if we found a newline, return what we have;
3014 * otherwise, return an error
3015 */
3016 if (found_nl)
3017 break;
3018 else
3019 goto ret_error;
3020 }
3021
3022 /*
3023 * make sure it's null-terminated, in case the buffer was
3024 * full
3025 */
3026 buf[256] = '\0';
3027
3028 /* translate into the heap area we've reserved */
3029 for (src = buf ; *src != '\0' ; ++src, ++dst)
3030 {
3031 /* determine if we need translations */
3032 switch(*src)
3033 {
3034 case '\n':
3035 case '\r':
3036 /* translate to a newline sequence */
3037 *dst++ = '\\';
3038 *dst = 'n';
3039
3040 /* note that we've found our newline */
3041 found_nl = TRUE;
3042 break;
3043
3044 case '\t':
3045 /* translate to a tab sequence */
3046 *dst++ = '\\';
3047 *dst = 't';
3048 break;
3049
3050 case '\\':
3051 /* expand to a double-backslash sequence */
3052 *dst++ = '\\';
3053 *dst = '\\';
3054 break;
3055
3056 default:
3057 /* leave other characters intact */
3058 *dst = *src;
3059 break;
3060 }
3061 }
3062
3063 /*
3064 * If we didn't find the newline, we'll need more space.
3065 * This is a bit tricky, because the space we've already set
3066 * up may move if we compact the heap while asking for more
3067 * space. So, remember our current length, reserve another
3068 * buffer-full of space, and set everything up at the new
3069 * output location if necessary.
3070 */
3071 if (!found_nl)
3072 {
3073 /* reserve another buffer-full (double for expansion) */
3074 res_total += sizeof(buf) * 2;
3075
3076 /* note our current offset */
3077 len = dst - val.runsv.runsvstr;
3078 oswp2(val.runsv.runsvstr, len);
3079
3080 /* ask for the space */
3081 runhres(ctx->bifcxrun, res_total, 0);
3082
3083 /*
3084 * Since we were at the top of the heap before, we
3085 * should still be at the top of the heap. If not,
3086 * we'll have to copy from our old location to the new
3087 * top of the heap.
3088 */
3089 if (val.runsv.runsvstr != ctx->bifcxrun->runcxhp)
3090 {
3091 /* copy our existing text to our new location */
3092 memmove(ctx->bifcxrun->runcxhp, val.runsv.runsvstr, len);
3093
3094 /* fix up our pointer */
3095 val.runsv.runsvstr = ctx->bifcxrun->runcxhp;
3096 }
3097
3098 /* re-establish our output pointer at our new location */
3099 dst = val.runsv.runsvstr + len;
3100 }
3101 }
3102
3103 /* finish setting up the string */
3104 len = dst - val.runsv.runsvstr;
3105 oswp2(val.runsv.runsvstr, len);
3106
3107 /* consume the space */
3108 ctx->bifcxrun->runcxhp += len;
3109
3110 /* push the value */
3111 runrepush(ctx->bifcxrun, &val);
3112 }
3113
3114 /* success - we've already pushed the return value */
3115 return;
3116
3117 ret_error:
3118 runpnil(ctx->bifcxrun);
3119 }
3120
bifcapture(bifcxdef * ctx,int argc)3121 void bifcapture(bifcxdef *ctx, int argc)
3122 {
3123 mcmcxdef *mcx = ctx->bifcxrun->runcxmem;
3124 mcmon obj;
3125 uint siz;
3126 uint ofs;
3127 uchar *p;
3128
3129 /* get the capture on/off flag */
3130 bifcntargs(ctx, 1, argc);
3131 switch(runtostyp(ctx->bifcxrun))
3132 {
3133 case DAT_TRUE:
3134 /* turn on capturing */
3135 tiocapture(ctx->bifcxtio, mcx, TRUE);
3136
3137 /*
3138 * The return value is a status code used to restore the
3139 * original status on the bracketing call to turn off output.
3140 * The only status necessary is the current output size.
3141 */
3142 siz = tiocapturesize(ctx->bifcxtio);
3143 runpnum(ctx->bifcxrun, (long)siz);
3144 break;
3145
3146 case DAT_NUMBER:
3147 /* get the original offset */
3148 ofs = runpopnum(ctx->bifcxrun);
3149
3150 /* get the capture object and size */
3151 obj = tiogetcapture(ctx->bifcxtio);
3152 siz = tiocapturesize(ctx->bifcxtio);
3153 if (obj == MCMONINV)
3154 {
3155 runpnil(ctx->bifcxrun);
3156 return;
3157 }
3158
3159 /* turn off capturing and reset the buffer on the outermost call */
3160 if (ofs == 0)
3161 {
3162 tiocapture(ctx->bifcxtio, mcx, FALSE);
3163 tioclrcapture(ctx->bifcxtio);
3164 }
3165
3166 /* lock the object */
3167 p = mcmlck(mcx, obj);
3168
3169 /* include only the part that happened after the matching call */
3170 p += ofs;
3171 siz = (ofs > siz) ? 0 : siz - ofs;
3172
3173 ERRBEGIN(ctx->bifcxerr)
3174
3175 /* push the string onto the stack */
3176 runpstr(ctx->bifcxrun, (char *)p, siz, 0);
3177
3178 ERRCLEAN(ctx->bifcxerr)
3179 /* done with the object - unlock it */
3180 mcmunlck(mcx, obj);
3181 ERRENDCLN(ctx->bifcxerr)
3182
3183 /* done with the object - unlock it */
3184 mcmunlck(mcx, obj);
3185 break;
3186
3187 default:
3188 runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "outcapture");
3189 }
3190 }
3191
3192 /*
3193 * systemInfo
3194 */
bifsysinfo(bifcxdef * ctx,int argc)3195 void bifsysinfo(bifcxdef *ctx, int argc)
3196 {
3197 runsdef val;
3198 int id;
3199 long result;
3200
3201 /* see what we have */
3202 switch(id = (int)runpopnum(ctx->bifcxrun))
3203 {
3204 case SYSINFO_SYSINFO:
3205 /* systemInfo call is supported in this version - return true */
3206 bifcntargs(ctx, 1, argc);
3207 val.runstyp = DAT_TRUE;
3208 runpush(ctx->bifcxrun, DAT_TRUE, &val);
3209 break;
3210
3211 case SYSINFO_VERSION:
3212 /* get the run-time version string */
3213 bifcntargs(ctx, 1, argc);
3214 runpushcstr(ctx->bifcxrun, TADS_RUNTIME_VERSION,
3215 strlen(TADS_RUNTIME_VERSION), 0);
3216 break;
3217
3218 case SYSINFO_OS_NAME:
3219 /* get the operating system name */
3220 bifcntargs(ctx, 1, argc);
3221 runpushcstr(ctx->bifcxrun, OS_SYSTEM_NAME, strlen(OS_SYSTEM_NAME), 0);
3222 break;
3223
3224 case SYSINFO_HTML:
3225 case SYSINFO_JPEG:
3226 case SYSINFO_PNG:
3227 case SYSINFO_WAV:
3228 case SYSINFO_MIDI:
3229 case SYSINFO_WAV_MIDI_OVL:
3230 case SYSINFO_WAV_OVL:
3231 case SYSINFO_PREF_IMAGES:
3232 case SYSINFO_PREF_SOUNDS:
3233 case SYSINFO_PREF_MUSIC:
3234 case SYSINFO_PREF_LINKS:
3235 case SYSINFO_MPEG:
3236 case SYSINFO_MPEG1:
3237 case SYSINFO_MPEG2:
3238 case SYSINFO_MPEG3:
3239 case SYSINFO_LINKS_HTTP:
3240 case SYSINFO_LINKS_FTP:
3241 case SYSINFO_LINKS_NEWS:
3242 case SYSINFO_LINKS_MAILTO:
3243 case SYSINFO_LINKS_TELNET:
3244 case SYSINFO_PNG_TRANS:
3245 case SYSINFO_PNG_ALPHA:
3246 case SYSINFO_OGG:
3247 case SYSINFO_MNG:
3248 case SYSINFO_MNG_TRANS:
3249 case SYSINFO_MNG_ALPHA:
3250 case SYSINFO_TEXT_HILITE:
3251 case SYSINFO_INTERP_CLASS:
3252 /*
3253 * these information types are all handled by the OS layer, and
3254 * take no additional arguments
3255 */
3256 bifcntargs(ctx, 1, argc);
3257 if (os_get_sysinfo(id, 0, &result))
3258 {
3259 /* we got a valid result - return it */
3260 runpnum(ctx->bifcxrun, result);
3261 }
3262 else
3263 {
3264 /* the code was unknown - return nil */
3265 runpnil(ctx->bifcxrun);
3266 }
3267 break;
3268
3269 case SYSINFO_HTML_MODE:
3270 /* ask the output formatter for its current HTML setting */
3271 bifcntargs(ctx, 1, argc);
3272 val.runstyp = runclog(tio_is_html_mode());
3273 runpush(ctx->bifcxrun, val.runstyp, &val);
3274 break;
3275
3276 case SYSINFO_TEXT_COLORS:
3277 /*
3278 * Text colors are only supported in full HTML interpreters. If
3279 * this is an HTML interpreter, ask the underlying OS layer about
3280 * color support; otherwise, colors are not available, since we
3281 * don't handle colors in our text-only HTML subset.
3282 *
3283 * Colors are NOT supported in the HTML mini-parser in text-only
3284 * interpreters in TADS 2. So, even if we're running in HTML
3285 * mode, if this is a text-only interpreter, we can't display text
3286 * colors.
3287 */
3288 bifcntargs(ctx, 1, argc);
3289 if (os_get_sysinfo(SYSINFO_HTML, 0, &result) && result != 0)
3290 {
3291 /*
3292 * we're in HTML mode, so ask the underlying HTML OS
3293 * implementation for its level of text color support
3294 */
3295 if (os_get_sysinfo(id, 0, &result))
3296 {
3297 /* push the OS-level result */
3298 runpnum(ctx->bifcxrun, result);
3299 }
3300 else
3301 {
3302 /* the OS code doesn't recognize it; assume no support */
3303 runpnum(ctx->bifcxrun, SYSINFO_TXC_NONE);
3304 }
3305 }
3306 else
3307 {
3308 /* we're a text-only interpreter - no color support */
3309 runpnum(ctx->bifcxrun, SYSINFO_TXC_NONE);
3310 }
3311 break;
3312
3313 case SYSINFO_BANNERS:
3314 /* TADS 2 does not offer banner support */
3315 bifcntargs(ctx, 1, argc);
3316 runpnum(ctx->bifcxrun, 0);
3317 break;
3318
3319 default:
3320 /*
3321 * Other codes fail harmlessly with a nil return value. Pop all
3322 * remaining arguments and return nil.
3323 */
3324 for ( ; argc > 1 ; --argc)
3325 rundisc(ctx->bifcxrun);
3326 runpnil(ctx->bifcxrun);
3327 break;
3328 }
3329 }
3330
3331 /*
3332 * morePrompt - display the more prompt and wait for the user to respond
3333 */
bifmore(bifcxdef * ctx,int argc)3334 void bifmore(bifcxdef *ctx, int argc)
3335 {
3336 /* this function takes no arguments */
3337 bifcntargs(ctx, 0, argc);
3338
3339 /* display the MORE prompt */
3340 tioflushn(ctx->bifcxtio, 1);
3341 out_more_prompt();
3342 }
3343
3344 /*
3345 * parserSetMe
3346 */
bifsetme(bifcxdef * ctx,int argc)3347 void bifsetme(bifcxdef *ctx, int argc)
3348 {
3349 objnum new_me;
3350
3351 /* this function takes one argument */
3352 bifcntargs(ctx, 1, argc);
3353
3354 /* get the new "Me" object */
3355 new_me = runpopobj(ctx->bifcxrun);
3356
3357 /* "Me" cannot be nil */
3358 if (new_me == MCMONINV)
3359 runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "parserSetMe");
3360
3361 /* set the current "Me" object in the parser */
3362 voc_set_me(ctx->bifcxrun->runcxvoc, new_me);
3363 }
3364
3365 /*
3366 * parserGetMe
3367 */
bifgetme(bifcxdef * ctx,int argc)3368 void bifgetme(bifcxdef *ctx, int argc)
3369 {
3370 /* this function takes no arguments */
3371 bifcntargs(ctx, 0, argc);
3372
3373 /* return the current Me object */
3374 runpobj(ctx->bifcxrun, ctx->bifcxrun->runcxvoc->voccxme);
3375 }
3376
3377 /*
3378 * reSearch
3379 */
bifresearch(bifcxdef * ctx,int argc)3380 void bifresearch(bifcxdef *ctx, int argc)
3381 {
3382 uchar *patstr;
3383 size_t patlen;
3384 uchar *searchstr;
3385 size_t searchlen;
3386 int result_len;
3387 int match_ofs;
3388
3389 /* this function takes two parameters: pattern, string */
3390 bifcntargs(ctx, 2, argc);
3391
3392 /* get the pattern string */
3393 patstr = runpopstr(ctx->bifcxrun);
3394 patlen = osrp2(patstr) - 2;
3395 patstr += 2;
3396
3397 /* get the search string */
3398 searchstr = runpopstr(ctx->bifcxrun);
3399 searchlen = osrp2(searchstr) - 2;
3400 searchstr += 2;
3401
3402 /* search for the pattern in the string */
3403 match_ofs = re_compile_and_search(&ctx->bifcxregex,
3404 (char *)patstr, patlen,
3405 (char *)searchstr, searchlen,
3406 &result_len);
3407
3408 /*
3409 * if we didn't match, return nil; otherwise, return a list with the
3410 * match offset and length
3411 */
3412 if (match_ofs < 0)
3413 {
3414 /* no match - return nil */
3415 runpnil(ctx->bifcxrun);
3416 }
3417 else
3418 {
3419 ushort listsiz;
3420 runsdef val;
3421 uchar *p;
3422
3423 /*
3424 * build a list consisting of two numbers and a string: two
3425 * bytes for the list header, then two elements at (one byte for
3426 * the datatype header, four bytes for the number), then the
3427 * string element with (one byte for the datatype, two bytes for
3428 * the string length prefix, and the bytes of the string)
3429 */
3430 listsiz = 2 + (1+4)*2 + (1 + 2 + (ushort)(result_len));
3431
3432 /* allocate the space */
3433 runhres(ctx->bifcxrun, listsiz, 0);
3434
3435 /* set up the list stack item */
3436 val.runstyp = DAT_LIST;
3437 p = val.runsv.runsvstr = ctx->bifcxrun->runcxhp;
3438
3439 /* set the list's length */
3440 oswp2(p, listsiz);
3441 p += 2;
3442
3443 /*
3444 * Add the offset element. For consistency with TADS
3445 * conventions, use 1 as the offset of the first character in
3446 * the string - this makes it easy to use the offset value with
3447 * substr().
3448 */
3449 *p++ = DAT_NUMBER;
3450 oswp4(p, match_ofs + 1);
3451 p += 4;
3452
3453 /* add the length element */
3454 *p++ = DAT_NUMBER;
3455 oswp4(p, result_len);
3456 p += 4;
3457
3458 /* add the result string */
3459 *p++ = DAT_SSTRING;
3460 oswp2(p, result_len + 2);
3461 p += 2;
3462 memcpy(p, ctx->bifcxregex.strbuf + match_ofs, result_len);
3463
3464 /* reserve the space in the heap */
3465 ctx->bifcxrun->runcxhp += listsiz;
3466
3467 /* return the list */
3468 runrepush(ctx->bifcxrun, &val);
3469 }
3470 }
3471
3472 /* reGetGroup */
bifregroup(bifcxdef * ctx,int argc)3473 void bifregroup(bifcxdef *ctx, int argc)
3474 {
3475 int grp;
3476 size_t len;
3477 re_group_register *reg;
3478 ushort hplen;
3479 runsdef val;
3480 uchar *p;
3481 long numval;
3482
3483 /* this function takes one parameter: the group number to retrieve */
3484 bifcntargs(ctx, 1, argc);
3485
3486 /* get the group number */
3487 grp = (int)runpopnum(ctx->bifcxrun);
3488
3489 /* make sure it's within range */
3490 if (grp < 1 || grp > RE_GROUP_REG_CNT)
3491 runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "reGetGroup");
3492
3493 /* adjust from a 1-bias to an array index */
3494 --grp;
3495
3496 /* if the group was never set, return nil */
3497 if (grp >= ctx->bifcxregex.cur_group)
3498 {
3499 runpnil(ctx->bifcxrun);
3500 return;
3501 }
3502
3503 /* get the register */
3504 reg = &ctx->bifcxregex.regs[grp];
3505
3506 /* if the group wasn't set, return nil */
3507 if (reg->start_ofs == 0 || reg->end_ofs == 0)
3508 {
3509 runpnil(ctx->bifcxrun);
3510 return;
3511 }
3512
3513 /* calculate the length of the string in this group */
3514 len = reg->end_ofs - reg->start_ofs;
3515
3516 /*
3517 * reserve the necessary heap space: two bytes for the list length
3518 * prefix, two number elements (one byte each for the type, four
3519 * bytes each for the value), and the string element (one byte for
3520 * the type, two bytes for the length prefix, plus the string
3521 * itself).
3522 */
3523 hplen = (ushort)(2 + 2*(1+4) + (1 + 2 + len));
3524 runhres(ctx->bifcxrun, hplen, 0);
3525
3526 /* set up the stack value */
3527 val.runstyp = DAT_LIST;
3528 p = val.runsv.runsvstr = ctx->bifcxrun->runcxhp;
3529
3530 /* put in the list length prefix */
3531 oswp2(p, hplen);
3532 p += 2;
3533
3534 /* add the starting character position of the group - adjust to 1-bias */
3535 *p++ = DAT_NUMBER;
3536 numval = (long)(reg->start_ofs - ctx->bifcxregex.strbuf) + 1;
3537 oswp4(p, numval);
3538 p += 4;
3539
3540 /* add the length of the group */
3541 *p++ = DAT_NUMBER;
3542 numval = (long)(reg->end_ofs - reg->start_ofs);
3543 oswp4(p, numval);
3544 p += 4;
3545
3546 /* set up the string */
3547 *p++ = DAT_SSTRING;
3548 oswp2(p, len+2);
3549 p += 2;
3550 memcpy(p, reg->start_ofs, len);
3551
3552 /* consume the heap space */
3553 ctx->bifcxrun->runcxhp += hplen;
3554
3555 /* push the result */
3556 runrepush(ctx->bifcxrun, &val);
3557 }
3558
3559
3560 /*
3561 * inputevent
3562 */
bifinpevt(bifcxdef * ctx,int argc)3563 void bifinpevt(bifcxdef *ctx, int argc)
3564 {
3565 unsigned long timeout;
3566 int use_timeout;
3567 os_event_info_t info;
3568 int evt;
3569 uchar *p;
3570 ushort lstsiz;
3571 runsdef val;
3572 size_t paramlen;
3573 char keyname[20];
3574
3575 /* check for a timeout value */
3576 if (argc == 0)
3577 {
3578 /* there's no timeout */
3579 use_timeout = FALSE;
3580 timeout = 0;
3581 }
3582 else if (argc >= 1)
3583 {
3584 /* get the timeout value */
3585 use_timeout = TRUE;
3586 timeout = (unsigned long)runpopnum(ctx->bifcxrun);
3587 }
3588
3589 /* ensure we don't have too many arguments */
3590 if (argc > 1)
3591 runsig(ctx->bifcxrun, ERR_BIFARGC);
3592
3593 /* flush any pending output */
3594 tioflushn(ctx->bifcxtio, 0);
3595
3596 /* reset count of lines since keyboard input */
3597 tioreset(ctx->bifcxtio);
3598
3599 /* ask the OS code for an event */
3600 evt = os_get_event(timeout, use_timeout, &info);
3601
3602 /*
3603 * the list always minimally needs two bytes of length prefix plus a
3604 * number with the event code (one byte for the type, four bytes for
3605 * the value)
3606 */
3607 lstsiz = 2 + (1 + 4);
3608
3609 /* figure out how much space we'll need based on the event type */
3610 switch(evt)
3611 {
3612 case OS_EVT_KEY:
3613 /*
3614 * we need space for a string with one or two bytes (depending
3615 * on whether or not we have an extended key code) - 1 byte for
3616 * type code, 2 for length prefix, and 1 or 2 for the string's
3617 * contents
3618 */
3619 paramlen = (info.key[0] == 0 ? 2 : 1);
3620
3621 /* map the extended key */
3622 get_ext_key_name(keyname, info.key[0], info.key[1]);
3623
3624 /* determine the length we need for the string */
3625 paramlen = strlen(keyname);
3626
3627 /* add it into the list */
3628 lstsiz += 1 + 2 + paramlen;
3629 break;
3630
3631 case OS_EVT_HREF:
3632 /*
3633 * we need space for the href string - 1 byte for type code, 2
3634 * for length prefix, plus the string's contents
3635 */
3636 paramlen = strlen(info.href);
3637 lstsiz += 1 + 2 + (ushort)paramlen;
3638 break;
3639
3640 default:
3641 /* other event types have no extra data */
3642 break;
3643 }
3644
3645 /* allocate space for the list */
3646 runhres(ctx->bifcxrun, lstsiz, 0);
3647
3648 /* set up the stack value */
3649 val.runstyp = DAT_LIST;
3650 p = val.runsv.runsvstr = ctx->bifcxrun->runcxhp;
3651
3652 /* set up the list length prefix */
3653 oswp2(p, lstsiz);
3654 p += 2;
3655
3656 /* set up the event type element */
3657 *p++ = DAT_NUMBER;
3658 oswp4(p, evt);
3659 p += 4;
3660
3661 /* add the event parameters, if any */
3662 switch(evt)
3663 {
3664 case OS_EVT_KEY:
3665 /* set up the string for the key */
3666 *p++ = DAT_SSTRING;
3667 oswp2(p, paramlen + 2);
3668 p += 2;
3669
3670 /* add the characters to the string */
3671 memcpy(p, keyname, paramlen);
3672 p += paramlen;
3673 break;
3674
3675 case OS_EVT_HREF:
3676 /* add the string for the href */
3677 *p++ = DAT_SSTRING;
3678 oswp2(p, paramlen + 2);
3679 memcpy(p + 2, info.href, paramlen);
3680 break;
3681 }
3682
3683 /* consume the heap space */
3684 ctx->bifcxrun->runcxhp += lstsiz;
3685
3686 /* push the result */
3687 runrepush(ctx->bifcxrun, &val);
3688 }
3689
3690 /* timeDelay */
bifdelay(bifcxdef * ctx,int argc)3691 void bifdelay(bifcxdef *ctx, int argc)
3692 {
3693 long delay;
3694
3695 /* ensure we have the right number of arguments */
3696 bifcntargs(ctx, 1, argc);
3697
3698 /* flush any pending output */
3699 tioflushn(ctx->bifcxtio, 0);
3700
3701 /* get the delay time */
3702 delay = runpopnum(ctx->bifcxrun);
3703
3704 /* let the system perform the delay */
3705 os_sleep_ms(delay);
3706 }
3707
3708 /* setOutputFilter */
bifsetoutfilter(bifcxdef * ctx,int argc)3709 void bifsetoutfilter(bifcxdef *ctx, int argc)
3710 {
3711 /* ensure we have the right number of arguments */
3712 bifcntargs(ctx, 1, argc);
3713
3714 /* see what we have */
3715 switch(runtostyp(ctx->bifcxrun))
3716 {
3717 case DAT_NIL:
3718 /* remove the current filter */
3719 out_set_filter(MCMONINV);
3720
3721 /* discard the argument */
3722 rundisc(ctx->bifcxrun);
3723 break;
3724
3725 case DAT_FNADDR:
3726 /* set the filter to the given function */
3727 out_set_filter(runpopfn(ctx->bifcxrun));
3728 break;
3729
3730 default:
3731 /* anything else is invalid */
3732 runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "setOutputFilter");
3733 }
3734 }
3735
3736 /*
3737 * Get an optional object argument. If the next argument is not an
3738 * object value, or we're out of arguments, we'll return MCMONINV.
3739 * Otherwise, we'll pop the object value and return it, decrementing the
3740 * remaining argument counter provided.
3741 */
bif_get_optional_obj_arg(bifcxdef * ctx,int * rem_argc)3742 static objnum bif_get_optional_obj_arg(bifcxdef *ctx, int *rem_argc)
3743 {
3744 /* if we're out of arguments, there's no object value */
3745 if (*rem_argc == 0)
3746 return MCMONINV;
3747
3748 /*
3749 * if the next argument is not an object or nil, we're out of object
3750 * arguments
3751 */
3752 if (runtostyp(ctx->bifcxrun) != DAT_OBJECT
3753 && runtostyp(ctx->bifcxrun) != DAT_NIL)
3754 return MCMONINV;
3755
3756 /* we have an object - remove it from the remaining argument count */
3757 --(*rem_argc);
3758
3759 /* pop and return the object value */
3760 return runpopobjnil(ctx->bifcxrun);
3761 }
3762
3763 /*
3764 * execCommand flag values
3765 */
3766 #define EC_HIDE_SUCCESS 0x00000001
3767 #define EC_HIDE_ERROR 0x00000002
3768 #define EC_SKIP_VALIDDO 0x00000004
3769 #define EC_SKIP_VALIDIO 0x00000008
3770
3771 /*
3772 * execCommand - execute a recursive command
3773 */
bifexec(bifcxdef * ctx,int argc)3774 void bifexec(bifcxdef *ctx, int argc)
3775 {
3776 objnum actor;
3777 objnum verb;
3778 objnum dobj;
3779 objnum prep;
3780 objnum iobj;
3781 int err;
3782 uint capture_start;
3783 uint capture_end;
3784 objnum capture_obj;
3785 ulong flags;
3786 int hide_any;
3787 int rem_argc;
3788
3789 /*
3790 * Check for the correct argument count. The first two arguments
3791 * are required; additional arguments are optional.
3792 */
3793 if (argc < 2 || argc > 6)
3794 runsig(ctx->bifcxrun, ERR_BIFARGC);
3795
3796 /* pop the arguments - actor, verb, dobj, prep, iobj */
3797 actor = runpopobjnil(ctx->bifcxrun);
3798 verb = runpopobjnil(ctx->bifcxrun);
3799
3800 /*
3801 * The other object arguments are optional. If we run into a
3802 * numeric argument, it's the flags value, in which case we're out
3803 * of objects.
3804 */
3805 rem_argc = argc - 2;
3806 dobj = bif_get_optional_obj_arg(ctx, &rem_argc);
3807 prep = bif_get_optional_obj_arg(ctx, &rem_argc);
3808 iobj = bif_get_optional_obj_arg(ctx, &rem_argc);
3809
3810 /* if we have a flags argument, pop it */
3811 if (rem_argc > 0)
3812 {
3813 /* the last argument is the flags - pop the numeric value */
3814 flags = runpopnum(ctx->bifcxrun);
3815
3816 /* remove it from the remaining argument counter */
3817 --rem_argc;
3818 }
3819 else
3820 {
3821 /* no flags specified - use zero by default */
3822 flags = 0;
3823 }
3824
3825 /*
3826 * make sure we don't have any arguments left - if we do, then it
3827 * means that we got an incorrect type and skipped an argument when
3828 * we were trying to sense the meanings of the arguments from their
3829 * types
3830 */
3831 if (rem_argc != 0)
3832 runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "execCommand");
3833
3834 /* if we're hiding any output, start output capture */
3835 hide_any = ((flags & (EC_HIDE_SUCCESS | EC_HIDE_ERROR)) != 0);
3836 if (hide_any)
3837 {
3838 /* start capturing */
3839 tiocapture(ctx->bifcxtio, ctx->bifcxrun->runcxmem, TRUE);
3840
3841 /* note the current output position */
3842 capture_start = tiocapturesize(ctx->bifcxtio);
3843 }
3844
3845 /* execute the command */
3846 err = execmd_recurs(ctx->bifcxrun->runcxvoc,
3847 actor, verb, dobj, prep, iobj,
3848 (flags & EC_SKIP_VALIDDO) == 0,
3849 (flags & EC_SKIP_VALIDIO) == 0);
3850
3851 /* if we're hiding any output, end hiding */
3852 if (hide_any)
3853 {
3854 uchar *p;
3855 int hide;
3856
3857 /* get the capture buffer size */
3858 capture_end = tiocapturesize(ctx->bifcxtio);
3859
3860 /* turn off capture if it wasn't already on when we started */
3861 if (capture_start == 0)
3862 tiocapture(ctx->bifcxtio, ctx->bifcxrun->runcxmem, FALSE);
3863
3864 /* determine whether we're hiding or showing the result */
3865 if (err == 0)
3866 hide = ((flags & EC_HIDE_SUCCESS) != 0);
3867 else
3868 hide = ((flags & EC_HIDE_ERROR) != 0);
3869
3870 /* show or hide the result, as appropriate */
3871 if (hide)
3872 {
3873 /*
3874 * We're hiding this result, so do not display the string.
3875 * If there's an enclosing capture, remove the string from
3876 * the enclosing capture.
3877 */
3878 if (capture_start != 0)
3879 tiopopcapture(ctx->bifcxtio, capture_start);
3880 }
3881 else
3882 {
3883 /*
3884 * We're showing the text. If we're in an enclosing
3885 * capture, do nothing - simply leave the string in the
3886 * enclosing capture buffer; otherwise, actually display it
3887 */
3888 if (capture_start == 0)
3889 {
3890 /* lock the capture object */
3891 capture_obj = tiogetcapture(ctx->bifcxtio);
3892 p = mcmlck(ctx->bifcxrun->runcxmem, capture_obj);
3893
3894 ERRBEGIN(ctx->bifcxerr)
3895 {
3896 /* display the string */
3897 outformatlen((char *)p + capture_start,
3898 capture_end - capture_start);
3899 }
3900 ERRCLEAN(ctx->bifcxerr)
3901 {
3902 /* unlock the capture object before signalling out */
3903 mcmunlck(ctx->bifcxrun->runcxmem, capture_obj);
3904 }
3905 ERRENDCLN(ctx->bifcxerr);
3906
3907 /* unlock the capture object */
3908 mcmunlck(ctx->bifcxrun->runcxmem, capture_obj);
3909 }
3910 }
3911
3912 /* clear the capture buffer if it wasn't on when we started */
3913 if (capture_start == 0)
3914 tioclrcapture(ctx->bifcxtio);
3915 }
3916
3917 /* push the result code */
3918 runpnum(ctx->bifcxrun, err);
3919 }
3920
3921 /*
3922 * parserGetObj - get one of the objects associated with the command
3923 */
bifgetobj(bifcxdef * ctx,int argc)3924 void bifgetobj(bifcxdef *ctx, int argc)
3925 {
3926 int id;
3927 objnum obj;
3928 voccxdef *voc = ctx->bifcxrun->runcxvoc;
3929
3930 /* check the argument count */
3931 bifcntargs(ctx, 1, argc);
3932
3933 /* get the argument */
3934 id = (int)runpopnum(ctx->bifcxrun);
3935
3936 /* get the appropriate object */
3937 switch(id)
3938 {
3939 case 1:
3940 /* get the current actor */
3941 obj = voc->voccxactor;
3942
3943 /* if there's no current actor, use the current 'me' by default */
3944 if (obj == MCMONINV)
3945 obj = voc->voccxme;
3946
3947 /* done */
3948 break;
3949
3950 case 2:
3951 /* verb */
3952 obj = voc->voccxverb;
3953 break;
3954
3955 case 3:
3956 /* direct object */
3957 obj = (voc->voccxdobj == 0 ? MCMONINV : voc->voccxdobj->vocolobj);
3958 break;
3959
3960 case 4:
3961 /* preposition */
3962 obj = voc->voccxprep;
3963 break;
3964
3965 case 5:
3966 /* indirect object */
3967 obj = (voc->voccxiobj == 0 ? MCMONINV : voc->voccxiobj->vocolobj);
3968 break;
3969
3970 case 6:
3971 /* "it" */
3972 obj = voc->voccxit;
3973 break;
3974
3975 case 7:
3976 /* "him" */
3977 obj = voc->voccxhim;
3978 break;
3979
3980 case 8:
3981 /* "her" */
3982 obj = voc->voccxher;
3983 break;
3984
3985 case 9:
3986 /* them */
3987 voc_push_objlist(voc, voc->voccxthm, voc->voccxthc);
3988
3989 /*
3990 * return directly, since we've already pushed the result (it's
3991 * a list, not an object)
3992 */
3993 return;
3994
3995 default:
3996 /* invalid argument */
3997 runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "parserGetObj");
3998 break;
3999 }
4000
4001 /* return the object */
4002 runpobj(ctx->bifcxrun, obj);
4003 }
4004
4005 /*
4006 * parseNounList - parse a noun list. Call like this:
4007 *
4008 * parserParseNounList(wordlist, typelist, starting_index, complain,
4009 * multi, check_actor);
4010 */
bifparsenl(bifcxdef * ctx,int argc)4011 void bifparsenl(bifcxdef *ctx, int argc)
4012 {
4013 /* check the argument count */
4014 bifcntargs(ctx, 6, argc);
4015
4016 /* call the parser */
4017 voc_parse_np(ctx->bifcxrun->runcxvoc);
4018 }
4019
4020 /*
4021 * parserTokenize - given a string, produce a list of tokens. Returns
4022 * nil on error, or a list of token strings.
4023 *
4024 * parserTokenize(commandString);
4025 */
bifprstok(bifcxdef * ctx,int argc)4026 void bifprstok(bifcxdef *ctx, int argc)
4027 {
4028 /* check arguments */
4029 bifcntargs(ctx, 1, argc);
4030
4031 /* call the parser */
4032 voc_parse_tok(ctx->bifcxrun->runcxvoc);
4033 }
4034
4035 /*
4036 * parserGetTokTypes - given a list of tokens (represented as strings),
4037 * get a corresponding list of token types.
4038 *
4039 * parserGetTokTypes(tokenList);
4040 */
bifprstoktyp(bifcxdef * ctx,int argc)4041 void bifprstoktyp(bifcxdef *ctx, int argc)
4042 {
4043 /* check arguments */
4044 bifcntargs(ctx, 1, argc);
4045
4046 /* call the parser */
4047 voc_parse_types(ctx->bifcxrun->runcxvoc);
4048 }
4049
4050 /*
4051 * parserDictLookup - given a list of tokens and their types, produce a
4052 * list of all of the objects that match all of the words.
4053 *
4054 * parserDictLookup(tokenList, typeList);
4055 */
bifprsdict(bifcxdef * ctx,int argc)4056 void bifprsdict(bifcxdef *ctx, int argc)
4057 {
4058 /* check arguments */
4059 bifcntargs(ctx, 2, argc);
4060
4061 /* call the parser */
4062 voc_parse_dict_lookup(ctx->bifcxrun->runcxvoc);
4063 }
4064
4065 /*
4066 * parserResolveObjects - resolve an object list of the sort returned by
4067 * parseNounList. Validates and disambiguates the objects.
4068 *
4069 * parserResolveObjects(actor, verb, prep, otherobj, usageType,
4070 * verprop, tokenList, objList, silent)
4071 */
bifprsrslv(bifcxdef * ctx,int argc)4072 void bifprsrslv(bifcxdef *ctx, int argc)
4073 {
4074 /* check arguments */
4075 bifcntargs(ctx, 9, argc);
4076
4077 /* call the parser */
4078 voc_parse_disambig(ctx->bifcxrun->runcxvoc);
4079 }
4080
4081 /*
4082 * parserReplaceCommand - replace the current command line with a new
4083 * string. Aborts the current command.
4084 */
bifprsrplcmd(bifcxdef * ctx,int argc)4085 void bifprsrplcmd(bifcxdef *ctx, int argc)
4086 {
4087 /* check arguments */
4088 bifcntargs(ctx, 1, argc);
4089
4090 /* call the parser */
4091 voc_parse_replace_cmd(ctx->bifcxrun->runcxvoc);
4092 }
4093
4094 /*
4095 * exitobj - throw a RUNEXITOBJ error
4096 */
bifexitobj(bifcxdef * ctx,int argc)4097 void bifexitobj(bifcxdef *ctx, int argc)
4098 {
4099 /* no arguments are allowed */
4100 bifcntargs(ctx, 0, argc);
4101
4102 /* throw the RUNEXITOBJ error */
4103 errsig(ctx->bifcxerr, ERR_RUNEXITOBJ);
4104 }
4105
4106 /*
4107 * Standard system button labels for bifinpdlg()
4108 */
4109 #define BIFINPDLG_LBL_OK 1
4110 #define BIFINPDLG_LBL_CANCEL 2
4111 #define BIFINPDLG_LBL_YES 3
4112 #define BIFINPDLG_LBL_NO 4
4113
4114 /*
4115 * inputdialog
4116 */
bifinpdlg(bifcxdef * ctx,int argc)4117 void bifinpdlg(bifcxdef *ctx, int argc)
4118 {
4119 uchar *p;
4120 char prompt[256];
4121 char lblbuf[256];
4122 char *labels[10];
4123 char *dst;
4124 uint len;
4125 size_t bcnt;
4126 int default_resp, cancel_resp;
4127 int resp;
4128 int std_btns;
4129 int icon_id;
4130
4131 /* check for proper arguments */
4132 bifcntargs(ctx, 5, argc);
4133
4134 /* get the icon number */
4135 icon_id = runpopnum(ctx->bifcxrun);
4136
4137 /* get the prompt string */
4138 p = runpopstr(ctx->bifcxrun);
4139 bifcstr(ctx, prompt, (size_t)sizeof(prompt), p);
4140
4141 /* check for a standard button set selection */
4142 if (runtostyp(ctx->bifcxrun) == DAT_NUMBER)
4143 {
4144 /* get the standard button set ID */
4145 std_btns = runpopnum(ctx->bifcxrun);
4146
4147 /* there are no actual buttons */
4148 bcnt = 0;
4149 }
4150 else
4151 {
4152 /* we're not using standard buttons */
4153 std_btns = 0;
4154
4155 /* get the response string list */
4156 p = runpoplst(ctx->bifcxrun);
4157 len = osrp2(p);
4158 p += 2;
4159
4160 /* build our internal button list */
4161 for (bcnt = 0, dst = lblbuf ; len != 0 ; lstadv(&p, &len))
4162 {
4163 /* see what we have */
4164 if (*p == DAT_SSTRING)
4165 {
4166 /* it's a label string - convert to a C string */
4167 bifcstr(ctx, dst, sizeof(lblbuf) - (dst - lblbuf), p + 1);
4168
4169 /* set this button to point to the converted text */
4170 labels[bcnt++] = dst;
4171
4172 /* move past this label in the button buffer */
4173 dst += strlen(dst) + 1;
4174 }
4175 else if (*p == DAT_NUMBER)
4176 {
4177 int id;
4178 int resid;
4179
4180 /* it's a standard system label ID - get the ID */
4181 id = (int)osrp4(p + 1);
4182
4183 /* translate it to the appropriate string resource */
4184 switch(id)
4185 {
4186 case BIFINPDLG_LBL_OK:
4187 resid = RESID_BTN_OK;
4188 break;
4189
4190 case BIFINPDLG_LBL_CANCEL:
4191 resid = RESID_BTN_CANCEL;
4192 break;
4193
4194 case BIFINPDLG_LBL_YES:
4195 resid = RESID_BTN_YES;
4196 break;
4197
4198 case BIFINPDLG_LBL_NO:
4199 resid = RESID_BTN_NO;
4200 break;
4201
4202 default:
4203 resid = 0;
4204 break;
4205 }
4206
4207 /*
4208 * if we got a valid resource ID, load the resource;
4209 * otherwise, skip this button
4210 */
4211 if (resid != 0
4212 && !os_get_str_rsc(resid, dst,
4213 sizeof(lblbuf) - (dst - lblbuf)))
4214 {
4215 /* set this button to point to the converted text */
4216 labels[bcnt++] = dst;
4217
4218 /* move past this label in the button buffer */
4219 dst += strlen(dst) + 1;
4220 }
4221 }
4222
4223 /* if we have exhausted our label array, stop now */
4224 if (bcnt >= sizeof(labels)/sizeof(labels[0])
4225 || dst >= lblbuf + sizeof(lblbuf))
4226 break;
4227 }
4228 }
4229
4230 /* get the default response */
4231 if (runtostyp(ctx->bifcxrun) == DAT_NIL)
4232 {
4233 rundisc(ctx->bifcxrun);
4234 default_resp = 0;
4235 }
4236 else
4237 default_resp = runpopnum(ctx->bifcxrun);
4238
4239 /* get the cancel response */
4240 if (runtostyp(ctx->bifcxrun) == DAT_NIL)
4241 {
4242 rundisc(ctx->bifcxrun);
4243 cancel_resp = 0;
4244 }
4245 else
4246 cancel_resp = runpopnum(ctx->bifcxrun);
4247
4248 /* flush output before showing the dialog */
4249 tioflushn(ctx->bifcxtio, 0);
4250
4251 /* show the dialog */
4252 resp = tio_input_dialog(icon_id, prompt, std_btns,
4253 (const char **)labels, bcnt,
4254 default_resp, cancel_resp);
4255
4256 /* return the result */
4257 runpnum(ctx->bifcxrun, resp);
4258 }
4259
4260 /*
4261 * Determine if a resource exists
4262 */
bifresexists(bifcxdef * ctx,int argc)4263 void bifresexists(bifcxdef *ctx, int argc)
4264 {
4265 uchar *p;
4266 char resname[OSFNMAX];
4267 appctxdef *appctx;
4268 int found;
4269 runsdef val;
4270
4271 /* check for proper arguments */
4272 bifcntargs(ctx, 1, argc);
4273
4274 /* get the resource name string */
4275 p = runpopstr(ctx->bifcxrun);
4276 bifcstr(ctx, resname, (size_t)sizeof(resname), p);
4277
4278 /*
4279 * if we have a host application context, and it provides a resource
4280 * finder function, ask the resource finder if the resource is
4281 * available; otherwise, report that the resource is not loadable,
4282 * since we must not be running a version of the interpreter that
4283 * supports external resource loading
4284 */
4285 appctx = ctx->bifcxappctx;
4286 found = (appctx != 0
4287 && appctx->resfile_exists != 0
4288 && (*appctx->resfile_exists)(appctx->resfile_exists_ctx,
4289 resname, strlen(resname)));
4290
4291 /* push the result */
4292 runpush(ctx->bifcxrun, runclog(found), &val);
4293 }
4294