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