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