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