3db013fb36682c365d57f4f9440055056a41e0c8
[informlib.git] / parserm.h
1 ! ==============================================================================
2 !   PARSERM:  Core of parser.
3 !
4 !   Supplied for use with Inform 6 -- Release 6.12.1 -- Serial number 160605
5 !
6 !   Copyright Graham Nelson 1993-2004 and David Griffith 2012-2016
7 !
8 !   This file is free software: you can redistribute it and/or modify
9 !   it under the terms of the GNU Affero General Public License as
10 !   published by the Free Software Foundation, either version 3 of the
11 !   License, or (at your option) any later version.
12 !
13 !   This file is distributed in the hope that it will be useful, but
14 !   WITHOUT ANY WARRANTY; without even the implied warranty of
15 !   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 !   Affero General Public License for more details.
17 !
18 !   You should have received a copy of the GNU Affero General Public
19 !   License along with this program. If not, see
20 !   https://gnu.org/licenses/
21 !
22 !   This file is automatically Included in your game file by "parser".
23 ! ------------------------------------------------------------------------------
24 !   Inclusion of "linklpa" (which defines properties and attributes)
25 !   Global variables, constants and arrays
26 !       1: outside of the parser
27 !       2: used within the parser
28 !   Inclusion of natural language definition file
29 !       (which creates a compass and direction-objects)
30 !   Darkness and player objects
31 !   Definition of grammar token numbering system used by Inform
32 !
33 !   The InformParser object
34 !       keyboard reading
35 !       level 0: outer shell, conversation, errors
36 !             1: grammar lines
37 !             2: tokens
38 !             3: object lists
39 !             4: scope and ambiguity resolving
40 !             5: object comparisons
41 !             6: word comparisons
42 !             7: reading words and moving tables about
43 !       pronoun management
44 !
45 !   The InformLibrary object
46 !       main game loop
47 !       action processing
48 !       end of turn sequence
49 !       scope looping, before/after sequence, sending messages out
50 !       timers, daemons, time of day, score notification
51 !       light and darkness
52 !       changing player personality
53 !       tracing code (only present if DEBUG is set)
54 !
55 !   Status line printing, menu display
56 !   Printing object names with articles
57 !   Miscellaneous utility routines
58 !   Game banner, "version" verb, run-time errors
59 ! ==============================================================================
60
61 System_file;
62
63 #Ifdef MODULE_MODE;
64 Constant DEBUG;
65 Constant Grammar__Version 2;
66 Include "linklpa";
67 #Endif; ! MODULE_MODE
68
69 #Ifdef COLOR;
70 Constant COLOUR;
71 #Endif;
72
73 #Ifdef COLOUR;
74 Global clr_on = 1;
75 #Ifnot;
76 Global clr_on = 0;
77 #Endif;
78
79 ! ------------------------------------------------------------------------------
80 !   Global variables and their associated Constant and Array declarations
81 ! ------------------------------------------------------------------------------
82
83 Global location = InformLibrary;    ! Must be first global defined
84 Global sline1;                      ! Must be second
85 Global sline2;                      ! Must be third
86                                     ! (for status line display)
87
88 ! ------------------------------------------------------------------------------
89 !   Z-Machine and interpreter issues
90 ! ------------------------------------------------------------------------------
91
92 #Ifdef TARGET_ZCODE;
93 Global top_object;                  ! Largest valid number of any tree object
94 ! ### these globals are not meaningful... well, maybe standard_interpreter,
95 ! but I'll decide that later (AP).
96 Constant INDIV_PROP_START 64;       ! Equivalent of a Glulx constant
97
98 #Endif; ! TARGET_ZCODE
99
100 Global standard_interpreter;        ! The version number of the Z-Machine Standard which the
101                                     ! interpreter claims to support, in form (upper byte).(lower)
102
103 Global undo_flag;                   ! Can the interpreter provide "undo"?
104 Global just_undone;                 ! Can't have two successive UNDOs
105
106 Global transcript_mode;             ! true when game scripting is on
107
108 #Ifdef TARGET_ZCODE;
109 Global xcommsdir;                   ! true if command recording is on
110 #Endif; ! TARGET_ZCODE
111
112 #Ifdef TARGET_GLULX;
113 Constant GG_MAINWIN_ROCK     201;
114 Constant GG_STATUSWIN_ROCK   202;
115 Constant GG_QUOTEWIN_ROCK    203;
116 Constant GG_SAVESTR_ROCK     301;
117 Constant GG_SCRIPTSTR_ROCK   302;
118 Constant GG_COMMANDWSTR_ROCK 303;
119 Constant GG_COMMANDRSTR_ROCK 304;
120 Constant GG_SCRIPTFREF_ROCK  401;
121 Array gg_event --> 4;
122 #Ifdef VN_1630;
123 Array gg_arguments buffer 28;
124 #Ifnot;
125 Array gg_arguments --> 8;
126 #Endif; ! VN_
127 Global gg_mainwin = 0;
128 Global gg_statuswin = 0;
129 Global gg_quotewin = 0;
130 Global gg_scriptfref = 0;
131 Global gg_scriptstr = 0;
132 Global gg_savestr = 0;
133 Global gg_commandstr = 0;
134 Global gg_command_reading = 0;      ! true if gg_commandstr is being replayed
135 #Endif; ! TARGET_GLULX
136
137 Global gg_statuswin_cursize = 0;
138 Global gg_statuswin_size = 1;
139
140 ! ------------------------------------------------------------------------------
141 !   Time and score
142 !   (for linkage reasons, the task_* arrays are created not here but in verblib.h)
143 ! ------------------------------------------------------------------------------
144
145 #Ifndef sys_statusline_flag;
146 Global sys_statusline_flag = 0;     ! non-zero if status line displays time
147 #Endif;
148
149 #Ifndef START_MOVE;
150 Constant START_MOVE 0;               ! Traditionally 0 for Infocom, 1 for Inform
151 #Endif;
152
153 Global turns = START_MOVE;          ! Number of turns of play so far
154 Global the_time = NULL;             ! Current time (in minutes since midnight)
155 Global time_rate = 1;               ! How often time is updated
156 Global time_step;                   ! By how much
157
158 #Ifndef MAX_TIMERS;
159 Constant MAX_TIMERS  32;            ! Max number timers/daemons active at once
160 #Endif; ! MAX_TIMERS
161 Array  the_timers  --> MAX_TIMERS;
162 Global active_timers;               ! Number of timers/daemons actives
163
164 Global score;                       ! The current score
165 Global last_score;                  ! Score last turn (for testing for changes)
166 Global notify_mode = true;          ! Score notification
167 Global places_score;                ! Contribution to score made by visiting
168 Global things_score;                ! Contribution made by acquisition
169
170 ! ------------------------------------------------------------------------------
171 !   The player
172 ! ------------------------------------------------------------------------------
173
174 Global player;                      ! Which object the human is playing through
175 Global deadflag;                    ! Normally 0, or false; 1 for dead
176                                     ! 2 for victorious, and higher numbers
177                                     ! represent exotic forms of death
178
179 ! ------------------------------------------------------------------------------
180 !   Light and room descriptions
181 ! ------------------------------------------------------------------------------
182
183 Global lightflag = true;            ! Is there currently light to see by?
184 Global real_location;               ! When in darkness, location = thedark
185                                     ! and this holds the real location
186 Global prev_location;               ! The previous value of real_location
187 Global visibility_ceiling;          ! Highest object in tree visible from the
188                                     ! player's point of view (usually the room,
189                                     ! sometimes darkness, sometimes a closed
190                                     ! non-transparent container).
191
192 Global lookmode = 2;                ! 1=brief, 2=verbose, 3=superbrief
193                                     ! room descriptions
194 Global print_player_flag;           ! If set, print something like "(as Fred)"
195                                     ! in room descriptions, to reveal whom the
196                                     ! player is playing through
197 Global lastdesc;                    ! Value of location at time of most recent
198                                     ! room description printed out
199
200 ! ------------------------------------------------------------------------------
201 !   List writing  (style bits are defined as Constants in "verblibm.h")
202 ! ------------------------------------------------------------------------------
203
204 Global c_style;                     ! Current list-writer style
205 Global lt_value;                    ! Common value of list_together
206 Global listing_together;            ! Object number of one member of a group
207                                     ! being listed together
208 Global listing_size;                ! Size of such a group
209 Global wlf_indent;                  ! Current level of indentation printed by
210                                     ! WriteListFrom()
211
212 Global inventory_stage = 1;         ! 1 or 2 according to the context in which
213                                     ! "invent" routines of objects are called
214 Global inventory_style;             ! List-writer style currently used while
215                                     ! printing inventories
216 ! ------------------------------------------------------------------------------
217 !   Menus and printing
218 ! ------------------------------------------------------------------------------
219
220 Global pretty_flag = true;          ! Use character graphics, or plain text?
221 Global menu_nesting;                ! Level of nesting (0 = root menu)
222 Global menu_item;                   ! These are used in communicating
223 Global item_width = 8;              ! with the menu-creating routines
224 Global item_name = "---";
225
226 Global lm_n;                        ! Parameters used by LibraryMessages
227 Global lm_o;                        ! mechanism
228 Global lm_s;
229
230 #Ifdef DEBUG;
231 Constant DEBUG_MESSAGES $0001;
232 Constant DEBUG_ACTIONS  $0002;
233 Constant DEBUG_TIMERS   $0004;
234 Constant DEBUG_CHANGES  $0008;
235 Constant DEBUG_VERBOSE  $0080;
236 Global debug_flag;                  ! Bitmap of flags for tracing actions,
237                                     ! calls to object routines, etc.
238 Global x_scope_count;               ! Used in printing a list of everything
239 #Endif; ! DEBUG                     ! in scope
240
241 ! five for colour control
242 ! see http://www.inform-fiction.org/patches/L61007.html
243 ! To enable colour define a constant or Global: COLOR or COLOUR
244 !Global clr_on;                      ! has colour been enabled by the player?
245 #Ifdef COLOUR;
246 Global clr_fg = 1;                  ! foreground colour
247 Global clr_bg = 1;                  ! background colour
248 Global clr_fgstatus = 1;            ! foreground colour of statusline
249 Global clr_bgstatus = 1;            ! background colour of statusline
250 #Endif; ! COLOUR
251 Global statuswin_current;           ! if writing to top window
252
253 Constant CLR_CURRENT 0;
254 Constant CLR_DEFAULT 1;
255 Constant CLR_BLACK   2;
256 Constant CLR_RED     3;
257 Constant CLR_GREEN   4;
258 Constant CLR_YELLOW  5;
259 Constant CLR_BLUE    6;
260 Constant CLR_MAGENTA 7;
261 Constant CLR_CYAN    8;
262 Constant CLR_WHITE   9;
263 Constant CLR_PURPLE  7;
264 Constant CLR_AZURE   8;
265
266 Constant WIN_ALL     0;
267 Constant WIN_STATUS  1;
268 Constant WIN_MAIN    2;
269
270 ! ------------------------------------------------------------------------------
271 !   Action processing
272 ! ------------------------------------------------------------------------------
273
274 Global action;                      ! Action currently being asked to perform
275 Global inp1;                        ! 0 (nothing), 1 (number) or first noun
276 Global inp2;                        ! 0 (nothing), 1 (number) or second noun
277 Global noun;                        ! First noun or numerical value
278 Global second;                      ! Second noun or numerical value
279
280 Global keep_silent;                 ! If true, attempt to perform the action
281                                     ! silently (e.g. for implicit takes,
282                                     ! implicit opening of unlocked doors)
283
284 Global reason_code;                 ! Reason for calling a "life" rule
285                                     ! (an action or fake such as ##Kiss)
286
287 Global receive_action;              ! Either ##PutOn or ##Insert, whichever is
288                                     ! action being tried when an object's
289                                     ! "before" rule is checking "Receive"
290
291 Global no_implicit_actions;         ! Don't implicitly do things.
292
293 ! ==============================================================================
294 !   Parser variables: first, for communication to the parser
295 ! ------------------------------------------------------------------------------
296
297 Global parser_trace = 0;            ! Set this to 1 to make the parser trace
298                                     ! tokens and lines
299 Global parser_action;               ! For the use of the parser when calling
300 Global parser_one;                  ! user-supplied routines
301 Global parser_two;                  !
302 Array  inputobjs       --> 16;      ! For parser to write its results in
303 Global parser_inflection;           ! A property (usually "name") to find
304                                     ! object names in
305 Global parser_inflection_func;      ! Programmer sets this to true when
306                                     ! parser_infection is a function
307
308 ! ------------------------------------------------------------------------------
309 !   Parser output
310 ! ------------------------------------------------------------------------------
311
312 Global actor;                       ! Person asked to do something
313 Global actors_location;             ! Like location, but for the actor
314 Global meta;                        ! Verb is a meta-command (such as "save")
315
316 #Ifdef INFIX;
317 Global infix_verb;                  ! Verb is an Infix command
318 #Endif;
319
320 Array  multiple_object --> 64;      ! List of multiple parameters
321 Global multiflag;                   ! Multiple-object flag passed to actions
322                                     ! Also used to prevent misleading MULTI_PE
323 Global toomany_flag;                ! Flag for "multiple match too large"
324                                     ! (e.g. if "take all" took over 100 things)
325
326 Global special_word;                ! Dictionary address for "special" token
327 Global special_number;              ! Number typed for "special" token
328 Global parsed_number;               ! For user-supplied parsing routines
329 Global consult_from;                ! Word that a "consult" topic starts on
330 Global consult_words;               ! ...and number of words in topic
331 Global asking_player;               ! True during disambiguation question
332
333 ! ------------------------------------------------------------------------------
334 !   Implicit taking
335 ! ------------------------------------------------------------------------------
336
337 Global notheld_mode;                ! To do with implicit taking
338 Global onotheld_mode;               !     "old copy of notheld_mode", ditto
339 Global not_holding;                 ! Object to be automatically taken as an
340                                     ! implicit command
341 Array  kept_results --> 16;         ! Delayed command (while the take happens)
342
343 ! ------------------------------------------------------------------------------
344 !   Error numbers when parsing a grammar line
345 ! ------------------------------------------------------------------------------
346
347 Global etype;                       ! Error number on current line
348 Global best_etype;                  ! Preferred error number so far
349 Global nextbest_etype;              ! Preferred one, if ASKSCOPE_PE disallowed
350
351 Constant STUCK_PE     = 1;
352 Constant UPTO_PE      = 2;
353 Constant NUMBER_PE    = 3;
354 Constant CANTSEE_PE   = 4;
355 Constant TOOLIT_PE    = 5;
356 Constant NOTHELD_PE   = 6;
357 Constant MULTI_PE     = 7;
358 Constant MMULTI_PE    = 8;
359 Constant VAGUE_PE     = 9;
360 Constant EXCEPT_PE    = 10;
361 Constant ANIMA_PE     = 11;
362 Constant VERB_PE      = 12;
363 Constant SCENERY_PE   = 13;
364 Constant ITGONE_PE    = 14;
365 Constant JUNKAFTER_PE = 15;
366 Constant TOOFEW_PE    = 16;
367 Constant NOTHING_PE   = 17;
368 Constant ASKSCOPE_PE  = 18;
369
370 ! ------------------------------------------------------------------------------
371 !   Pattern-matching against a single grammar line
372 ! ------------------------------------------------------------------------------
373
374 Array pattern --> 32;               ! For the current pattern match
375 Global pcount;                      ! and a marker within it
376 Array pattern2 --> 32;              ! And another, which stores the best match
377 Global pcount2;                     ! so far
378 Constant PATTERN_NULL = $ffff;      ! Entry for a token producing no text
379
380 Array  line_ttype-->32;             ! For storing an analysed grammar line
381 Array  line_tdata-->32;
382 Array  line_token-->32;
383
384 Global parameters;                  ! Parameters (objects) entered so far
385 Global nsns;                        ! Number of special_numbers entered so far
386 Global special_number1;             ! First number, if one was typed
387 Global special_number2;             ! Second number, if two were typed
388
389 ! ------------------------------------------------------------------------------
390 !   Inferences and looking ahead
391 ! ------------------------------------------------------------------------------
392
393 Global params_wanted;               ! Number of parameters needed
394                                     ! (which may change in parsing)
395
396 Global inferfrom;                   ! The point from which the rest of the
397                                     ! command must be inferred
398 Global inferword;                   ! And the preposition inferred
399 Global dont_infer;                  ! Another dull flag
400 Global no_infer_message = false;    ! Use in ChooseObjects to suppress
401                                     ! an inference message.
402
403 Global action_to_be;                ! (If the current line were accepted.)
404 Global action_reversed;             ! (Parameters would be reversed in order.)
405 Global advance_warning;             ! What a later-named thing will be
406
407 ! ------------------------------------------------------------------------------
408 !   At the level of individual tokens now
409 ! ------------------------------------------------------------------------------
410
411 Global found_ttype;                 ! Used to break up tokens into type
412 Global found_tdata;                 ! and data (by AnalyseToken)
413 Global token_filter;                ! For noun filtering by user routines
414
415 Global length_of_noun;              ! Set by NounDomain to no of words in noun
416
417 #Ifdef TARGET_ZCODE;
418 Constant REPARSE_CODE = 10000;      ! Signals "reparse the text" as a reply
419                                     ! from NounDomain
420 #Ifnot; ! TARGET_GLULX
421 Constant REPARSE_CODE = $40000000;  ! The parser rather gunkily adds addresses
422                                     ! to REPARSE_CODE for some purposes and
423                                     ! expects the result to be greater than
424                                     ! REPARSE_CODE (signed comparison).
425                                     ! So Glulx Inform is limited to a single
426                                     ! gigabyte of storage, for the moment.
427 #Endif; ! TARGET_
428
429 Global lookahead;                   ! The token after the one now being matched
430
431 Global multi_mode;                  ! Multiple mode
432 Global multi_wanted;                ! Number of things needed in multitude
433 Global multi_had;                   ! Number of things actually found
434 Global multi_context;               ! What token the multi-obj was accepted for
435
436 Global indef_mode;                  ! "Indefinite" mode - ie, "take a brick"
437                                     ! is in this mode
438 Global indef_type;                  ! Bit-map holding types of specification
439 Global indef_wanted;                ! Number of items wanted (100 for all)
440 Global indef_guess_p;               ! Plural-guessing flag
441 Global indef_owner;                 ! Object which must hold these items
442 Global indef_cases;                 ! Possible gender and numbers of them
443 Global indef_possambig;             ! Has a possibly dangerous assumption
444                                     ! been made about meaning of a descriptor?
445 Global indef_nspec_at;              ! Word at which a number like "two" was
446                                     ! parsed (for backtracking)
447 Global allow_plurals;               ! Whether plurals presently allowed or not
448
449 Global take_all_rule;               ! Slightly different rules apply to
450                                     ! "take all" than other uses of multiple
451                                     ! objects, to make adjudication produce
452                                     ! more pragmatically useful results
453                                     ! (Not a flag: possible values 0, 1, 2)
454
455 Global dict_flags_of_noun;          ! Of the noun currently being parsed
456                                     ! (a bitmap in #dict_par1 format)
457 Constant DICT_VERB $01;
458 Constant DICT_META $02;
459 Constant DICT_PLUR $04;
460 Constant DICT_PREP $08;
461 Constant DICT_X654 $70;
462 Constant DICT_NOUN $80;
463
464 Global pronoun_word;                ! Records which pronoun ("it", "them", ...)
465                                     ! caused an error
466 Global pronoun_obj;                 ! And what obj it was thought to refer to
467 Global pronoun__word;               ! Saved value
468 Global pronoun__obj;                ! Saved value
469
470 ! ------------------------------------------------------------------------------
471 !   Searching through scope and parsing "scope=Routine" grammar tokens
472 ! ------------------------------------------------------------------------------
473
474 Constant PARSING_REASON       = 0;  ! Possible reasons for searching scope
475 Constant TALKING_REASON       = 1;
476 Constant EACH_TURN_REASON     = 2;
477 Constant REACT_BEFORE_REASON  = 3;
478 Constant REACT_AFTER_REASON   = 4;
479 Constant LOOPOVERSCOPE_REASON = 5;
480 Constant TESTSCOPE_REASON     = 6;
481
482 Global scope_reason = PARSING_REASON; ! Current reason for searching scope
483
484 Global scope_token;                 ! For "scope=Routine" grammar tokens
485 Global scope_error;
486 Global scope_stage;                 ! 1, 2 then 3
487
488 Global ats_flag = 0;                ! For AddToScope routines
489 Global ats_hls;                     !
490
491 Global placed_in_flag;              ! To do with PlaceInScope
492
493 ! ------------------------------------------------------------------------------
494 !   The match list of candidate objects for a given token
495 ! ------------------------------------------------------------------------------
496
497 Constant MATCH_LIST_SIZE = 64;
498 Array  match_list    --> MATCH_LIST_SIZE; ! An array of matched objects so far
499 Array  match_classes --> MATCH_LIST_SIZE; ! An array of equivalence classes for them
500 Array  match_scores --> MATCH_LIST_SIZE;  ! An array of match scores for them
501 Global number_matched;              ! How many items in it?  (0 means none)
502 Global number_of_classes;           ! How many equivalence classes?
503 Global match_length;                ! How many words long are these matches?
504 Global saved_ml;
505 Global match_from;                  ! At what word of the input do they begin?
506 Global bestguess_score;             ! What did the best-guess object score?
507
508 ! ------------------------------------------------------------------------------
509 !   Low level textual manipulation
510 ! ------------------------------------------------------------------------------
511
512 #Ifdef TARGET_ZCODE;
513
514 ! 'buffer' holds the input line as typed by the player
515 !
516 !       buffer->0                     INPUT_BUFFER_LEN - WORDSIZE
517 !       buffer->1                     Number of characters input by player
518 !       buffer->2 ... buffer->121     The actual characters
519 !       buffer->122                   Spare byte to allow for 'terp bugs
520 !
521 ! 'parse' holds the result of parsing that line into dictionary words
522 !
523 !       parse->0                      MAX_BUFFER_WORDS
524 !       parse->1                      Number of words input by player
525 !
526 !       parse-->1                     Dictionary addr of first input word
527 !       parse->4                      Number of characters in the word
528 !       parse->5                      Start position in 'buffer' of the word
529 !
530 !       parse-->3  parse->8,9         Same data for second input word
531 !       ...
532 !       parse-->29 parse->60,61       Same data for MAX_BUFFER_WORDS input word
533 !       parse->62,63,64               Spare bytes (not sure why)
534
535
536 Constant INPUT_BUFFER_LEN = WORDSIZE + 120;  ! 120 is limit on input chars
537 Constant MAX_BUFFER_WORDS = 15;              ! Limit on input words
538
539 Array  buffer  -> INPUT_BUFFER_LEN + 1;      ! For main line of input
540 Array  buffer2 -> INPUT_BUFFER_LEN + 1;      ! For supplementary questions
541 Array  buffer3 -> INPUT_BUFFER_LEN + 1;      ! Retaining input for "AGAIN"
542
543 #Ifdef VN_1630;
544 Array  parse   buffer (MAX_BUFFER_WORDS * 4) + 3;   ! Parsed data from 'buffer'
545 Array  parse2  buffer (MAX_BUFFER_WORDS * 4) + 3;   ! Parsed data from 'buffer2'
546 #Ifnot;
547 Array  parse   -> 2 + (MAX_BUFFER_WORDS * 4) + 3;
548 Array  parse2  -> 2 + (MAX_BUFFER_WORDS * 4) + 3;
549 #Endif; ! VN_
550
551 #Ifnot; ! TARGET_GLULX
552
553 ! 'buffer' holds the input line as typed by the player
554 !
555 !       buffer-->0                    Number of characters input by player
556 !       buffer->4 ... buffer->259     The actual characters
557 !
558 ! 'parse' holds the result of parsing that line into dictionary words
559 !
560 !       parse-->0                     Number of words input by player
561 !
562 !       parse-->1                     Dictionary addr of first input word
563 !       parse-->2                     Number of characters in the word
564 !       parse-->3                     Start position in 'buffer' of the word
565 !
566 !       parse-->4,5,6                 Same data for second input word
567 !       ...
568 !       parse-->58,59,60              Same data for MAX_BUFFER_WORDS input word
569
570 Constant INPUT_BUFFER_LEN = WORDSIZE + 256;    ! 256 is limit on input chars
571 Constant MAX_BUFFER_WORDS = 20;                ! Limit on input words
572
573 #Ifdef VN_1630;
574 Array  buffer  buffer (INPUT_BUFFER_LEN-WORDSIZE);  ! For main line of input
575 Array  buffer2 buffer (INPUT_BUFFER_LEN-WORDSIZE);  ! For supplementary questions
576 Array  buffer3 buffer (INPUT_BUFFER_LEN-WORDSIZE);  ! Retaining input for "AGAIN"
577 #Ifnot;
578 Array  buffer  -> INPUT_BUFFER_LEN;
579 Array  buffer2 -> INPUT_BUFFER_LEN;
580 Array  buffer3 -> INPUT_BUFFER_LEN;
581 #Endif; ! VN_
582 Array  parse   --> 1 + (MAX_BUFFER_WORDS * 3);      ! Parsed data from 'buffer'
583 Array  parse2  --> 1 + (MAX_BUFFER_WORDS * 3);      ! Parsed data from 'buffer2'
584
585 #Endif; ! TARGET_
586
587 Constant comma_word = 'comma,';     ! An "untypeable word" used to substitute
588                                     ! for commas in parse buffers
589
590 Global wn;                          ! Word number within "parse" (from 1)
591 Global num_words;                   ! Number of words typed
592 Global num_desc;                    ! Number of descriptors typed
593 Global verb_word;                   ! Verb word (eg, take in "take all" or
594                                     ! "dwarf, take all") - address in dict
595 Global verb_wordnum;                ! its number in typing order (eg, 1 or 3)
596 Global usual_grammar_after;         ! Point from which usual grammar is parsed (it may vary from the
597                                     ! above if user's routines match multi-word verbs)
598
599 Global oops_from;                   ! The "first mistake" word number
600 Global saved_oops;                  ! Used in working this out
601
602 Constant OOPS_WORKSPACE_LEN 64;     ! Used temporarily by "oops" routine
603 Array  oops_workspace -> OOPS_WORKSPACE_LEN;
604
605 Global held_back_mode;              ! Flag: is there some input from last time
606 Global hb_wn;                       ! left over?  (And a save value for wn.)
607                                     ! (Used for full stops and "then".)
608
609 Global caps_mode;                   ! Keep track of (The) with 'proper' caps
610 Global print_anything_result;       ! Return value from a PrintAny() routine
611 Global initial_lookmode;            ! Default, or set in Initialise()
612 Global before_first_turn;           ! True until after initial LOOK
613
614 ! ----------------------------------------------------------------------------
615
616 Array PowersOfTwo_TB                ! Used in converting case numbers to case
617   --> $$100000000000                ! bitmaps
618       $$010000000000
619       $$001000000000
620       $$000100000000
621       $$000010000000
622       $$000001000000
623       $$000000100000
624       $$000000010000
625       $$000000001000
626       $$000000000100
627       $$000000000010
628       $$000000000001;
629
630 ! ============================================================================
631 !  Constants, and one variable, needed for the language definition file
632 ! ----------------------------------------------------------------------------
633
634 Constant POSSESS_PK  = $100;
635 Constant DEFART_PK   = $101;
636 Constant INDEFART_PK = $102;
637 Global short_name_case;
638
639 Global dict_start;
640 Global dict_entry_size;
641 Global dict_end;
642
643 ! ----------------------------------------------------------------------------
644
645 Include "language__";               ! The natural language definition, whose filename is taken from
646                                     ! the ICL language_name variable
647
648 ! ----------------------------------------------------------------------------
649
650 #Ifndef LanguageCases;
651 Constant LanguageCases = 1;
652 #Endif; ! LanguageCases
653
654 ! ------------------------------------------------------------------------------
655 !   Pronouns support for the cruder (library 6/2 and earlier) version:
656 !   only needed in English
657 ! ------------------------------------------------------------------------------
658
659 #Ifdef EnglishNaturalLanguage;
660 Global itobj = NULL;                ! The object which is currently "it"
661 Global himobj = NULL;               ! The object which is currently "him"
662 Global herobj = NULL;               ! The object which is currently "her"
663
664 Global old_itobj = NULL;            ! The object which is currently "it"
665 Global old_himobj = NULL;           ! The object which is currently "him"
666 Global old_herobj = NULL;           ! The object which is currently "her"
667 #Endif; ! EnglishNaturalLanguage
668
669 ! ============================================================================
670 ! For present and past tenses
671 ! ----------------------------------------------------------------------------
672 Constant PRESENT_TENSE 0;
673 Constant PAST_TENSE    1;
674
675 ! ============================================================================
676 ! For InformLibrary.actor_act() to control what happens when it aborts.
677 ! ----------------------------------------------------------------------------
678 Constant ACTOR_ACT_OK 0;
679 Constant ACTOR_ACT_ABORT_NOTUNDERSTOOD 1;
680 Constant ACTOR_ACT_ABORT_ORDER 2;
681
682 ! ============================================================================
683 ! "Darkness" is not really a place: but it has to be an object so that the
684 !  location-name on the status line can be "Darkness".
685 ! ----------------------------------------------------------------------------
686
687 Object  thedark "(darkness object)"
688   with  initial 0,
689         short_name DARKNESS__TX,
690         description [;  return L__M(##Miscellany, 17); ];
691
692 ! If you want to use the third-person of the narrative voice, you will
693 ! need to replace this selfobj with your own.
694
695 Class  SelfClass
696   with name ',a' ',b' ',c' ',d' ',e',
697         short_name  YOURSELF__TX,
698         description [;  return L__M(##Miscellany, 19); ],
699         before NULL,
700         after NULL,
701         life NULL,
702         each_turn NULL,
703         time_out NULL,
704         describe NULL,
705         article "the",
706         add_to_scope 0,
707         capacity 100,
708         parse_name 0,
709         orders 0,
710         number 0,
711         narrative_voice 2,
712         narrative_tense PRESENT_TENSE,
713         nameless true,
714         posture 0,
715         before_implicit [;Take: return 2;],
716   has   concealed animate proper transparent;
717
718 SelfClass selfobj "(self object)";
719
720 ! ============================================================================
721 !  The definition of the token-numbering system used by Inform.
722 ! ----------------------------------------------------------------------------
723
724 Constant ILLEGAL_TT         = 0;    ! Types of grammar token: illegal
725 Constant ELEMENTARY_TT      = 1;    !     (one of those below)
726 Constant PREPOSITION_TT     = 2;    !     e.g. 'into'
727 Constant ROUTINE_FILTER_TT  = 3;    !     e.g. noun=CagedCreature
728 Constant ATTR_FILTER_TT     = 4;    !     e.g. edible
729 Constant SCOPE_TT           = 5;    !     e.g. scope=Spells
730 Constant GPR_TT             = 6;    !     a general parsing routine
731
732 Constant NOUN_TOKEN         = 0;    ! The elementary grammar tokens, and
733 Constant HELD_TOKEN         = 1;    ! the numbers compiled by Inform to
734 Constant MULTI_TOKEN        = 2;    ! encode them
735 Constant MULTIHELD_TOKEN    = 3;
736 Constant MULTIEXCEPT_TOKEN  = 4;
737 Constant MULTIINSIDE_TOKEN  = 5;
738 Constant CREATURE_TOKEN     = 6;
739 Constant SPECIAL_TOKEN      = 7;
740 Constant NUMBER_TOKEN       = 8;
741 Constant TOPIC_TOKEN        = 9;
742
743
744 Constant GPR_FAIL           = -1;   ! Return values from General Parsing
745 Constant GPR_PREPOSITION    = 0;    ! Routines
746 Constant GPR_NUMBER         = 1;
747 Constant GPR_MULTIPLE       = 2;
748 Constant GPR_REPARSE        = REPARSE_CODE;
749 Constant GPR_NOUN           = $ff00;
750 Constant GPR_HELD           = $ff01;
751 Constant GPR_MULTI          = $ff02;
752 Constant GPR_MULTIHELD      = $ff03;
753 Constant GPR_MULTIEXCEPT    = $ff04;
754 Constant GPR_MULTIINSIDE    = $ff05;
755 Constant GPR_CREATURE       = $ff06;
756
757 Constant ENDIT_TOKEN        = 15;   ! Value used to mean "end of grammar line"
758
759 #Iftrue (Grammar__Version == 1);
760
761 [ AnalyseToken token m;
762     found_tdata = token;
763     if (token < 0)   { found_ttype = ILLEGAL_TT; return; }
764     if (token <= 8)  { found_ttype = ELEMENTARY_TT; return; }
765     if (token < 15)  { found_ttype = ILLEGAL_TT; return; }
766     if (token == 15) { found_ttype = ELEMENTARY_TT; return; }
767     if (token < 48)  { found_ttype = ROUTINE_FILTER_TT;
768                        found_tdata = token - 16;
769                        return;
770     }
771     if (token < 80)  { found_ttype = GPR_TT;
772                        found_tdata = #preactions_table-->(token-48);
773                        return;
774     }
775     if (token < 128) { found_ttype = SCOPE_TT;
776                        found_tdata = #preactions_table-->(token-80);
777                        return;
778     }
779     if (token < 180) { found_ttype = ATTR_FILTER_TT;
780                        found_tdata = token - 128;
781                        return;
782     }
783
784     found_ttype = PREPOSITION_TT;
785     m = #adjectives_table;
786     for (::) {
787         if (token == m-->1) { found_tdata = m-->0; return; }
788         m = m+4;
789     }
790     m = #adjectives_table; RunTimeError(1);
791     found_tdata = m;
792 ];
793
794 [ UnpackGrammarLine line_address i m;
795     for (i=0 : i<32 : i++) {
796         line_token-->i = ENDIT_TOKEN;
797         line_ttype-->i = ELEMENTARY_TT;
798         line_tdata-->i = ENDIT_TOKEN;
799     }
800     for (i=0 : i<=5 : i++) {
801         line_token-->i = line_address->(i+1);
802         AnalyseToken(line_token-->i);
803         if ((found_ttype == ELEMENTARY_TT) && (found_tdata == NOUN_TOKEN)
804            && (m == line_address->0)) {
805             line_token-->i = ENDIT_TOKEN;
806             break;
807         }
808         line_ttype-->i = found_ttype;
809         line_tdata-->i = found_tdata;
810         if (found_ttype ~= PREPOSITION_TT) m++;
811     }
812     action_to_be = line_address->7;
813     action_reversed = false;
814     params_wanted = line_address->0;
815     return line_address + 8;
816 ];
817
818 #Ifnot; ! Grammar__Version == 2
819
820 [ AnalyseToken token;
821     if (token == ENDIT_TOKEN) {
822         found_ttype = ELEMENTARY_TT;
823         found_tdata = ENDIT_TOKEN;
824         return;
825     }
826     found_ttype = (token->0) & $$1111;
827     found_tdata = (token+1)-->0;
828 ];
829
830 #Ifdef TARGET_ZCODE;
831
832 [ UnpackGrammarLine line_address i;
833     for (i=0 : i<32 : i++) {
834         line_token-->i = ENDIT_TOKEN;
835         line_ttype-->i = ELEMENTARY_TT;
836         line_tdata-->i = ENDIT_TOKEN;
837     }
838     action_to_be = 256*(line_address->0) + line_address->1;
839     action_reversed = ((action_to_be & $400) ~= 0);
840     action_to_be = action_to_be & $3ff;
841     line_address--;
842     params_wanted = 0;
843     for (i=0 : : i++) {
844         line_address = line_address + 3;
845         if (line_address->0 == ENDIT_TOKEN) break;
846         line_token-->i = line_address;
847         AnalyseToken(line_address);
848         if (found_ttype ~= PREPOSITION_TT) params_wanted++;
849         line_ttype-->i = found_ttype;
850         line_tdata-->i = found_tdata;
851     }
852     return line_address + 1;
853 ];
854
855 #Ifnot; ! TARGET_GLULX
856
857 [ UnpackGrammarLine line_address i;
858     for (i=0 : i<32 : i++) {
859         line_token-->i = ENDIT_TOKEN;
860         line_ttype-->i = ELEMENTARY_TT;
861         line_tdata-->i = ENDIT_TOKEN;
862     }
863     @aloads line_address 0 action_to_be;
864     action_reversed = (((line_address->2) & 1) ~= 0);
865     line_address = line_address - 2;
866     params_wanted = 0;
867     for (i=0 : : i++) {
868         line_address = line_address + 5;
869         if (line_address->0 == ENDIT_TOKEN) break;
870         line_token-->i = line_address;
871         AnalyseToken(line_address);
872         if (found_ttype ~= PREPOSITION_TT) params_wanted++;
873         line_ttype-->i = found_ttype;
874         line_tdata-->i = found_tdata;
875     }
876     return line_address + 1;
877 ];
878
879 #Endif; ! TARGET_
880 #Endif; ! Grammar__Version
881
882 ! To protect against a bug in early versions of the "Zip" interpreter:
883 ! Of course, in Glulx, this routine actually performs work.
884
885 #Ifdef TARGET_ZCODE;
886
887 [ Tokenise__ b p; b->(2 + b->1) = 0; @tokenise b p; ];
888
889 #Ifnot; ! TARGET_GLULX
890
891 Array gg_tokenbuf -> DICT_WORD_SIZE;
892
893 [ GGWordCompare str1 str2 ix jx;
894     for (ix=0 : ix<DICT_WORD_SIZE : ix++) {
895         jx = (str1->ix) - (str2->ix);
896         if (jx ~= 0) return jx;
897     }
898     return 0;
899 ];
900
901 [ Tokenise__ buf tab
902     cx numwords len bx ix wx wpos wlen val res dictlen entrylen;
903     len = buf-->0;
904     buf = buf+WORDSIZE;
905
906     ! First, split the buffer up into words. We use the standard Infocom
907     ! list of word separators (comma, period, double-quote).
908
909     cx = 0;
910     numwords = 0;
911     while (cx < len) {
912         while (cx < len && buf->cx == ' ') cx++;
913         if (cx >= len) break;
914         bx = cx;
915         if (buf->cx == '.' or ',' or '"') cx++;
916         else {
917             while (cx < len && buf->cx ~= ' ' or '.' or ',' or '"') cx++;
918         }
919         tab-->(numwords*3+2) = (cx-bx);
920         tab-->(numwords*3+3) = WORDSIZE+bx;
921         numwords++;
922         if (numwords >= MAX_BUFFER_WORDS) break;
923     }
924     tab-->0 = numwords;
925
926     ! Now we look each word up in the dictionary.
927
928     dictlen = #dictionary_table-->0;
929     entrylen = DICT_WORD_SIZE + 7;
930
931     for (wx=0 : wx<numwords : wx++) {
932         wlen = tab-->(wx*3+2);
933         wpos = tab-->(wx*3+3);
934
935         ! Copy the word into the gg_tokenbuf array, clipping to DICT_WORD_SIZE
936         ! characters and lower case.
937         if (wlen > DICT_WORD_SIZE) wlen = DICT_WORD_SIZE;
938         cx = wpos - WORDSIZE;
939         for (ix=0 : ix<wlen : ix++) gg_tokenbuf->ix = glk_char_to_lower(buf->(cx+ix));
940         for (: ix<DICT_WORD_SIZE : ix++) gg_tokenbuf->ix = 0;
941
942         val = #dictionary_table + WORDSIZE;
943         @binarysearch gg_tokenbuf DICT_WORD_SIZE val entrylen dictlen 1 1 res;
944         tab-->(wx*3+1) = res;
945     }
946 ];
947
948 #Endif; ! TARGET_
949
950 ! ============================================================================
951 !   The InformParser object abstracts the front end of the parser.
952 !
953 !   InformParser.parse_input(results)
954 !   returns only when a sensible request has been made, and puts into the
955 !   "results" buffer:
956 !
957 !   --> 0 = The action number
958 !   --> 1 = Number of parameters
959 !   --> 2, 3, ... = The parameters (object numbers), but
960 !                   0 means "put the multiple object list here"
961 !                   1 means "put one of the special numbers here"
962 !
963 ! ----------------------------------------------------------------------------
964
965 Object  InformParser "(Inform Parser)"
966   with  parse_input [ results; Parser__parse(results); ],
967   has   proper;
968
969 ! ----------------------------------------------------------------------------
970 !   The Keyboard routine actually receives the player's words,
971 !   putting the words in "a_buffer" and their dictionary addresses in
972 !   "a_table".  It is assumed that the table is the same one on each
973 !   (standard) call.
974 !
975 !   It can also be used by miscellaneous routines in the game to ask
976 !   yes-no questions and the like, without invoking the rest of the parser.
977 !
978 !   Return the number of words typed
979 ! ----------------------------------------------------------------------------
980
981 #Ifdef TARGET_ZCODE;
982
983 [ GetNthChar a_buffer n i;
984     for (i = 0: a_buffer->(2+i) == ' ': i++) {
985         if (i > a_buffer->(1)) return false;
986     }
987     return a_buffer->(2+i+n);
988 ];
989
990 [ KeyboardPrimitive  a_buffer a_table;
991     read a_buffer a_table;
992
993     #Iftrue (#version_number == 6);
994     @output_stream -1;
995     @loadb a_buffer 1 -> sp;
996     @add a_buffer 2 -> sp;
997     @print_table sp sp;
998     new_line;
999     @output_stream 1;
1000     #Endif;
1001 ];
1002
1003 [ KeyCharPrimitive win  key;
1004     if (win) @set_window win;
1005     @read_char 1 -> key;
1006     return key;
1007 ];
1008
1009 [ KeyTimerInterrupt;
1010     rtrue;
1011 ];
1012
1013 [ KeyDelay tenths  key;
1014     @read_char 1 tenths KeyTimerInterrupt -> key;
1015     return key;
1016 ];
1017
1018 #Ifnot; ! TARGET_GLULX
1019
1020 [ GetNthChar a_buffer n i;
1021     for (i = 0: a_buffer->(4+i) == ' ': i++) {
1022         if (i > a_buffer->(1)) return false;
1023     }
1024     return a_buffer->(4+i+n);
1025 ];
1026
1027 [ KeyCharPrimitive win nostat done res ix jx ch;
1028     jx = ch; ! squash compiler warnings
1029     if (win == 0) win = gg_mainwin;
1030     if (gg_commandstr ~= 0 && gg_command_reading ~= false) {
1031         ! get_line_stream
1032         done = glk_get_line_stream(gg_commandstr, gg_arguments, 31);
1033         if (done == 0) {
1034             glk_stream_close(gg_commandstr, 0);
1035             gg_commandstr = 0;
1036             gg_command_reading = false;
1037             ! fall through to normal user input.
1038         }
1039         else {
1040             ! Trim the trailing newline
1041             if (gg_arguments->(done-1) == 10) done = done-1;
1042             res = gg_arguments->0;
1043             if (res == '\') {
1044                 res = 0;
1045                 for (ix=1 : ix<done : ix++) {
1046                     ch = gg_arguments->ix;
1047                     if (ch >= '0' && ch <= '9') {
1048                         @shiftl res 4 res;
1049                         res = res + (ch-'0');
1050                     }
1051                     else if (ch >= 'a' && ch <= 'f') {
1052                         @shiftl res 4 res;
1053                         res = res + (ch+10-'a');
1054                     }
1055                     else if (ch >= 'A' && ch <= 'F') {
1056                         @shiftl res 4 res;
1057                         res = res + (ch+10-'A');
1058                     }
1059                 }
1060             }
1061         jump KCPContinue;
1062         }
1063     }
1064     done = false;
1065     glk_request_char_event(win);
1066     while (~~done) {
1067         glk_select(gg_event);
1068         switch (gg_event-->0) {
1069           5: ! evtype_Arrange
1070             if (nostat) {
1071                 glk_cancel_char_event(win);
1072                 res = $80000000;
1073                 done = true;
1074                 break;
1075             }
1076             DrawStatusLine();
1077           2: ! evtype_CharInput
1078             if (gg_event-->1 == win) {
1079                 res = gg_event-->2;
1080                 done = true;
1081                 }
1082         }
1083         ix = HandleGlkEvent(gg_event, 1, gg_arguments);
1084         if (ix == 0) ix = LibraryExtensions.RunWhile(ext_handleglkevent, 0, gg_event, 1, gg_arguments);
1085         if (ix == 2) {
1086             res = gg_arguments-->0;
1087             done = true;
1088         }
1089         else if (ix == -1) {
1090             done = false;
1091         }
1092     }
1093     if (gg_commandstr ~= 0 && gg_command_reading == false) {
1094         if (res < 32 || res >= 256 || (res == '\' or ' ')) {
1095             glk_put_char_stream(gg_commandstr, '\');
1096             done = 0;
1097             jx = res;
1098             for (ix=0 : ix<8 : ix++) {
1099                 @ushiftr jx 28 ch;
1100                 @shiftl jx 4 jx;
1101                 ch = ch & $0F;
1102                 if (ch ~= 0 || ix == 7) done = 1;
1103                 if (done) {
1104                     if (ch >= 0 && ch <= 9) ch = ch + '0';
1105                     else                    ch = (ch - 10) + 'A';
1106                     glk_put_char_stream(gg_commandstr, ch);
1107                 }
1108             }
1109         }
1110         else {
1111             glk_put_char_stream(gg_commandstr, res);
1112         }
1113         glk_put_char_stream(gg_commandstr, 10);
1114     }
1115   .KCPContinue;
1116     return res;
1117 ];
1118
1119 [ KeyDelay tenths  key done ix;
1120     glk_request_char_event(gg_mainwin);
1121     glk_request_timer_events(tenths*100);
1122     while (~~done) {
1123         glk_select(gg_event);
1124         ix = HandleGlkEvent(gg_event, 1, gg_arguments);
1125         if (ix == 0) ix = LibraryExtensions.RunWhile(ext_handleglkevent, 0, gg_event, 1, gg_arguments);
1126         if (ix == 2) {
1127             key = gg_arguments-->0;
1128             done = true;
1129         }
1130         else if (ix >= 0 && gg_event-->0 == 1 or 2) {
1131             key = gg_event-->2;
1132             done = true;
1133         }
1134     }
1135     glk_cancel_char_event(gg_mainwin);
1136     glk_request_timer_events(0);
1137     return key;
1138 ];
1139
1140 [ KeyboardPrimitive  a_buffer a_table done ix;
1141     if (gg_commandstr ~= 0 && gg_command_reading ~= false) {
1142         ! get_line_stream
1143         done = glk_get_line_stream(gg_commandstr, a_buffer+WORDSIZE, (INPUT_BUFFER_LEN-WORDSIZE)-1);
1144         if (done == 0) {
1145             glk_stream_close(gg_commandstr, 0);
1146             gg_commandstr = 0;
1147             gg_command_reading = false;
1148             ! L__M(##CommandsRead, 5); would come after prompt
1149             ! fall through to normal user input.
1150         }
1151         else {
1152             ! Trim the trailing newline
1153             if ((a_buffer+WORDSIZE)->(done-1) == 10) done = done-1;
1154             a_buffer-->0 = done;
1155             glk_set_style(style_Input);
1156             glk_put_buffer(a_buffer+WORDSIZE, done);
1157             glk_set_style(style_Normal);
1158             print "^";
1159             jump KPContinue;
1160         }
1161     }
1162     done = false;
1163     glk_request_line_event(gg_mainwin, a_buffer+WORDSIZE, INPUT_BUFFER_LEN-WORDSIZE, 0);
1164     while (~~done) {
1165         glk_select(gg_event);
1166         switch (gg_event-->0) {
1167           5: ! evtype_Arrange
1168             DrawStatusLine();
1169           3: ! evtype_LineInput
1170             if (gg_event-->1 == gg_mainwin) {
1171                 a_buffer-->0 = gg_event-->2;
1172                 done = true;            }
1173         }
1174         ix = HandleGlkEvent(gg_event, 0, a_buffer);
1175         if (ix == 0) ix = LibraryExtensions.RunWhile(ext_handleglkevent, 0, gg_event, 0, a_buffer);
1176         if (ix == 2) done = true;
1177         else if (ix == -1) done = false;
1178     }
1179     if (gg_commandstr ~= 0 && gg_command_reading == false) {
1180         ! put_buffer_stream
1181
1182         glk_put_buffer_stream(gg_commandstr, a_buffer+WORDSIZE, a_buffer-->0);
1183         glk_put_char_stream(gg_commandstr, 10);
1184     }
1185   .KPContinue;
1186     Tokenise__(a_buffer,a_table);
1187     ! It's time to close any quote window we've got going.
1188     if (gg_quotewin) {
1189         glk_window_close(gg_quotewin, 0);
1190         gg_quotewin = 0;
1191     }
1192 ];
1193
1194 #Endif; ! TARGET_
1195
1196 [ Keyboard  a_buffer a_table  nw i w w2 x1 x2;
1197     DisplayStatus();
1198
1199   .FreshInput;
1200
1201     ! Save the start of the buffer, in case "oops" needs to restore it
1202     ! to the previous time's buffer
1203
1204     for (i=0 : i<OOPS_WORKSPACE_LEN : i++) oops_workspace->i = a_buffer->i;
1205
1206     ! In case of an array entry corruption that shouldn't happen, but would be
1207     ! disastrous if it did:
1208
1209     #Ifdef TARGET_ZCODE;
1210     a_buffer->0 = INPUT_BUFFER_LEN - WORDSIZE;
1211     a_table->0  = MAX_BUFFER_WORDS; ! Allow to split input into this many words
1212     #Endif; ! TARGET_
1213
1214     ! Print the prompt, and read in the words and dictionary addresses
1215
1216     L__M(##Prompt);
1217     if (AfterPrompt() == 0) LibraryExtensions.RunAll(ext_afterprompt);
1218     #IfV5;
1219     DrawStatusLine();
1220     #Endif; ! V5
1221
1222     KeyboardPrimitive(a_buffer, a_table);
1223     nw = NumberWords(a_table);
1224
1225     ! If the line was blank, get a fresh line
1226     if (nw == 0) {
1227         L__M(##Miscellany, 10);
1228         jump FreshInput;
1229     }
1230
1231     ! Unless the opening word was "oops", return
1232     ! Conveniently, a_table-->1 is the first word in both ZCODE and GLULX.
1233
1234     w = a_table-->1;
1235     if (w == OOPS1__WD or OOPS2__WD or OOPS3__WD) jump DoOops;
1236
1237     if (a_buffer->WORDSIZE == COMMENT_CHARACTER) {
1238         #Ifdef TARGET_ZCODE;
1239         if ((HDR_GAMEFLAGS-->0) & $0001 || xcommsdir)
1240                                            L__M(##Miscellany, 54);
1241         else                               L__M(##Miscellany, 55);
1242         #Ifnot; ! TARGET_GLULX
1243         if (gg_scriptstr || gg_commandstr) L__M(##Miscellany, 54);
1244         else                               L__M(##Miscellany, 55);
1245         #Endif; ! TARGET_
1246
1247         jump FreshInput;
1248     }
1249
1250     #IfV5;
1251     ! Undo handling
1252
1253     if ((w == UNDO1__WD or UNDO2__WD or UNDO3__WD) && (nw==1)) {
1254         i = PerformUndo();
1255         if (i == 0) jump FreshInput;
1256     }
1257     #Ifdef TARGET_ZCODE;
1258     @save_undo i;
1259     #Ifnot; ! TARGET_GLULX
1260     @saveundo i;
1261     if (i == -1) {
1262         GGRecoverObjects();
1263         i = 2;
1264     }
1265     else  i = (~~i);
1266     #Endif; ! TARGET_
1267     just_undone = 0;
1268     undo_flag = 2;
1269     if (i == -1) undo_flag = 0;
1270     if (i == 0) undo_flag = 1;
1271     if (i == 2) {
1272         RestoreColours();
1273         #Ifdef TARGET_ZCODE;
1274         style bold;
1275         #Ifnot; ! TARGET_GLULX
1276         glk_set_style(style_Subheader);
1277         #Endif; ! TARGET_
1278         print (name) location, "^";
1279         #Ifdef TARGET_ZCODE;
1280         style roman;
1281         #Ifnot; ! TARGET_GLULX
1282         glk_set_style(style_Normal);
1283         #Endif; ! TARGET_
1284         L__M(##Miscellany, 13);
1285         just_undone = 1;
1286         jump FreshInput;
1287     }
1288     #Endif; ! V5
1289
1290     return nw;
1291
1292   .DoOops;
1293     if (oops_from == 0) {
1294         L__M(##Miscellany, 14);
1295         jump FreshInput;
1296     }
1297     if (nw == 1) {
1298         L__M(##Miscellany, 15);
1299         jump FreshInput;
1300     }
1301     if (nw > 2) {
1302         L__M(##Miscellany, 16);
1303         jump FreshInput;
1304     }
1305
1306     ! So now we know: there was a previous mistake, and the player has
1307     ! attempted to correct a single word of it.
1308
1309     for (i=0 : i<INPUT_BUFFER_LEN : i++) buffer2->i = a_buffer->i;
1310     #Ifdef TARGET_ZCODE;
1311     x1 = a_table->9;  ! Start of word following "oops"
1312     x2 = a_table->8;  ! Length of word following "oops"
1313     #Ifnot; ! TARGET_GLULX
1314     x1 = a_table-->6; ! Start of word following "oops"
1315     x2 = a_table-->5; ! Length of word following "oops"
1316     #Endif; ! TARGET_
1317
1318     ! Repair the buffer to the text that was in it before the "oops"
1319     ! was typed:
1320
1321     for (i=0 : i < OOPS_WORKSPACE_LEN : i++) a_buffer->i = oops_workspace->i;
1322     Tokenise__(a_buffer, a_table);
1323
1324     ! Work out the position in the buffer of the word to be corrected:
1325
1326     #Ifdef TARGET_ZCODE;
1327     w = a_table->(4*oops_from + 1); ! Start of word to go
1328     w2 = a_table->(4*oops_from);    ! Length of word to go
1329     #Ifnot; ! TARGET_GLULX
1330     w = a_table-->(3*oops_from);      ! Start of word to go
1331     w2 = a_table-->(3*oops_from - 1); ! Length of word to go
1332     #Endif; ! TARGET_
1333
1334 #IfDef OOPS_CHECK;
1335     print "[~";
1336     for (i=0 : i<w2 : i++) for (i=0 : i<w2 : i++) print (char)a_buffer->(i+w);
1337     print "~ --> ~";
1338 #Endif;
1339
1340     ! Write spaces over the word to be corrected:
1341
1342     for (i=0 : i<w2 : i++) a_buffer->(i+w) = ' ';
1343
1344     if (w2 < x2) {
1345         ! If the replacement is longer than the original, move up...
1346         for (i=INPUT_BUFFER_LEN-1 : i>=w+x2 : i--)
1347             a_buffer->i = a_buffer->(i-x2+w2);
1348
1349         ! ...increasing buffer size accordingly.
1350         SetKeyBufLength(GetKeyBufLength(a_buffer) + (x2-w2), a_buffer);
1351     }
1352
1353     ! Write the correction in:
1354
1355     for (i=0 : i<x2 : i++) {
1356         a_buffer->(i+w) = buffer2->(i+x1);
1357 #IfDef OOPS_CHECK;
1358         print (char) buffer2->(i+x1);
1359 #Endif;
1360     }
1361
1362 #IfDef OOPS_CHECK;
1363         print "~]^^";
1364 #Endif;
1365
1366     Tokenise__(a_buffer, a_table);
1367     nw=NumberWords(a_table);
1368
1369 !    saved_ml = 0;
1370     return nw;
1371 ]; ! end of Keyboard
1372
1373 [ PerformUndo i;
1374     if (turns == START_MOVE) { L__M(##Miscellany, 11); return 0; }
1375     if (undo_flag == 0) {      L__M(##Miscellany, 6); return 0; }
1376     if (undo_flag == 1) {      L__M(##Miscellany, 7); return 0; }
1377     #Ifdef TARGET_ZCODE;
1378     @restore_undo i;
1379     #Ifnot; ! TARGET_GLULX
1380     @restoreundo i;
1381     i = (~~i);
1382     #Endif; ! TARGET_
1383     if (i == 0) {    L__M(##Miscellany, 7); return 0; }
1384     L__M(##Miscellany, 1);
1385     return 1;
1386 ];
1387
1388 ! ----------------------------------------------------------------------------
1389 !   To simplify the picture a little, a rough map of the main routine:
1390 !
1391 !   (A) Get the input, do "oops" and "again"
1392 !   (B) Is it a direction, and so an implicit "go"?  If so go to (K)
1393 !   (C) Is anyone being addressed?
1394 !   (D) Get the verb: try all the syntax lines for that verb
1395 !   (E) Break down a syntax line into analysed tokens
1396 !   (F) Look ahead for advance warning for multiexcept/multiinside
1397 !   (G) Parse each token in turn (calling ParseToken to do most of the work)
1398 !   (H) Cheaply parse otherwise unrecognised conversation and return
1399 !   (I) Print best possible error message
1400 !   (J) Retry the whole lot
1401 !   (K) Last thing: check for "then" and further instructions(s), return.
1402 !
1403 !   The strategic points (A) to (K) are marked in the commentary.
1404 !
1405 !   Note that there are three different places where a return can happen.
1406 ! ----------------------------------------------------------------------------
1407
1408 [ Parser__parse  results   syntax line num_lines line_address i j k
1409                            token l m line_etype vw;
1410
1411     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1412     !
1413     ! A: Get the input, do "oops" and "again"
1414     !
1415     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1416
1417     ! Firstly, in "not held" mode, we still have a command left over from last
1418     ! time (eg, the user typed "eat biscuit", which was parsed as "take biscuit"
1419     ! last time, with "eat biscuit" tucked away until now).  So we return that.
1420
1421     if (notheld_mode == 1) {
1422         for (i=0 : i<8 : i++) results-->i = kept_results-->i;
1423         notheld_mode = 0;
1424         rtrue;
1425     }
1426
1427     if (held_back_mode ~= 0) {
1428         held_back_mode = 0;
1429         Tokenise__(buffer, parse);
1430         jump ReParse;
1431     }
1432
1433   .ReType;
1434
1435     Keyboard(buffer, parse);
1436
1437 #Ifdef INFIX;
1438     ! An Infix verb is a special kind of meta verb.  We mark them here.
1439     if (GetNthChar(buffer, 0) == ';')
1440         infix_verb = true;
1441     else
1442         infix_verb = false;
1443 #Endif;
1444
1445   .ReParse;
1446
1447     parser_inflection = name;
1448     parser_inflection_func = false;
1449
1450     ! Initially assume the command is aimed at the player, and the verb
1451     ! is the first word
1452
1453     num_words = NumberWords();
1454     wn = 1;
1455
1456     #Ifdef LanguageToInformese;
1457     LanguageToInformese();
1458     #IfV5;
1459     ! Re-tokenise:
1460     Tokenise__(buffer,parse);
1461     #Endif; ! V5
1462     #Endif; ! LanguageToInformese
1463
1464     if (BeforeParsing() == false) {
1465         LibraryExtensions.ext_number_1 = wn;    ! Set "between calls" functionality to restore wn each pass
1466         LibraryExtensions.BetweenCalls = LibraryExtensions.RestoreWN;
1467         LibraryExtensions.RunWhile(ext_beforeparsing, false);
1468         LibraryExtensions.BetweenCalls = 0;     ! Turn off "between calls" functionality
1469      }
1470     num_words = NumberWords();
1471
1472     k=0;
1473     #Ifdef DEBUG;
1474     if (parser_trace >= 2) {
1475         print "[ ";
1476         for (i=0 : i<num_words : i++) {
1477
1478             j = WordValue(i+1);
1479             k = WordAddress(i+1);
1480             l = WordLength(i+1);
1481             print "~"; for (m=0 : m<l : m++) print (char) k->m; print "~ ";
1482
1483             if (j == 0) print "?";
1484             else {
1485                 #Ifdef TARGET_ZCODE;
1486                 if (UnsignedCompare(j, HDR_DICTIONARY-->0) >= 0 &&
1487                     UnsignedCompare(j, HDR_HIGHMEMORY-->0) < 0)
1488                      print (address) j;
1489                 else print j;
1490                 #Ifnot; ! TARGET_GLULX
1491                 if (j->0 == $60) print (address) j;
1492                 else print j;
1493                 #Endif; ! TARGET_
1494             }
1495             if (i ~= num_words-1) print " / ";
1496         }
1497         print " ]^";
1498     }
1499     #Endif; ! DEBUG
1500     verb_wordnum = 1;
1501     actor = player;
1502     actors_location = ScopeCeiling(player);
1503     usual_grammar_after = 0;
1504
1505   .AlmostReParse;
1506
1507     scope_token = 0;
1508     action_to_be = NULL;
1509
1510     ! Begin from what we currently think is the verb word
1511
1512   .BeginCommand;
1513
1514     wn = verb_wordnum;
1515     verb_word = NextWordStopped();
1516
1517     ! If there's no input here, we must have something like "person,".
1518
1519     if (verb_word == -1) {
1520         best_etype = STUCK_PE;
1521         jump GiveError;
1522     }
1523
1524     ! Now try for "again" or "g", which are special cases: don't allow "again" if nothing
1525     ! has previously been typed; simply copy the previous text across
1526
1527     if (verb_word == AGAIN2__WD or AGAIN3__WD) verb_word = AGAIN1__WD;
1528     if (verb_word == AGAIN1__WD) {
1529         if (actor ~= player) {
1530             L__M(##Miscellany, 20);
1531             jump ReType;
1532         }
1533         if (GetKeyBufLength(buffer3) == 0) {
1534             L__M(##Miscellany, 21);
1535             jump ReType;
1536         }
1537
1538         if (WordAddress(verb_wordnum) == buffer + WORDSIZE) { ! not held back
1539             ! splice rest of buffer onto end of buffer3
1540             i = GetKeyBufLength(buffer3);
1541             while (buffer3 -> (i + WORDSIZE - 1) == ' ' or '.')
1542                 i--;
1543             j = i - WordLength(verb_wordnum);  ! amount to move buffer up by
1544             if (j > 0) {
1545                 for (m=INPUT_BUFFER_LEN-1 : m>=WORDSIZE+j : m--)
1546                     buffer->m = buffer->(m-j);
1547                 SetKeyBufLength(GetKeyBufLength()+j);
1548                 }
1549             for (m=WORDSIZE : m<WORDSIZE+i : m++) buffer->m = buffer3->m;
1550             if (j < 0) for (:m<WORDSIZE+i-j : m++) buffer->m = ' ';
1551          }
1552         else
1553             for (i=0 : i<INPUT_BUFFER_LEN : i++) buffer->i = buffer3->i;
1554         jump ReParse;
1555     }
1556
1557     ! Save the present input in case of an "again" next time
1558
1559     if (verb_word ~= AGAIN1__WD)
1560         for (i=0 : i<INPUT_BUFFER_LEN : i++) buffer3->i = buffer->i;
1561
1562     if (usual_grammar_after == 0) {
1563         j = verb_wordnum;
1564         i = RunRoutines(actor, grammar);
1565         #Ifdef DEBUG;
1566         if (parser_trace >= 2 && actor.grammar ~= 0 or NULL)
1567             print " [Grammar property returned ", i, "]^";
1568         #Endif; ! DEBUG
1569
1570         #Ifdef TARGET_ZCODE;
1571         if ((i ~= 0 or 1) &&
1572             (UnsignedCompare(i, dict_start) < 0 ||
1573              UnsignedCompare(i, dict_end) >= 0 ||
1574              (i - dict_start) % dict_entry_size ~= 0)) {
1575             usual_grammar_after = j;
1576             i=-i;
1577         }
1578
1579         #Ifnot; ! TARGET_GLULX
1580         if (i < 0) { usual_grammar_after = j; i=-i; }
1581         #Endif;
1582
1583         if (i == 1) {
1584             results-->0 = action;
1585             results-->1 = 0;            ! Number of parameters
1586             results-->2 = noun;
1587             results-->3 = second;
1588             if (noun) results-->1 = 1;
1589             if (second) results-->1 = 2;
1590             rtrue;
1591         }
1592         if (i ~= 0) { verb_word = i; wn--; verb_wordnum--; }
1593         else { wn = verb_wordnum; verb_word = NextWord(); }
1594     }
1595     else usual_grammar_after = 0;
1596
1597     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1598     !
1599     ! B: Is it a direction, and so an implicit "go"?  If so go to (K)
1600     !
1601     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1602
1603     #Ifdef LanguageIsVerb;
1604     if (verb_word == 0) {
1605         i = wn; verb_word = LanguageIsVerb(buffer, parse, verb_wordnum);
1606         wn = i;
1607     }
1608     #Endif; ! LanguageIsVerb
1609
1610     ! If the first word is not listed as a verb, it must be a direction
1611     ! or the name of someone to talk to
1612
1613     if (verb_word == 0 || ((verb_word->#dict_par1) & DICT_VERB) == 0) {
1614
1615         ! So is the first word an object contained in the special object "compass"
1616         ! (i.e., a direction)?  This needs use of NounDomain, a routine which
1617         ! does the object matching, returning the object number, or 0 if none found,
1618         ! or REPARSE_CODE if it has restructured the parse table so the whole parse
1619         ! must be begun again...
1620
1621         wn = verb_wordnum; indef_mode = false; token_filter = 0;
1622         l = NounDomain(compass, 0, NOUN_TOKEN);
1623         if (l == REPARSE_CODE) jump ReParse;
1624
1625         ! If it is a direction, send back the results:
1626         ! action=GoSub, no of arguments=1, argument 1=the direction.
1627
1628         if (l ~= 0) {
1629             results-->0 = ##Go;
1630             action_to_be = ##Go;
1631             results-->1 = 1;
1632             results-->2 = l;
1633             jump LookForMore;
1634         }
1635
1636     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1637     !
1638     ! C: Is anyone being addressed?
1639     !
1640     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1641
1642         ! Only check for a comma (a "someone, do something" command) if we are
1643         ! not already in the middle of one.  (This simplification stops us from
1644         ! worrying about "robot, wizard, you are an idiot", telling the robot to
1645         ! tell the wizard that she is an idiot.)
1646
1647         if (actor == player) {
1648             for (j=2 : j<=num_words : j++) {
1649                 i=NextWord();
1650                 if (i == comma_word) jump Conversation;
1651             }
1652         }
1653         vw = verb_word;
1654         verb_word = UnknownVerb(vw);
1655         if (verb_word == false) verb_word = LibraryExtensions.RunWhile(ext_unknownverb, false, vw);
1656         if (verb_word) jump VerbAccepted;
1657         best_etype = VERB_PE;
1658         jump GiveError;
1659
1660         ! NextWord nudges the word number wn on by one each time, so we've now
1661         ! advanced past a comma.  (A comma is a word all on its own in the table.)
1662
1663       .Conversation;
1664
1665         j = wn - 1;
1666         if (j == 1) {
1667             L__M(##Miscellany, 22);
1668             jump ReType;
1669         }
1670
1671         ! Use NounDomain (in the context of "animate creature") to see if the
1672         ! words make sense as the name of someone held or nearby
1673
1674         wn = 1; lookahead = HELD_TOKEN;
1675         scope_reason = TALKING_REASON;
1676         l = NounDomain(player,actors_location,CREATURE_TOKEN);
1677         scope_reason = PARSING_REASON;
1678         if (l == REPARSE_CODE) jump ReParse;
1679         if (l == 0) {
1680             L__M(##Miscellany, 23);
1681             jump ReType;
1682         }
1683
1684       .Conversation2;
1685
1686         ! The object addressed must at least be "talkable" if not actually "animate"
1687         ! (the distinction allows, for instance, a microphone to be spoken to,
1688         ! without the parser thinking that the microphone is human).
1689
1690         if (l hasnt animate && l hasnt talkable) {
1691             L__M(##Miscellany, 24, l);
1692             jump ReType;
1693         }
1694
1695         ! Check that there aren't any mystery words between the end of the person's
1696         ! name and the comma (eg, throw out "dwarf sdfgsdgs, go north").
1697
1698         if (wn ~= j) {
1699             L__M(##Miscellany, 25);
1700             jump ReType;
1701         }
1702
1703         ! The player has now successfully named someone.  Adjust "him", "her", "it":
1704
1705         PronounNotice(l);
1706
1707         ! Set the global variable "actor", adjust the number of the first word,
1708         ! and begin parsing again from there.
1709
1710         verb_wordnum = j + 1;
1711
1712         ! Stop things like "me, again":
1713
1714         if (l == player) {
1715             wn = verb_wordnum;
1716             if (NextWordStopped() == AGAIN1__WD or AGAIN2__WD or AGAIN3__WD) {
1717                 L__M(##Miscellany, 20);
1718                 jump ReType;
1719             }
1720         }
1721
1722         actor = l;
1723         actors_location = ScopeCeiling(l);
1724         #Ifdef DEBUG;
1725         if (parser_trace >= 1)
1726             print "[Actor is ", (the) actor, " in ", (name) actors_location, "]^";
1727         #Endif; ! DEBUG
1728         jump BeginCommand;
1729
1730     } ! end of first-word-not-a-verb
1731
1732     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1733     !
1734     ! D: Get the verb: try all the syntax lines for that verb
1735     !
1736     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1737
1738   .VerbAccepted;
1739
1740     ! We now definitely have a verb, not a direction, whether we got here by the
1741     ! "take ..." or "person, take ..." method.  Get the meta flag for this verb:
1742
1743     meta = (verb_word->#dict_par1) & DICT_META;
1744
1745     ! You can't order other people to "full score" for you, and so on...
1746
1747     if (meta && actor ~= player) {
1748         best_etype = VERB_PE;
1749         meta = false;
1750         jump GiveError;
1751     }
1752
1753     ! Now let i be the corresponding verb number, stored in the dictionary entry
1754     ! (in a peculiar 255-n fashion for traditional Infocom reasons)...
1755
1756     i = $ff-(verb_word->#dict_par2);
1757
1758     ! ...then look up the i-th entry in the verb table, whose address is at word
1759     ! 7 in the Z-machine (in the header), so as to get the address of the syntax
1760     ! table for the given verb...
1761
1762     #Ifdef TARGET_ZCODE;
1763     syntax = (HDR_STATICMEMORY-->0)-->i;
1764     #Ifnot; ! TARGET_GLULX
1765     syntax = (#grammar_table)-->(i+1);
1766     #Endif; ! TARGET_
1767
1768     ! ...and then see how many lines (ie, different patterns corresponding to the
1769     ! same verb) are stored in the parse table...
1770
1771     num_lines = (syntax->0) - 1;
1772
1773     ! ...and now go through them all, one by one.
1774     ! To prevent pronoun_word 0 being misunderstood,
1775
1776     pronoun_word = NULL; pronoun_obj = NULL;
1777
1778     #Ifdef DEBUG;
1779     if (parser_trace >= 1) print "[Parsing for the verb '", (address) verb_word, "' (", num_lines+1, " lines)]^";
1780     #Endif; ! DEBUG
1781
1782     best_etype = STUCK_PE; nextbest_etype = STUCK_PE;
1783     multiflag = false; saved_oops = 0;
1784
1785     ! "best_etype" is the current failure-to-match error - it is by default
1786     ! the least informative one, "don't understand that sentence".
1787     ! "nextbest_etype" remembers the best alternative to having to ask a
1788     ! scope token for an error message (i.e., the best not counting ASKSCOPE_PE).
1789     ! multiflag is used here to prevent inappropriate MULTI_PE errors
1790     ! in addition to its unrelated duties passing information to action routines
1791
1792     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1793     !
1794     ! E: Break down a syntax line into analysed tokens
1795     !
1796     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1797
1798     line_address = syntax + 1;
1799
1800     for (line=0 : line<=num_lines : line++) {
1801
1802         for (i=0 : i<32 : i++) {
1803             line_token-->i = ENDIT_TOKEN;
1804             line_ttype-->i = ELEMENTARY_TT;
1805             line_tdata-->i = ENDIT_TOKEN;
1806         }
1807
1808         ! Unpack the syntax line from Inform format into three arrays; ensure that
1809         ! the sequence of tokens ends in an ENDIT_TOKEN.
1810
1811         line_address = UnpackGrammarLine(line_address);
1812
1813         #Ifdef DEBUG;
1814         if (parser_trace >= 1) {
1815             if (parser_trace >= 2) new_line;
1816             print "[line ", line; DebugGrammarLine();
1817             print "]^";
1818         }
1819         #Endif; ! DEBUG
1820
1821         ! We aren't in "not holding" or inferring modes, and haven't entered
1822         ! any parameters on the line yet, or any special numbers; the multiple
1823         ! object is still empty.
1824
1825         token_filter = 0;
1826         not_holding = 0;
1827         inferfrom = 0;
1828         parameters = 0;
1829         nsns = 0; special_word = 0; special_number = 0;
1830         multiple_object-->0 = 0;
1831         multi_context = 0;
1832         etype = STUCK_PE; line_etype = 100;
1833
1834         ! Put the word marker back to just after the verb
1835
1836         wn = verb_wordnum+1;
1837
1838     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1839     !
1840     ! F: Look ahead for advance warning for multiexcept/multiinside
1841     !
1842     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1843
1844         ! There are two special cases where parsing a token now has to be
1845         ! affected by the result of parsing another token later, and these
1846         ! two cases (multiexcept and multiinside tokens) are helped by a quick
1847         ! look ahead, to work out the future token now.  We can only carry this
1848         ! out in the simple (but by far the most common) case:
1849         !
1850         !     multiexcept <one or more prepositions> noun
1851         !
1852         ! and similarly for multiinside.
1853
1854         advance_warning = NULL; indef_mode = false;
1855         for (i=0,m=false,pcount=0 : line_token-->pcount ~= ENDIT_TOKEN : pcount++) {
1856             scope_token = 0;
1857
1858             if (line_ttype-->pcount ~= PREPOSITION_TT) i++;
1859
1860             if (line_ttype-->pcount == ELEMENTARY_TT) {
1861                 if (line_tdata-->pcount == MULTI_TOKEN) m = true;
1862                 if (line_tdata-->pcount == MULTIEXCEPT_TOKEN or MULTIINSIDE_TOKEN  && i == 1) {
1863                     ! First non-preposition is "multiexcept" or
1864                     ! "multiinside", so look ahead.
1865
1866                     #Ifdef DEBUG;
1867                     if (parser_trace >= 2) print " [Trying look-ahead]^";
1868                     #Endif; ! DEBUG
1869
1870                     ! We need this to be followed by 1 or more prepositions.
1871
1872                     pcount++;
1873                     if (line_ttype-->pcount == PREPOSITION_TT) {
1874                         ! skip ahead to a preposition word in the input
1875                         do {
1876                             l = NextWord();
1877                         } until ((wn > num_words) ||
1878                                  (l && (l->#dict_par1) & DICT_PREP ~= 0));
1879
1880                         if (wn > num_words) {
1881                             #Ifdef DEBUG;
1882                             if (parser_trace >= 2)
1883                                 print " [Look-ahead aborted: prepositions missing]^";
1884                             #Endif;
1885                             jump EmptyLine;
1886                         }
1887
1888                         do {
1889                             if (PrepositionChain(l, pcount) ~= -1) {
1890                                 ! advance past the chain
1891                                 if ((line_token-->pcount)->0 & $20 ~= 0) {
1892                                     pcount++;
1893                                     while ((line_token-->pcount ~= ENDIT_TOKEN) &&
1894                                            ((line_token-->pcount)->0 & $10 ~= 0))
1895                                         pcount++;
1896                                 } else {
1897                                     pcount++;
1898                                 }
1899                             } else {
1900                                 ! try to find another preposition word
1901                                 do {
1902                                     l = NextWord();
1903                                 } until ((wn >= num_words) ||
1904                                          (l && (l->#dict_par1) & 8 ~= 0));
1905
1906                                 if (l && (l->#dict_par1) & 8) continue;
1907
1908                                 ! lookahead failed
1909                                 #Ifdef DEBUG;
1910                                 if (parser_trace >= 2)
1911                                     print " [Look-ahead aborted: prepositions don't match]^";
1912                                 #Endif;
1913                                 jump LineFailed;
1914                             }
1915                             l = NextWord();
1916                         } until (line_ttype-->pcount ~= PREPOSITION_TT);
1917
1918                         .EmptyLine;
1919                         ! put back the non-preposition we just read
1920                         wn--;
1921
1922                         if ((line_ttype-->pcount == ELEMENTARY_TT) && (line_tdata-->pcount == NOUN_TOKEN)) {
1923                             l = Descriptors();  ! skip past THE etc
1924                             if (l~=0) etype=l;  ! don't allow multiple objects
1925                             l = NounDomain(actors_location, actor, NOUN_TOKEN);
1926
1927                             #Ifdef DEBUG;
1928                             if (parser_trace >= 2) {
1929                                 print " [Advanced to ~noun~ token: ";
1930                                 if (l == REPARSE_CODE) print "re-parse request]^";
1931                                 if (l == 1) print "but multiple found]^";
1932                                 if (l == 0) print "error ", etype, "]^";
1933                                 if (l >= 2) print (the) l, "]^";
1934                             }
1935                             #Endif; ! DEBUG
1936                             if (l == REPARSE_CODE) jump ReParse;
1937                             if (l >= 2) advance_warning = l;
1938                         }
1939                     }
1940                     break;
1941                 }
1942             }
1943         }
1944
1945         ! Slightly different line-parsing rules will apply to "take multi", to
1946         ! prevent "take all" behaving correctly but misleadingly when there's
1947         ! nothing to take.
1948
1949         take_all_rule = 0;
1950         if (m && params_wanted == 1 && action_to_be == ##Take)
1951             take_all_rule = 1;
1952
1953         ! And now start again, properly, forearmed or not as the case may be.
1954         ! As a precaution, we clear all the variables again (they may have been
1955         ! disturbed by the call to NounDomain, which may have called outside
1956         ! code, which may have done anything!).
1957
1958         not_holding = 0;
1959         inferfrom = 0;
1960         inferword = 0;
1961         parameters = 0;
1962         nsns = 0; special_word = 0; special_number = 0;
1963         multiple_object-->0 = 0;
1964         etype = STUCK_PE; line_etype = 100;
1965         wn = verb_wordnum+1;
1966
1967     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1968     !
1969     ! G: Parse each token in turn (calling ParseToken to do most of the work)
1970     !
1971     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1972
1973         ! "Pattern" gradually accumulates what has been recognised so far,
1974         ! so that it may be reprinted by the parser later on
1975
1976         for (pcount=1 : : pcount++) {
1977             pattern-->pcount = PATTERN_NULL; scope_token = 0;
1978
1979             token = line_token-->(pcount-1);
1980             lookahead = line_token-->pcount;
1981
1982             #Ifdef DEBUG;
1983             if (parser_trace >= 2)
1984                 print " [line ", line, " token ", pcount, " word ", wn, " : ", (DebugToken) token,
1985                   "]^";
1986             #Endif; ! DEBUG
1987
1988             if (token ~= ENDIT_TOKEN) {
1989                 scope_reason = PARSING_REASON;
1990                 parser_inflection = name;
1991                 parser_inflection_func = false;
1992                 AnalyseToken(token);
1993
1994                 if (action_to_be == ##AskTo && found_ttype == ELEMENTARY_TT &&
1995                     found_tdata == TOPIC_TOKEN && line_etype == 100) {
1996                     if (actor ~= player) {
1997                         best_etype = VERB_PE; jump GiveError;
1998                     }
1999                     l = inputobjs-->2;
2000                     wn--;
2001                     j = wn;
2002                     jump Conversation2;
2003                 }
2004
2005                 l = ParseToken__(found_ttype, found_tdata, pcount-1, token);
2006                 while (l<-200) l = ParseToken__(ELEMENTARY_TT, l + 256);
2007                 scope_reason = PARSING_REASON;
2008
2009                 if (l == GPR_PREPOSITION) {
2010                     if (found_ttype~=PREPOSITION_TT && (found_ttype~=ELEMENTARY_TT ||
2011                         found_tdata~=TOPIC_TOKEN)) params_wanted--;
2012                     l = true;
2013                 }
2014                 else
2015                     if (l < 0) l = false;
2016                     else
2017                         if (l ~= GPR_REPARSE) {
2018                             if (l == GPR_NUMBER) {
2019                                 if (nsns == 0) special_number1 = parsed_number;
2020                                 else special_number2 = parsed_number;
2021                                 nsns++; l = 1;
2022                             }
2023                             if (l == GPR_MULTIPLE) l = 0;
2024                             results-->(parameters+2) = l;
2025                             parameters++;
2026                             pattern-->pcount = l;
2027                             l = true;
2028                         }
2029
2030                 #Ifdef DEBUG;
2031                 if (parser_trace >= 3) {
2032                     print "  [token resulted in ";
2033                     if (l == REPARSE_CODE) print "re-parse request]^";
2034                     if (l == 0) print "failure with error type ", etype, "]^";
2035                     if (l == 1) print "success]^";
2036                 }
2037                 #Endif; ! DEBUG
2038
2039                 if (l == REPARSE_CODE) jump ReParse;
2040                 if (l == false) {
2041                     if (etype < line_etype) line_etype = etype;
2042                     if (etype == STUCK_PE || wn >= num_words) break;
2043                 }
2044             }
2045             else {
2046
2047                 ! If the player has entered enough already but there's still
2048                 ! text to wade through: store the pattern away so as to be able to produce
2049                 ! a decent error message if this turns out to be the best we ever manage,
2050                 ! and in the mean time give up on this line
2051
2052                 ! However, if the superfluous text begins with a comma or "then" then
2053                 ! take that to be the start of another instruction
2054
2055                 if (line_etype < 100) break;
2056                 if (wn <= num_words) {
2057                     l = NextWord();
2058                     if (l == THEN1__WD or THEN2__WD or THEN3__WD or comma_word or AND1__WD) {
2059                         held_back_mode = 1; hb_wn = wn-1;
2060                     }
2061                     else {
2062                         for (m=0 : m<32 : m++) pattern2-->m = pattern-->m;
2063                         pcount2 = pcount;
2064                         etype = UPTO_PE;
2065                         break;
2066                     }
2067                 }
2068
2069                 ! Now, we may need to revise the multiple object because of the single one
2070                 ! we now know (but didn't when the list was drawn up).
2071
2072                 if (parameters >= 1 && results-->2 == 0) {
2073                     l = ReviseMulti(results-->3);
2074                     if (l ~= 0) { etype = l; results-->0 = action_to_be; break; }
2075                 }
2076                 if (parameters >= 2 && results-->3 == 0) {
2077                     l = ReviseMulti(results-->2);
2078                     if (l ~= 0) { etype = l; break; }
2079                 }
2080
2081                 ! To trap the case of "take all" inferring only "yourself" when absolutely
2082                 ! nothing else is in the vicinity...
2083
2084                 if (take_all_rule == 2 && results-->2 == actor) {
2085                     best_etype = NOTHING_PE;
2086                     jump GiveError;
2087                 }
2088
2089                 #Ifdef DEBUG;
2090                 if (parser_trace >= 1) print "[Line successfully parsed]^";
2091                 #Endif; ! DEBUG
2092
2093                 ! The line has successfully matched the text.  Declare the input error-free...
2094
2095                 oops_from = 0;
2096
2097                 ! ...explain any inferences made (using the pattern)...
2098
2099                 if (inferfrom ~= 0 && no_infer_message == false) {
2100                     print "("; PrintCommand(inferfrom); print ")^";
2101                 }
2102                 no_infer_message = false;
2103
2104                 ! ...copy the action number, and the number of parameters...
2105
2106                 results-->0 = action_to_be;
2107                 results-->1 = parameters;
2108
2109                 ! ...reverse first and second parameters if need be...
2110
2111                 if (action_reversed && parameters == 2) {
2112                     i = results-->2; results-->2 = results-->3;
2113                     results-->3 = i;
2114                     if (nsns == 2) {
2115                         i = special_number1; special_number1 = special_number2;
2116                         special_number2 = i;
2117                     }
2118                 }
2119
2120                 ! ...and to reset "it"-style objects to the first of these parameters, if
2121                 ! there is one (and it really is an object)...
2122
2123                 if (parameters > 0 && results-->2 >= 2)
2124                     PronounNotice(results-->2);
2125
2126                 ! ...and worry about the case where an object was allowed as a parameter
2127                 ! even though the player wasn't holding it and should have been: in this
2128                 ! event, keep the results for next time round, go into "not holding" mode,
2129                 ! and for now tell the player what's happening and return a "take" request
2130                 ! instead...
2131
2132                 if (not_holding ~= 0 && actor == player) {
2133                     action = ##Take;
2134                     i = RunRoutines(not_holding, before_implicit);
2135                     ! i = 0: Take the object, tell the player (default)
2136                     ! i = 1: Take the object, don't tell the player
2137                     ! i = 2: don't Take the object, continue
2138                     ! i = 3: don't Take the object, don't continue
2139                     if (i > 2 || no_implicit_actions) { best_etype = NOTHELD_PE; jump GiveError; }
2140                     ! perform the implicit Take
2141                     if (i < 2) {
2142                         if (i ~= 1)     ! and tell the player
2143                             L__M(##Miscellany, 26, not_holding);
2144                         notheld_mode = 1;
2145                         for (i=0 : i<8 : i++) kept_results-->i = results-->i;
2146                         results-->0 = ##Take;
2147                         results-->1 = 1;
2148                         results-->2 = not_holding;
2149                     }
2150                 }
2151
2152                 ! (Notice that implicit takes are only generated for the player, and not
2153                 ! for other actors.  This avoids entirely logical, but misleading, text
2154                 ! being printed.)
2155
2156                 ! ...and return from the parser altogether, having successfully matched
2157                 ! a line.
2158
2159                 if (held_back_mode == 1) {
2160                     wn=hb_wn;
2161                     jump LookForMore;
2162                 }
2163                 rtrue;
2164
2165             } ! end of if(token ~= ENDIT_TOKEN) else
2166         } ! end of for(pcount++)
2167
2168         .LineFailed;
2169         ! The line has failed to match.
2170         ! We continue the outer "for" loop, trying the next line in the grammar.
2171
2172         if (line_etype < 100) etype = line_etype;
2173         if (etype > best_etype) best_etype = etype;
2174         if (etype ~= ASKSCOPE_PE && etype > nextbest_etype) nextbest_etype = etype;
2175
2176         ! ...unless the line was something like "take all" which failed because
2177         ! nothing matched the "all", in which case we stop and give an error now.
2178
2179         if (take_all_rule == 2 && etype==NOTHING_PE) break;
2180
2181     } ! end of for(line++)
2182
2183     ! The grammar is exhausted: every line has failed to match.
2184
2185     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2186     !
2187     ! H: Cheaply parse otherwise unrecognised conversation and return
2188     !
2189     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2190
2191   .GiveError;
2192
2193     etype = best_etype;
2194
2195     ! Errors are handled differently depending on who was talking.
2196     ! If the command was addressed to somebody else (eg, "dwarf, sfgh") then
2197     ! it is taken as conversation which the parser has no business in disallowing.
2198
2199     if (actor ~= player) {
2200         if (usual_grammar_after ~= 0) {
2201             verb_wordnum = usual_grammar_after;
2202             jump AlmostReParse;
2203         }
2204         wn = verb_wordnum;
2205         special_word = NextWord();
2206         if (special_word == comma_word) {
2207             special_word = NextWord();
2208             verb_wordnum++;
2209         }
2210         special_number = TryNumber(verb_wordnum);
2211         results-->0 = ##NotUnderstood;
2212         results-->1 = 2;
2213         results-->2 = 1; special_number1 = special_word;
2214         results-->3 = actor;
2215         consult_from = verb_wordnum; consult_words = num_words-consult_from+1;
2216         rtrue;
2217     }
2218
2219     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2220     !
2221     ! I: Print best possible error message
2222     !
2223     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2224
2225     ! If the player was the actor (eg, in "take dfghh") the error must be
2226     ! printed, and fresh input called for.  In four cases the oops word
2227     ! must be jiggled (where oops_from is set to something).
2228
2229     if (ParserError(etype)) jump ReType;
2230     if (LibraryExtensions.RunWhile(ext_parsererror, false, etype)) jump ReType;
2231     pronoun_word = pronoun__word; pronoun_obj = pronoun__obj;
2232
2233     if (etype == STUCK_PE) {    L__M(##Miscellany, 27); oops_from = 1; }
2234     if (etype == UPTO_PE) {     L__M(##Miscellany, 28);
2235         for (m=0 : m<32 : m++) pattern-->m = pattern2-->m;
2236         pcount = pcount2; PrintCommand(0); L__M(##Miscellany, 56);
2237         oops_from = wn-1;
2238     }
2239     if (etype == NUMBER_PE)     L__M(##Miscellany, 29);
2240     if (etype == CANTSEE_PE) {  L__M(##Miscellany, 30); oops_from=saved_oops;}
2241     if (etype == TOOLIT_PE)     L__M(##Miscellany, 31);
2242     if (etype == NOTHELD_PE) {  L__M(##Miscellany, 32, not_holding); oops_from=saved_oops; }
2243     if (etype == MULTI_PE)      L__M(##Miscellany, 33);
2244     if (etype == MMULTI_PE)     L__M(##Miscellany, 34);
2245     if (etype == VAGUE_PE)      L__M(##Miscellany, 35, pronoun_word);
2246     if (etype == EXCEPT_PE)     L__M(##Miscellany, 36);
2247     if (etype == ANIMA_PE)      L__M(##Miscellany, 37);
2248     if (etype == VERB_PE)       L__M(##Miscellany, 38);
2249     if (etype == SCENERY_PE)    L__M(##Miscellany, 39);
2250     if (etype == ITGONE_PE) {
2251         if (pronoun_obj == NULL)
2252                                 L__M(##Miscellany, 35, pronoun_word);
2253         else                    L__M(##Miscellany, 40, pronoun_word, pronoun_obj);
2254     }
2255     if (etype == JUNKAFTER_PE)  L__M(##Miscellany, 41);
2256     if (etype == TOOFEW_PE)     L__M(##Miscellany, 42, multi_had);
2257     if (etype == NOTHING_PE) {
2258         if (results-->0 == ##Remove && results-->3 ofclass Object) {
2259             noun = results-->3; ! ensure valid for messages
2260             if (noun has animate) L__M(##Miscellany, 44, verb_word);
2261             else if (noun hasnt container or supporter) L__M(##Insert, 2, noun);
2262             else if (noun has container && noun hasnt open) L__M(##Take, 9, noun);
2263             else if (children(noun)==0) L__M(##Search, 6, noun);
2264             else results-->0 = 0;
2265         }
2266         if (results-->0 ~= ##Remove) {
2267             if (multi_wanted == 100)    L__M(##Miscellany, 43);
2268             else {
2269                 #Ifdef NO_TAKE_ALL;
2270                 if (take_all_rule == 2) L__M(##Miscellany, 59);
2271                 else                    L__M(##Miscellany, 44, verb_word);
2272                 #Ifnot;
2273                 L__M(##Miscellany, 44, verb_word);
2274                 #Endif; ! NO_TAKE_ALL
2275             }
2276         }
2277     }
2278     if (etype == ASKSCOPE_PE) {
2279         scope_stage = 3;
2280         if (scope_error() == -1) {
2281             best_etype = nextbest_etype;
2282             jump GiveError;
2283         }
2284     }
2285
2286     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2287     !
2288     ! J: Retry the whole lot
2289     !
2290     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2291
2292     ! And go (almost) right back to square one...
2293
2294     jump ReType;
2295
2296     ! ...being careful not to go all the way back, to avoid infinite repetition
2297     ! of a deferred command causing an error.
2298
2299
2300     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2301     !
2302     ! K: Last thing: check for "then" and further instructions(s), return.
2303     !
2304     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2305
2306     ! At this point, the return value is all prepared, and we are only looking
2307     ! to see if there is a "then" followed by subsequent instruction(s).
2308
2309   .LookForMore;
2310
2311     if (wn > num_words) rtrue;
2312
2313     i = NextWord();
2314     if (i == THEN1__WD or THEN2__WD or THEN3__WD or comma_word or AND1__WD) {
2315         if (wn > num_words) {
2316            held_back_mode = false;
2317            return;
2318         }
2319         i = WordAddress(verb_wordnum);
2320         j = WordAddress(wn);
2321         for (: i<j : i++) i->0 = ' ';
2322         i = NextWord();
2323         if (i == AGAIN1__WD or AGAIN2__WD or AGAIN3__WD) {
2324             ! Delete the words "then again" from the again buffer,
2325             ! in which we have just realised that it must occur:
2326             ! prevents an infinite loop on "i. again"
2327
2328             i = WordAddress(wn-2)-buffer;
2329             if (wn > num_words) j = INPUT_BUFFER_LEN-1;
2330             else j = WordAddress(wn)-buffer;
2331             for (: i<j : i++) buffer3->i = ' ';
2332         }
2333         Tokenise__(buffer,parse);
2334         held_back_mode = true;
2335         return;
2336     }
2337     best_etype = UPTO_PE;
2338     jump GiveError;
2339
2340 ]; ! end of Parser__parse
2341
2342 [ ScopeCeiling person act;
2343   act = parent(person);
2344   if (act == 0) return person;
2345   if (person == player && location == thedark) return thedark;
2346   while (parent(act)~=0 && (act has transparent || act has supporter ||
2347                            (act has container && act has open)))
2348       act = parent(act);
2349   return act;
2350 ];
2351
2352 ! ----------------------------------------------------------------------------
2353 !  Descriptors()
2354 !
2355 !  Handles descriptive words like "my", "his", "another" and so on.
2356 !  Skips "the", and leaves wn pointing to the first misunderstood word.
2357 !
2358 !  Allowed to set up for a plural only if allow_p is set
2359 !
2360 !  Returns error number, or 0 if no error occurred
2361 ! ----------------------------------------------------------------------------
2362
2363 Constant OTHER_BIT  =   1;     !  These will be used in Adjudicate()
2364 Constant MY_BIT     =   2;     !  to disambiguate choices
2365 Constant THAT_BIT   =   4;
2366 Constant PLURAL_BIT =   8;
2367 Constant LIT_BIT    =  16;
2368 Constant UNLIT_BIT  =  32;
2369
2370 [ ResetDescriptors;
2371     indef_mode = 0; indef_type = 0; indef_wanted = 0; indef_guess_p = 0;
2372     indef_possambig = false;
2373     indef_owner = nothing;
2374     indef_cases = $$111111111111;
2375     indef_nspec_at = 0;
2376 ];
2377
2378 [ Descriptors  allows_multiple o x flag cto type m n;
2379     ResetDescriptors();
2380     if (wn > num_words) return 0;
2381     m = wn;
2382     for (flag=true : flag :) {
2383         o = NextWordStopped(); flag = false;
2384        for (x=1 : x<=LanguageDescriptors-->0 : x=x+4)
2385             if (o == LanguageDescriptors-->x) {
2386                 flag = true;
2387                 type = LanguageDescriptors-->(x+2);
2388                 if (type ~= DEFART_PK) indef_mode = true;
2389                 indef_possambig = true;
2390                 indef_cases = indef_cases & (LanguageDescriptors-->(x+1));
2391                 if (type == POSSESS_PK) {
2392                     cto = LanguageDescriptors-->(x+3);
2393                     switch (cto) {
2394                       0: indef_type = indef_type | MY_BIT;
2395                       1: indef_type = indef_type | THAT_BIT;
2396                       default:
2397                         indef_owner = PronounValue(cto);
2398                         if (indef_owner == NULL) indef_owner = InformParser;
2399                     }
2400                 }
2401                 if (type == light)  indef_type = indef_type | LIT_BIT;
2402                 if (type == -light) indef_type = indef_type | UNLIT_BIT;
2403             }
2404         if (o == OTHER1__WD or OTHER2__WD or OTHER3__WD) {
2405             indef_mode = 1; flag = 1;
2406             indef_type = indef_type | OTHER_BIT;
2407         }
2408         if (o == ALL1__WD or ALL2__WD or ALL3__WD or ALL4__WD or ALL5__WD) {
2409             indef_mode = 1; flag = 1; indef_wanted = 100;
2410             if (take_all_rule == 1) take_all_rule = 2;
2411             indef_type = indef_type | PLURAL_BIT;
2412         }
2413         if (allow_plurals && allows_multiple) {
2414             n = TryNumber(wn-1);
2415             if (n == 1) { indef_mode = 1; flag = 1; indef_wanted = 1; }
2416             if (n > 1) {
2417                 indef_guess_p = 1;
2418                 indef_mode = 1; flag = 1; indef_wanted = n;
2419                 indef_nspec_at = wn-1;
2420                 indef_type = indef_type | PLURAL_BIT;
2421             }
2422         }
2423         if (flag == 1 && NextWordStopped() ~= OF1__WD or OF2__WD or OF3__WD or OF4__WD)
2424             wn--;  ! Skip 'of' after these
2425     }
2426     wn--;
2427     num_desc = wn - m;
2428     return 0;
2429 ];
2430
2431 ! ----------------------------------------------------------------------------
2432 !  CreatureTest: Will this person do for a "creature" token?
2433 ! ----------------------------------------------------------------------------
2434
2435 [ CreatureTest obj;
2436     if (actor ~= player) rtrue;
2437     if (obj has animate) rtrue;
2438     if (obj hasnt talkable) rfalse;
2439     if (action_to_be == ##Ask or ##Answer or ##Tell or ##AskFor) rtrue;
2440     rfalse;
2441 ];
2442
2443 [ PrepositionChain wd index;
2444     if (line_tdata-->index == wd) return wd;
2445     if ((line_token-->index)->0 & $20 == 0) return -1;
2446     do {
2447         if (line_tdata-->index == wd) return wd;
2448         index++;
2449     } until ((line_token-->index == ENDIT_TOKEN) || (((line_token-->index)->0 & $10) == 0));
2450     return -1;
2451 ];
2452
2453 ! ----------------------------------------------------------------------------
2454 !  ParseToken(type, data):
2455 !      Parses the given token, from the current word number wn, with exactly
2456 !      the specification of a general parsing routine.
2457 !      (Except that for "topic" tokens and prepositions, you need to supply
2458 !      a position in a valid grammar line as third argument.)
2459 !
2460 !  Returns:
2461 !    GPR_REPARSE  for "reconstructed input, please re-parse from scratch"
2462 !    GPR_PREPOSITION  for "token accepted with no result"
2463 !    $ff00 + x    for "please parse ParseToken(ELEMENTARY_TT, x) instead"
2464 !    0            for "token accepted, result is the multiple object list"
2465 !    1            for "token accepted, result is the number in parsed_number"
2466 !    object num   for "token accepted with this object as result"
2467 !    -1           for "token rejected"
2468 !
2469 !  (A)            Analyse the token; handle all tokens not involving
2470 !                 object lists and break down others into elementary tokens
2471 !  (B)            Begin parsing an object list
2472 !  (C)            Parse descriptors (articles, pronouns, etc.) in the list
2473 !  (D)            Parse an object name
2474 !  (E)            Parse connectives ("and", "but", etc.) and go back to (C)
2475 !  (F)            Return the conclusion of parsing an object list
2476 ! ----------------------------------------------------------------------------
2477
2478 [ ParseToken given_ttype given_tdata token_n x y;
2479     x = lookahead; lookahead = NOUN_TOKEN;
2480     y = ParseToken__(given_ttype,given_tdata,token_n);
2481     if (y == GPR_REPARSE) Tokenise__(buffer,parse);
2482     lookahead = x; return y;
2483 ];
2484
2485 [ ParseToken__ given_ttype given_tdata token_n
2486              token l o i j k and_parity single_object desc_wn many_flag
2487              token_allows_multiple prev_indef_wanted;
2488
2489     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2490     !
2491     ! A: Analyse token; handle all not involving object lists, break down others
2492     !
2493     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2494
2495     token_filter = 0;
2496
2497     switch (given_ttype) {
2498       ELEMENTARY_TT:
2499         switch (given_tdata) {
2500           SPECIAL_TOKEN:
2501             l = TryNumber(wn);
2502             special_word = NextWord();
2503             #Ifdef DEBUG;
2504             if (l ~= -1000)
2505                 if (parser_trace >= 3) print "  [Read special as the number ", l, "]^";
2506             #Endif; ! DEBUG
2507             if (l == -1000) {
2508                 #Ifdef DEBUG;
2509                 if (parser_trace >= 3) print "  [Read special word at word number ", wn, "]^";
2510                 #Endif; ! DEBUG
2511                 l = special_word;
2512             }
2513             parsed_number = l; return GPR_NUMBER;
2514
2515           NUMBER_TOKEN:
2516             l=TryNumber(wn++);
2517             if (l == -1000) { etype = NUMBER_PE; return GPR_FAIL; }
2518             #Ifdef DEBUG;
2519             if (parser_trace>=3) print "  [Read number as ", l, "]^";
2520             #Endif; ! DEBUG
2521             parsed_number = l; return GPR_NUMBER;
2522
2523           CREATURE_TOKEN:
2524             if (action_to_be == ##Answer or ##Ask or ##AskFor or ##Tell)
2525                 scope_reason = TALKING_REASON;
2526
2527           TOPIC_TOKEN:
2528             consult_from = wn;
2529             if ((line_ttype-->(token_n+1) ~= PREPOSITION_TT) &&
2530                (line_token-->(token_n+1) ~= ENDIT_TOKEN))
2531                 RunTimeError(13);
2532             do o = NextWordStopped();
2533             until (o == -1 || PrepositionChain(o, token_n+1) ~= -1);
2534             wn--;
2535             consult_words = wn-consult_from;
2536             if (consult_words == 0) return GPR_FAIL;
2537             if (action_to_be == ##Ask or ##Answer or ##Tell) {
2538                 o = wn; wn = consult_from; parsed_number = NextWord();
2539                 #Ifdef EnglishNaturalLanguage;
2540                 if (parsed_number == 'the' && consult_words > 1) parsed_number=NextWord();
2541                 #Endif; ! EnglishNaturalLanguage
2542                 wn = o; return 1;
2543             }
2544             if (o==-1 && (line_ttype-->(token_n+1) == PREPOSITION_TT))
2545                 return GPR_FAIL;    ! don't infer if required preposition is absent
2546             return GPR_PREPOSITION;
2547         }
2548
2549       PREPOSITION_TT:
2550         #Iffalse (Grammar__Version == 1);
2551         ! Is it an unnecessary alternative preposition, when a previous choice
2552         ! has already been matched?
2553         if ((token->0) & $10) return GPR_PREPOSITION;
2554         #Endif; ! Grammar__Version
2555
2556         ! If we've run out of the player's input, but still have parameters to
2557         ! specify, we go into "infer" mode, remembering where we are and the
2558         ! preposition we are inferring...
2559
2560         if (wn > num_words) {
2561             if (inferfrom==0 && parameters<params_wanted) {
2562                 inferfrom = pcount; inferword = token;
2563                 pattern-->pcount = REPARSE_CODE + Dword__No(given_tdata);
2564             }
2565
2566             ! If we are not inferring, then the line is wrong...
2567
2568             if (inferfrom == 0) return -1;
2569
2570             ! If not, then the line is right but we mark in the preposition...
2571
2572             pattern-->pcount = REPARSE_CODE + Dword__No(given_tdata);
2573             return GPR_PREPOSITION;
2574         }
2575
2576         o = NextWord();
2577
2578         pattern-->pcount = REPARSE_CODE + Dword__No(o);
2579
2580         ! Whereas, if the player has typed something here, see if it is the
2581         ! required preposition... if it's wrong, the line must be wrong,
2582         ! but if it's right, the token is passed (jump to finish this token).
2583
2584         if (o == given_tdata) return GPR_PREPOSITION;
2585         #Iffalse (Grammar__Version == 1);
2586         if (PrepositionChain(o, token_n) ~= -1) return GPR_PREPOSITION;
2587         #Endif; ! Grammar__Version
2588         return -1;
2589
2590       GPR_TT:
2591         l = given_tdata();
2592         #Ifdef DEBUG;
2593         if (parser_trace >= 3) print "  [Outside parsing routine returned ", l, "]^";
2594         #Endif; ! DEBUG
2595         return l;
2596
2597       SCOPE_TT:
2598         scope_token = given_tdata;
2599         scope_stage = 1;
2600         l = scope_token();
2601         #Ifdef DEBUG;
2602         if (parser_trace >= 3) print "  [Scope routine returned multiple-flag of ", l, "]^";
2603         #Endif; ! DEBUG
2604         if (l == 1) given_tdata = MULTI_TOKEN; else given_tdata = NOUN_TOKEN;
2605
2606       ATTR_FILTER_TT:
2607         token_filter = 1 + given_tdata;
2608         given_tdata = NOUN_TOKEN;
2609
2610       ROUTINE_FILTER_TT:
2611         token_filter = given_tdata;
2612         given_tdata = NOUN_TOKEN;
2613
2614     } ! end of switch(given_ttype)
2615
2616     token = given_tdata;
2617
2618     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2619     !
2620     ! B: Begin parsing an object list
2621     !
2622     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2623
2624     ! There are now three possible ways we can be here:
2625     !     parsing an elementary token other than "special" or "number";
2626     !     parsing a scope token;
2627     !     parsing a noun-filter token (either by routine or attribute).
2628     !
2629     ! In each case, token holds the type of elementary parse to
2630     ! perform in matching one or more objects, and
2631     ! token_filter is 0 (default), an attribute + 1 for an attribute filter
2632     ! or a routine address for a routine filter.
2633
2634     token_allows_multiple = false;
2635     if (token == MULTI_TOKEN or MULTIHELD_TOKEN or MULTIEXCEPT_TOKEN or MULTIINSIDE_TOKEN)
2636         token_allows_multiple = true;
2637
2638     many_flag = false; and_parity = true; dont_infer = false;
2639
2640     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2641     !
2642     ! C: Parse descriptors (articles, pronouns, etc.) in the list
2643     !
2644     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2645
2646     ! We expect to find a list of objects next in what the player's typed.
2647
2648   .ObjectList;
2649
2650     #Ifdef DEBUG;
2651     if (parser_trace >= 3) print "  [Object list from word ", wn, "]^";
2652     #Endif; ! DEBUG
2653
2654     ! Take an advance look at the next word: if it's "it" or "them", and these
2655     ! are unset, set the appropriate error number and give up on the line
2656     ! (if not, these are still parsed in the usual way - it is not assumed
2657     ! that they still refer to something in scope)
2658
2659     o = NextWord(); wn--;
2660
2661     pronoun_word = NULL; pronoun_obj = NULL;
2662     l = PronounValue(o);
2663     if (l ~= 0) {
2664         pronoun_word = o; pronoun_obj = l;
2665         if (l == NULL) {
2666             ! Don't assume this is a use of an unset pronoun until the
2667             ! descriptors have been checked, because it might be an
2668             ! article (or some such) instead
2669
2670             for (l=1 : l<=LanguageDescriptors-->0 : l=l+4)
2671                 if (o == LanguageDescriptors-->l) jump AssumeDescriptor;
2672             pronoun__word = pronoun_word; pronoun__obj = pronoun_obj;
2673             etype = VAGUE_PE; return GPR_FAIL;
2674         }
2675     }
2676
2677   .AssumeDescriptor;
2678
2679     if (o == ME1__WD or ME2__WD or ME3__WD) { pronoun_word = o; pronoun_obj = player; }
2680
2681     allow_plurals = true;
2682     desc_wn = wn;
2683
2684   .TryAgain;
2685
2686     ! First, we parse any descriptive words (like "the", "five" or "every"):
2687     l = Descriptors(token_allows_multiple);
2688     if (l ~= 0) { etype = l; return GPR_FAIL; }
2689
2690   .TryAgain2;
2691
2692     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2693     !
2694     ! D: Parse an object name
2695     !
2696     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2697
2698     ! This is an actual specified object, and is therefore where a typing error
2699     ! is most likely to occur, so we set:
2700
2701     oops_from = wn;
2702
2703     ! So, two cases.  Case 1: token not equal to "held"
2704     ! but we may well be dealing with multiple objects
2705
2706     ! In either case below we use NounDomain, giving it the token number as
2707     ! context, and two places to look: among the actor's possessions, and in the
2708     ! present location.  (Note that the order depends on which is likeliest.)
2709     if (token ~= HELD_TOKEN) {
2710         i = multiple_object-->0;
2711         #Ifdef DEBUG;
2712         if (parser_trace >= 3) print "  [Calling NounDomain on location and actor]^";
2713         #Endif; ! DEBUG
2714         l = NounDomain(actors_location, actor, token);
2715         if (l == REPARSE_CODE) return l;                  ! Reparse after Q&A
2716         if (l ~= nothing && l ~= 1 && l notin actor && token == MULTIHELD_TOKEN or MULTIEXCEPT_TOKEN) {
2717             if (ImplicitTake(l)) {
2718                 etype = NOTHELD_PE;
2719                 jump FailToken;
2720             }
2721         }
2722
2723         if (indef_wanted == 100 && l == 0 && number_matched == 0)
2724             l = 1;  ! ReviseMulti if TAKE ALL FROM empty container
2725
2726         if (token_allows_multiple && ~~multiflag) {
2727             if (best_etype==MULTI_PE) best_etype=STUCK_PE;
2728             multiflag = true;
2729         }
2730         if (l == 0) {
2731             if (indef_possambig) {
2732                 saved_ml = match_length;
2733                 ResetDescriptors();
2734                 wn = desc_wn;
2735                 jump TryAgain2;
2736             }
2737             if (etype ~=TOOFEW_PE && (multiflag || etype ~= MULTI_PE))
2738                 etype = CantSee();
2739             jump FailToken;
2740         } ! Choose best error
2741
2742         #Ifdef DEBUG;
2743         if (parser_trace >= 3) {
2744             if (l > 1) print "  [NounDomain returned ", (the) l, "]^";
2745             else {
2746                 print "  [NounDomain appended to the multiple object list:^";
2747                 k = multiple_object-->0;
2748                 for (j=i+1 : j<=k : j++)
2749                     print "  Entry ", j, ": ", (The) multiple_object-->j,
2750                           " (", multiple_object-->j, ")^";
2751                 print "  List now has size ", k, "]^";
2752             }
2753         }
2754         #Endif; ! DEBUG
2755
2756         if (l == 1) {
2757             if (~~many_flag) many_flag = true;
2758             else {                                ! Merge with earlier ones
2759                 k = multiple_object-->0;            ! (with either parity)
2760                 multiple_object-->0 = i;
2761                 for (j=i+1 : j<=k : j++) {
2762                     if (and_parity) MultiAdd(multiple_object-->j);
2763                     else            MultiSub(multiple_object-->j);
2764                 }
2765                 #Ifdef DEBUG;
2766                 if (parser_trace >= 3) print "  [Merging ", k-i, " new objects to the ", i, " old ones]^";
2767                 #Endif; ! DEBUG
2768             }
2769         }
2770         else {
2771             ! A single object was indeed found
2772
2773             if (match_length == 0 && indef_possambig) {
2774                 ! So the answer had to be inferred from no textual data,
2775                 ! and we know that there was an ambiguity in the descriptor
2776                 ! stage (such as a word which could be a pronoun being
2777                 ! parsed as an article or possessive).  It's worth having
2778                 ! another go.
2779
2780                 ResetDescriptors();
2781                 wn = desc_wn;
2782                 jump TryAgain2;
2783             }
2784
2785             if (token == CREATURE_TOKEN && CreatureTest(l) == 0) {
2786                 etype = ANIMA_PE;
2787                 jump FailToken;
2788             } !  Animation is required
2789
2790             if (~~many_flag) single_object = l;
2791             else {
2792                 if (and_parity) MultiAdd(l); else MultiSub(l);
2793                 #Ifdef DEBUG;
2794                 if (parser_trace >= 3) print "  [Combining ", (the) l, " with list]^";
2795                 #Endif; ! DEBUG
2796             }
2797         }
2798
2799     } else {
2800     ! Case 2: token is "held" (which fortunately can't take multiple objects)
2801     ! and may generate an implicit take
2802         l = NounDomain(actor,actors_location,token);       ! Same as above...
2803         if (l == REPARSE_CODE) return GPR_REPARSE;
2804         if (l == 0) {
2805             if (indef_possambig) {
2806                 ResetDescriptors();
2807                 wn = desc_wn;
2808                 jump TryAgain2;
2809             }
2810             etype = CantSee(); jump FailToken;            ! Choose best error
2811         }
2812
2813         ! ...until it produces something not held by the actor.  Then an implicit
2814         ! take must be tried.  If this is already happening anyway, things are too
2815         ! confused and we have to give up (but saving the oops marker so as to get
2816         ! it on the right word afterwards).
2817         ! The point of this last rule is that a sequence like
2818         !
2819         !     > read newspaper
2820         !     (taking the newspaper first)
2821         !     The dwarf unexpectedly prevents you from taking the newspaper!
2822         !
2823         ! should not be allowed to go into an infinite repeat - read becomes
2824         ! take then read, but take has no effect, so read becomes take then read...
2825         ! Anyway for now all we do is record the number of the object to take.
2826
2827         o = parent(l);
2828
2829         if (o ~= actor) {
2830             if (notheld_mode == 1) {
2831                 saved_oops = oops_from;
2832                 etype = NOTHELD_PE;
2833                 jump FailToken;
2834             }
2835             not_holding = l;
2836             #Ifdef DEBUG;
2837             if (parser_trace >= 3) print "  [Allowing object ", (the) l, " for now]^";
2838             #Endif; ! DEBUG
2839         }
2840         single_object = l;
2841     } ! end of if (token ~= HELD_TOKEN) else
2842
2843     ! The following moves the word marker to just past the named object...
2844
2845     wn = oops_from + match_length;
2846
2847     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2848     !
2849     ! E: Parse connectives ("and", "but", etc.) and go back to (C)
2850     !
2851     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2852
2853     ! Object(s) specified now: is that the end of the list, or have we reached
2854     ! "and", "but" and so on?  If so, create a multiple-object list if we
2855     ! haven't already (and are allowed to).
2856
2857   .NextInList;
2858
2859     o = NextWord();
2860
2861     if (o == AND1__WD or AND2__WD or AND3__WD or BUT1__WD or BUT2__WD or BUT3__WD or comma_word) {
2862
2863         #Ifdef DEBUG;
2864         if (parser_trace >= 3) print "  [Read connective '", (address) o, "']^";
2865         #Endif; ! DEBUG
2866
2867         k = NextWord();
2868         if (k ~= AND1__WD) wn--;  ! allow Serial commas in input
2869         if (k > 0 && (k->#dict_par1) & (DICT_NOUN+DICT_VERB) == DICT_VERB) {
2870             wn--; ! player meant 'THEN'
2871             jump PassToken;
2872         }
2873         if (~~token_allows_multiple) {
2874             if (multiflag) jump PassToken; ! give UPTO_PE error
2875             etype=MULTI_PE;
2876             jump FailToken;
2877         }
2878
2879         if (o == BUT1__WD or BUT2__WD or BUT3__WD) and_parity = 1-and_parity;
2880
2881         if (~~many_flag) {
2882             multiple_object-->0 = 1;
2883             multiple_object-->1 = single_object;
2884             many_flag = true;
2885             #Ifdef DEBUG;
2886             if (parser_trace >= 3) print "  [Making new list from ", (the) single_object, "]^";
2887             #Endif; ! DEBUG
2888         }
2889         dont_infer = true; inferfrom=0;           ! Don't print (inferences)
2890         jump ObjectList;                          ! And back around
2891     }
2892
2893     wn--;   ! Word marker back to first not-understood word
2894
2895     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2896     !
2897     ! F: Return the conclusion of parsing an object list
2898     !
2899     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2900
2901     ! Happy or unhappy endings:
2902
2903   .PassToken;
2904
2905     if (many_flag) {
2906         single_object = GPR_MULTIPLE;
2907         multi_context = token;
2908     }
2909     else {
2910         if (indef_mode == 1 && indef_type & PLURAL_BIT ~= 0) {
2911             if (indef_wanted < 100 && indef_wanted > 1) {
2912                 multi_had = 1; multi_wanted = indef_wanted;
2913                 etype = TOOFEW_PE;
2914                 jump FailToken;
2915             }
2916         }
2917     }
2918     return single_object;
2919
2920   .FailToken;
2921
2922     ! If we were only guessing about it being a plural, try again but only
2923     ! allowing singulars (so that words like "six" are not swallowed up as
2924     ! Descriptors)
2925
2926     if (allow_plurals && indef_guess_p == 1) {
2927         #Ifdef DEBUG;
2928         if (parser_trace >= 4) print "   [Retrying singulars after failure ", etype, "]^";
2929         #Endif;
2930         prev_indef_wanted = indef_wanted;
2931         allow_plurals = false;
2932         wn = desc_wn;
2933         jump TryAgain;
2934     }
2935
2936     if ((indef_wanted > 0 || prev_indef_wanted > 0) && (~~multiflag)) etype = MULTI_PE;
2937
2938     return GPR_FAIL;
2939
2940 ]; ! end of ParseToken__
2941
2942 ! ----------------------------------------------------------------------------
2943 !  NounDomain does the most substantial part of parsing an object name.
2944 !
2945 !  It is given two "domains" - usually a location and then the actor who is
2946 !  looking - and a context (i.e. token type), and returns:
2947 !
2948 !   0    if no match at all could be made,
2949 !   1    if a multiple object was made,
2950 !   k    if object k was the one decided upon,
2951 !   REPARSE_CODE if it asked a question of the player and consequently rewrote
2952 !        the player's input, so that the whole parser should start again
2953 !        on the rewritten input.
2954 !
2955 !   In the case when it returns 1<k<REPARSE_CODE, it also sets the variable
2956 !   length_of_noun to the number of words in the input text matched to the
2957 !   noun.
2958 !   In the case k=1, the multiple objects are added to multiple_object by
2959 !   hand (not by MultiAdd, because we want to allow duplicates).
2960 ! ----------------------------------------------------------------------------
2961
2962 [ NounDomain domain1 domain2 context    first_word i j k l
2963                                         answer_words;
2964     #Ifdef DEBUG;
2965     if (parser_trace >= 4) {
2966         print "   [NounDomain called at word ", wn, "]^";
2967         print "   ";
2968         if (indef_mode) {
2969             print "seeking indefinite object: ";
2970             if (indef_type & OTHER_BIT)  print "other ";
2971             if (indef_type & MY_BIT)     print "my ";
2972             if (indef_type & THAT_BIT)   print "that ";
2973             if (indef_type & PLURAL_BIT) print "plural ";
2974             if (indef_type & LIT_BIT)    print "lit ";
2975             if (indef_type & UNLIT_BIT)  print "unlit ";
2976             if (indef_owner ~= 0) print "owner:", (name) indef_owner;
2977             new_line;
2978             print "   number wanted: ";
2979             if (indef_wanted == 100) print "all"; else print indef_wanted;
2980             new_line;
2981             print "   most likely GNAs of names: ", indef_cases, "^";
2982         }
2983         else print "seeking definite object^";
2984     }
2985     #Endif; ! DEBUG
2986
2987     match_length = 0; number_matched = 0; match_from = wn; placed_in_flag = 0;
2988
2989     SearchScope(domain1, domain2, context);
2990
2991     #Ifdef DEBUG;
2992     if (parser_trace >= 4) print "   [NounDomain made ", number_matched, " matches]^";
2993     #Endif; ! DEBUG
2994
2995     wn = match_from+match_length;
2996
2997     ! If nothing worked at all, leave with the word marker skipped past the
2998     ! first unmatched word...
2999
3000     if (number_matched == 0) { wn++; rfalse; }
3001
3002     ! Suppose that there really were some words being parsed (i.e., we did
3003     ! not just infer).  If so, and if there was only one match, it must be
3004     ! right and we return it...
3005     if (match_from <= num_words) {
3006         if (number_matched == 1) {
3007             i=match_list-->0;
3008             if (indef_mode) {
3009                 if ((indef_type & LIT_BIT) && i hasnt light) rfalse;
3010                 if ((indef_type & UNLIT_BIT) && i has light) rfalse;
3011             }
3012             return i;
3013         }
3014
3015         ! ...now suppose that there was more typing to come, i.e. suppose that
3016         ! the user entered something beyond this noun.  If nothing ought to follow,
3017         ! then there must be a mistake, (unless what does follow is just a full
3018         ! stop, and or comma)
3019
3020         if (wn <= num_words) {
3021             i = NextWord(); wn--;
3022             if (i ~=  AND1__WD or AND2__WD or AND3__WD or comma_word
3023                    or THEN1__WD or THEN2__WD or THEN3__WD
3024                    or BUT1__WD or BUT2__WD or BUT3__WD) {
3025                 if (lookahead == ENDIT_TOKEN) rfalse;
3026             }
3027         }
3028     }
3029
3030     ! Now look for a good choice, if there's more than one choice...
3031
3032     number_of_classes = 0;
3033
3034     if (match_length == 0 && indef_mode && indef_wanted ~= 100)
3035         number_matched = 0;  ! ask question for 'take three'
3036     if (number_matched == 1) i = match_list-->0;
3037     if (number_matched > 1) {
3038         i = Adjudicate(context);
3039         if (i == -1) rfalse;
3040         if (i == 1) rtrue;       !  Adjudicate has made a multiple
3041                                  !  object, and we pass it on
3042     }
3043
3044     ! If i is non-zero here, one of two things is happening: either
3045     ! (a) an inference has been successfully made that object i is
3046     !     the intended one from the user's specification, or
3047     ! (b) the user finished typing some time ago, but we've decided
3048     !     on i because it's the only possible choice.
3049     ! In either case we have to keep the pattern up to date,
3050     ! note that an inference has been made and return.
3051     ! (Except, we don't note which of a pile of identical objects.)
3052
3053     if (i ~= 0) {
3054         if (dont_infer) return i;
3055         if (inferfrom == 0) inferfrom=pcount;
3056         pattern-->pcount = i;
3057         return i;
3058     }
3059
3060     ! If we get here, there was no obvious choice of object to make.  If in
3061     ! fact we've already gone past the end of the player's typing (which
3062     ! means the match list must contain every object in scope, regardless
3063     ! of its name), then it's foolish to give an enormous list to choose
3064     ! from - instead we go and ask a more suitable question...
3065
3066     if (match_from > num_words) jump Incomplete;
3067     return AskPlayer(context);
3068
3069     ! Now we come to the question asked when the input has run out
3070     ! and can't easily be guessed (eg, the player typed "take" and there
3071     ! were plenty of things which might have been meant).
3072
3073   .Incomplete;
3074
3075     if (best_etype == NOTHING_PE && pattern-->1 == 0) rfalse; ! for DROP when empty-handed
3076     if (context == CREATURE_TOKEN) L__M(##Miscellany, 48, actor);
3077     else                           L__M(##Miscellany, 49, actor);
3078
3079     #Ifdef TARGET_ZCODE;
3080     for (i=2 : i<INPUT_BUFFER_LEN : i++) buffer2->i = ' ';
3081     #Endif; ! TARGET_ZCODE
3082     answer_words = Keyboard(buffer2, parse2);
3083
3084     first_word = WordValue(1, parse2);
3085     #Ifdef LanguageIsVerb;
3086     if (first_word == 0) {
3087         j = wn; first_word = LanguageIsVerb(buffer2, parse2, 1); wn = j;
3088     }
3089     #Endif; ! LanguageIsVerb
3090
3091     ! Once again, if the reply looks like a command, give it to the
3092     ! parser to get on with and forget about the question...
3093
3094     ! Once again, if the reply looks like a command
3095     ! (that is, VERB ... or XXX,VERB ...), give it to the parser to get
3096     ! on with and forget about the question...
3097
3098     if (first_word) {
3099         if ((first_word->#dict_par1) & DICT_VERB) {
3100             CopyBuffer(buffer, buffer2);
3101             return REPARSE_CODE;
3102         }
3103         if (NumberWords(parse2) > 2) {
3104             j = WordValue(2, parse2);
3105             k = WordValue(3, parse2);
3106             if (j == ',//' && k && (k->#dict_par1) & DICT_VERB) {
3107                 CopyBuffer(buffer, buffer2);
3108                 return REPARSE_CODE;
3109             }
3110         }
3111     }
3112
3113     ! ...but if we have a genuine answer, then:
3114     !
3115     ! (1) we must glue in text suitable for anything that's been inferred.
3116
3117     if (inferfrom ~= 0) {
3118         for (j=inferfrom : j<pcount : j++) {
3119             if (pattern-->j == PATTERN_NULL) continue;
3120             i = WORDSIZE + GetKeyBufLength();
3121             SetKeyBufLength(i-WORDSIZE + 1);
3122             buffer->(i++) = ' ';
3123
3124             #Ifdef DEBUG;
3125             if (parser_trace >= 5) print "[Gluing in inference with pattern code ", pattern-->j, "]^";
3126             #Endif; ! DEBUG
3127
3128             ! Conveniently, parse2-->1 is the first word in both ZCODE and GLULX.
3129
3130             parse2-->1 = 0;
3131
3132             ! An inferred object.  Best we can do is glue in a pronoun.
3133             ! (This is imperfect, but it's very seldom needed anyway.)
3134
3135             if (pattern-->j >= 2 && pattern-->j < REPARSE_CODE) {
3136                 ! was the inference made from some noun words?
3137                 ! In which case, we can infer again.
3138                 if ((WordValue(NumberWords())->#dict_par1) & DICT_NOUN) continue;
3139                 PronounNotice(pattern-->j);
3140                 for (k=1 : k<=LanguagePronouns-->0 : k=k+3)
3141                     if (pattern-->j == LanguagePronouns-->(k+2)) {
3142                         parse2-->1 = LanguagePronouns-->k;
3143                         #Ifdef DEBUG;
3144                         if (parser_trace >= 5) print "[Using pronoun '", (address) parse2-->1, "']^";
3145                         #Endif; ! DEBUG
3146                         break;
3147                     }
3148             }
3149             else {
3150                 ! An inferred preposition.
3151                 parse2-->1 = No__Dword(pattern-->j - REPARSE_CODE);
3152                 #Ifdef DEBUG;
3153                 if (parser_trace >= 5) print "[Using preposition '", (address) parse2-->1, "']^";
3154                 #Endif; ! DEBUG
3155             }
3156
3157             ! parse2-->1 now holds the dictionary address of the word to glue in.
3158
3159             if (parse2-->1 ~= 0) {
3160                 k = buffer + i;
3161                 #Ifdef TARGET_ZCODE;
3162                 @output_stream 3 k;
3163                 print (address) parse2-->1;
3164                 @output_stream -3;
3165                 k = k-->0;
3166                 for (l=i : l<i+k : l++) buffer->l = buffer->(l+2);
3167                 #Ifnot; ! TARGET_GLULX
3168                 k = PrintAnyToArray(buffer+i, INPUT_BUFFER_LEN-i, parse2-->1);
3169                 l=l; ! suppress compiler warning
3170                 #Endif; ! TARGET_
3171                 i = i + k; SetKeyBufLength(i-WORDSIZE);
3172             }
3173         }
3174     }
3175
3176     ! (2) we must glue the newly-typed text onto the end.
3177
3178     i = WORDSIZE + GetKeyBufLength();
3179     buffer->(i++) = ' ';
3180     SetKeyBufLength(GetKeyBufLength()+1);
3181     for (j=0 : j<GetKeyBufLength(buffer2) : i++,j++) {
3182         buffer->i = buffer2->(j+WORDSIZE);
3183         SetKeyBufLength(GetKeyBufLength()+1);
3184         if (i-WORDSIZE == INPUT_BUFFER_LEN-1) break;
3185     }
3186
3187     ! (3) we fill up the buffer with spaces, which is unnecessary, but may
3188     !     help incorrectly-written interpreters to cope.
3189
3190     #Ifdef TARGET_ZCODE;
3191     for (: i<INPUT_BUFFER_LEN : i++) buffer->i = ' ';
3192     #Endif; ! TARGET_ZCODE
3193
3194     return REPARSE_CODE;
3195
3196 ]; ! end of NounDomain
3197
3198
3199 [ AskPlayer context  i j k l first_word answer_words marker;
3200     ! Now we print up the question, using the equivalence classes as worked
3201     ! out by Adjudicate() so as not to repeat ourselves on plural objects...
3202
3203     asking_player = true;
3204     if (context == CREATURE_TOKEN) L__M(##Miscellany, 45);
3205     else                           L__M(##Miscellany, 46);
3206
3207     j = number_of_classes; marker = 0;
3208     for (i=1 : i<=number_of_classes : i++) {
3209         while (((match_classes-->marker) ~= i) && ((match_classes-->marker) ~= -i)) marker++;
3210         k = match_list-->marker;
3211
3212         if (match_classes-->marker > 0) print (the) k; else print (a) k;
3213
3214         if (i < j-1)  print (string) COMMA__TX;
3215         if (i == j-1) print (SerialComma) j, (string) OR__TX;
3216     }
3217     L__M(##Miscellany, 57);
3218
3219     ! ...and get an answer:
3220
3221   .WhichOne;
3222     #Ifdef TARGET_ZCODE;
3223     for (i=WORDSIZE : i<INPUT_BUFFER_LEN : i++) buffer2->i = ' ';
3224     #Endif; ! TARGET_ZCODE
3225     answer_words = Keyboard(buffer2, parse2);
3226
3227     first_word = WordValue(1, parse2);
3228     asking_player = false;
3229
3230     ! Take care of "all", because that does something too clever here to do
3231     ! later on:
3232
3233     if (first_word == ALL1__WD or ALL2__WD or ALL3__WD or ALL4__WD or ALL5__WD) {
3234         if (context == MULTI_TOKEN or MULTIHELD_TOKEN or MULTIEXCEPT_TOKEN or MULTIINSIDE_TOKEN) {
3235             l = multiple_object-->0;
3236             for (i=0 : i<number_matched && l+i<63 : i++) {
3237                 k = match_list-->i;
3238                 multiple_object-->(i+1+l) = k;
3239             }
3240             multiple_object-->0 = i+l;
3241             rtrue;
3242         }
3243         L__M(##Miscellany, 47);
3244         jump WhichOne;
3245     }
3246
3247     ! If the first word of the reply can be interpreted as a verb, then
3248     ! assume that the player has ignored the question and given a new
3249     ! command altogether.
3250     ! (This is one time when it's convenient that the directions are
3251     ! not themselves verbs - thus, "north" as a reply to "Which, the north
3252     ! or south door" is not treated as a fresh command but as an answer.)
3253
3254     #Ifdef LanguageIsVerb;
3255     if (first_word == 0) {
3256         j = wn; first_word = LanguageIsVerb(buffer2, parse2, 1); wn = j;
3257     }
3258     #Endif; ! LanguageIsVerb
3259     if (first_word) {
3260         if (((first_word->#dict_par1) & DICT_VERB) && ~~LanguageVerbMayBeName(first_word)) {
3261             CopyBuffer(buffer, buffer2);
3262             return REPARSE_CODE;
3263         }
3264         if (NumberWords(parse2) > 2) {
3265             j = WordValue(2, parse2);
3266             k = WordValue(3, parse2);
3267             if (j == ',//' && k && (k->#dict_par1) & DICT_VERB) {
3268                 CopyBuffer(buffer, buffer2);
3269                 return REPARSE_CODE;
3270             }
3271         }
3272     }
3273
3274     ! Now we insert the answer into the original typed command, as
3275     ! words additionally describing the same object
3276     ! (eg, > take red button
3277     !      Which one, ...
3278     !      > music
3279     ! becomes "take music red button".  The parser will thus have three
3280     ! words to work from next time, not two.)
3281
3282     k = WordAddress(match_from) - buffer;
3283     l = GetKeyBufLength(buffer2) +1;
3284     for (j=buffer + INPUT_BUFFER_LEN - 1 : j>=buffer+k+l : j--) j->0 = j->(-l);
3285     for (i=0 : i<l : i++) buffer->(k+i) = buffer2->(WORDSIZE+i);
3286     buffer->(k+l-1) = ' ';
3287     SetKeyBufLength(GetKeyBufLength() + l);
3288
3289     ! Having reconstructed the input, we warn the parser accordingly
3290     ! and get out.
3291
3292     return REPARSE_CODE;
3293 ];
3294
3295
3296 ! ----------------------------------------------------------------------------
3297 !  The Adjudicate routine tries to see if there is an obvious choice, when
3298 !  faced with a list of objects (the match_list) each of which matches the
3299 !  player's specification equally well.
3300 !
3301 !  To do this it makes use of the context (the token type being worked on).
3302 !  It counts up the number of obvious choices for the given context
3303 !  (all to do with where a candidate is, except for 6 (animate) which is to
3304 !  do with whether it is animate or not);
3305 !
3306 !  if only one obvious choice is found, that is returned;
3307 !
3308 !  if we are in indefinite mode (don't care which) one of the obvious choices
3309 !    is returned, or if there is no obvious choice then an unobvious one is
3310 !    made;
3311 !
3312 !  at this stage, we work out whether the objects are distinguishable from
3313 !    each other or not: if they are all indistinguishable from each other,
3314 !    then choose one, it doesn't matter which;
3315 !
3316 !  otherwise, 0 (meaning, unable to decide) is returned (but remember that
3317 !    the equivalence classes we've just worked out will be needed by other
3318 !    routines to clear up this mess, so we can't economise on working them
3319 !    out).
3320 !
3321 !  Returns -1 if an error occurred
3322 ! ----------------------------------------------------------------------------
3323
3324 Constant SCORE__CHOOSEOBJ   = 1000;
3325 Constant SCORE__IFGOOD      = 500;
3326 Constant SCORE__UNCONCEALED = 100;
3327 Constant SCORE__BESTLOC     = 60;
3328 Constant SCORE__NEXTBESTLOC = 40;
3329 Constant SCORE__NOTCOMPASS  = 20;
3330 Constant SCORE__NOTSCENERY  = 10;
3331 Constant SCORE__NOTACTOR    = 5;
3332 Constant SCORE__GNA         = 1;
3333 Constant SCORE__DIVISOR     = 20;
3334
3335 [ Adjudicate context i j k good_flag good_ones last n flag offset sovert;
3336     #Ifdef DEBUG;
3337     if (parser_trace >= 4) {
3338         print "   [Adjudicating match list of size ", number_matched, " in context ", context, "]^";
3339         print "   ";
3340         if (indef_mode) {
3341             print "indefinite type: ";
3342             if (indef_type & OTHER_BIT)  print "other ";
3343             if (indef_type & MY_BIT)     print "my ";
3344             if (indef_type & THAT_BIT)   print "that ";
3345             if (indef_type & PLURAL_BIT) print "plural ";
3346             if (indef_type & LIT_BIT)    print "lit ";
3347             if (indef_type & UNLIT_BIT)  print "unlit ";
3348             if (indef_owner ~= 0) print "owner:", (name) indef_owner;
3349             new_line;
3350             print "   number wanted: ";
3351             if (indef_wanted == 100) print "all"; else print indef_wanted;
3352             new_line;
3353             print "   most likely GNAs of names: ", indef_cases, "^";
3354         }
3355         else print "definite object^";
3356     }
3357     #Endif; ! DEBUG
3358
3359     j = number_matched-1; good_ones = 0; last = match_list-->0;
3360     for (i=0 : i<=j : i++) {
3361         n = match_list-->i;
3362         match_scores-->i = 0;
3363
3364         good_flag = false;
3365
3366         switch (context) {
3367           HELD_TOKEN, MULTIHELD_TOKEN:
3368             if (parent(n) == actor) good_flag = true;
3369           MULTIEXCEPT_TOKEN:
3370             if (advance_warning == -1) {
3371                 good_flag = true;
3372             }
3373             else {
3374                 if (n ~= advance_warning) good_flag = true;
3375             }
3376           MULTIINSIDE_TOKEN:
3377             if (advance_warning == -1) {
3378                 if (parent(n) ~= actor) good_flag = true;
3379             }
3380             else {
3381                 if (n in advance_warning) good_flag = true;
3382             }
3383           CREATURE_TOKEN:
3384             if (CreatureTest(n) == 1) good_flag = true;
3385           default:
3386             good_flag = true;
3387         }
3388
3389         if (good_flag) {
3390             match_scores-->i = SCORE__IFGOOD;
3391             good_ones++; last = n;
3392         }
3393     }
3394     if (good_ones == 1) return last;
3395
3396     ! If there is ambiguity about what was typed, but it definitely wasn't
3397     ! animate as required, then return anything; higher up in the parser
3398     ! a suitable error will be given.  (This prevents a question being asked.)
3399
3400     if (context == CREATURE_TOKEN && good_ones == 0) return match_list-->0;
3401
3402     if (indef_mode == 0) indef_type=0;
3403
3404     ScoreMatchL(context);
3405     if (number_matched == 0) return -1;
3406
3407     if (indef_mode == 1 && indef_type & PLURAL_BIT ~= 0) {
3408         if (context ~= MULTI_TOKEN or MULTIHELD_TOKEN or MULTIEXCEPT_TOKEN
3409                      or MULTIINSIDE_TOKEN) {
3410             etype = MULTI_PE;
3411             return -1;
3412         }
3413         i = 0; offset = multiple_object-->0; sovert = -1;
3414         for (j=BestGuess() : j~=-1 && i<indef_wanted && i+offset<63 : j=BestGuess()) {
3415             flag = 1;
3416             if (j has concealed or worn) flag = 0;
3417             if (sovert == -1) sovert = bestguess_score/SCORE__DIVISOR;
3418             else {
3419                 if (indef_wanted == 100 && bestguess_score/SCORE__DIVISOR < sovert)
3420                     flag = 0;
3421             }
3422             if (context == MULTIHELD_TOKEN or MULTIEXCEPT_TOKEN && parent(j) ~= actor)
3423                 flag = 0;
3424             #Ifdef TRADITIONAL_TAKE_ALL;
3425             if (action_to_be == ##Take or ##Remove && parent(j) == actor)
3426                 flag = 0;
3427             #Ifnot;
3428             if (action_to_be == ##Take or ##Remove &&
3429                (j has animate or scenery or static || parent(j) == actor))
3430                 flag = 0;
3431             #Endif; ! TRADITIONAL_TAKE_ALL
3432             #Ifdef NO_TAKE_ALL;
3433             if (take_all_rule == 2 && match_length == 0) flag = 0;
3434             #Endif; ! NO_TAKE_ALL
3435             n = ChooseObjects(j, flag);
3436             if (n == 0) n = LibraryExtensions.RunWhile(ext_chooseobjects, 0, j, flag);
3437             switch (n) {
3438               2: flag = 0;  ! forcing rejection
3439               1: flag = 1;  ! forcing acceptance
3440              !0:            ! going with parser's decision
3441             }
3442             if (flag == 1) {
3443                 i++; multiple_object-->(i+offset) = j;
3444                 #Ifdef DEBUG;
3445                 if (parser_trace >= 4) print "   Accepting it^";
3446                 #Endif; ! DEBUG
3447             }
3448             else {
3449                 i = i;
3450                 #Ifdef DEBUG;
3451                 if (parser_trace >= 4) print "   Rejecting it^";
3452                 #Endif; ! DEBUG
3453             }
3454         }
3455         if (i < indef_wanted && indef_wanted < 100) {
3456             etype = TOOFEW_PE; multi_wanted = indef_wanted;
3457             multi_had=i;
3458             return -1;
3459         }
3460         multiple_object-->0 = i+offset;
3461         multi_context = context;
3462         #Ifdef DEBUG;
3463         if (parser_trace >= 4)
3464             print "   Made multiple object of size ", i, "]^";
3465         #Endif; ! DEBUG
3466         return 1;
3467     }
3468
3469     for (i=0 : i<number_matched : i++) match_classes-->i = 0;
3470
3471     n = 1;
3472     for (i=0 : i<number_matched : i++)
3473         if (match_classes-->i == 0) {
3474             match_classes-->i = n++; flag = 0;
3475             for (j=i+1 : j<number_matched : j++)
3476                 if (match_classes-->j == 0 && Identical(match_list-->i, match_list-->j) == 1) {
3477                     flag=1;
3478                     match_classes-->j = match_classes-->i;
3479                 }
3480             if (flag == 1) match_classes-->i = 1-n;
3481         }
3482      n--; number_of_classes = n;
3483
3484     #Ifdef DEBUG;
3485     if (parser_trace >= 4) {
3486         print "   Grouped into ", n, " possibilities by name:^";
3487         for (i=0 : i<number_matched : i++)
3488             if (match_classes-->i > 0)
3489                 print "   ", (The) match_list-->i, " (", match_list-->i, ")  ---  group ",
3490                   match_classes-->i, "^";
3491     }
3492     #Endif; ! DEBUG
3493     if (n == 1) dont_infer = true;
3494
3495     if (indef_mode == 0) {
3496         !  Is there now a single highest-scoring object?
3497         i = SingleBestGuess();
3498         if (i >= 0) {
3499
3500             #Ifdef DEBUG;
3501             if (parser_trace >= 4) print "   Single best-scoring object returned.]^";
3502             #Endif; ! DEBUG
3503             return i;
3504         }
3505     }
3506
3507     if (indef_mode == 0) {
3508         if (n > 1) {
3509             k = -1;
3510             for (i=0 : i<number_matched : i++) {
3511                 if (match_scores-->i > k) {
3512                     k = match_scores-->i;
3513                     j = match_classes-->i; j = j*j;
3514                     flag = 0;
3515                 }
3516                 else
3517                     if (match_scores-->i == k) {
3518                         if ((match_classes-->i) * (match_classes-->i) ~= j)
3519                             flag = 1;
3520                     }
3521             }
3522
3523         if (flag) {
3524             #Ifdef DEBUG;
3525             if (parser_trace >= 4) print "   Unable to choose best group, so ask player.]^";
3526             #Endif; ! DEBUG
3527             return 0;
3528         }
3529         #Ifdef DEBUG;
3530         if (parser_trace >= 4) print "   Best choices are all from the same group.^";
3531         #Endif; ! DEBUG
3532         }
3533     }
3534
3535     !  When the player is really vague, or there's a single collection of
3536     !  indistinguishable objects to choose from, choose the one the player
3537     !  most recently acquired, or if the player has none of them, then
3538     !  the one most recently put where it is.
3539
3540     return BestGuess();
3541
3542 ]; ! Adjudicate
3543
3544 ! ----------------------------------------------------------------------------
3545 !  ReviseMulti  revises the multiple object which already exists, in the
3546 !    light of information which has come along since then (i.e., the second
3547 !    parameter).  It returns a parser error number, or else 0 if all is well.
3548 !    This only ever throws things out, never adds new ones.
3549 ! ----------------------------------------------------------------------------
3550
3551 [ ReviseMulti second_p  i low;
3552     #Ifdef DEBUG;
3553     if (parser_trace >= 4) print "   Revising multiple object list of size ", multiple_object-->0,
3554       " with 2nd ", (name) second_p, "^";
3555     #Endif; ! DEBUG
3556
3557     if (multi_context == MULTIEXCEPT_TOKEN or MULTIINSIDE_TOKEN) {
3558         for (i=1,low=0 : i<=multiple_object-->0 : i++) {
3559             if ( (multi_context==MULTIEXCEPT_TOKEN && multiple_object-->i ~= second_p) ||
3560                  (multi_context==MULTIINSIDE_TOKEN && multiple_object-->i in second_p)) {
3561                 low++;
3562                 multiple_object-->low = multiple_object-->i;
3563             }
3564         }
3565         multiple_object-->0 = low;
3566     }
3567
3568     if (multi_context == MULTI_TOKEN && action_to_be == ##Take) {
3569         for (i=1,low=0 : i<=multiple_object-->0 : i++)
3570             if (ScopeCeiling(multiple_object-->i)==ScopeCeiling(actor)) low++;
3571         #Ifdef DEBUG;
3572         if (parser_trace >= 4) print "   Token 2 plural case: number with actor ", low, "^";
3573         #Endif; ! DEBUG
3574         if (take_all_rule == 2 || low > 0) {
3575             for (i=1,low=0 : i<=multiple_object-->0 : i++) {
3576                 if (ScopeCeiling(multiple_object-->i) == ScopeCeiling(actor)) {
3577                     low++;
3578                     multiple_object-->low = multiple_object-->i;
3579                 }
3580             }
3581             multiple_object-->0 = low;
3582         }
3583     }
3584
3585     i = multiple_object-->0;
3586     #Ifdef DEBUG;
3587     if (parser_trace >= 4) print "   Done: new size ", i, "^";
3588     #Endif; ! DEBUG
3589     if (i == 0) return NOTHING_PE;
3590     return 0;
3591 ];
3592
3593 ! ----------------------------------------------------------------------------
3594 !  ScoreMatchL  scores the match list for quality in terms of what the
3595 !  player has vaguely asked for.  Points are awarded for conforming with
3596 !  requirements like "my", and so on.  Remove from the match list any
3597 !  entries which fail the basic requirements of the descriptors.
3598 ! ----------------------------------------------------------------------------
3599
3600 [ ScoreMatchL context its_owner its_score obj i j threshold met a_s l_s;
3601 !   if (indef_type & OTHER_BIT ~= 0) threshold++;
3602     if (indef_type & MY_BIT ~= 0)    threshold++;
3603     if (indef_type & THAT_BIT ~= 0)  threshold++;
3604     if (indef_type & LIT_BIT ~= 0)   threshold++;
3605     if (indef_type & UNLIT_BIT ~= 0) threshold++;
3606     if (indef_owner ~= nothing)      threshold++;
3607
3608     #Ifdef DEBUG;
3609     if (parser_trace >= 4) print "   Scoring match list: indef mode ", indef_mode, " type ",
3610       indef_type, ", satisfying ", threshold, " requirements:^";
3611     #Endif; ! DEBUG
3612
3613     if (action_to_be ~= ##Take)
3614         a_s = SCORE__NEXTBESTLOC;
3615     l_s = SCORE__BESTLOC;
3616     if (context == HELD_TOKEN or MULTIHELD_TOKEN or MULTIEXCEPT_TOKEN) {
3617         a_s = SCORE__BESTLOC; l_s = SCORE__NEXTBESTLOC;
3618     }
3619
3620     for (i=0 : i<number_matched : i++) {
3621         obj = match_list-->i; its_owner = parent(obj); its_score=0; met=0;
3622
3623         !      if (indef_type & OTHER_BIT ~= 0
3624         !          &&  obj ~= itobj or himobj or herobj) met++;
3625         if (indef_type & MY_BIT ~= 0 && its_owner == actor) met++;
3626         if (indef_type & THAT_BIT ~= 0 && its_owner == actors_location) met++;
3627         if (indef_type & LIT_BIT ~= 0 && obj has light) met++;
3628         if (indef_type & UNLIT_BIT ~= 0 && obj hasnt light) met++;
3629         if (indef_owner ~= 0 && its_owner == indef_owner) met++;
3630
3631         if (met < threshold) {
3632             #Ifdef DEBUG;
3633             if (parser_trace >= 4) print "   ", (The) match_list-->i, " (", match_list-->i, ") in ",
3634               (the) its_owner, " is rejected (doesn't match descriptors)^";
3635             #Endif; ! DEBUG
3636             match_list-->i = -1;
3637         }
3638         else {
3639             its_score = 0;
3640             if (obj hasnt concealed) its_score = SCORE__UNCONCEALED;
3641
3642             if (its_owner == actor) its_score = its_score + a_s;
3643             else
3644                 if (its_owner == actors_location) its_score = its_score + l_s;
3645                 else {
3646                     #Ifdef TRADITIONAL_TAKE_ALL;
3647                     if (its_owner ~= compass) its_score = its_score + SCORE__NOTCOMPASS;
3648                     #Ifnot;
3649                     if (its_owner ~= compass)
3650                         if (take_all_rule && its_owner &&
3651                             its_owner has static or scenery &&
3652                               (its_owner has supporter ||
3653                               (its_owner has container && its_owner has open)))
3654                             its_score = its_score + l_s;
3655                     else
3656                             its_score = its_score + SCORE__NOTCOMPASS;
3657                     #Endif; ! TRADITIONAL_TAKE_ALL
3658                 }
3659             j = ChooseObjects(obj, 2);
3660             if (j == 0) j = LibraryExtensions.RunAll(ext_chooseobjects, obj, 2);
3661             its_score = its_score + SCORE__CHOOSEOBJ * j;
3662
3663             if (obj hasnt scenery) its_score = its_score + SCORE__NOTSCENERY;
3664             if (obj ~= actor) its_score = its_score + SCORE__NOTACTOR;
3665
3666             !   A small bonus for having the correct GNA,
3667             !   for sorting out ambiguous articles and the like.
3668
3669             if (indef_cases & (PowersOfTwo_TB-->(GetGNAOfObject(obj))))
3670                 its_score = its_score + SCORE__GNA;
3671
3672             match_scores-->i = match_scores-->i + its_score;
3673             #Ifdef DEBUG;
3674             if (parser_trace >= 4) print "     ", (The) match_list-->i, " (", match_list-->i,
3675               ") in ", (the) its_owner, " : ", match_scores-->i, " points^";
3676             #Endif; ! DEBUG
3677         }
3678      }
3679
3680     for (i=0 : i<number_matched : i++) {
3681         while (match_list-->i == -1) {
3682             if (i == number_matched-1) { number_matched--; break; }
3683             for (j=i : j<number_matched-1 : j++) {
3684                 match_list-->j = match_list-->(j+1);
3685                 match_scores-->j = match_scores-->(j+1);
3686             }
3687             number_matched--;
3688         }
3689     }
3690 ];
3691
3692 ! ----------------------------------------------------------------------------
3693 !  BestGuess makes the best guess it can out of the match list, assuming that
3694 !  everything in the match list is textually as good as everything else;
3695 !  however it ignores items marked as -1, and so marks anything it chooses.
3696 !  It returns -1 if there are no possible choices.
3697 ! ----------------------------------------------------------------------------
3698
3699 [ BestGuess  earliest its_score best i;
3700     earliest = 0; best = -1;
3701     for (i=0 : i<number_matched : i++) {
3702         if (match_list-->i >= 0) {
3703             its_score = match_scores-->i;
3704             if (its_score > best) { best = its_score; earliest = i; }
3705         }
3706     }
3707     #Ifdef DEBUG;
3708     if (parser_trace >= 4)
3709       if (best < 0) print "   Best guess ran out of choices^";
3710       else print "   Best guess ", (the) match_list-->earliest, " (", match_list-->earliest, ")^";
3711     #Endif; ! DEBUG
3712     if (best < 0) return -1;
3713     i = match_list-->earliest;
3714     match_list-->earliest = -1;
3715     bestguess_score = best;
3716     return i;
3717 ];
3718
3719 ! ----------------------------------------------------------------------------
3720 !  SingleBestGuess returns the highest-scoring object in the match list
3721 !  if it is the clear winner, or returns -1 if there is no clear winner
3722 ! ----------------------------------------------------------------------------
3723
3724 [ SingleBestGuess  earliest its_score best i;
3725     earliest = -1; best = -1000;
3726     for (i=0 : i<number_matched : i++) {
3727         its_score = match_scores-->i;
3728         if (its_score == best) earliest = -1;
3729         if (its_score > best) { best = its_score; earliest = match_list-->i; }
3730     }
3731     bestguess_score = best;
3732     return earliest;
3733 ];
3734
3735 ! ----------------------------------------------------------------------------
3736 !  Identical decides whether or not two objects can be distinguished from
3737 !  each other by anything the player can type.  If not, it returns true.
3738 ! ----------------------------------------------------------------------------
3739
3740 [ Identical o1 o2 p1 p2 n1 n2 i j flag;
3741     if (o1 == o2) rtrue;  ! This should never happen, but to be on the safe side
3742     if (o1 == 0 || o2 == 0) rfalse;  ! Similarly
3743     if (parent(o1) == compass || parent(o2) == compass) rfalse; ! Saves time
3744
3745     !  What complicates things is that o1 or o2 might have a parsing routine,
3746     !  so the parser can't know from here whether they are or aren't the same.
3747     !  If they have different parsing routines, we simply assume they're
3748     !  different.  If they have the same routine (which they probably got from
3749     !  a class definition) then the decision process is as follows:
3750     !
3751     !     the routine is called (with self being o1, not that it matters)
3752     !       with noun and second being set to o1 and o2, and action being set
3753     !       to the fake action TheSame.  If it returns -1, they are found
3754     !       identical; if -2, different; and if >=0, then the usual method
3755     !       is used instead.
3756
3757     if (o1.parse_name ~= 0 || o2.parse_name ~= 0) {
3758       if (o1.parse_name ~= o2.parse_name) rfalse;
3759       parser_action = ##TheSame; parser_one = o1; parser_two = o2;
3760       j = wn; i = RunRoutines(o1,parse_name); wn = j;
3761       if (i == -1) rtrue;
3762       if (i == -2) rfalse;
3763     }
3764
3765     !  This is the default algorithm: do they have the same words in their
3766     !  "name" (i.e. property no. 1) properties.  (Note that the following allows
3767     !  for repeated words and words in different orders.)
3768
3769     p1 = o1.&1; n1 = (o1.#1)/WORDSIZE;
3770     p2 = o2.&1; n2 = (o2.#1)/WORDSIZE;
3771
3772     !  for (i=0 : i<n1 : i++) { print (address) p1-->i, " "; } new_line;
3773     !  for (i=0 : i<n2 : i++) { print (address) p2-->i, " "; } new_line;
3774
3775     for (i=0 : i<n1 : i++) {
3776         flag = 0;
3777         for (j=0 : j<n2 : j++)
3778             if (p1-->i == p2-->j) flag = 1;
3779         if (flag == 0) rfalse;
3780     }
3781
3782     for (j=0 : j<n2 : j++) {
3783         flag = 0;
3784         for (i=0 : i<n1 : i++)
3785             if (p1-->i == p2-->j) flag = 1;
3786         if (flag == 0) rfalse;
3787     }
3788
3789     !  print "Which are identical!^";
3790     rtrue;
3791 ];
3792
3793 ! ----------------------------------------------------------------------------
3794 !  PrintCommand reconstructs the command as it presently reads, from
3795 !  the pattern which has been built up
3796 !
3797 !  If from is 0, it starts with the verb: then it goes through the pattern.
3798 !  The other parameter is "emptyf" - a flag: if 0, it goes up to pcount:
3799 !  if 1, it goes up to pcount-1.
3800 !
3801 !  Note that verbs and prepositions are printed out of the dictionary:
3802 !  and that since the dictionary may only preserve the first six characters
3803 !  of a word (in a V3 game), we have to hand-code the longer words needed.
3804 !
3805 !  (Recall that pattern entries are 0 for "multiple object", 1 for "special
3806 !  word", 2 to REPARSE_CODE-1 are object numbers and REPARSE_CODE+n means the
3807 !  preposition n)
3808 ! ----------------------------------------------------------------------------
3809
3810 [ PrintCommand from i k spacing_flag;
3811     #Ifdef LanguageCommand;
3812     LanguageCommand(from);
3813     i = k = spacing_flag = 0;   ! suppress warning
3814     #Ifnot;
3815     if (from == 0) {
3816         i = verb_word;
3817         if (LanguageVerb(i) == 0 && PrintVerb(i) == false && LibraryExtensions.RunWhile(ext_printverb, false, i) == 0)
3818             print (address) i;
3819         from++; spacing_flag = true;
3820     }
3821
3822     for (k=from : k<pcount : k++) {
3823         i = pattern-->k;
3824         if (i == PATTERN_NULL) continue;
3825         if (spacing_flag) print (char) ' ';
3826         if (i == 0) { print (string) THOSET__TX; jump TokenPrinted; }
3827         if (i == 1) { print (string) THAT__TX;   jump TokenPrinted; }
3828         if (i >= REPARSE_CODE)
3829             print (address) No__Dword(i-REPARSE_CODE);
3830         else
3831             if (i in compass && LanguageVerbLikesAdverb(verb_word))
3832                 LanguageDirection (i.door_dir); ! the direction name as adverb
3833             else
3834                 print (the) i;
3835       .TokenPrinted;
3836         spacing_flag = true;
3837     }
3838     #Endif; ! LanguageCommand
3839 ];
3840
3841 ! ----------------------------------------------------------------------------
3842 !  The CantSee routine returns a good error number for the situation where
3843 !  the last word looked at didn't seem to refer to any object in context.
3844 !
3845 !  The idea is that: if the actor is in a location (but not inside something
3846 !  like, for instance, a tank which is in that location) then an attempt to
3847 !  refer to one of the words listed as meaningful-but-irrelevant there
3848 !  will cause "you don't need to refer to that in this game" rather than
3849 !  "no such thing" or "what's 'it'?".
3850 !  (The advantage of not having looked at "irrelevant" local nouns until now
3851 !  is that it stops them from clogging up the ambiguity-resolving process.
3852 !  Thus game objects always triumph over scenery.)
3853 ! ----------------------------------------------------------------------------
3854
3855 [ CantSee  i w e;
3856     if (scope_token ~= 0) {
3857         scope_error = scope_token;
3858         return ASKSCOPE_PE;
3859     }
3860
3861     wn--; w = NextWord();
3862     e = CANTSEE_PE;
3863     if (w == pronoun_word) {
3864         pronoun__word = pronoun_word; pronoun__obj = pronoun_obj;
3865         e = ITGONE_PE;
3866     }
3867     i = actor; while (parent(i) ~= 0) i = parent(i);
3868
3869     wn--;
3870     if (i has visited && Refers(i,wn) == 1) e = SCENERY_PE;
3871     else {
3872         Descriptors();  ! skip past THE etc
3873         if (i has visited && Refers(i,wn) == 1) e = SCENERY_PE;
3874     }
3875
3876     if (saved_ml)
3877         saved_oops = num_desc + match_from + saved_ml;
3878     else
3879         saved_oops = num_desc + match_from + match_length;
3880
3881     wn++;
3882     return e;
3883 ];
3884
3885 ! ----------------------------------------------------------------------------
3886 !  The MultiAdd routine adds object "o" to the multiple-object-list.
3887 !
3888 !  This is only allowed to hold 63 objects at most, at which point it ignores
3889 !  any new entries (and sets a global flag so that a warning may later be
3890 !  printed if need be).
3891 ! ----------------------------------------------------------------------------
3892
3893 [ MultiAdd o i j;
3894     i = multiple_object-->0;
3895     if (i == 63) { toomany_flag = 1; rtrue; }
3896     for (j=1 : j<=i : j++)
3897         if (o == multiple_object-->j) rtrue;
3898     i++;
3899     multiple_object-->i = o;
3900     multiple_object-->0 = i;
3901 ];
3902
3903 ! ----------------------------------------------------------------------------
3904 !  The MultiSub routine deletes object "o" from the multiple-object-list.
3905 !
3906 !  It returns 0 if the object was there in the first place, and 9 (because
3907 !  this is the appropriate error number in Parser()) if it wasn't.
3908 ! ----------------------------------------------------------------------------
3909
3910 [ MultiSub o i j k et;
3911     i = multiple_object-->0; et = 0;
3912     for (j=1 : j<=i : j++)
3913         if (o == multiple_object-->j) {
3914             for (k=j : k<=i : k++)
3915                 multiple_object-->k = multiple_object-->(k+1);
3916             multiple_object-->0 = --i;
3917             return et;
3918         }
3919     et = 9; return et;
3920 ];
3921
3922 ! ----------------------------------------------------------------------------
3923 !  The MultiFilter routine goes through the multiple-object-list and throws
3924 !  out anything without the given attribute "attr" set.
3925 ! ----------------------------------------------------------------------------
3926
3927 [ MultiFilter attr  i j o;
3928
3929   .MFiltl;
3930
3931     i = multiple_object-->0;
3932     for (j=1 : j<=i : j++) {
3933         o = multiple_object-->j;
3934         if (o hasnt attr) {
3935             MultiSub(o);
3936             jump Mfiltl;
3937         }
3938     }
3939 ];
3940
3941 ! ----------------------------------------------------------------------------
3942 !  The UserFilter routine consults the user's filter (or checks on attribute)
3943 !  to see what already-accepted nouns are acceptable
3944 ! ----------------------------------------------------------------------------
3945
3946 [ UserFilter obj;
3947     if (token_filter > 0 && token_filter < 49) {
3948         if (obj has (token_filter-1)) rtrue;
3949         rfalse;
3950     }
3951     noun = obj;
3952     return token_filter();
3953 ];
3954
3955 ! ----------------------------------------------------------------------------
3956 !  MoveWord copies word at2 from parse buffer b2 to word at1 in "parse"
3957 !  (the main parse buffer)
3958 ! ----------------------------------------------------------------------------
3959
3960 #Ifdef TARGET_ZCODE;
3961
3962 [ MoveWord at1 b2 at2 x y;
3963     x = at1*2-1; y = at2*2-1;
3964     parse-->x++ = b2-->y++;
3965     parse-->x = b2-->y;
3966 ];
3967
3968 #Ifnot; ! TARGET_GLULX
3969
3970 [ MoveWord at1 b2 at2 x y;
3971     x = at1*3-2; y = at2*3-2;
3972     parse-->x++ = b2-->y++;
3973     parse-->x++ = b2-->y++;
3974     parse-->x = b2-->y;
3975 ];
3976
3977 #Endif; ! TARGET_
3978
3979 ! ----------------------------------------------------------------------------
3980 !  SearchScope  domain1 domain2 context
3981 !
3982 !  Works out what objects are in scope (possibly asking an outside routine),
3983 !  but does not look at anything the player has typed.
3984 ! ----------------------------------------------------------------------------
3985
3986 [ SearchScope domain1 domain2 context i is;
3987     i = 0;
3988     !  Everything is in scope to the debugging commands
3989
3990     #Ifdef DEBUG;
3991     if (scope_reason == PARSING_REASON
3992         && LanguageVerbIsDebugging(verb_word)) {
3993
3994         #Ifdef TARGET_ZCODE;
3995         for (i=selfobj : i<=top_object : i++)
3996             if (i ofclass Object && (parent(i) == 0 || parent(i) ofclass Object))
3997                 PlaceInScope(i);
3998         #Ifnot; ! TARGET_GLULX
3999         objectloop (i)
4000             if (i ofclass Object && (parent(i) == 0 || parent(i) ofclass Object))
4001                 PlaceInScope(i);
4002         #Endif; ! TARGET_
4003         rtrue;
4004     }
4005     #Endif; ! DEBUG
4006
4007     ! First, a scope token gets priority here:
4008
4009     if (scope_token ~= 0) {
4010         scope_stage = 2;
4011         if (scope_token()) rtrue;
4012     }
4013
4014     ! Pick up everything in the location except the actor's possessions;
4015     ! then go through those.  (This ensures the actor's possessions are in
4016     ! scope even in Darkness.)
4017
4018     if (context == MULTIINSIDE_TOKEN && advance_warning ~= -1) {
4019         if (IsSeeThrough(advance_warning) == 1)
4020            ScopeWithin(advance_warning, 0, context);
4021     }
4022     else {
4023         ! Next, call any user-supplied routine adding things to the scope,
4024         ! which may circumvent the usual routines altogether
4025         ! if they return true:
4026
4027         if (actor == domain1 or domain2) {
4028             is = InScope(actor);
4029             if (is == false) is = LibraryExtensions.RunWhile(ext_inscope, false, actor);
4030             if (is) rtrue;
4031         }
4032
4033         if (domain1 ~= 0 && domain1 has supporter or container)
4034             ScopeWithin_O(domain1, domain1, context);
4035         ScopeWithin(domain1, domain2, context);
4036         if (domain2 ~= 0 && domain2 has supporter or container)
4037             ScopeWithin_O(domain2, domain2, context);
4038         ScopeWithin(domain2, 0, context);
4039     }
4040
4041     ! A special rule applies:
4042     ! in Darkness as in light, the actor is always in scope to himself.
4043
4044     if (thedark == domain1 or domain2) {
4045         ScopeWithin_O(actor, actor, context);
4046         if (parent(actor) has supporter or container)
4047             ScopeWithin_O(parent(actor), parent(actor), context);
4048     }
4049 ];
4050
4051 ! ----------------------------------------------------------------------------
4052 !  IsSeeThrough is used at various places: roughly speaking, it determines
4053 !  whether o being in scope means that the contents of o are in scope.
4054 ! ----------------------------------------------------------------------------
4055
4056 [ IsSeeThrough o;
4057     if (o has supporter or transparent ||
4058        (o has container && o has open))
4059         rtrue;
4060     rfalse;
4061 ];
4062
4063 ! ----------------------------------------------------------------------------
4064 !  PlaceInScope is provided for routines outside the library, and is not
4065 !  called within the parser (except for debugging purposes).
4066 ! ----------------------------------------------------------------------------
4067
4068 [ PlaceInScope thing;
4069     if (scope_reason~=PARSING_REASON or TALKING_REASON) {
4070         DoScopeAction(thing); rtrue;
4071     }
4072     wn = match_from; TryGivenObject(thing); placed_in_flag = 1;
4073 ];
4074
4075 ! ----------------------------------------------------------------------------
4076 !  DoScopeAction
4077 ! ----------------------------------------------------------------------------
4078
4079 [ DoScopeAction thing s p1;
4080     s = scope_reason; p1 = parser_one;
4081     #Ifdef DEBUG;
4082     if (parser_trace >= 6)
4083         print "[DSA on ", (the) thing, " with reason = ", scope_reason,
4084             " p1 = ", parser_one, " p2 = ", parser_two, "]^";
4085     #Endif; ! DEBUG
4086     switch (scope_reason) {
4087       REACT_BEFORE_REASON:
4088         if (thing.react_before == 0 or NULL) return;
4089         #Ifdef DEBUG;
4090         if (parser_trace >= 2)
4091               print "[Considering react_before for ", (the) thing, "]^";
4092         #Endif; ! DEBUG
4093         if (parser_one == 0) parser_one = RunRoutines(thing, react_before);
4094       REACT_AFTER_REASON:
4095         if (thing.react_after == 0 or NULL) return;
4096         #Ifdef DEBUG;
4097         if (parser_trace >= 2)
4098             print "[Considering react_after for ", (the) thing, "]^";
4099         #Endif; ! DEBUG
4100         if (parser_one == 0) parser_one = RunRoutines(thing, react_after);
4101       EACH_TURN_REASON:
4102         if (thing.each_turn == 0) return;
4103         #Ifdef DEBUG;
4104         if (parser_trace >= 2)
4105               print "[Considering each_turn for ", (the) thing, "]^";
4106         #Endif; ! DEBUG
4107         PrintOrRun(thing, each_turn);
4108       TESTSCOPE_REASON:
4109         if (thing == parser_one) parser_two = 1;
4110       LOOPOVERSCOPE_REASON:
4111         parser_one(thing);
4112         parser_one=p1;
4113     }
4114     scope_reason = s;
4115 ];
4116
4117 ! ----------------------------------------------------------------------------
4118 !  ScopeWithin looks for objects in the domain which make textual sense
4119 !  and puts them in the match list.  (However, it does not recurse through
4120 !  the second argument.)
4121 ! ----------------------------------------------------------------------------
4122
4123 [ ScopeWithin domain nosearch context x y;
4124     if (domain == 0) rtrue;
4125
4126     ! Special rule: the directions (interpreted as the 12 walls of a room) are
4127     ! always in context.  (So, e.g., "examine north wall" is always legal.)
4128     ! (Unless we're parsing something like "all", because it would just slow
4129     ! things down then, or unless the context is "creature".)
4130
4131     if (indef_mode==0 && domain==actors_location
4132         && scope_reason==PARSING_REASON && context~=CREATURE_TOKEN)
4133             ScopeWithin(compass);
4134
4135     ! Look through the objects in the domain, avoiding "objectloop" in case
4136     ! movements occur, e.g. when trying each_turn.
4137
4138     x = child(domain);
4139     while (x ~= 0) {
4140         y = sibling(x);
4141         ScopeWithin_O(x, nosearch, context);
4142         x = y;
4143     }
4144 ];
4145
4146 [ ScopeWithin_O domain nosearch context i ad n;
4147
4148     ! If the scope reason is unusual, don't parse.
4149
4150     if (scope_reason ~= PARSING_REASON or TALKING_REASON) {
4151         DoScopeAction(domain);
4152         jump DontAccept;
4153     }
4154
4155     ! "it" or "them" matches to the it-object only.  (Note that (1) this means
4156     ! that "it" will only be understood if the object in question is still
4157     ! in context, and (2) only one match can ever be made in this case.)
4158
4159     if (match_from <= num_words) {  ! If there's any text to match, that is
4160         wn = match_from;
4161         i = NounWord();
4162         if (i == 1 && player == domain) MakeMatch(domain, 1);
4163         if (i >= 2 && i < 128 && (LanguagePronouns-->i == domain)) MakeMatch(domain, 1);
4164     }
4165
4166     ! Construing the current word as the start of a noun, can it refer to the
4167     ! object?
4168
4169     wn = match_from;
4170     if (TryGivenObject(domain) > 0)
4171         if (indef_nspec_at > 0 && match_from ~= indef_nspec_at) {
4172             ! This case arises if the player has typed a number in
4173             ! which is hypothetically an indefinite descriptor:
4174             ! e.g. "take two clubs".  We have just checked the object
4175             ! against the word "clubs", in the hope of eventually finding
4176             ! two such objects.  But we also backtrack and check it
4177             ! against the words "two clubs", in case it turns out to
4178             ! be the 2 of Clubs from a pack of cards, say.  If it does
4179             ! match against "two clubs", we tear up our original
4180             ! assumption about the meaning of "two" and lapse back into
4181             ! definite mode.
4182
4183             wn = indef_nspec_at;
4184             if (TryGivenObject(domain) > 0) {
4185                 match_from = indef_nspec_at;
4186                 ResetDescriptors();
4187             }
4188             wn = match_from;
4189         }
4190
4191   .DontAccept;
4192
4193     ! Shall we consider the possessions of the current object, as well?
4194     ! Only if it's a container (so, for instance, if a dwarf carries a
4195     ! sword, then "drop sword" will not be accepted, but "dwarf, drop sword"
4196     ! will).
4197     ! Also, only if there are such possessions.
4198     !
4199     ! Notice that the parser can see "into" anything flagged as
4200     ! transparent - such as a dwarf whose sword you can get at.
4201
4202     if (child(domain) ~= 0 && domain ~= nosearch && IsSeeThrough(domain) == 1)
4203         ScopeWithin(domain,nosearch,context);
4204
4205     ! Drag any extras into context
4206
4207     ad = domain.&add_to_scope;
4208     if (ad ~= 0) {
4209
4210         ! Test if the property value is not an object.
4211         #Ifdef TARGET_ZCODE;
4212         i = (UnsignedCompare(ad-->0, top_object) > 0);
4213         #Ifnot; ! TARGET_GLULX
4214         i = (((ad-->0)->0) ~= $70);
4215         #Endif; ! TARGET_
4216
4217         if (i) {
4218             ats_flag = 2+context;
4219             RunRoutines(domain, add_to_scope);
4220             ats_flag = 0;
4221         }
4222         else {
4223             n = domain.#add_to_scope;
4224             for (i=0 : (WORDSIZE*i)<n : i++)
4225                 if (ad-->i)
4226                     ScopeWithin_O(ad-->i, 0, context);
4227         }
4228     }
4229 ];
4230
4231 [ AddToScope obj;
4232     if (ats_flag >= 2)
4233         ScopeWithin_O(obj, 0, ats_flag-2);
4234     if (ats_flag == 1) {
4235         if  (HasLightSource(obj)==1) ats_hls = 1;
4236     }
4237 ];
4238
4239 ! ----------------------------------------------------------------------------
4240 !  MakeMatch looks at how good a match is.  If it's the best so far, then
4241 !  wipe out all the previous matches and start a new list with this one.
4242 !  If it's only as good as the best so far, add it to the list.
4243 !  If it's worse, ignore it altogether.
4244 !
4245 !  The idea is that "red panic button" is better than "red button" or "panic".
4246 !
4247 !  number_matched (the number of words matched) is set to the current level
4248 !  of quality.
4249 !
4250 !  We never match anything twice, and keep at most 64 equally good items.
4251 ! ----------------------------------------------------------------------------
4252
4253 [ MakeMatch obj quality i;
4254     #Ifdef DEBUG;
4255     if (parser_trace >= 6) print "    Match with quality ",quality,"^";
4256     #Endif; ! DEBUG
4257     if (token_filter ~= 0 && UserFilter(obj) == 0) {
4258         #Ifdef DEBUG;
4259         if (parser_trace >= 6) print "    Match filtered out: token filter ", token_filter, "^";
4260         #Endif; ! DEBUG
4261         rtrue;
4262     }
4263     if (quality < match_length) rtrue;
4264     if (quality > match_length) { match_length = quality; number_matched = 0; }
4265     else {
4266         if (number_matched >= MATCH_LIST_SIZE) rtrue;
4267         for (i=0 : i<number_matched : i++)
4268             if (match_list-->i == obj) rtrue;
4269     }
4270     match_list-->number_matched++ = obj;
4271     #Ifdef DEBUG;
4272     if (parser_trace >= 6) print "    Match added to list^";
4273     #Endif; ! DEBUG
4274 ];
4275
4276 ! ----------------------------------------------------------------------------
4277 !  TryGivenObject tries to match as many words as possible in what has been
4278 !  typed to the given object, obj.  If it manages any words matched at all,
4279 !  it calls MakeMatch to say so, then returns the number of words (or 1
4280 !  if it was a match because of inadequate input).
4281 ! ----------------------------------------------------------------------------
4282
4283 [ TryGivenObject obj threshold k w j;
4284     #Ifdef DEBUG;
4285     if (parser_trace >= 5) print "    Trying ", (the) obj, " (", obj, ") at word ", wn, "^";
4286     #Endif; ! DEBUG
4287
4288     dict_flags_of_noun = 0;
4289
4290     !  If input has run out then always match, with only quality 0 (this saves
4291     !  time).
4292
4293     if (wn > num_words) {
4294         if (indef_mode ~= 0)
4295             dict_flags_of_noun = DICT_X654;  ! Reject "plural" bit
4296         MakeMatch(obj,0);
4297         #Ifdef DEBUG;
4298         if (parser_trace >= 5) print "    Matched (0)^";
4299         #Endif; ! DEBUG
4300         return 1;
4301     }
4302
4303     !  Ask the object to parse itself if necessary, sitting up and taking notice
4304     !  if it says the plural was used:
4305
4306     if (obj.parse_name~=0) {
4307         parser_action = NULL; j=wn;
4308         k = RunRoutines(obj,parse_name);
4309         if (k > 0) {
4310             wn=j+k;
4311
4312           .MMbyPN;
4313
4314             if (parser_action == ##PluralFound)
4315                 dict_flags_of_noun = dict_flags_of_noun | DICT_PLUR;
4316
4317             if (dict_flags_of_noun & DICT_PLUR) {
4318                 if (~~allow_plurals) k = 0;
4319                 else {
4320                     if (indef_mode == 0) {
4321                         indef_mode = 1; indef_type = 0; indef_wanted = 0;
4322                     }
4323                     indef_type = indef_type | PLURAL_BIT;
4324                     if (indef_wanted == 0) indef_wanted = 100;
4325                 }
4326             }
4327
4328             #Ifdef DEBUG;
4329             if (parser_trace >= 5) print "    Matched (", k, ")^";
4330             #Endif; ! DEBUG
4331             MakeMatch(obj,k);
4332             return k;
4333         }
4334         if (k == 0) jump NoWordsMatch;
4335         wn = j;
4336     }
4337
4338     ! The default algorithm is simply to count up how many words pass the
4339     ! Refers test:
4340
4341     parser_action = NULL;
4342
4343     w = NounWord();
4344
4345     if (w == 1 && player == obj) { k=1; jump MMbyPN; }
4346
4347     if (w >= 2 && w < 128 && (LanguagePronouns-->w == obj)) { k = 1; jump MMbyPN; }
4348
4349     j = --wn;
4350     threshold = ParseNoun(obj);
4351     if (threshold == -1) {
4352         LibraryExtensions.ext_number_1 = wn;    ! Set the "between calls" functionality to
4353         LibraryExtensions.BetweenCalls = LibraryExtensions.RestoreWN;
4354         threshold = LibraryExtensions.RunWhile(ext_parsenoun, -1, obj);
4355         LibraryExtensions.BetweenCalls = 0;     ! Turn off the "between calls" functionality
4356     }
4357     #Ifdef DEBUG;
4358     if (threshold >= 0 && parser_trace >= 5) print "    ParseNoun returned ", threshold, "^";
4359     #Endif; ! DEBUG
4360     if (threshold < 0) wn++;
4361     if (threshold > 0) { k = threshold; jump MMbyPN; }
4362
4363     if (threshold == 0 || Refers(obj,wn-1) == 0) {
4364       .NoWordsMatch;
4365         if (indef_mode ~= 0) {
4366             k = 0; parser_action = NULL;
4367             jump MMbyPN;
4368         }
4369         rfalse;
4370     }
4371
4372     if (threshold < 0) {
4373         threshold = 1;
4374         dict_flags_of_noun = (w->#dict_par1) & (DICT_X654+DICT_PLUR);!$$01110100;
4375         w = NextWord();
4376         while (Refers(obj, wn-1)) {
4377             threshold++;
4378             if (w)
4379                dict_flags_of_noun = dict_flags_of_noun | ((w->#dict_par1) & (DICT_X654+DICT_PLUR));
4380             w = NextWord();
4381         }
4382     }
4383
4384     k = threshold;
4385     jump MMbyPN;
4386 ];
4387
4388 ! ----------------------------------------------------------------------------
4389 !  Refers works out whether the word at number wnum can refer to the object
4390 !  obj, returning true or false.  The standard method is to see if the
4391 !  word is listed under "name" for the object, but this is more complex
4392 !  in languages other than English.
4393 ! ----------------------------------------------------------------------------
4394
4395 [ Refers obj wnum   wd k l m;
4396     if (obj == 0) rfalse;
4397
4398     #Ifdef LanguageRefers;
4399     k = LanguageRefers(obj,wnum); if (k >= 0) return k;
4400     #Endif; ! LanguageRefers
4401
4402     k = wn; wn = wnum; wd = NextWordStopped(); wn = k;
4403
4404     if (parser_inflection_func) {
4405         k = parser_inflection(obj, wd);
4406         if (k >= 0) return k;
4407         m = -k;
4408     }
4409     else
4410         m = parser_inflection;
4411
4412     k = obj.&m; l = (obj.#m)/WORDSIZE-1;
4413     for (m=0 : m<=l : m++)
4414         if (wd == k-->m) rtrue;
4415     rfalse;
4416 ];
4417
4418 [ WordInProperty wd obj prop k l m;
4419     k = obj.&prop; l = (obj.#prop)/WORDSIZE-1;
4420     for (m=0 : m<=l : m++)
4421         if (wd == k-->m) rtrue;
4422     rfalse;
4423 ];
4424
4425 [ DictionaryLookup b l i;
4426     for (i=0 : i<l : i++) buffer2->(WORDSIZE+i) = b->i;
4427     SetKeyBufLength(l, buffer2);
4428     Tokenise__(buffer2, parse2);
4429     return parse2-->1;
4430 ];
4431
4432 ! ----------------------------------------------------------------------------
4433 !  NounWord (which takes no arguments) returns:
4434 !
4435 !   0  if the next word is unrecognised or does not carry the "noun" bit in
4436 !      its dictionary entry,
4437 !   1  if a word meaning "me",
4438 !   the index in the pronoun table (plus 2) of the value field of a pronoun,
4439 !      if the word is a pronoun,
4440 !   the address in the dictionary if it is a recognised noun.
4441 !
4442 !  The "current word" marker moves on one.
4443 ! ----------------------------------------------------------------------------
4444
4445 [ NounWord i j s;
4446     i = NextWord();
4447     if (i == 0) rfalse;
4448     if (i == ME1__WD or ME2__WD or ME3__WD) return 1;
4449     s = LanguagePronouns-->0;
4450     for (j=1 : j<=s : j=j+3)
4451         if (i == LanguagePronouns-->j)
4452             return j+2;
4453     if ((i->#dict_par1) & DICT_NOUN == 0) rfalse;
4454     return i;
4455 ];
4456
4457 ! ----------------------------------------------------------------------------
4458 !  NextWord (which takes no arguments) returns:
4459 !
4460 !  0            if the next word is unrecognised,
4461 !  comma_word   if a comma
4462 !  THEN1__WD    if a full stop
4463 !  or the dictionary address if it is recognised.
4464 !  The "current word" marker is moved on.
4465 !
4466 !  NextWordStopped does the same, but returns -1 when input has run out
4467 ! ----------------------------------------------------------------------------
4468
4469 #Ifdef TARGET_ZCODE;
4470
4471 [ NextWord i j;
4472     if (wn > parse->1) { wn++; rfalse; }
4473     i = wn*2-1; wn++;
4474     j = parse-->i;
4475     if (j == ',//') j = comma_word;
4476     if (j == './/') j = THEN1__WD;
4477     return j;
4478 ];
4479
4480 [ NextWordStopped;
4481     if (wn > parse->1) { wn++; return -1; }
4482     return NextWord();
4483 ];
4484
4485 [ WordAddress wordnum p b;  ! Absolute addr of 'wordnum' string in buffer
4486     if (p==0) p=parse;
4487     if (b==0) b=buffer;
4488     return b + p->(wordnum*4+1);
4489 ];
4490
4491 [ WordLength wordnum p;     ! Length of 'wordnum' string in buffer
4492     if (p==0) p=parse;
4493     return p->(wordnum*4);
4494 ];
4495
4496 [ WordValue wordnum p;      ! Dictionary value of 'wordnum' string in buffer
4497     if (p==0) p=parse;
4498     return p-->(wordnum*2-1);
4499 ];
4500
4501 [ NumberWords p;            ! Number of parsed strings in buffer
4502     if (p==0) p=parse;
4503     return p->1;
4504 ];
4505
4506 [ GetKeyBufLength b;        ! Number of typed chars in buffer
4507     if (b==0) b=buffer;
4508     return b->1;
4509 ];
4510
4511 [ SetKeyBufLength n b;      ! Update number of typed chars in buffer
4512     if (b==0) b=buffer;
4513     if (n > INPUT_BUFFER_LEN-WORDSIZE) n=INPUT_BUFFER_LEN-WORDSIZE;
4514     b->1 = n;
4515 ];
4516
4517 #Ifnot; ! TARGET_GLULX
4518
4519 [ NextWord i j;
4520     if (wn > parse-->0) { wn++; rfalse; }
4521     i = wn*3-2; wn++;
4522     j = parse-->i;
4523     if (j == ',//') j=comma_word;
4524     if (j == './/') j=THEN1__WD;
4525     return j;
4526 ];
4527
4528 [ NextWordStopped;
4529     if (wn > parse-->0) {
4530         wn++;
4531         return -1;
4532     }
4533     return NextWord();
4534 ];
4535
4536 [ WordAddress wordnum p b;  ! Absolute addr of 'wordnum' string in buffer
4537     if (p==0) p=parse;
4538     if (b==0) b=buffer;
4539     return b + p-->(wordnum*3);
4540 ];
4541
4542 [ WordLength wordnum p;     ! Length of 'wordnum' string in buffer
4543     if (p==0) p=parse;
4544     return p-->(wordnum*3-1);
4545 ];
4546
4547 [ WordValue wordnum p;      ! Dictionary value of 'wordnum' string in buffer
4548     if (p==0) p=parse;
4549     return p-->(wordnum*3-2);
4550 ];
4551
4552 [ NumberWords p;            ! Number of parsed strings in buffer
4553     if (p==0) p=parse;
4554     return p-->0;
4555 ];
4556
4557 [ GetKeyBufLength b;        ! Number of typed chars in buffer
4558     if (b==0) b=buffer;
4559     return b-->0;
4560 ];
4561
4562 [ SetKeyBufLength n b;      ! Update number of typed chars in buffer
4563     if (b==0) b=buffer;
4564     if (n > INPUT_BUFFER_LEN-WORDSIZE) n=INPUT_BUFFER_LEN-WORDSIZE;
4565     b-->0 = n;
4566 ];
4567
4568 #Endif; ! TARGET_
4569
4570 ! ----------------------------------------------------------------------------
4571 !  TryNumber is the only routine which really does any character-level
4572 !  parsing, since that's normally left to the Z-machine.
4573 !  It takes word number "wordnum" and tries to parse it as an (unsigned)
4574 !  decimal number, returning
4575 !
4576 !  -1000                if it is not a number
4577 !  the number           if it has between 1 and 4 digits
4578 !  10000                if it has 5 or more digits.
4579 !
4580 !  (The danger of allowing 5 digits is that Z-machine integers are only
4581 !  16 bits long, and anyway this isn't meant to be perfect.)
4582 !
4583 !  Using NumberWord, it also catches "one" up to "twenty".
4584 !
4585 !  Note that a game can provide a ParseNumber routine which takes priority,
4586 !  to enable parsing of odder numbers ("x45y12", say).
4587 ! ----------------------------------------------------------------------------
4588
4589 [ TryNumber wordnum   i j c num len mul tot d digit;
4590     i = wn; wn = wordnum; j = NextWord(); wn = i;
4591     j = NumberWord(j);
4592     if (j >= 1) return j;
4593
4594     num = WordAddress(wordnum); len = WordLength(wordnum);
4595
4596     tot = ParseNumber(num, len);
4597     if (tot == 0) tot = LibraryExtensions.RunWhile(ext_parsenumber, 0, num, len);
4598
4599     if (tot ~= 0) return tot;
4600
4601     if (len >= 4) mul=1000;
4602     if (len == 3) mul=100;
4603     if (len == 2) mul=10;
4604     if (len == 1) mul=1;
4605
4606     tot = 0; c = 0;
4607
4608     for (c = 0 : c < len : c++) {
4609         digit=num->c;
4610         if (digit == '0') { d = 0; jump digok; }
4611         if (digit == '1') { d = 1; jump digok; }
4612         if (digit == '2') { d = 2; jump digok; }
4613         if (digit == '3') { d = 3; jump digok; }
4614         if (digit == '4') { d = 4; jump digok; }
4615         if (digit == '5') { d = 5; jump digok; }
4616         if (digit == '6') { d = 6; jump digok; }
4617         if (digit == '7') { d = 7; jump digok; }
4618         if (digit == '8') { d = 8; jump digok; }
4619         if (digit == '9') { d = 9; jump digok; }
4620         return -1000;
4621      .digok;
4622         tot = tot+mul*d; mul = mul/10;
4623     }
4624     if (len > 4) tot=10000;
4625     return tot;
4626 ];
4627
4628 ! ----------------------------------------------------------------------------
4629 !  AnyNumber is a general parsing routine which accepts binary, hexadecimal
4630 !  and decimal numbers up to the full Zcode/Glulx ranges.
4631 ! ----------------------------------------------------------------------------
4632
4633 #Ifdef TARGET_ZCODE;                ! decimal range is -32768 to 32767
4634 Constant MAX_DECIMAL_SIZE 5;
4635 Constant MAX_DECIMAL_BASE 3276;
4636 #Ifnot; ! TARGET_GLULX              ! decimal range is -2147483648 to 2147483647
4637 Constant MAX_DECIMAL_SIZE 10;
4638 Constant MAX_DECIMAL_BASE 214748364;
4639 #Endif; ! TARGET_
4640
4641 [ AnyNumber
4642     wa we sign base digit digit_count num;
4643
4644     wa = WordAddress(wn); we = wa + WordLength(wn);
4645     sign = 1; base = 10;
4646     if     (wa->0 == '-') { sign = -1; wa++; }
4647     else {
4648         if (wa->0 == '$') { base = 16; wa++; }
4649         if (wa->0 == '$') { base = 2;  wa++; }
4650     }
4651     if (wa >= we) return GPR_FAIL;  ! no digits after -/$
4652     while (wa->0 == '0') wa++;      ! skip leading zeros
4653     for (num=0,digit_count=1 : wa<we : wa++,digit_count++) {
4654         switch (wa->0) {
4655           '0' to '9': digit = wa->0 - '0';
4656           'A' to 'F': digit = wa->0 - 'A' + 10;
4657           'a' to 'f': digit = wa->0 - 'a' + 10;
4658           default:    return GPR_FAIL;
4659         }
4660         if (digit >= base) return GPR_FAIL;
4661         digit_count++;
4662         switch (base) {
4663           16:     if (digit_count > 2*WORDSIZE)  return GPR_FAIL;
4664           2:      if (digit_count > 8*WORDSIZE)  return GPR_FAIL;
4665           10:
4666             if (digit_count >  MAX_DECIMAL_SIZE) return GPR_FAIL;
4667             if (digit_count == MAX_DECIMAL_SIZE) {
4668                 if (num >  MAX_DECIMAL_BASE)     return GPR_FAIL;
4669                 if (num == MAX_DECIMAL_BASE) {
4670                     if (sign == 1  && digit > 7) return GPR_FAIL;
4671                     if (sign == -1 && digit > 8) return GPR_FAIL;
4672                 }
4673             }
4674         }
4675         num = base*num + digit;
4676     }
4677    parsed_number = num * sign;
4678     wn++;
4679     return GPR_NUMBER;
4680 ];
4681
4682 ! ----------------------------------------------------------------------------
4683 !  GetGender returns 0 if the given animate object is female, and 1 if male
4684 !  (not all games will want such a simple decision function!)
4685 ! ----------------------------------------------------------------------------
4686
4687 [ GetGender person;
4688     if (person hasnt female) rtrue;
4689     rfalse;
4690 ];
4691
4692 [ GetGNAOfObject obj case gender;
4693     if (obj hasnt animate) case = 6;
4694     if (obj has male) gender = male;
4695     if (obj has female) gender = female;
4696     if (obj has neuter) gender = neuter;
4697     if (gender == 0) {
4698         if (case == 0) gender = LanguageAnimateGender;
4699         else gender = LanguageInanimateGender;
4700     }
4701     if (gender == female)   case = case + 1;
4702     if (gender == neuter)   case = case + 2;
4703     if (obj has pluralname) case = case + 3;
4704     return case;
4705 ];
4706
4707 ! ----------------------------------------------------------------------------
4708 !  Converting between dictionary addresses and entry numbers
4709 ! ----------------------------------------------------------------------------
4710
4711 #Ifdef TARGET_ZCODE;
4712
4713 [ Dword__No w; return (w-(HDR_DICTIONARY-->0 + 7))/9; ];
4714 [ No__Dword n; return HDR_DICTIONARY-->0 + 7 + 9*n; ];
4715
4716 #Ifnot; ! TARGET_GLULX
4717
4718 ! In Glulx, dictionary entries *are* addresses.
4719 [ Dword__No w; return w; ];
4720 [ No__Dword n; return n; ];
4721
4722 #Endif; ! TARGET_
4723
4724 ! ----------------------------------------------------------------------------
4725 !  For copying buffers
4726 ! ----------------------------------------------------------------------------
4727
4728 #Ifdef TARGET_ZCODE;
4729
4730 [ CopyBuffer bto bfrom i size;
4731     size = bto->0;
4732     for (i=1 : i<=size : i++) bto->i = bfrom->i;
4733 ];
4734
4735 #Ifnot; ! TARGET_GLULX
4736
4737 [ CopyBuffer bto bfrom i;
4738     for (i=0 : i<INPUT_BUFFER_LEN : i++) bto->i = bfrom->i;
4739 ];
4740
4741 #Endif; ! TARGET_
4742
4743 ! ----------------------------------------------------------------------------
4744 !  Provided for use by language definition files
4745 ! ----------------------------------------------------------------------------
4746
4747 #Ifdef TARGET_ZCODE;
4748
4749 [ LTI_Insert i ch  b y;
4750
4751     ! Protect us from strict mode, as this isn't an array in quite the
4752     ! sense it expects
4753     b = buffer;
4754
4755     ! Insert character ch into buffer at point i.
4756     ! Being careful not to let the buffer possibly overflow:
4757     y = b->1;
4758     if (y > b->0) y = b->0;
4759
4760     ! Move the subsequent text along one character:
4761     for (y=y+2 : y>i : y--) b->y = b->(y-1);
4762     b->i = ch;
4763
4764     ! And the text is now one character longer:
4765     if (b->1 < b->0) (b->1)++;
4766 ];
4767
4768 #Ifnot; ! TARGET_GLULX
4769
4770 [ LTI_Insert i ch  b y;
4771
4772     ! Protect us from strict mode, as this isn't an array in quite the
4773     ! sense it expects
4774     b = buffer;
4775
4776     ! Insert character ch into buffer at point i.
4777     ! Being careful not to let the buffer possibly overflow:
4778     y = b-->0;
4779     if (y > INPUT_BUFFER_LEN) y = INPUT_BUFFER_LEN;
4780
4781     ! Move the subsequent text along one character:
4782     for (y=y+WORDSIZE : y>i : y--) b->y = b->(y-1);
4783     b->i = ch;
4784
4785     ! And the text is now one character longer:
4786     if (b-->0 < INPUT_BUFFER_LEN) (b-->0)++;
4787 ];
4788
4789 #Endif; ! TARGET_
4790
4791 ! ============================================================================
4792
4793 [ PronounsSub x y c d;
4794     L__M(##Pronouns, 1);
4795
4796     c = (LanguagePronouns-->0)/3;
4797     if (player ~= selfobj) c++;
4798
4799     if (c == 0) return L__M(##Pronouns, 4);
4800
4801     for (x=1,d=0 : x<=LanguagePronouns-->0 : x=x+3) {
4802         print "~", (address) LanguagePronouns-->x, "~ ";
4803         y = LanguagePronouns-->(x+2);
4804         if (y == NULL) L__M(##Pronouns, 3);
4805         else {
4806             L__M(##Pronouns, 2);
4807             print (the) y;
4808         }
4809         d++;
4810         if (d < c-1) print (string) COMMA__TX;
4811         if (d == c-1) print (SerialComma) c, (string) AND__TX;
4812     }
4813     if (player ~= selfobj) {
4814         print "~", (address) ME1__WD, "~ "; L__M(##Pronouns, 2);
4815         c = player; player = selfobj;
4816         print (the) c; player = c;
4817     }
4818     L__M(##Pronouns, 5);
4819 ];
4820
4821 [ SetPronoun dword value x;
4822     for (x=1 : x<=LanguagePronouns-->0 : x=x+3)
4823         if (LanguagePronouns-->x == dword) {
4824             LanguagePronouns-->(x+2) = value; return;
4825         }
4826     RunTimeError(12);
4827 ];
4828
4829 [ PronounValue dword x;
4830     for (x=1 : x<=LanguagePronouns-->0 : x=x+3)
4831         if (LanguagePronouns-->x == dword)
4832             return LanguagePronouns-->(x+2);
4833     return 0;
4834 ];
4835
4836 [ ResetVagueWords obj; PronounNotice(obj); ];
4837
4838 #Ifdef EnglishNaturalLanguage;
4839
4840 [ PronounOldEnglish;
4841     if (itobj ~= old_itobj)   SetPronoun('it', itobj);
4842     if (himobj ~= old_himobj) SetPronoun('him', himobj);
4843     if (herobj ~= old_herobj) SetPronoun('her', herobj);
4844     old_itobj = itobj; old_himobj = himobj; old_herobj = herobj;
4845 ];
4846
4847 #Endif; !EnglishNaturalLanguage
4848
4849 [ PronounNotice obj x bm;
4850     if (obj == player) return;
4851
4852     #Ifdef EnglishNaturalLanguage;
4853     PronounOldEnglish();
4854     #Endif; ! EnglishNaturalLanguage
4855
4856     bm = PowersOfTwo_TB-->(GetGNAOfObject(obj));
4857
4858     for (x=1 : x<=LanguagePronouns-->0 : x=x+3)
4859         if (bm & (LanguagePronouns-->(x+1)) ~= 0)
4860             LanguagePronouns-->(x+2) = obj;
4861
4862     #Ifdef EnglishNaturalLanguage;
4863     itobj  = PronounValue('it');  old_itobj  = itobj;
4864     himobj = PronounValue('him'); old_himobj = himobj;
4865     herobj = PronounValue('her'); old_herobj = herobj;
4866     #Endif; ! EnglishNaturalLanguage
4867 ];
4868
4869 ! ============================================================================
4870 !  End of the parser proper: the remaining routines are its front end.
4871 ! ----------------------------------------------------------------------------
4872
4873 Object  InformLibrary "(Inform Library)"
4874   with  play [ i j k l;
4875
4876             #Ifdef TARGET_ZCODE;
4877             ZZInitialise();
4878             #Ifnot; ! TARGET_GLULX
4879             GGInitialise();
4880             #Endif; ! TARGET_
4881
4882             GamePrologue();
4883             while (~~deadflag) {    ! everything happens in this loop
4884
4885                 #Ifdef EnglishNaturalLanguage;
4886                 PronounOldEnglish();
4887                 old_itobj = PronounValue('it');
4888                 old_himobj = PronounValue('him');
4889                 old_herobj = PronounValue('her');
4890                 #Endif; ! EnglishNaturalLanguage
4891
4892               .very__late__error;
4893
4894                 if (score ~= last_score) {
4895                     if (notify_mode == 1) NotifyTheScore();
4896                     last_score = score;
4897                 }
4898
4899               .late__error;
4900
4901                 inputobjs-->0 = 0; inputobjs-->1 = 0;
4902                 inputobjs-->2 = 0; inputobjs-->3 = 0; meta = false;
4903
4904                 ! The Parser writes its results into inputobjs and meta,
4905                 ! a flag indicating a "meta-verb".  This can only be set for
4906                 ! commands by the player, not for orders to others.
4907
4908                 InformParser.parse_input(inputobjs);
4909
4910                 action = inputobjs-->0;
4911
4912                 ! --------------------------------------------------------------
4913
4914                 ! Reverse "give fred biscuit" into "give biscuit to fred"
4915
4916                 if (action == ##GiveR or ##ShowR) {
4917                     i = inputobjs-->2; inputobjs-->2 = inputobjs-->3; inputobjs-->3 = i;
4918                     if (action == ##GiveR) action = ##Give; else action = ##Show;
4919                 }
4920
4921                 ! Convert "P, tell me about X" to "ask P about X"
4922
4923                 if (action == ##Tell && inputobjs-->2 == player && actor ~= player) {
4924                     inputobjs-->2 = actor; actor = player; action = ##Ask;
4925                 }
4926
4927                 ! Convert "ask P for X" to "P, give X to me"
4928
4929                 if (action == ##AskFor && inputobjs-->2 ~= player && actor == player) {
4930                     actor = inputobjs-->2; inputobjs-->2 = inputobjs-->3;
4931                     inputobjs-->3 = player; action = ##Give;
4932                 }
4933
4934                 ! For old, obsolete code: special_word contains the topic word
4935                 ! in conversation
4936
4937                 if (action == ##Ask or ##Tell or ##Answer)
4938                     special_word = special_number1;
4939
4940                 !  --------------------------------------------------------------
4941
4942                 multiflag = false; onotheld_mode = notheld_mode; notheld_mode = false;
4943                 ! For implicit taking and multiple object detection
4944
4945               .begin__action;
4946                 inp1 = 0; inp2 = 0; i = inputobjs-->1;
4947                 if (i >= 1) inp1 = inputobjs-->2;
4948                 if (i >= 2) inp2 = inputobjs-->3;
4949
4950                 ! inp1 and inp2 hold: object numbers, or 0 for "multiple object",
4951                 ! or 1 for "a number or dictionary address"
4952
4953                 if (inp1 == 1) noun = special_number1; else noun = inp1;
4954                 if (inp2 == 1) {
4955                     if (inp1 == 1) second = special_number2;
4956                     else           second = special_number1;
4957                 }
4958                 else second = inp2;
4959
4960                 !  -------------------------------------------------------------
4961
4962 !print "inp1:          ", (name) inp1, "^";
4963 !print "inp2:          ", (name) inp2, "^";
4964 !print "inputobjs-->1: ", (name) inputobjs-->1, "^";
4965 !print "inputobjs-->2: ", (name) inputobjs-->2, "^";
4966 !print "inputobjs-->3: ", (name) inputobjs-->3, "^";
4967 !print "noun:          ", (name) noun, "^";
4968 !print "second:        ", (name) second, "^";
4969 !print "actor:         ", (name) actor, "^";
4970 !print "---^";
4971
4972                 ! --------------------------------------------------------------
4973                 ! Generate the action...
4974
4975                 if ((i == 0) ||
4976                     (i == 1 && inp1 ~= 0) ||
4977                     (i == 2 && inp1 ~= 0 && inp2 ~= 0)) {
4978
4979                     if (actor ~= player) {
4980                          switch (self.actor_act(actor, action, noun, second)) {
4981                              ACTOR_ACT_ABORT_NOTUNDERSTOOD: jump begin__action;
4982                              default: jump turn__end;
4983                          }
4984
4985                     }
4986
4987
4988                     self.begin_action(action, noun, second, 0);
4989                     jump turn__end;
4990                 }
4991
4992                 ! ...unless a multiple object must be substituted.  First:
4993                 ! (a) check the multiple list isn't empty;
4994                 ! (b) warn the player if it has been cut short because too long;
4995                 ! (c) generate a sequence of actions from the list
4996                 !     (stopping in the event of death or movement away).
4997
4998                 multiflag = true;
4999                 j = multiple_object-->0;
5000                 if (j == 0) {
5001                     L__M(##Miscellany, 2);
5002                     jump late__error;
5003                 }
5004                 if (toomany_flag) {
5005                     toomany_flag = false;
5006                     L__M(##Miscellany, 1);
5007                 }
5008                 i = location;
5009                 for (k=1 : k<=j : k++) {
5010                     if (deadflag) break;
5011                     if (location ~= i) {
5012                         L__M(##Miscellany, 51);
5013                         break;
5014                     }
5015                     l = multiple_object-->k;
5016                     PronounNotice(l);
5017                     print (name) l, (string) COLON__TX;
5018                     if (inp1 == 0) {
5019                         inp1 = l;
5020                         switch (self.actor_act(actor, action, l, second)) {
5021                           ACTOR_ACT_ABORT_NOTUNDERSTOOD: jump begin__action;
5022                           ACTOR_ACT_ABORT_ORDER: jump turn__end;
5023                         }
5024                         inp1 = 0;
5025                     }
5026                     else {
5027                         inp2 = l;
5028                         if (self.actor_act(actor, action, noun, l) == ACTOR_ACT_ABORT_NOTUNDERSTOOD)
5029                             jump begin__action;
5030                         inp2 = 0;
5031                     }
5032                 }
5033
5034                 ! --------------------------------------------------------------
5035
5036               .turn__end;
5037
5038                 ! No time passes if either (i) the verb was meta, or
5039                 ! (ii) we've only had the implicit take before the "real"
5040                 ! action to follow.
5041
5042                 if (notheld_mode == 1) { NoteObjectAcquisitions(); continue; }
5043                 if (meta) continue;
5044                 if (~~deadflag) self.end_turn_sequence();
5045                 else if (START_MOVE ~= 1) turns++;
5046             } ! end of while()
5047
5048             if (deadflag ~= 2 && AfterLife() == false)
5049                  LibraryExtensions.RunAll(ext_afterlife);
5050             if (deadflag == 0) jump very__late__error;
5051             GameEpilogue();
5052         ], ! end of 'play' property
5053
5054         end_turn_sequence [;
5055             AdvanceWorldClock();        if (deadflag) return;
5056             RunTimersAndDaemons();      if (deadflag) return;
5057             RunEachTurnProperties();    if (deadflag) return;
5058             if (TimePasses() == 0)  LibraryExtensions.RunAll(ext_timepasses);
5059                                         if (deadflag) return;
5060             AdjustLight();              if (deadflag) return;
5061             NoteObjectAcquisitions();
5062         ],
5063
5064         ! The first time we call self.actor_act(), set the fifth
5065         ! parameter to true.  Details can be seen in
5066         ! 1d95759b1bd6674509d6cf9161e6db3da3831f10 and in Issues #23 and
5067         ! #30 (Mantis 1813 and 1885)
5068         actor_act [ p a n s ft  j sp sa sn ss;
5069             sp = actor; actor = p;
5070             if (p ~= player) {
5071                 ! The player's "orders" property can refuse to allow
5072                 ! conversation here, by returning true.  If not, the order is
5073                 ! sent to the other person's "orders" property.  If that also
5074                 ! returns false, then: if it was a misunderstood command
5075                 ! anyway, it is converted to an Answer action (thus
5076                 ! "floyd, grrr" ends up as "say grrr to floyd").  If it was a
5077                 ! good command, it is finally offered to the Order: part of
5078                 ! the other person's "life" property, the old-fashioned
5079                 ! way of dealing with conversation.
5080
5081                 sa = action; sn = noun; ss = second;
5082                 action = a; noun = n; second = s;
5083                 j = RunRoutines(player, orders);
5084                 if (j == 0) {
5085                     j = RunRoutines(actor, orders);
5086                     if (j == 0) {
5087                         if (action == ##NotUnderstood) {
5088                             inputobjs-->3 = actor; actor = player; action = ##Answer;
5089                             ! abort, not resetting action globals
5090                             return ACTOR_ACT_ABORT_NOTUNDERSTOOD;
5091                         }
5092                         if (RunLife(actor, ##Order) == 0) {
5093                             L__M(##Order, 1, actor);
5094                             if (~~ft)
5095                                 return ACTOR_ACT_ABORT_ORDER;
5096                         }
5097                     }
5098                 }
5099                 action = sa; noun = sn; second = ss;
5100                 if (ft)
5101                     return ACTOR_ACT_ABORT_ORDER;
5102             }
5103             else
5104                 if (~~ft)
5105                     self.begin_action(a, n, s, 0);
5106
5107             actor = sp;
5108             return ACTOR_ACT_OK;
5109         ],
5110
5111         begin_action [ a n s source   sa sn ss;
5112             sa = action; sn = noun; ss = second;
5113             action = a; noun = n; second = s;
5114             #Ifdef DEBUG;
5115             if (debug_flag & DEBUG_ACTIONS) TraceAction(source);
5116             #Ifnot;
5117             source = 0;
5118             #Endif; ! DEBUG
5119
5120             #Iftrue (Grammar__Version == 1);
5121             if ((meta || BeforeRoutines() == false) && action < 256) {
5122                 #Ifdef INFIX;
5123                 if (infix_verb) {
5124                     if (BeforeRoutines() == false)
5125                         ActionPrimitive();
5126                 } else ActionPrimitive();
5127                 #Ifnot;
5128                 ActionPrimitive();
5129                 #Endif;
5130             }
5131             #Ifnot;
5132             if ((meta || BeforeRoutines() == false) && action < 4096) {
5133                 #Ifdef INFIX;
5134                 if (infix_verb) {
5135                     if (BeforeRoutines() == false)
5136                         ActionPrimitive();
5137                 } else ActionPrimitive();
5138                 #Ifnot;
5139                 ActionPrimitive();
5140                 #Endif;
5141             }
5142             #Endif; ! Grammar__Version
5143             action = sa; noun = sn; second = ss;
5144         ],
5145   has   proper;
5146
5147 ! ----------------------------------------------------------------------------
5148 ! Routines called before and after main 'play' loop
5149
5150 [ GamePrologue i j;
5151     before_first_turn = true;
5152     for (i=1 : i<=100 : i++) j = random(i);
5153
5154     ChangeDefault(cant_go, CANTGO__TX);
5155
5156     real_location = thedark;
5157     player = selfobj; actor = player;
5158     selfobj.capacity = MAX_CARRIED; ! ### change?
5159
5160     #Ifdef LanguageInitialise;
5161     LanguageInitialise();
5162     #Endif; ! LanguageInitialise
5163
5164     #Ifdef EnglishNaturalLanguage;
5165     old_itobj = itobj; old_himobj = himobj; old_herobj = herobj;
5166     #Endif;! EnglishNaturalLanguage
5167
5168     new_line;
5169     LibraryExtensions.RunAll(ext_initialise);
5170     j = Initialise();
5171     last_score = score;
5172     initial_lookmode = lookmode;
5173
5174     objectloop (i in player) give i moved ~concealed;
5175     move player to location;
5176     while (parent(location)) location = parent(location);
5177     real_location = location;
5178     MoveFloatingObjects();
5179
5180     actor = player; ! resync, because player may have been changed in Initialise()
5181     actors_location = location;
5182
5183     lightflag = OffersLight(parent(player));
5184     if (lightflag == 0) location = thedark;
5185
5186     if (j ~= 2) Banner();
5187 #ifndef NOINITIAL_LOOK;
5188     <Look>;
5189 #endif;
5190     before_first_turn = false;
5191 ];
5192
5193 [ GameEpilogue;
5194     print "^^    ";
5195     #Ifdef TARGET_ZCODE;
5196     #IfV5; style bold; #Endif; ! V5
5197     #Ifnot; ! TARGET_GLULX
5198     glk_set_style(style_Alert);
5199     #Endif; ! TARGET_
5200     print "***";
5201     switch (deadflag) {
5202       1:        L__M(##Miscellany, 3);
5203       2:        L__M(##Miscellany, 4);
5204       default:  print " ";
5205                 if (DeathMessage() == false)
5206                     LibraryExtensions.RunAll(ext_deathmessage);
5207                 print " ";
5208     }
5209     print "***";
5210     #Ifdef TARGET_ZCODE;
5211     #IfV5; style roman; #Endif; ! V5
5212     #Ifnot; ! TARGET_GLULX
5213     glk_set_style(style_Normal);
5214     #Endif; ! TARGET_
5215     print "^^";
5216     #Ifndef NO_SCORE;
5217     print "^";
5218     #Endif; ! NO_SCORE
5219     Epilogue();
5220     ScoreSub();
5221     DisplayStatus();
5222     AfterGameOver();
5223 ];
5224
5225 ! ----------------------------------------------------------------------------
5226 ! Routines called at end of each turn
5227
5228 [ AdvanceWorldClock;
5229     turns++;
5230     if (the_time ~= NULL) {
5231         if (time_rate >= 0) the_time=the_time+time_rate;
5232         else {
5233             time_step--;
5234             if (time_step == 0) {
5235                 the_time++;
5236                 time_step = -time_rate;
5237             }
5238         }
5239         the_time = the_time % 1440;
5240     }
5241 ];
5242
5243 [ RunTimersAndDaemons i j;
5244     #Ifdef DEBUG;
5245     if (debug_flag & DEBUG_TIMERS) {
5246         for (i=0 : i<active_timers : i++) {
5247             j = the_timers-->i;
5248             if (j ~= 0) {
5249                 print (name) (j&~WORD_HIGHBIT), ": ";
5250                 if (j & WORD_HIGHBIT) print "daemon";
5251                 else
5252                     print "timer with ", j.time_left, " turns to go";
5253                 new_line;
5254             }
5255         }
5256     }
5257     #Endif; ! DEBUG
5258
5259     for (i=0 : i<active_timers : i++) {
5260         if (deadflag) return;
5261         j = the_timers-->i;
5262         if (j ~= 0) {
5263             if (j & WORD_HIGHBIT) RunRoutines(j&~WORD_HIGHBIT, daemon);
5264             else {
5265                 if (j.time_left == 0) {
5266                     StopTimer(j);
5267                     RunRoutines(j, time_out);
5268                 }
5269                 else
5270                     j.time_left = j.time_left-1;
5271             }
5272         }
5273     }
5274 ];
5275
5276 [ RunEachTurnProperties;
5277     scope_reason = EACH_TURN_REASON; verb_word = 0;
5278     DoScopeAction(location);
5279     SearchScope(ScopeCeiling(player), player, 0);
5280     scope_reason = PARSING_REASON;
5281 ];
5282
5283 ! ----------------------------------------------------------------------------
5284
5285 #Ifdef TARGET_ZCODE;
5286
5287 [ ActionPrimitive; (#actions_table-->action)(); ];
5288
5289 #Ifnot; ! TARGET_GLULX
5290
5291 [ ActionPrimitive; (#actions_table-->(action+1))(); ];
5292
5293 #Endif; ! TARGET_
5294
5295 [ AfterGameOver i amus_ret;
5296
5297   .RRQPL;
5298
5299     L__M(##Miscellany,5);
5300
5301   .RRQL;
5302
5303     L__M(##Prompt);
5304     #Ifdef TARGET_ZCODE;
5305     #IfV3; read buffer parse; #Endif; ! V3
5306     temp_global=0;
5307     #IfV5; read buffer parse DrawStatusLine; #Endif; ! V5
5308     #Ifnot; ! TARGET_GLULX
5309     KeyboardPrimitive(buffer, parse);
5310     #Endif; ! TARGET_
5311     i = parse-->1;
5312     if (i == QUIT1__WD or QUIT2__WD) {
5313         #Ifdef TARGET_ZCODE;
5314         quit;
5315         #Ifnot; ! TARGET_GLULX
5316         quit;
5317         #Endif; ! TARGET_
5318     }
5319     if (i == RESTART__WD) {
5320         #Ifdef TARGET_ZCODE;
5321         @restart;
5322         #Ifnot; ! TARGET_GLULX
5323         @restart;
5324         #Endif; ! TARGET_
5325     }
5326     if (i == RESTORE__WD) {
5327         RestoreSub();
5328         jump RRQPL;
5329     }
5330     if (i == FULLSCORE1__WD or FULLSCORE2__WD && TASKS_PROVIDED==0) {
5331         new_line; FullScoreSub();
5332         jump RRQPL;
5333     }
5334     if (deadflag == 2 && i == AMUSING__WD) {
5335         amus_ret = false;
5336         if (AMUSING_PROVIDED == 0) {
5337             new_line;
5338             amus_ret = Amusing();
5339         }
5340         if (amus_ret == false) LibraryExtensions.RunAll(ext_amusing);
5341         jump RRQPL;
5342     }
5343     #IfV5;
5344     if (i == UNDO1__WD or UNDO2__WD or UNDO3__WD) {
5345         i = PerformUndo();
5346         if (i == 0) jump RRQPL;
5347     }
5348     #Endif; ! V5
5349     L__M(##Miscellany, 8);
5350     jump RRQL;
5351 ];
5352
5353 [ NoteObjectAcquisitions i;
5354     objectloop (i in player)
5355         if (i hasnt moved) {
5356             give i moved;
5357             if (i has scored) {
5358                 score = score + OBJECT_SCORE;
5359                 things_score = things_score + OBJECT_SCORE;
5360             }
5361         }
5362 ];
5363
5364 ! ----------------------------------------------------------------------------
5365 ! R_Process is invoked by the <...> and <<...>> statements, whose syntax is:
5366 !   <action [noun] [second]>                ! traditional
5367 !   <action [noun] [second], actor>         ! introduced at compiler 6.33
5368
5369 [ R_Process a n s p
5370     s1 s2 s3;
5371     s1 = inp1; s2 = inp2; s3 = actor;
5372     inp1 = n; inp2 = s; if (p) actor = p; else actor = player;
5373     InformLibrary.begin_action(a, n, s, 1);
5374     inp1 = s1; inp2 = s2; actor = s3;
5375 ];
5376
5377 ! ----------------------------------------------------------------------------
5378
5379 [ TestScope obj act a al sr x y;
5380     x = parser_one; y = parser_two;
5381     parser_one = obj; parser_two = 0; a = actor; al = actors_location;
5382     sr = scope_reason; scope_reason = TESTSCOPE_REASON;
5383     if (act == 0) actor = player; else actor = act;
5384     actors_location = ScopeCeiling(actor);
5385     SearchScope(actors_location, actor, 0); scope_reason = sr; actor = a;
5386     actors_location = al; parser_one = x; x = parser_two; parser_two = y;
5387     return x;
5388 ];
5389
5390 [ LoopOverScope routine act x y a al;
5391     x = parser_one; y = scope_reason; a = actor; al = actors_location;
5392     parser_one = routine;
5393     if (act == 0) actor = player; else actor = act;
5394     actors_location = ScopeCeiling(actor);
5395     scope_reason = LOOPOVERSCOPE_REASON;
5396     SearchScope(actors_location, actor, 0);
5397     parser_one = x; scope_reason = y; actor = a; actors_location = al;
5398 ];
5399
5400 [ BeforeRoutines rv;
5401     if (GamePreRoutine()) rtrue;
5402     if (rv == false) rv=LibraryExtensions.RunWhile(ext_gamepreroutine, 0);
5403     if (rv) rtrue;
5404     if (RunRoutines(player, orders)) rtrue;
5405     scope_reason = REACT_BEFORE_REASON; parser_one = 0;
5406     SearchScope(ScopeCeiling(player), player, 0);
5407     scope_reason = PARSING_REASON;
5408     if (parser_one) rtrue;
5409     if (location && RunRoutines(location, before)) rtrue;
5410     if (inp1 > 1 && RunRoutines(inp1, before)) rtrue;
5411     rfalse;
5412 ];
5413
5414 [ AfterRoutines rv;
5415     scope_reason = REACT_AFTER_REASON; parser_one = 0;
5416     SearchScope(ScopeCeiling(player), player, 0); scope_reason = PARSING_REASON;
5417     if (parser_one) rtrue;
5418     if (location && RunRoutines(location, after)) rtrue;
5419     if (inp1 > 1 && RunRoutines(inp1, after)) rtrue;
5420     rv = GamePostRoutine();
5421     if (rv == false) rv=LibraryExtensions.RunWhile(ext_gamepostroutine, false);
5422     return rv;
5423 ];
5424
5425 [ RunLife a j;
5426     #Ifdef DEBUG;
5427     if (debug_flag & DEBUG_ACTIONS) TraceAction(2, j);
5428     #Endif; ! DEBUG
5429     reason_code = j; return RunRoutines(a,life);
5430 ];
5431
5432 [ ZRegion addr;
5433     switch (metaclass(addr)) {      ! Left over from Inform 5
5434       nothing:          return 0;
5435       Object, Class:    return 1;
5436       Routine:          return 2;
5437       String:           return 3;
5438     }
5439 ];
5440
5441 [ PrintOrRun obj prop flag;
5442     if (obj.#prop > WORDSIZE) return RunRoutines(obj, prop);
5443     if (obj.prop == NULL) rfalse;
5444     switch (metaclass(obj.prop)) {
5445       Class, Object, nothing:
5446         return RunTimeError(2,obj,prop);
5447       String:
5448         print (string) obj.prop;
5449         if (flag == 0) new_line;
5450         rtrue;
5451       Routine:
5452         return RunRoutines(obj, prop);
5453     }
5454 ];
5455
5456 [ PrintOrRunVar var flag;
5457     switch (metaclass(var)) {
5458       Object:
5459         print (name) var;
5460       String:
5461         print (string) var;
5462         if (flag == 0) new_line;
5463       Routine:
5464         return var();
5465       default:
5466         print (char) '(', var, (char) ')';
5467     }
5468     rtrue;
5469 ];
5470
5471 [ ValueOrRun obj prop;
5472   !### this is entirely unlikely to work. Does anyone care? (AP)
5473   ! Well, it's certainly used three times in verblibm.h (RF)
5474   ! Update: now not used (RF)
5475     if (obj.prop < 256) return obj.prop;
5476     return RunRoutines(obj, prop);
5477 ];
5478
5479 [ RunRoutines obj prop;
5480     if (obj == thedark && prop ~= initial or short_name or description) obj = real_location;
5481     if (obj.&prop == 0 && prop >= INDIV_PROP_START) rfalse;
5482     return obj.prop();
5483 ];
5484
5485 #Ifdef TARGET_ZCODE;
5486
5487 [ ChangeDefault prop val a b;
5488     ! Use assembly-language here because -S compilation won't allow this:
5489     @loadw 0 5 -> a;
5490     b = prop-1;
5491     @storew a b val;
5492 ];
5493
5494 #Ifnot; ! TARGET_GLULX
5495
5496 [ ChangeDefault prop val;
5497     ! Use assembly-language here because -S compilation won't allow this:
5498     ! #cpv__start-->prop = val;
5499     @astore #cpv__start prop val;
5500 ];
5501
5502 #Endif; ! TARGET_
5503
5504 ! ----------------------------------------------------------------------------
5505
5506 [ StartTimer obj timer i;
5507     for (i=0 : i<active_timers : i++)
5508         if (the_timers-->i == obj) rfalse;
5509     for (i=0 : i<active_timers : i++)
5510         if (the_timers-->i == 0) jump FoundTSlot;
5511     i = active_timers++;
5512     if (i >= MAX_TIMERS) { RunTimeError(4); return; }
5513   .FoundTSlot;
5514     if (obj.&time_left == 0) { RunTimeError(5, obj, time_left); return; }
5515     the_timers-->i = obj; obj.time_left = timer;
5516 ];
5517
5518 [ StopTimer obj i;
5519     for (i=0 : i<active_timers : i++)
5520         if (the_timers-->i == obj) jump FoundTSlot2;
5521     rfalse;
5522   .FoundTSlot2;
5523     if (obj.&time_left == 0) { RunTimeError(5, obj, time_left); return; }
5524     the_timers-->i = 0; obj.time_left = 0;
5525 ];
5526
5527 [ StartDaemon obj i;
5528     for (i=0 : i<active_timers : i++)
5529         if (the_timers-->i == WORD_HIGHBIT + obj) rfalse;
5530     for (i=0 : i<active_timers : i++)
5531         if (the_timers-->i == 0) jump FoundTSlot3;
5532     i = active_timers++;
5533     if (i >= MAX_TIMERS) RunTimeError(4);
5534   .FoundTSlot3;
5535     the_timers-->i = WORD_HIGHBIT + obj;
5536 ];
5537
5538 [ StopDaemon obj i;
5539     for (i=0 : i<active_timers : i++)
5540         if (the_timers-->i == WORD_HIGHBIT + obj) jump FoundTSlot4;
5541     rfalse;
5542   .FoundTSlot4;
5543     the_timers-->i = 0;
5544 ];
5545
5546 ! ----------------------------------------------------------------------------
5547
5548 [ DisplayStatus;
5549     if (sys_statusline_flag == 0) { sline1 = score; sline2 = turns; }
5550     else { sline1 = the_time/60; sline2 = the_time%60;}
5551 ];
5552
5553 [ SetTime t s;
5554     the_time = t; time_rate = s; time_step = 0;
5555     if (s < 0) time_step = 0-s;
5556 ];
5557
5558 [ NotifyTheScore;
5559     #Ifdef TARGET_GLULX;
5560     glk_set_style(style_Note);
5561     #Endif; ! TARGET_GLULX
5562     print "^[";  L__M(##Miscellany, 50, score-last_score);  print ".]^";
5563     #Ifdef TARGET_GLULX;
5564     glk_set_style(style_Normal);
5565     #Endif; ! TARGET_GLULX
5566 ];
5567
5568 ! ----------------------------------------------------------------------------
5569
5570 [ AdjustLight flag i;
5571     i = lightflag;
5572     lightflag = OffersLight(parent(player));
5573
5574     if (i == 0 && lightflag == 1) {
5575         location = real_location;
5576         if (flag == 0) <Look>;
5577     }
5578
5579     if (i == 1 && lightflag == 0) {
5580         real_location = location; location = thedark;
5581         if (flag == 0) {
5582             NoteArrival();
5583             return L__M(##Miscellany, 9);
5584         }
5585     }
5586     if (i == 0 && lightflag == 0) location = thedark;
5587 ];
5588
5589 [ OffersLight i j;
5590     if (i == 0) rfalse;
5591     if (i has light) rtrue;
5592     objectloop (j in i)
5593         if (HasLightSource(j) == 1) rtrue;
5594     if (i has container) {
5595         if (i has open || i has transparent)
5596             return OffersLight(parent(i));
5597     }
5598     else {
5599         if (i has enterable || i has transparent || i has supporter)
5600             return OffersLight(parent(i));
5601     }
5602     rfalse;
5603 ];
5604
5605 [ HidesLightSource obj;
5606     if (obj == player) rfalse;
5607     if (obj has transparent or supporter) rfalse;
5608     if (obj has container) return (obj hasnt open);
5609     return (obj hasnt enterable);
5610 ];
5611
5612 [ HasLightSource i j ad;
5613     if (i == 0) rfalse;
5614     if (i has light) rtrue;
5615     if (i has enterable || IsSeeThrough(i) == 1)
5616         if (~~(HidesLightSource(i)))
5617             objectloop (j in i)
5618                 if (HasLightSource(j) == 1) rtrue;
5619     ad = i.&add_to_scope;
5620     if (parent(i) ~= 0 && ad ~= 0) {
5621         if (metaclass(ad-->0) == Routine) {
5622             ats_hls = 0; ats_flag = 1;
5623             RunRoutines(i, add_to_scope);
5624             ats_flag = 0; if (ats_hls == 1) rtrue;
5625         }
5626         else {
5627             for (j=0 : (WORDSIZE*j)<i.#add_to_scope : j++)
5628                 if (HasLightSource(ad-->j) == 1) rtrue;
5629         }
5630     }
5631     rfalse;
5632 ];
5633
5634 [ ChangePlayer obj flag i;
5635 !   if (obj.&number == 0) return RunTimeError(7, obj);
5636
5637     if (obj == nothing) obj = selfobj;
5638     if (actor == player) actor=obj;
5639     give player ~transparent ~concealed;
5640     i = obj; while (parent(i) ~= 0) {
5641         if (i has animate) give i transparent;
5642         i = parent(i);
5643     }
5644     if (player == selfobj && player provides nameless && player.nameless == true) {
5645         if (player provides narrative_voice) {
5646             if (player.narrative_voice == 1) {
5647                 player.short_name = MYFORMER__TX;
5648                 (player.&name)-->0 = 'my';
5649                 (player.&name)-->1 = 'former';
5650                 (player.&name)-->2 = 'self';
5651             } else if (player.narrative_voice == 2) {
5652                 player.short_name = FORMER__TX;
5653                 (player.&name)-->0 = 'my';
5654                 (player.&name)-->1 = 'former';
5655                 (player.&name)-->2 = 'self';
5656             }
5657         }
5658     }
5659
5660
5661     player = obj;
5662
5663     give player transparent concealed animate;
5664     i = player; while (parent(i) ~= 0) i = parent(i);
5665     location = i; real_location = location;
5666     if (parent(player) == 0) return RunTimeError(10);
5667     MoveFloatingObjects();
5668     lightflag = OffersLight(parent(player));
5669     if (lightflag == 0) location = thedark;
5670     print_player_flag = flag;
5671 ];
5672
5673 ! ----------------------------------------------------------------------------
5674
5675 #Ifdef DEBUG;
5676
5677 #Ifdef TARGET_ZCODE;
5678
5679 [ DebugParameter w;
5680     print w;
5681     if (w >= 1 && w <= top_object) print " (", (name) w, ")";
5682     if (UnsignedCompare(w, dict_start) >= 0 &&
5683             UnsignedCompare(w, dict_end) < 0 &&
5684             (w - dict_start) % dict_entry_size == 0)
5685         print " ('", (address) w, "')";
5686 ];
5687
5688 [ DebugAction a anames;
5689     #Iftrue (Grammar__Version == 1);
5690     if (a >= 256) { print "<fake action ", a-256, ">"; return; }
5691     #Ifnot;
5692     if (a >= 4096) { print "<fake action ", a-4096, ">"; return; }
5693     #Endif; ! Grammar__Version
5694     anames = #identifiers_table;
5695     anames = anames + 2*(anames-->0) + 2*48;
5696     print (string) anames-->a;
5697 ];
5698
5699 [ DebugAttribute a anames;
5700     if (a < 0 || a >= 48) print "<invalid attribute ", a, ">";
5701     else {
5702         anames = #identifiers_table; anames = anames + 2*(anames-->0);
5703         print (string) anames-->a;
5704     }
5705 ];
5706
5707 #Ifnot; ! TARGET_GLULX
5708
5709 [ DebugParameter w endmem;
5710     print w;
5711     @getmemsize endmem;
5712     if (w >= 1 && w < endmem) {
5713         if (w->0 >= $70 && w->0 < $7F) print " (", (name) w, ")";
5714         if (w->0 >= $60 && w->0 < $6F) print " ('", (address) w, "')";
5715     }
5716 ];
5717
5718 [ DebugAction a str;
5719     if (a >= 4096) { print "<fake action ", a-4096, ">"; return; }
5720     if (a < 0 || a >= #identifiers_table-->7) print "<invalid action ", a, ">";
5721     else {
5722         str = #identifiers_table-->6;
5723         str = str-->a;
5724         if (str) print (string) str; else print "<unnamed action ", a, ">";
5725     }
5726 ];
5727
5728 [ DebugAttribute a str;
5729     if (a < 0 || a >= NUM_ATTR_BYTES*8) print "<invalid attribute ", a, ">";
5730     else {
5731         str = #identifiers_table-->4;
5732         str = str-->a;
5733         if (str) print (string) str; else print "<unnamed attribute ", a, ">";
5734     }
5735 ];
5736
5737 #Endif; ! TARGET_
5738
5739 [ TraceAction source ar;
5740     if (source < 2) print "[ Action ", (DebugAction) action;
5741     else {
5742         if (ar == ##Order)
5743             print "[ Order to ", (name) actor, ": ", (DebugAction) action;
5744         else
5745             print "[ Life rule ", (DebugAction) ar;
5746     }
5747     if (noun ~= 0)   print " with noun ", (DebugParameter) noun;
5748     if (second ~= 0) print " and second ", (DebugParameter) second;
5749     if (source == 0) print " ";
5750     if (source == 1) print " (from < > statement) ";
5751     print "]^";
5752 ];
5753
5754 [ DebugToken token;
5755     AnalyseToken(token);
5756     switch (found_ttype) {
5757       ILLEGAL_TT:
5758         print "<illegal token number ", token, ">";
5759       ELEMENTARY_TT:
5760         switch (found_tdata) {
5761           NOUN_TOKEN:           print "noun";
5762           HELD_TOKEN:           print "held";
5763           MULTI_TOKEN:          print "multi";
5764           MULTIHELD_TOKEN:      print "multiheld";
5765           MULTIEXCEPT_TOKEN:    print "multiexcept";
5766           MULTIINSIDE_TOKEN:    print "multiinside";
5767           CREATURE_TOKEN:       print "creature";
5768           SPECIAL_TOKEN:        print "special";
5769           NUMBER_TOKEN:         print "number";
5770           TOPIC_TOKEN:          print "topic";
5771           ENDIT_TOKEN:          print "END";
5772         }
5773       PREPOSITION_TT:
5774         print "'", (address) found_tdata, "'";
5775       ROUTINE_FILTER_TT:
5776         #Ifdef INFIX;
5777         print "noun=", (InfixPrintPA) found_tdata;
5778         #Ifnot;
5779         print "noun=Routine(", found_tdata, ")";
5780         #Endif; ! INFIX
5781       ATTR_FILTER_TT:
5782         print (DebugAttribute) found_tdata;
5783       SCOPE_TT:
5784         #Ifdef INFIX;
5785         print "scope=", (InfixPrintPA) found_tdata;
5786         #Ifnot;
5787         print "scope=Routine(", found_tdata, ")";
5788         #Endif; ! INFIX
5789       GPR_TT:
5790         #Ifdef INFIX;
5791         print (InfixPrintPA) found_tdata;
5792         #Ifnot;
5793         print "Routine(", found_tdata, ")";
5794         #Endif; ! INFIX
5795     }
5796 ];
5797
5798 [ DebugGrammarLine pcount;
5799     print " * ";
5800     for (: line_token-->pcount ~= ENDIT_TOKEN : pcount++) {
5801         if ((line_token-->pcount)->0 & $10) print "/ ";
5802         print (DebugToken) line_token-->pcount, " ";
5803     }
5804     print "-> ", (DebugAction) action_to_be;
5805     if (action_reversed) print " reverse";
5806 ];
5807
5808 #Ifdef TARGET_ZCODE;
5809
5810 [ ShowVerbSub grammar lines j;
5811     if (noun == 0 || ((noun->#dict_par1) & DICT_VERB) == 0)
5812         "Try typing ~showverb~ and then the name of a verb.";
5813     print "Verb";
5814     if ((noun->#dict_par1) & DICT_META) print " meta";
5815     for (j=dict_start : j<dict_end : j=j+dict_entry_size)
5816         if (j->#dict_par2 == noun->#dict_par2)
5817             print " '", (address) j, "'";
5818     new_line;
5819     grammar = (HDR_STATICMEMORY-->0)-->($ff-(noun->#dict_par2));
5820     lines = grammar->0;
5821     grammar++;
5822     if (lines == 0) "has no grammar lines.";
5823     for (: lines>0 : lines--) {
5824         grammar = UnpackGrammarLine(grammar);
5825         print "    "; DebugGrammarLine(); new_line;
5826     }
5827 ];
5828
5829 #Ifnot; ! TARGET_GLULX
5830
5831 [ ShowVerbSub grammar lines j wd dictlen entrylen;
5832     if (noun == 0 || ((noun->#dict_par1) & DICT_VERB) == 0)
5833         "Try typing ~showverb~ and then the name of a verb.";
5834     print "Verb";
5835     if ((noun->#dict_par1) & DICT_META) print " meta";
5836     dictlen = #dictionary_table-->0;
5837     entrylen = DICT_WORD_SIZE + 7;
5838     for (j=0 : j<dictlen : j++) {
5839         wd = #dictionary_table + WORDSIZE + entrylen*j;
5840         if (wd->#dict_par2 == noun->#dict_par2)
5841             print " '", (address) wd, "'";
5842     }
5843     new_line;
5844     grammar = (#grammar_table)-->($ff-(noun->#dict_par2)+1);
5845     lines = grammar->0;
5846     grammar++;
5847     if (lines == 0) "has no grammar lines.";
5848     for (: lines>0 : lines--) {
5849         grammar = UnpackGrammarLine(grammar);
5850         print "    "; DebugGrammarLine(); new_line;
5851     }
5852 ];
5853
5854 #Endif; ! TARGET_
5855
5856 [ ShowObjSub c f l a n x numattr;
5857     if (noun == 0) noun = location;
5858     objectloop (c ofclass Class) if (noun ofclass c) { f++; l=c; }
5859     if (f == 1) print (name) l, " ~"; else print "Object ~";
5860     print (name) noun, "~ (", noun, ")";
5861     if (parent(noun)) print " in ~", (name) parent(noun), "~ (", parent(noun), ")";
5862     new_line;
5863     if (f > 1) {
5864         print "  class ";
5865         objectloop (c ofclass Class) if (noun ofclass c) print (name) c, " ";
5866         new_line;
5867     }
5868     #Ifdef TARGET_ZCODE;
5869     numattr = 48;
5870     #Ifnot; ! TARGET_GLULX
5871     numattr = NUM_ATTR_BYTES * 8;
5872     #Endif; ! TARGET_
5873     for (a=0,f=0 : a<numattr : a++) if (noun has a) f=1;
5874     if (f) {
5875         print "  has ";
5876         for (a=0 : a<numattr : a++) if (noun has a) print (DebugAttribute) a, " ";
5877         new_line;
5878     }
5879     if (noun ofclass Class) return;
5880
5881     f=0;
5882     #Ifdef TARGET_ZCODE;
5883     l = #identifiers_table-->0;
5884     #Ifnot; ! TARGET_GLULX
5885     l = INDIV_PROP_START + #identifiers_table-->3;
5886     #Endif; ! TARGET_
5887     for (a=1 : a<=l : a++) {
5888         if ((a ~= 2 or 3) && noun.&a) {
5889             if (f == 0) { print "  with "; f=1; }
5890             print (property) a;
5891             n = noun.#a;
5892             for (c=0 : WORDSIZE*c<n : c++) {
5893                 print " ";
5894                 x = (noun.&a)-->c;
5895                 if (a == name) print "'", (address) x, "'";
5896                 else {
5897                     if (a == number or capacity or time_left) print x;
5898                     else {
5899                         switch (x) {
5900                           NULL: print "NULL";
5901                           0:    print "0";
5902                           1:    print "1";
5903                           default:
5904                             switch (metaclass(x)) {
5905                               Class, Object:
5906                                 print (name) x;
5907                               String:
5908                                 print "~", (string) x, "~";
5909                               Routine:
5910                                 print "[...]";
5911                            }
5912                            print " (", x, ")";
5913                         }
5914                     }
5915                 }
5916             }
5917             print ",^       ";
5918         }
5919     }
5920 !   if (f==1) new_line;
5921 ];
5922
5923 [ ShowDictSub_helper x; print (address) x; ];
5924 [ ShowDictSub
5925     dp el ne   f x y z;
5926
5927     #Ifdef TARGET_ZCODE;
5928     dp = HDR_DICTIONARY-->0;             ! start of dictionary
5929     dp = dp + dp->0 + 1;                 ! skip over word-separators table
5930     el = dp->0;  dp = dp + 1;            ! entry length
5931     ne = dp-->0; dp = dp + WORDSIZE;     ! number of entries
5932     #Ifnot; ! TARGET_GLULX;
5933     dp = #dictionary_table;              ! start of dictionary
5934     el = DICT_WORD_SIZE + 7;             ! entry length
5935     ne = dp-->0; dp = dp + WORDSIZE;     ! number of entries
5936     #Endif; ! TARGET_
5937                                          ! dp now at first entry
5938     wn = 2; x = NextWordStopped();
5939     switch (x) {
5940       0:
5941         "That word isn't in the dictionary.";
5942       -1:
5943         ;                                ! show all entries
5944       THEN1__WD:
5945         dp = './/'; ne = 1;              ! show '.'
5946       COMMA_WORD:
5947         dp = ',//'; ne = 1;              ! show ','
5948       default:
5949         dp = x; ne = 1; f = true;        ! show specified entry, plus associated objects
5950     }
5951     for ( : ne-- : dp=dp+el) {
5952         print (address) dp, " --> ";
5953         x = dp->#dict_par1;              ! flag bits
5954         y = PrintToBuffer(StorageForShortName, SHORTNAMEBUF_LEN, ShowDictSub_helper, dp) + WORDSIZE;
5955         for (z=WORDSIZE : z<y : z++) {
5956             !if (x & DICT_NOUN) StorageForShortName->z = UpperCase(StorageForShortName->z);
5957             if (y > WORDSIZE+1 && StorageForShortName->z == ' ' or '.' or ',') x = x | $8000;
5958             print (char) StorageForShortName->z;
5959         }
5960         print " --> ";
5961         if (x == 0)
5962             print " no flags";
5963         else {
5964             !if (x & $0040)     print " BIT_6";
5965             !if (x & $0020)     print " BIT_5";
5966             !if (x & $0010)     print " BIT_4";
5967             if (x & $8000)     print " UNTYPEABLE";
5968             if (x & DICT_NOUN) print " noun";
5969             if (x & DICT_PLUR) print "+plural";
5970             if (x & DICT_VERB) print " verb";
5971             if (x & DICT_META) print "+meta";
5972             if (x & DICT_PREP) print " preposition";
5973             if (f && (x & DICT_NOUN)) {
5974                 print " --> refers to these objects:";
5975                 objectloop (x)
5976                     if (WordInProperty(dp, x, name)) print "^  ", (name) x, " (", x, ")";
5977             }
5978         }
5979         new_line;
5980     }
5981 ];
5982
5983 #Endif; ! DEBUG
5984
5985 ! ----------------------------------------------------------------------------
5986 !  Miscellaneous display routines used by DrawStatusLine and available for
5987 !  user.  Most of these vary according to which machine is being compiled to
5988 ! ----------------------------------------------------------------------------
5989
5990 #Ifdef TARGET_ZCODE;
5991
5992 [ ClearScreen window;
5993     switch (window) {
5994       WIN_ALL:    @erase_window -1;
5995       WIN_STATUS: @erase_window 1;
5996       WIN_MAIN:   @erase_window 0;
5997     }
5998 ];
5999
6000 #Iftrue (#version_number == 6);
6001 [ MoveCursorV6 line column  charw;  ! 1-based postion on text grid
6002     @get_wind_prop 1 13 -> charw; ! font size
6003     charw = charw & $FF;
6004     line = 1 + charw*(line-1);
6005     column = 1 + charw*(column-1);
6006     @set_cursor line column;
6007 ];
6008 #Endif;
6009
6010 #Ifndef MoveCursor;
6011 [ MoveCursor line column;  ! 1-based postion on text grid
6012     if (~~statuswin_current) {
6013         @set_window 1;
6014         #Ifdef COLOUR;
6015         if (clr_on && clr_bgstatus > 1)
6016             @set_colour clr_fgstatus clr_bgstatus;
6017         else
6018         #Endif; ! COLOUR
6019             style reverse;
6020     }
6021     if (line == 0) { line = 1; column = 1; }
6022     #Iftrue (#version_number == 6);
6023     MoveCursorV6(line, column);
6024     #Ifnot;
6025     @set_cursor line column;
6026     #Endif;
6027     statuswin_current = true;
6028 ];
6029 #Endif;
6030
6031 [ MainWindow;
6032     if (statuswin_current) {
6033 #Ifdef COLOUR;
6034         if (clr_on && clr_bgstatus > 1) @set_colour clr_fg clr_bg;
6035         else
6036 #Endif; ! COLOUR
6037             style roman;
6038         @set_window 0;
6039         }
6040     statuswin_current = false;
6041 ];
6042
6043 #Iftrue (#version_number == 6);
6044 [ ScreenWidth  width charw;
6045     @get_wind_prop 1 3 -> width;
6046     @get_wind_prop 1 13 -> charw;
6047     charw = charw & $FF;
6048     if (charw == 0) return width;
6049     return (width+charw-1) / charw;
6050 ];
6051 #Ifnot;
6052 [ ScreenWidth;
6053     return (HDR_SCREENWCHARS->0);
6054 ];
6055 #Endif;
6056
6057 [ ScreenHeight;
6058     return (HDR_SCREENHLINES->0);
6059 ];
6060
6061 #Iftrue (#version_number == 6);
6062 [ StatusLineHeight height  wx wy x y charh;
6063     ! Split the window. Standard 1.0 interpreters should keep the window 0
6064     ! cursor in the same absolute position, but older interpreters,
6065     ! including Infocom's don't - they keep the window 0 cursor in the
6066     ! same position relative to its origin. We therefore compensate
6067     ! manually.
6068     @get_wind_prop 0 0 -> wy; @get_wind_prop 0 1 -> wx;
6069     @get_wind_prop 0 13 -> charh; @log_shift charh $FFF8 -> charh;
6070     @get_wind_prop 0 4 -> y; @get_wind_prop 0 5 -> x;
6071     height = height * charh;
6072     @split_window height;
6073     y = y - height + wy - 1;
6074     if (y < 1) y = 1;
6075     x = x + wx - 1;
6076     @set_cursor y x 0;
6077     gg_statuswin_cursize = height;
6078 ];
6079 #Ifnot;
6080 [ StatusLineHeight height;
6081     if (gg_statuswin_cursize ~= height)
6082         @split_window height;
6083     gg_statuswin_cursize = height;
6084 ];
6085 #Endif;
6086
6087 #Ifdef COLOUR;
6088 [ SetColour f b window;
6089     if (window == 0) {  ! if setting both together, set reverse
6090         clr_fgstatus = b;
6091         clr_bgstatus = f;
6092     }
6093     if (window == 1) {
6094         clr_fgstatus = f;
6095         clr_bgstatus = b;
6096     }
6097     if (window == 0 or 2) {
6098         clr_fg = f;
6099         clr_bg = b;
6100     }
6101     if (clr_on) {
6102         if (statuswin_current)
6103             @set_colour clr_fgstatus clr_bgstatus;
6104         else
6105             @set_colour clr_fg clr_bg;
6106     }
6107 ];
6108 #Endif; ! COLOUR
6109
6110
6111 #Ifnot; ! TARGET_GLULX
6112
6113 [ ClearScreen window;
6114     if (window == WIN_ALL or WIN_MAIN) {
6115         glk_window_clear(gg_mainwin);
6116         if (gg_quotewin) {
6117             glk_window_close(gg_quotewin, 0);
6118             gg_quotewin = 0;
6119         }
6120     }
6121     if (gg_statuswin && window == WIN_ALL or WIN_STATUS)
6122         glk_window_clear(gg_statuswin);
6123 ];
6124
6125 [ MoveCursor line column;  ! 0-based postion on text grid
6126     if (gg_statuswin) {
6127         glk_set_window(gg_statuswin);
6128     }
6129     if (line == 0) { line = 1; column = 1; }
6130     glk_window_move_cursor(gg_statuswin, column-1, line-1);
6131     statuswin_current=1;
6132 ];
6133
6134 [ MainWindow;
6135     glk_set_window(gg_mainwin);
6136     statuswin_current=0;
6137 ];
6138
6139 [ MakeColourWord c;
6140     if (c > 9) return c;
6141     c = c-2;
6142     return $ff0000*(c&1) + $ff00*(c&2 ~= 0) + $ff*(c&4 ~= 0);
6143 ];
6144
6145 [ ScreenWidth  id;
6146     id=gg_mainwin;
6147     if (gg_statuswin && statuswin_current) id = gg_statuswin;
6148     glk_window_get_size(id, gg_arguments, 0);
6149     return gg_arguments-->0;
6150 ];
6151
6152 [ ScreenHeight;
6153     glk_window_get_size(gg_mainwin, 0, gg_arguments);
6154     return gg_arguments-->0;
6155 ];
6156
6157 #Ifdef COLOUR;
6158 [ SetColour f b window doclear  i fwd bwd swin;
6159     if (window) swin = 5-window; ! 4 for TextGrid, 3 for TextBuffer
6160
6161     if (clr_on) {
6162         fwd = MakeColourWord(f);
6163         bwd = MakeColourWord(b);
6164         for (i=0 : i<=10: i++) {
6165             if (f == CLR_DEFAULT || b == CLR_DEFAULT) { ! remove style hints
6166                 glk_stylehint_clear(swin, i, 7);
6167                 glk_stylehint_clear(swin, i, 8);
6168             }
6169             else {
6170                 glk_stylehint_set(swin, i, 7, fwd);
6171                 glk_stylehint_set(swin, i, 8, bwd);
6172             }
6173         }
6174         ! Now re-open the windows to apply the hints
6175         if (gg_statuswin) glk_window_close(gg_statuswin, 0);
6176
6177         if (doclear || ( window ~= 1 && (clr_fg ~= f || clr_bg ~= b) ) ) {
6178             glk_window_close(gg_mainwin, 0);
6179             gg_mainwin = glk_window_open(0, 0, 0, 3, GG_MAINWIN_ROCK);
6180             if (gg_scriptstr ~= 0)
6181                 glk_window_set_echo_stream(gg_mainwin, gg_scriptstr);
6182         }
6183
6184         gg_statuswin = glk_window_open($12, gg_statuswin_cursize,
6185            4, GG_STATUSWIN_ROCK);
6186         if (statuswin_current && gg_statuswin)
6187             MoveCursor(); else MainWindow();
6188     }
6189
6190     if (window ~= 2) {
6191         clr_fgstatus = f;
6192         clr_bgstatus = b;
6193     }
6194     if (window ~= 1) {
6195         clr_fg = f;
6196         clr_bg = b;
6197     }
6198 ];
6199 #Endif; ! COLOUR
6200 #Endif; ! TARGET_
6201
6202 #Ifndef COLOUR;
6203 [ SetColour f b window doclear;
6204     f = b = window = doclear = 0;
6205 ];
6206 #Endif;
6207
6208 [ SetClr f b w;
6209     SetColour (f, b, w);
6210 ];
6211
6212 [ RestoreColours;    ! L61007, L61113
6213     gg_statuswin_cursize = -1;    ! Force window split in StatusLineHeight()
6214     #Ifdef COLOUR;
6215     if (clr_on) { ! check colour has been used
6216         SetColour(clr_fg, clr_bg, 2); ! make sure both sets of variables are restored
6217         SetColour(clr_fgstatus, clr_bgstatus, 1, true);
6218         ClearScreen();
6219     }
6220     #Endif;
6221     #Ifdef TARGET_ZCODE;
6222     #Iftrue (#version_number == 6); ! request screen update
6223     (0-->8) = (0-->8) | $$00000100;
6224     #Endif;
6225     #Endif; ! TARGET_
6226 ];
6227
6228 ! ----------------------------------------------------------------------------
6229 !  Except in Version 3, the DrawStatusLine routine does just that: this is
6230 !  provided explicitly so that it can be Replace'd to change the style, and
6231 !  as written it emulates the ordinary Standard game status line, which is
6232 !  drawn in hardware
6233 ! ----------------------------------------------------------------------------
6234
6235 #Ifdef TARGET_ZCODE;
6236
6237 #IfV5;
6238
6239 #Iftrue (#version_number == 6);
6240 [ DrawStatusLine width x charw scw mvw;
6241     HDR_GAMEFLAGS-->0 = (HDR_GAMEFLAGS-->0) & ~$0004;
6242
6243     StatusLineHeight(gg_statuswin_size);
6244     ! Now clear the window. This isn't totally trivial. Our approach is to
6245     ! select the fixed space font, measure its width, and print an appropriate
6246     ! number of spaces. We round up if the screen isn't a whole number of
6247     ! characters wide, and rely on window 1 being set to clip by default.
6248     MoveCursor(1, 1);
6249     @set_font 4 -> x;
6250     width = ScreenWidth();
6251     spaces width;
6252     ! Back to standard font for the display. We use output_stream 3 to
6253     ! measure the space required, the aim being to get 50 characters
6254     ! worth of space for the location name.
6255     MoveCursor(1, 2);
6256     @set_font 1 -> x;
6257     if (location == thedark)
6258         print (name) location;
6259     else {
6260         FindVisibilityLevels();
6261         if (visibility_ceiling == location) print (name) location;
6262         else                                print (The) visibility_ceiling;
6263     }
6264     @get_wind_prop 1 3 -> width;
6265     @get_wind_prop 1 13 -> charw;
6266     charw = charw & $FF;
6267     @output_stream 3 StorageForShortName;
6268     print (string) SCORE__TX, "00000";
6269     @output_stream -3; scw = HDR_PIXELSTO3-->0 + charw;
6270     @output_stream 3 StorageForShortName;
6271     print (string) MOVES__TX, "00000";
6272     @output_stream -3; mvw = HDR_PIXELSTO3-->0 + charw;
6273     if (width - scw - mvw >= 50*charw) {
6274         x = 1+width-scw-mvw;
6275         @set_cursor 1 x; print (string) SCORE__TX, sline1;
6276         x = x+scw;
6277         @set_cursor 1 x; print (string) MOVES__TX, sline2;
6278     }
6279     else {
6280         @output_stream 3 StorageForShortName;
6281         print "00000/00000";
6282         @output_stream -3; scw = HDR_PIXELSTO3-->0 + charw;
6283         if (width - scw >= 50*charw) {
6284             x = 1+width-scw;
6285             @set_cursor 1 x; print sline1, "/", sline2;
6286         }
6287     }
6288     ! Reselect roman, as Infocom's interpreters interpreters go funny
6289     ! if reverse is selected twice.
6290     MainWindow();
6291 ];
6292
6293 #Endif; ! #version_number == 6
6294
6295 #Endif; ! V5
6296
6297 #Endif; ! TARGET_ZCODE
6298
6299 #Ifndef DrawStatusLine;
6300 [ DrawStatusLine width posa posb;
6301     #Ifdef TARGET_GLULX;
6302     ! If we have no status window, we must not try to redraw it.
6303     if (gg_statuswin == 0)
6304         return;
6305     #Endif;
6306
6307     ! If there is no player location, we shouldn't try to draw status window
6308     if (location == nothing || parent(player) == nothing)
6309         return;
6310
6311     StatusLineHeight(gg_statuswin_size);
6312     MoveCursor(1, 1);
6313
6314     width = ScreenWidth();
6315     posa = width-26; posb = width-13;
6316     spaces width;
6317
6318     MoveCursor(1, 2);
6319     if (location == thedark) {
6320         print (name) location;
6321     }
6322     else {
6323         FindVisibilityLevels();
6324         if (visibility_ceiling == location)
6325             print (name) location;
6326         else
6327             print (The) visibility_ceiling;
6328     }
6329
6330     if (sys_statusline_flag && width > 53) {
6331         MoveCursor(1, posa);
6332         print (string) TIME__TX;
6333         LanguageTimeOfDay(sline1, sline2);
6334     }
6335     else {
6336         if (width > 66) {
6337             #Ifndef NO_SCORE;
6338             MoveCursor(1, posa);
6339             print (string) SCORE__TX, sline1;
6340             #Endif;
6341             MoveCursor(1, posb);
6342             print (string) MOVES__TX, sline2;
6343         }
6344         #Ifndef NO_SCORE;
6345         if (width > 53 && width <= 66) {
6346             MoveCursor(1, posb);
6347             print sline1, "/", sline2;
6348         }
6349         #Endif;
6350     }
6351
6352     MainWindow(); ! set_window
6353 ];
6354 #Endif;
6355
6356 #Ifdef TARGET_GLULX;
6357
6358 [ StatusLineHeight hgt parwin;
6359     if (gg_statuswin == 0) return;
6360     if (hgt == gg_statuswin_cursize) return;
6361     parwin = glk_window_get_parent(gg_statuswin);
6362     glk_window_set_arrangement(parwin, $12, hgt, 0);
6363     gg_statuswin_cursize = hgt;
6364 ];
6365
6366 [ Box__Routine maxwid arr ix lines lastnl parwin;
6367     maxwid = 0; ! squash compiler warning
6368     lines = arr-->0;
6369
6370     if (gg_quotewin == 0) {
6371         gg_arguments-->0 = lines;
6372         ix = InitGlkWindow(GG_QUOTEWIN_ROCK);
6373         if (ix == false) ix = LibraryExtensions.RunWhile(ext_InitGlkWindow, 0, GG_QUOTEWIN_ROCK);
6374         if (ix == false)
6375             gg_quotewin = glk_window_open(gg_mainwin, $12, lines, 3,
6376                 GG_QUOTEWIN_ROCK); ! window_open
6377     }
6378     else {
6379         parwin = glk_window_get_parent(gg_quotewin);
6380         glk_window_set_arrangement(parwin, $12, lines, 0);
6381     }
6382
6383     lastnl = true;
6384     if (gg_quotewin) {
6385         glk_window_clear(gg_quotewin);
6386         glk_set_window(gg_quotewin);
6387         lastnl = false;
6388     }
6389
6390     ! If gg_quotewin is zero here, the quote just appears in the story window.
6391
6392     glk_set_style(style_BlockQuote);
6393     for (ix=0 : ix<lines : ix++) {
6394         print (string) arr-->(ix+1);
6395         if (ix < lines-1 || lastnl) new_line;
6396     }
6397     glk_set_style(style_Normal);
6398
6399     if (gg_quotewin) {
6400         glk_set_window(gg_mainwin);
6401     }
6402 ];
6403
6404 #Endif; ! TARGET_GLULX
6405
6406
6407 #Ifdef TARGET_ZCODE;
6408
6409 [ ZZInitialise;
6410     standard_interpreter = HDR_TERPSTANDARD-->0;
6411    transcript_mode = ((HDR_GAMEFLAGS-->0) & $0001);
6412     sys_statusline_flag = ( (HDR_TERPFLAGS->0) & $0002 ) / 2;
6413     top_object = #largest_object-255;
6414
6415     dict_start = HDR_DICTIONARY-->0;
6416     dict_entry_size = dict_start->(dict_start->0 + 1);
6417     dict_start = dict_start + dict_start->0 + 4;
6418     dict_end = dict_start + (dict_start - 2)-->0 * dict_entry_size;
6419     #Ifdef DEBUG;
6420     if (dict_start > 0 && dict_end < 0 &&
6421       ((-dict_start) - dict_end) % dict_entry_size == 0)
6422         print "** Warning: grammar properties might not work correctly **^";
6423     #Endif; ! DEBUG
6424
6425     buffer->0  = INPUT_BUFFER_LEN - WORDSIZE;
6426     buffer2->0 = INPUT_BUFFER_LEN - WORDSIZE;
6427     buffer3->0 = INPUT_BUFFER_LEN - WORDSIZE;
6428     parse->0   = MAX_BUFFER_WORDS;
6429     parse2->0  = MAX_BUFFER_WORDS;
6430 ];
6431
6432 #Ifnot; ! TARGET_GLULX;
6433
6434 [ GGInitialise res;
6435     @gestalt 4 2 res; ! Test if this interpreter has Glk.
6436     if (res == 0) {
6437       ! Without Glk, we're entirely screwed.
6438       quit;
6439     }
6440     ! Set the VM's I/O system to be Glk.
6441     @setiosys 2 0;
6442
6443     ! First, we must go through all the Glk objects that exist, and see
6444     ! if we created any of them. One might think this strange, since the
6445     ! program has just started running, but remember that the player might
6446     ! have just typed "restart".
6447
6448     GGRecoverObjects();
6449     res = InitGlkWindow(0);
6450     if (res == false) res = LibraryExtensions.RunWhile(ext_InitGlkWindow, 0, 0);
6451     if (res) return;
6452
6453     ! Now, gg_mainwin and gg_storywin might already be set. If not, set them.
6454
6455     if (gg_mainwin == 0) {
6456         ! Open the story window.
6457         res = InitGlkWindow(GG_MAINWIN_ROCK);
6458         if (res == false) res = LibraryExtensions.RunWhile(ext_InitGlkWindow, 0, GG_MAINWIN_ROCK);
6459         if (res == false)
6460             gg_mainwin = glk_window_open(0, 0, 0, 3, GG_MAINWIN_ROCK);
6461         if (gg_mainwin == 0) {
6462             ! If we can't even open one window, there's no point in going on.
6463             quit;
6464         }
6465     }
6466     else {
6467         ! There was already a story window. We should erase it.
6468         glk_window_clear(gg_mainwin);
6469     }
6470
6471     if (gg_statuswin == 0) {
6472         res = InitGlkWindow(GG_STATUSWIN_ROCK);
6473         if (res == false) res = LibraryExtensions.RunWhile(ext_InitGlkWindow, 0, GG_STATUSWIN_ROCK);
6474         if (res == false) {
6475             gg_statuswin_cursize = gg_statuswin_size;
6476             gg_statuswin = glk_window_open(gg_mainwin, $12,
6477                 gg_statuswin_cursize, 4, GG_STATUSWIN_ROCK);
6478         }
6479     }
6480     ! It's possible that the status window couldn't be opened, in which case
6481     ! gg_statuswin is now zero. We must allow for that later on.
6482
6483     glk_set_window(gg_mainwin);
6484
6485     if (InitGlkWindow(1) == false) LibraryExtensions.RunWhile(ext_InitGlkWindow, 0, 1);
6486 ];
6487
6488 [ GGRecoverObjects id;
6489     ! If GGRecoverObjects() has been called, all these stored IDs are
6490     ! invalid, so we start by clearing them all out.
6491     ! (In fact, after a restoreundo, some of them may still be good.
6492     ! For simplicity, though, we assume the general case.)
6493     gg_mainwin = 0;
6494     gg_statuswin = 0;
6495     gg_quotewin = 0;
6496     gg_scriptfref = 0;
6497     gg_scriptstr = 0;
6498     gg_savestr = 0;
6499     gg_statuswin_cursize = 0;
6500     #Ifdef DEBUG;
6501     gg_commandstr = 0;
6502     gg_command_reading = false;
6503     #Endif; ! DEBUG
6504     ! Also tell the game to clear its object references.
6505     if (IdentifyGlkObject(0) == false) LibraryExtensions.RunWhile(ext_identifyglkobject, 0, 0);
6506
6507     id = glk_stream_iterate(0, gg_arguments);
6508     while (id) {
6509         switch (gg_arguments-->0) {
6510             GG_SAVESTR_ROCK: gg_savestr = id;
6511             GG_SCRIPTSTR_ROCK: gg_scriptstr = id;
6512             #Ifdef DEBUG;
6513             GG_COMMANDWSTR_ROCK: gg_commandstr = id;
6514                                  gg_command_reading = false;
6515             GG_COMMANDRSTR_ROCK: gg_commandstr = id;
6516                                  gg_command_reading = true;
6517             #Endif; ! DEBUG
6518             default: if (IdentifyGlkObject(1, 1, id, gg_arguments-->0) == false)
6519                          LibraryExtensions.RunWhile(ext_identifyglkobject, false, 1, 1, id, gg_arguments-->0);
6520         }
6521         id = glk_stream_iterate(id, gg_arguments);
6522     }
6523
6524     id = glk_window_iterate(0, gg_arguments);
6525     while (id) {
6526         switch (gg_arguments-->0) {
6527             GG_MAINWIN_ROCK: gg_mainwin = id;
6528             GG_STATUSWIN_ROCK: gg_statuswin = id;
6529             GG_QUOTEWIN_ROCK: gg_quotewin = id;
6530             default: if (IdentifyGlkObject(1, 0, id, gg_arguments-->0) == false)
6531                         LibraryExtensions.RunWhile(ext_identifyglkobject, false, 1, 0, id, gg_arguments-->0);
6532         }
6533         id = glk_window_iterate(id, gg_arguments);
6534     }
6535
6536     id = glk_fileref_iterate(0, gg_arguments);
6537     while (id) {
6538         switch (gg_arguments-->0) {
6539             GG_SCRIPTFREF_ROCK: gg_scriptfref = id;
6540             default: if (IdentifyGlkObject(1, 2, id, gg_arguments-->0) == false)
6541                         LibraryExtensions.RunWhile(ext_identifyglkobject, false, 1, 2, id, gg_arguments-->0);
6542         }
6543         id = glk_fileref_iterate(id, gg_arguments);
6544     }
6545
6546     ! Tell the game to tie up any loose ends.
6547     if (IdentifyGlkObject(2) == false)
6548         LibraryExtensions.RunWhile(ext_identifyglkobject, 0, 2);
6549 ];
6550
6551 ! This somewhat obfuscated function will print anything.
6552 ! It handles strings, functions (with optional arguments), objects,
6553 ! object properties (with optional arguments), and dictionary words.
6554 ! It does *not* handle plain integers, but you can use
6555 ! DecimalNumber or EnglishNumber to handle that case.
6556 !
6557 ! Calling:                           Is equivalent to:
6558 ! -------                            ----------------
6559 ! PrintAnything()                    <nothing printed>
6560 ! PrintAnything(0)                   <nothing printed>
6561 ! PrintAnything("string");           print (string) "string";
6562 ! PrintAnything('word')              print (address) 'word';
6563 ! PrintAnything(obj)                 print (name) obj;
6564 ! PrintAnything(obj, prop)           obj.prop();
6565 ! PrintAnything(obj, prop, args...)  obj.prop(args...);
6566 ! PrintAnything(func)                func();
6567 ! PrintAnything(func, args...)       func(args...);
6568
6569 [ PrintAnything _vararg_count obj mclass;
6570     print_anything_result = 0;
6571     if (_vararg_count == 0) return;
6572     @copy sp obj;
6573     _vararg_count--;
6574     if (obj == 0) return;
6575
6576     if (obj->0 == $60) {
6577         ! Dictionary word. Metaclass() can't catch this case, so we do
6578         ! it manually.
6579         print (address) obj;
6580         return;
6581     }
6582
6583     mclass = metaclass(obj);
6584     switch (mclass) {
6585       nothing:
6586         return;
6587       String:
6588         print (string) obj;
6589         return;
6590       Routine:
6591         ! Call the function with all the arguments which are already
6592         ! on the stack.
6593         @call obj _vararg_count print_anything_result;
6594         return;
6595       Object:
6596         if (_vararg_count == 0) {
6597             print (name) obj;
6598         }
6599         else {
6600             ! Push the object back onto the stack, and call the
6601             ! veneer routine that handles obj.prop() calls.
6602             @copy obj sp;
6603             _vararg_count++;
6604             @call CA__Pr _vararg_count print_anything_result;
6605         }
6606         return;
6607     }
6608 ];
6609
6610 ! This does the same as PrintAnything, but the output is sent to a
6611 ! byte array in memory. The first two arguments must be the array
6612 ! address and length; the following arguments are interpreted as
6613 ! for PrintAnything. The return value is the number of characters
6614 ! output.
6615 ! If the output is longer than the array length given, the extra
6616 ! characters are discarded, so the array does not overflow.
6617 ! (However, the return value is the total length of the output,
6618 ! including discarded characters.)
6619
6620 [ PrintAnyToArray _vararg_count arr arrlen str oldstr len;
6621     @copy sp arr;
6622     @copy sp arrlen;
6623     _vararg_count = _vararg_count - 2;
6624
6625     oldstr = glk_stream_get_current(); ! stream_get_current
6626     str = glk_stream_open_memory(arr, arrlen, 1, 0);
6627     if (str == 0) return 0;
6628
6629     glk_stream_set_current(str);
6630
6631     @call PrintAnything _vararg_count 0;
6632
6633     glk_stream_set_current(oldstr);
6634     @copy $ffffffff sp;
6635     @copy str sp;
6636     @glk $0044 2 0;
6637     @copy sp len;
6638     @copy sp 0;
6639
6640     return len;
6641 ];
6642
6643 ! And this calls PrintAnyToArray on a particular array, jiggering
6644 ! the result to be a Glulx C-style ($E0) string.
6645
6646 Constant GG_ANYTOSTRING_LEN 66;
6647 Array AnyToStrArr -> GG_ANYTOSTRING_LEN+1;
6648
6649 [ ChangeAnyToCString _vararg_count ix len;
6650     ix = GG_ANYTOSTRING_LEN-2;
6651     @copy ix sp;
6652     ix = AnyToStrArr+1;
6653     @copy ix sp;
6654     ix = _vararg_count+2;
6655     @call PrintAnyToArray ix len;
6656     AnyToStrArr->0 = $E0;
6657     if (len >= GG_ANYTOSTRING_LEN)
6658         len = GG_ANYTOSTRING_LEN-1;
6659     AnyToStrArr->(len+1) = 0;
6660     return AnyToStrArr;
6661 ];
6662
6663 #Endif; ! TARGET_
6664
6665 ! This is a trivial function which just prints a number, in decimal
6666 ! digits. It may be useful as a stub to pass to PrintAnything.
6667
6668 [ DecimalNumber num; print num; ];
6669
6670 #Ifndef SHORTNAMEBUF_LEN;               ! Can't use 'Default', unfortunately,
6671 Constant SHORTNAMEBUF_LEN 160;          ! but this is functionally equivalent
6672 #Endif;
6673
6674 #IfV5;
6675 #Ifdef VN_1630;
6676 Array StorageForShortName buffer SHORTNAMEBUF_LEN;
6677 #Ifnot;
6678 Array StorageForShortName -> WORDSIZE + SHORTNAMEBUF_LEN;
6679 #Endif; ! VN_1630
6680
6681 #Endif; ! V5
6682
6683 #Ifdef TARGET_ZCODE;
6684
6685 ! Platform-independent way of printing strings, routines and properties
6686 ! to a buffer (defined as length word followed by byte characters).
6687
6688 [ PrintToBuffer buf len a b c d e;
6689     print_anything_result = 0;
6690     @output_stream 3 buf;
6691     switch (metaclass(a)) {
6692       String:
6693         print (string) a;
6694       Routine:
6695         print_anything_result = a(b, c, d, e);
6696       Object,Class:
6697         if (b)
6698             print_anything_result = PrintOrRun(a, b, true);
6699         else
6700             print (name) a;
6701     }
6702     @output_stream -3;
6703     if (buf-->0 > len) RunTimeError(14, len, "in PrintToBuffer()");
6704     return buf-->0;
6705 ];
6706
6707 #Ifnot; ! TARGET_GLULX
6708
6709 [ PrintToBuffer buf len a b c d e;
6710     if (b) {
6711         if (metaclass(a) == Object && a.#b == WORDSIZE
6712             && metaclass(a.b) == String)
6713             buf-->0 = PrintAnyToArray(buf+WORDSIZE, len, a.b);
6714         else
6715             buf-->0 = PrintAnyToArray(buf+WORDSIZE, len, a, b, c, d, e);
6716     }
6717     else
6718         buf-->0 = PrintAnyToArray(buf+WORDSIZE, len, a);
6719     if (buf-->0 > len) buf-->0 = len;
6720     return buf-->0;
6721 ];
6722
6723 #Endif; ! TARGET_
6724
6725 ! Print contents of buffer (defined as length word followed by byte characters).
6726 ! no_break == 1: omit trailing newline.
6727 ! set_case == 1: capitalise first letter;
6728 !          == 2: capitalise first letter, remainder lower case;
6729 !          == 3: all lower case;
6730 !          == 4: all upper case.
6731 ! centred == 1:  add leading spaces.
6732
6733 [ PrintFromBuffer buf no_break set_case centred
6734     i j k;
6735     j = (buf-->0) - 1;
6736     if (buf->(j+WORDSIZE) ~= 10 or 13) j++;     ! trim any trailing newline
6737     if (centred) {
6738         k = (ScreenWidth() - j) / 2;
6739         if (k>0) spaces k;
6740     }
6741     for (i=0 : i<j : i++) {
6742         k = buf->(WORDSIZE+i);
6743         switch (set_case) {
6744           0:    break;
6745           1:    if (i) set_case = 0;
6746                 else   k = UpperCase(k);
6747           2:    if (i) k = LowerCase(k);
6748                 else   k = UpperCase(k);
6749           3:           k = LowerCase(k);
6750           4:           k = UpperCase(k);
6751         }
6752         print (char) k;
6753     }
6754     if (no_break == false) new_line;
6755     return j;
6756 ];
6757
6758 ! None of the following functions should be called for zcode if the
6759 ! output exceeds the size of the buffer.
6760
6761 [ StringSize a b c d e;
6762     PrintToBuffer(StorageForShortName, 160, a, b, c, d, e);
6763     return StorageForShortName-->0;
6764 ];
6765
6766 [ PrintCapitalised a b no_break no_caps centred;
6767     if (metaclass(a) == Routine or String || b == 0 || metaclass(a.b) == Routine or String)
6768         PrintToBuffer(StorageForShortName, SHORTNAMEBUF_LEN, a, b);
6769     else
6770         if (a.b == NULL) rfalse;
6771         else             return RunTimeError(2, a, b);
6772     if (no_caps == 0 or 1) no_caps = ~~no_caps;
6773     PrintFromBuffer(StorageForShortName, no_break, no_caps, centred);
6774     return print_anything_result;
6775 ];
6776
6777 [ Centre a b;
6778     PrintCapitalised(a, b, false, true, true);
6779 ];
6780
6781 [ CapitRule str no_caps;
6782     if (no_caps) print (string) str;
6783     else         PrintCapitalised(str,0,true);
6784 ];
6785
6786 [ PrefaceByArticle o acode pluralise capitalise  i artform findout artval;
6787     if (o provides articles) {
6788         artval=(o.&articles)-->(acode+short_name_case*LanguageCases);
6789         if (capitalise)
6790             print (CapitRule) artval;
6791         else
6792             print (string) artval;
6793         if (pluralise) return;
6794         print (PSN__) o; return;
6795     }
6796
6797     i = GetGNAOfObject(o);
6798     if (pluralise) {
6799         if (i < 3 || (i >= 6 && i < 9)) i = i + 3;
6800     }
6801     i = LanguageGNAsToArticles-->i;
6802
6803     artform = LanguageArticles
6804         + 3*WORDSIZE*LanguageContractionForms*(short_name_case + i*LanguageCases);
6805
6806     #Iftrue (LanguageContractionForms == 2);
6807     if (artform-->acode ~= artform-->(acode+3)) findout = true;
6808     #Endif; ! LanguageContractionForms
6809     #Iftrue (LanguageContractionForms == 3);
6810     if (artform-->acode ~= artform-->(acode+3)) findout = true;
6811     if (artform-->(acode+3) ~= artform-->(acode+6)) findout = true;
6812     #Endif; ! LanguageContractionForms
6813     #Iftrue (LanguageContractionForms == 4);
6814     if (artform-->acode ~= artform-->(acode+3)) findout = true;
6815     if (artform-->(acode+3) ~= artform-->(acode+6)) findout = true;
6816     if (artform-->(acode+6) ~= artform-->(acode+9)) findout = true;
6817     #Endif; ! LanguageContractionForms
6818     #Iftrue (LanguageContractionForms > 4);
6819     findout = true;
6820     #Endif; ! LanguageContractionForms
6821
6822     #Ifdef TARGET_ZCODE;
6823     if (standard_interpreter && findout) {
6824         StorageForShortName-->0 = SHORTNAMEBUF_LEN;
6825         @output_stream 3 StorageForShortName;
6826         if (pluralise) print (number) pluralise; else print (PSN__) o;
6827         @output_stream -3;
6828         acode = acode + 3*LanguageContraction(StorageForShortName + 2);
6829     }
6830     #Ifnot; ! TARGET_GLULX
6831     if (findout) {
6832         if (pluralise)
6833             PrintAnyToArray(StorageForShortName, SHORTNAMEBUF_LEN, EnglishNumber, pluralise);
6834         else
6835             PrintAnyToArray(StorageForShortName, SHORTNAMEBUF_LEN, PSN__, o);
6836         acode = acode + 3*LanguageContraction(StorageForShortName);
6837     }
6838     #Endif; ! TARGET_
6839
6840     CapitRule (artform-->acode, ~~capitalise); ! print article
6841     if (pluralise) return;
6842     print (PSN__) o;
6843 ];
6844
6845 [ PSN__ o;
6846     if (o == 0) { print (string) NOTHING__TX; rtrue; }
6847     switch (metaclass(o)) {
6848       Routine:  print "<routine ", o, ">"; rtrue;
6849       String:   print "<string ~", (string) o, "~>"; rtrue;
6850       nothing:  print "<illegal object number ", o, ">"; rtrue;
6851     }
6852     #Ifdef LanguagePrintShortName;
6853     if (LanguagePrintShortName(o)) rtrue;
6854     #Endif; ! LanguagePrintShortName
6855     if (indef_mode && o.&short_name_indef ~= 0 && PrintOrRun(o, short_name_indef, 1) ~= 0) rtrue;
6856     if (o.&short_name ~= 0 && PrintOrRun(o, short_name, 1) ~= 0) rtrue;
6857     print (object) o;
6858 ];
6859
6860 [ Indefart o saveIndef;
6861     saveIndef = indef_mode; indef_mode = true; caps_mode = false;
6862     if (o has proper) {
6863         indef_mode = NULL;
6864         print (PSN__) o;
6865         indef_mode = saveIndef;
6866         return;
6867     }
6868
6869     if (o provides article) {
6870         PrintOrRun(o, article, 1);
6871         print " ", (PSN__) o;
6872         indef_mode = saveIndef;
6873         return;
6874     }
6875     PrefaceByArticle(o, 2);
6876     indef_mode = saveIndef;
6877 ];
6878
6879 [ CInDefArt o saveIndef saveCaps;
6880     saveIndef = indef_mode; indef_mode = true;
6881     saveCaps = caps_mode; caps_mode = true;
6882
6883     if (o has proper) {
6884         indef_mode = NULL;
6885         PrintToBuffer(StorageForShortName, SHORTNAMEBUF_LEN, PSN__, o);
6886         PrintFromBuffer(StorageForShortName, true, caps_mode);
6887         caps_mode = saveCaps;
6888         return;
6889     }
6890
6891     if (o provides article) {
6892         PrintCapitalised(o, article, true);
6893         print " ", (PSN__) o;
6894         indef_mode = saveIndef;
6895         caps_mode = saveCaps;
6896         return;
6897     }
6898     PrefaceByArticle(o, 2, 0, 1);
6899     caps_mode = saveCaps;
6900     indef_mode = saveIndef;
6901 ];
6902
6903 [ Defart o saveIndef;
6904     saveIndef = indef_mode;
6905     indef_mode = false;
6906     caps_mode = false;
6907     if ((~~o ofclass Object) || o has proper) {
6908         indef_mode = NULL;
6909         if (o == player) {
6910             if (player provides narrative_voice) {
6911                 switch (player.narrative_voice) {
6912                   1:  print (string) MYSELF__TX;
6913                   2:  print (string) YOURSELF__TX;
6914                   3:  print (PSN__) o;
6915                   default: RunTimeError(16, player.narrative_voice);
6916                 }
6917             }
6918             else ThatOrThose(player);
6919         } else {
6920             print (PSN__) o;
6921         }
6922         indef_mode = saveIndef;
6923         return;
6924     }
6925     PrefaceByArticle(o, 1);
6926     indef_mode = saveIndef;
6927 ];
6928
6929 [ CDefart o saveIndef saveCaps;
6930     saveIndef = indef_mode; indef_mode = false;
6931     saveCaps = caps_mode; caps_mode = true;
6932     if (~~o ofclass Object) {
6933         indef_mode = NULL; print (PSN__) o;
6934     }
6935     else
6936         if (o has proper) {
6937             indef_mode = NULL;
6938             PrintToBuffer(StorageForShortName, SHORTNAMEBUF_LEN, PSN__, o);
6939             PrintFromBuffer(StorageForShortName, true, caps_mode);
6940         }
6941         else
6942             PrefaceByArticle(o, 0);
6943     indef_mode = saveIndef; caps_mode = saveCaps;
6944 ];
6945
6946 [ PrintShortName o saveIndef;
6947     saveIndef = indef_mode; indef_mode = NULL;
6948     PSN__(o); indef_mode = saveIndef;
6949 ];
6950
6951 [ EnglishNumber n; LanguageNumber(n); ];
6952
6953 [ SerialComma n;
6954     #Ifdef SERIAL_COMMAS;
6955     if (n>2) print ",";
6956     #Endif;
6957     n=0;        ! quell unused n variable warning
6958 ];
6959
6960 [ NumberWord o i n;
6961     n = LanguageNumbers-->0;
6962     for (i=1 : i<=n : i=i+2)
6963         if (o == LanguageNumbers-->i) return LanguageNumbers-->(i+1);
6964     return 0;
6965 ];
6966
6967 [ RandomEntry tab;
6968     if (tab-->0 == 0) return RunTimeError(8);
6969     return tab-->(random(tab-->0));
6970 ];
6971
6972 ! ----------------------------------------------------------------------------
6973 !  Useful routine: unsigned comparison (for addresses in Z-machine)
6974 !    Returns 1 if x>y, 0 if x=y, -1 if x<y
6975 ! ----------------------------------------------------------------------------
6976
6977 [ UnsignedCompare x y u v;
6978     if (x == y) return 0;
6979     if (x < 0 && y >= 0) return 1;
6980     if (x >= 0 && y < 0) return -1;
6981     u = x&~WORD_HIGHBIT; v= y&~WORD_HIGHBIT;
6982     if (u > v) return 1;
6983     return -1;
6984 ];
6985
6986 ! ==============================================================================
6987
6988 #Ifdef NITFOL_HOOKS;          ! Code contributed by Evin Robertson
6989 #Ifdef TARGET_GLULX;          ! Might be nice for Z-machine games too,
6990                               ! but I'm not going to try to make this work
6991                               ! given #Ifdef funniness.
6992
6993 Array magic_array -->         ! This is so nitfol can do typo correction /
6994                               ! automapping / debugging on Glulx games
6995     $6e66726d $4d616763 $ff0010 ! Goes to 'NfrmMagc'  10 refers to length
6996     Magic_Global_Dispatch__
6997     DI__check_word            ! DI__check_word(buf, length)
6998     PrintShortName
6999     WV__Pr RV__Pr CA__Pr      ! obj.prop = x; x = obj.prop; obj.prop(x)
7000     RA__Pr RL__Pr RA__Sc      ! obj.&prop; obj.#prop; class::prop
7001     OP__Pr OC__Cl             ! obj provides prop; obj ofclass class
7002     OB__Move OB__Remove
7003     OB__Parent__ OB__Child__ OB__Sibling__  ! No explicit veneer for these
7004     ;
7005
7006 [ OB__Parent__ obj; return parent(obj); ];
7007
7008 [ OB__Child__ obj; return child(obj); ];
7009
7010 [ OB__Sibling__ obj; return sibling(obj); ];
7011
7012 [ Magic_Global_Dispatch__ glbl;
7013     switch (glbl) {
7014       0:
7015         if (location == TheDark) return real_location; return location;
7016       1:
7017         return Player;
7018       -1:
7019         return CompassDirection::number; ! Silliness to make exist RA__Sc
7020                                          ! Should never be called.
7021     }
7022     return magic_array;       ! Silences a warning.
7023 ];
7024
7025 [ DI__check_word buf wlen  ix val res dictlen entrylen;
7026     ! Just like in Tokenise__.  In fact, Tokenise__ could call this if
7027     ! it wanted, instead of doing this itself.
7028     if (wlen > DICT_WORD_SIZE) wlen = DICT_WORD_SIZE;
7029     for (ix=0 : ix<wlen : ix++) {
7030         gg_tokenbuf->ix = glk_char_to_lower(buf->ix);
7031     }
7032     for (: ix<DICT_WORD_SIZE : ix++) {
7033         gg_tokenbuf->ix = 0;
7034     }
7035     val = #dictionary_table + WORDSIZE;
7036     entrylen = DICT_WORD_SIZE + 7;
7037     @binarysearch gg_tokenbuf DICT_WORD_SIZE val entrylen dictlen 1 1 res;
7038     return res;
7039 ];
7040
7041 #Endif; ! TARGET_
7042 #Endif; ! NITFOL_HOOKS
7043
7044 ! ==============================================================================
7045
7046 Object  LibraryExtensions "(Library Extensions)"
7047   with  RunAll [ prop a1 a2 a3
7048             obj rval max;
7049             objectloop (obj in self)
7050                 if (obj provides prop && obj.prop ofclass Routine) {
7051                     rval = obj.prop(a1, a2, a3);
7052                     if (rval > max) max = rval;
7053                     if (self.BetweenCalls) self.BetweenCalls();
7054                 }
7055             return max;
7056         ],
7057         RunUntil [ prop exitval a1 a2 a3
7058             obj rval;
7059             objectloop (obj in self)
7060                 if (obj provides prop && obj.prop ofclass Routine) {
7061                     rval = obj.prop(a1, a2, a3);
7062                     if (rval == exitval) return rval;
7063                     if (self.BetweenCalls) self.BetweenCalls();
7064                 }
7065             return ~~exitval;
7066         ],
7067         RunWhile [ prop exitval a1 a2 a3
7068             obj rval;
7069             objectloop (obj in self)
7070                 if (obj provides prop && obj.prop ofclass Routine) {
7071                     rval = obj.prop(a1, a2, a3);
7072                     if (rval ~= exitval) return rval;
7073                     if (self.BetweenCalls) self.BetweenCalls();
7074                 }
7075             return exitval;
7076         ],
7077
7078         ext_number_1 0, ! general temporary workspace
7079
7080         ! can be set to a function (e.g. RestoreWN) meant for execution
7081         ! after non-terminating calls to extension objects
7082         ! (via RunUntil/While/All)
7083         BetweenCalls 0,
7084         RestoreWN [; wn = self.ext_number_1; ],
7085
7086         ! Special interception points
7087         ext_messages            0,  ! Called if LibraryMessages.before()
7088                                     !    returns false
7089                                     ! Extensions run while they return false
7090
7091         ! Cross-platform entry points
7092         !                             Called/Runs
7093         ext_afterlife           0,  ! [C2/R1]
7094         ext_afterprompt         0,  ! [C2/R1]
7095         ext_amusing             0,  ! [C2/R1]
7096         ext_beforeparsing       0,  ! [C2/R2]
7097         ext_chooseobjects       0,  ! [C2/R2]
7098         ext_darktodark          0,  ! [C2/R1]
7099         ext_deathmessage        0,  ! [C2/R1]
7100         ext_gamepostroutine     0,  ! [C2/R2]
7101         ext_gamepreroutine      0,  ! [C2/R2]
7102         ext_initialise          0,  ! [C1/R1]
7103         ext_inscope             0,  ! [C2/R2]
7104         ext_lookroutine         0,  ! [C2/R1]
7105         ext_newroom             0,  ! [C2/R1]
7106         ext_objectdoesnotfit    0,  ! [C2/R2]
7107         ext_parsenoun           0,  ! [C3/R3]
7108         ext_parsenumber         0,  ! [C2/R2]
7109         ext_parsererror         0,  ! [C2/R2]
7110         ext_printrank           0,  ! [C2/R1]
7111         ext_printtaskname       0,  ! [C2/R1]
7112         ext_printverb           0,  ! [C2/R2]
7113         ext_timepasses          0,  ! [C2/R1]
7114         ext_unknownverb         0,  ! [C2/R2]
7115         !                             [C1] = Called in all cases
7116         !                             [C2] = Called if EP is undefined, or returns false
7117         !                             [C3] = called if EP is undefined, or returns -1
7118         !                             [R1] = All extensions run
7119         !                             [R2] = Extensions run while they return false
7120         !                             [R3] = Extensions run while they return -1
7121
7122         #Ifdef TARGET_GLULX;
7123         ! Glulx entry points
7124         !                             Called:           Runs:
7125         ext_handleglkevent      0,  ! if EP undefined   while extensions return false
7126         ext_identifyglkobject   0,  ! if EP undefined   while extensions return false
7127         ext_initglkwindow       0,  ! if EP undefined   while extensions return false
7128         #Endif; ! TARGET_GLULX;
7129
7130   has   proper;
7131
7132 ! ==============================================================================