I6 inclusions: in-game messages about window, parent, stream

I’m fiddling around with a parser hack, and I’m getting some very weird messages when I run the game. In one important case, after the game prints text that I’ve told it to print, I get this:

Any idea what could be causing this? It’s happening at a point where I’ve tried to get the parser to reparse a command when it’s not expecting me to, so I may have copied a buffer wrong or failed to initialize a pointer properly or something. I know little enough about I6 that I’m not sure that any of the things I just said made sense.

Here’s the code of my extension as it stands; things I changed are marked in comments with “RD:”:

[spoiler][code]Responsive Disambiguation for 6M62 by Matt Weiner begins here.

Section 1 - New Globals

Include
(- Global processing_disambiguation; ! set to 1 if we are currently processing a disambiguation request
Global asked_for_disambiguation; ! set to 1 if we just asked for disambiguation
-) before “Parser.i6t”.

Section 2 - Parser Letter A Replacement

[The only change here is that we reset the flags. We reset the asked_for_disambiguation flag before the point where we jump to reparse, and we reset the processing_disambiguation flag after the point where we jump to reparse, if the asked_for_disambiguation flag isn’t currently set. That should mean that when we’re reparsing a disambiguated command the processing_disambiguation flag stays set, while they get reset with every fresh command]

Include
(-
if (held_back_mode) {
held_back_mode = false; wn = hb_wn;
if (verb_wordnum > 0) i = WordAddress(verb_wordnum); else i = WordAddress(1);
j = WordAddress(wn);
if (i<=j) for (: i<j : i++) i->0 = ’ ';
i = NextWord();
if (i == AGAIN1__WD or AGAIN2__WD or AGAIN3__WD) {
! Delete the words “then again” from the again buffer,
! in which we have just realised that it must occur:
! prevents an infinite loop on “i. again”

        i = WordAddress(wn-2)-buffer;
        if (wn > num_words) j = INPUT_BUFFER_LEN-1;
        else j = WordAddress(wn)-buffer;
        for (: i<j : i++) buffer3->i = ' ';
    }

    VM_Tokenise(buffer, parse);
    jump ReParse;
}

.ReType;

cobj_flag = 0;
actors_location = ScopeCeiling(player);
BeginActivity(READING_A_COMMAND_ACT); if (ForActivity(READING_A_COMMAND_ACT)==false) {
	Keyboard(buffer,parse);
	num_words = WordCount(); players_command = 100 + num_words;
} if (EndActivity(READING_A_COMMAND_ACT)) jump ReType;

asked_for_disambiguation = 0; ! RD: reset asked_for_disambiguation after getting the normal command and before reparsing

.ReParse;

! RD: while reparsing, if we didn’t ask for disambiguation, we want to make sure we haven’t
! RD: marked that we’re processing disambiguation
if (asked_for_disambiguation == 0) processing_disambiguation =0;

parser_inflection = name;

! Initially assume the command is aimed at the player, and the verb
! is the first word

num_words = WordCount(); players_command = 100 + num_words;
wn = 1; inferred_go = false;

#Ifdef LanguageToInformese;
LanguageToInformese();
! Re-tokenise:
VM_Tokenise(buffer,parse);
#Endif; ! LanguageToInformese

num_words = WordCount(); players_command = 100 + num_words;

k=0;
#Ifdef DEBUG;
if (parser_trace >= 2) {
    print "[ ";
    for (i=0 : i<num_words : i++) {

        #Ifdef TARGET_ZCODE;
        j = parse-->(i*2 + 1);
        #Ifnot; ! TARGET_GLULX
        j = parse-->(i*3 + 1);
        #Endif; ! TARGET_
        k = WordAddress(i+1);
        l = WordLength(i+1);
        print "~"; for (m=0 : m<l : m++) print (char) k->m; print "~ ";

        if (j == 0) print "?";
        else {
            #Ifdef TARGET_ZCODE;
            if (UnsignedCompare(j, HDR_DICTIONARY-->0) >= 0 &&
                UnsignedCompare(j, HDR_HIGHMEMORY-->0) < 0)
                 print (address) j;
            else print j;
            #Ifnot; ! TARGET_GLULX
            if (j->0 == $60) print (address) j;
            else print j;
            #Endif; ! TARGET_
        }
        if (i ~= num_words-1) print " / ";
    }
    print " ]^";
}
#Endif; ! DEBUG
verb_wordnum = 1;
actor = player;
actors_location = ScopeCeiling(player);
usual_grammar_after = 0;

.AlmostReParse;

scope_token = 0;
action_to_be = NULL;

! Begin from what we currently think is the verb word

.BeginCommand;

wn = verb_wordnum;
verb_word = NextWordStopped();

! If there's no input here, we must have something like "person,".

if (verb_word == -1) {
    best_etype = STUCK_PE; jump GiveError;
}
if (verb_word == comma_word) {
	best_etype = COMMABEGIN_PE; jump GiveError;
}

! Now try for "again" or "g", which are special cases: don't allow "again" if nothing
! has previously been typed; simply copy the previous text across

if (verb_word == AGAIN2__WD or AGAIN3__WD) verb_word = AGAIN1__WD;
if (verb_word == AGAIN1__WD) {
    if (actor ~= player) {
        best_etype = ANIMAAGAIN_PE;
		jump GiveError;
    }
    #Ifdef TARGET_ZCODE;
    if (buffer3->1 == 0) {
        PARSER_COMMAND_INTERNAL_RM('D'); new_line;
        jump ReType;
    }
    #Ifnot; ! TARGET_GLULX
    if (buffer3-->0 == 0) {
        PARSER_COMMAND_INTERNAL_RM('D'); new_line;
        jump ReType;
    }
    #Endif; ! TARGET_
    for (i=0 : i<INPUT_BUFFER_LEN : i++) buffer->i = buffer3->i;
    VM_Tokenise(buffer,parse);
	num_words = WordCount(); players_command = 100 + num_words;
	jump ReParse;
}

! Save the present input in case of an "again" next time

if (verb_word ~= AGAIN1__WD)
    for (i=0 : i<INPUT_BUFFER_LEN : i++) buffer3->i = buffer->i;

if (usual_grammar_after == 0) {
    j = verb_wordnum;
    i = RunRoutines(actor, grammar); 
    #Ifdef DEBUG;
    if (parser_trace >= 2 && actor.grammar ~= 0 or NULL)
        print " [Grammar property returned ", i, "]^";
    #Endif; ! DEBUG

    if ((i ~= 0 or 1) && (VM_InvalidDictionaryAddress(i))) {
        usual_grammar_after = verb_wordnum; i=-i;
    }

    if (i == 1) {
        parser_results-->ACTION_PRES = action;
        parser_results-->NO_INPS_PRES = 0;
        parser_results-->INP1_PRES = noun;
        parser_results-->INP2_PRES = second;
        if (noun) parser_results-->NO_INPS_PRES = 1;
        if (second) parser_results-->NO_INPS_PRES = 2;
        rtrue;
    }
    if (i ~= 0) { verb_word = i; wn--; verb_wordnum--; }
    else { wn = verb_wordnum; verb_word = NextWord(); }
}
else usual_grammar_after = 0;

-) instead of “Parser Letter A” in “Parser.i6t”.

Section 3 - NounDomain Replacement

Include
(-
[ NounDomain domain1 domain2 context dont_ask
first_word i j k l answer_words marker;
#Ifdef DEBUG;
if (parser_trace >= 4) {
print " [NounDomain called at word ", wn, “^”;
print " ";
if (indef_mode) {
print "seeking indefinite object: ";
if (indef_type & OTHER_BIT) print "other ";
if (indef_type & MY_BIT) print "my ";
if (indef_type & THAT_BIT) print "that ";
if (indef_type & PLURAL_BIT) print "plural ";
if (indef_type & LIT_BIT) print "lit ";
if (indef_type & UNLIT_BIT) print "unlit ";
if (indef_owner ~= 0) print “owner:”, (name) indef_owner;
new_line;
print " number wanted: ";
if (indef_wanted == INDEF_ALL_WANTED) print “all”; else print indef_wanted;
new_line;
print " most likely GNAs of names: ", indef_cases, “^”;
}
else print “seeking definite object^”;
}
#Endif; ! DEBUG

match_length = 0; number_matched = 0; match_from = wn;
SearchScope(domain1, domain2, context);

#Ifdef DEBUG;
if (parser_trace >= 4) print "   [ND made ", number_matched, " matches]^";
#Endif; ! DEBUG

wn = match_from+match_length;

! If nothing worked at all, leave with the word marker skipped past the
! first unmatched word...

if (number_matched == 0) { wn++; rfalse; }

! Suppose that there really were some words being parsed (i.e., we did
! not just infer).  If so, and if there was only one match, it must be
! right and we return it...

if (match_from <= num_words) {
    if (number_matched == 1) {
        i=match_list-->0;
        return i;
    }

    ! ...now suppose that there was more typing to come, i.e. suppose that
    ! the user entered something beyond this noun.  If nothing ought to follow,
    ! then there must be a mistake, (unless what does follow is just a full
    ! stop, and or comma)

    if (wn <= num_words) {
        i = NextWord(); wn--;
        if (i ~=  AND1__WD or AND2__WD or AND3__WD or comma_word
               or THEN1__WD or THEN2__WD or THEN3__WD
               or BUT1__WD or BUT2__WD or BUT3__WD) {
            if (lookahead == ENDIT_TOKEN) rfalse;
        }
    }
}

! Now look for a good choice, if there's more than one choice...

number_of_classes = 0;

if (number_matched == 1) {
	i = match_list-->0;
	if (indef_mode == 1 && indef_type & PLURAL_BIT ~= 0) {
		if (context == MULTI_TOKEN or MULTIHELD_TOKEN or
			MULTIEXCEPT_TOKEN or MULTIINSIDE_TOKEN or
			NOUN_TOKEN or HELD_TOKEN or CREATURE_TOKEN) {
			BeginActivity(DECIDING_WHETHER_ALL_INC_ACT, i);
			if ((ForActivity(DECIDING_WHETHER_ALL_INC_ACT, i)) &&
				(RulebookFailed())) rfalse;
			EndActivity(DECIDING_WHETHER_ALL_INC_ACT, i);
		}
	}
}
if (number_matched > 1) {
	i = true;
    if (number_matched > 1)
    	for (j=0 : j<number_matched-1 : j++)
			if (Identical(match_list-->j, match_list-->(j+1)) == false)
				i = false;
	if (i) dont_infer = true;
    i = Adjudicate(context);
    if (i == -1) rfalse;
    if (i == 1) rtrue;       !  Adjudicate has made a multiple
                         !  object, and we pass it on
}

! If i is non-zero here, one of two things is happening: either
! (a) an inference has been successfully made that object i is
!     the intended one from the user's specification, or
! (b) the user finished typing some time ago, but we've decided
!     on i because it's the only possible choice.
! In either case we have to keep the pattern up to date,
! note that an inference has been made and return.
! (Except, we don't note which of a pile of identical objects.)

if (i ~= 0) {
	if (dont_infer) return i;
    if (inferfrom == 0) inferfrom=pcount;
    pattern-->pcount = i;
    return i;
}

if (dont_ask) return match_list-->0;

! If we get here, there was no obvious choice of object to make.  If in
! fact we've already gone past the end of the player's typing (which
! means the match list must contain every object in scope, regardless
! of its name), then it's foolish to give an enormous list to choose
! from - instead we go and ask a more suitable question...

if (match_from > num_words) jump Incomplete;

! Now we print up the question, using the equivalence classes as worked
! out by Adjudicate() so as not to repeat ourselves on plural objects...

BeginActivity(ASKING_WHICH_DO_YOU_MEAN_ACT);
if (ForActivity(ASKING_WHICH_DO_YOU_MEAN_ACT)) jump SkipWhichQuestion;
j = 1; marker = 0;
for (i=1 : i<=number_of_classes : i++) {
	while (((match_classes-->marker) ~= i) && ((match_classes-->marker) ~= -i))
		marker++;
	if (match_list-->marker hasnt animate) j = 0;
}
if (j) PARSER_CLARIF_INTERNAL_RM('A');
else PARSER_CLARIF_INTERNAL_RM('B');

j = number_of_classes; marker = 0;
for (i=1 : i<=number_of_classes : i++) {
    while (((match_classes-->marker) ~= i) && ((match_classes-->marker) ~= -i)) marker++;
    k = match_list-->marker;

    if (match_classes-->marker > 0) print (the) k; else print (a) k;

    if (i < j-1)  print ", ";
    if (i == j-1) {
		#Ifdef SERIAL_COMMA;
		if (j ~= 2) print ",";
    	#Endif; ! SERIAL_COMMA
    	PARSER_CLARIF_INTERNAL_RM('H');
    }
}
print "?^";

.SkipWhichQuestion; EndActivity(ASKING_WHICH_DO_YOU_MEAN_ACT);

! ...and get an answer:

.WhichOne;
#Ifdef TARGET_ZCODE;
for (i=2 : i<INPUT_BUFFER_LEN : i++) buffer2->i = ’ ';
#Endif; ! TARGET_ZCODE
answer_words=Keyboard(buffer2, parse2);

! Conveniently, parse2-->1 is the first word in both ZCODE and GLULX.
first_word = (parse2-->1);

! Take care of "all", because that does something too clever here to do
! later on:

if (first_word == ALL1__WD or ALL2__WD or ALL3__WD or ALL4__WD or ALL5__WD) {
    if (context == MULTI_TOKEN or MULTIHELD_TOKEN or MULTIEXCEPT_TOKEN or MULTIINSIDE_TOKEN) {
        l = multiple_object-->0;
        for (i=0 : i<number_matched && l+i<MATCH_LIST_WORDS : i++) {
            k = match_list-->i;
            multiple_object-->(i+1+l) = k;
        }
        multiple_object-->0 = i+l;
        rtrue;
    }
    PARSER_CLARIF_INTERNAL_RM('C');
    jump WhichOne;
}

! Look for a comma, and interpret this as a fresh conversation command
! if so:

for (i=1 : i<=answer_words : i++)
	if (WordFrom(i, parse2) == comma_word) {
        VM_CopyBuffer(buffer, buffer2);
        jump RECONSTRUCT_INPUT;		
	}

! RD: if we didn't jump out of that, we're processing a disambiguation request
! RD: Instead of checking whether the first word is a verb to decide whether to process it,
! RD: we just proceed to inserting the answer into the original typed command.
! RD: If that doesn't work, we will hit a parser error, at which point we go back
! RD: and reprocess the disambiguation response as a new command.
! RD: All we need to do now is set the flag that we're processing a disambiguation request
! RD: which will be checked when it comes time to print a parser error.

processing_disambiguation = 1;
asked_for_disambiguation = 1;

! Now we insert the answer into the original typed command, as
! words additionally describing the same object
! (eg, > take red button
!      Which one, ...
!      > music
! becomes "take music red button".  The parser will thus have three
! words to work from next time, not two.)

! RD: had to insert spaces between -- and ) in two lines so it didn't prematurely end the I6 inclusion
#Ifdef TARGET_ZCODE; 
k = WordAddress(match_from) - buffer; l=buffer2->1+1;
for (j=buffer + buffer->0 - 1 : j>=buffer+k+l : j-- ) j->0 = 0->(j-l); ! RD: here
for (i=0 : i<l : i++) buffer->(k+i) = buffer2->(2+i);
buffer->(k+l-1) = ' ';
buffer->1 = buffer->1 + l;
if (buffer->1 >= (buffer->0 - 1)) buffer->1 = buffer->0;
#Ifnot; ! TARGET_GLULX
k = WordAddress(match_from) - buffer;
l = (buffer2-->0) + 1;
for (j=buffer+INPUT_BUFFER_LEN-1 : j>=buffer+k+l : j-- ) j->0 = j->(-l); ! RD: and here
for (i=0 : i<l : i++) buffer->(k+i) = buffer2->(WORDSIZE+i);
buffer->(k+l-1) = ' ';
buffer-->0 = buffer-->0 + l;
if (buffer-->0 > (INPUT_BUFFER_LEN-WORDSIZE)) buffer-->0 = (INPUT_BUFFER_LEN-WORDSIZE);
#Endif; ! TARGET_

! Having reconstructed the input, we warn the parser accordingly
! and get out.

.RECONSTRUCT_INPUT;

num_words = WordCount(); players_command = 100 + num_words;
wn = 1;
#Ifdef LanguageToInformese;
LanguageToInformese();
! Re-tokenise:
VM_Tokenise(buffer,parse);
#Endif; ! LanguageToInformese
num_words = WordCount(); players_command = 100 + num_words;
actors_location = ScopeCeiling(player);
FollowRulebook(Activity_after_rulebooks-->READING_A_COMMAND_ACT);

return REPARSE_CODE;

! Now we come to the question asked when the input has run out
! and can't easily be guessed (eg, the player typed "take" and there
! were plenty of things which might have been meant).

.Incomplete;

if (context == CREATURE_TOKEN) PARSER_CLARIF_INTERNAL_RM('D', actor);
else                           PARSER_CLARIF_INTERNAL_RM('E', actor);
new_line;

#Ifdef TARGET_ZCODE;
for (i=2 : i<INPUT_BUFFER_LEN : i++) buffer2->i=' ';
#Endif; ! TARGET_ZCODE
answer_words = Keyboard(buffer2, parse2);

! Look for a comma, and interpret this as a fresh conversation command
! if so:

for (i=1 : i<=answer_words : i++)
	if (WordFrom(i, parse2) == comma_word) {
		VM_CopyBuffer(buffer, buffer2);
		jump RECONSTRUCT_INPUT;
	}

first_word=(parse2-->1);
#Ifdef LanguageIsVerb;
if (first_word==0) {
    j = wn; first_word=LanguageIsVerb(buffer2, parse2, 1); wn = j;
}
#Endif; ! LanguageIsVerb

! Once again, if the reply looks like a command, give it to the
! parser to get on with and forget about the question...

if (first_word ~= 0) {
    j = first_word->#dict_par1;
    if ((0 ~= j&1) && ~~LanguageVerbMayBeName(first_word)) {
        VM_CopyBuffer(buffer, buffer2);
        jump RECONSTRUCT_INPUT;
    }
}

! ...but if we have a genuine answer, then:
!
! (1) we must glue in text suitable for anything that's been inferred.

if (inferfrom ~= 0) {
    for (j=inferfrom : j<pcount : j++) {
        if (pattern-->j == PATTERN_NULL) continue;
        #Ifdef TARGET_ZCODE;
        i = 2+buffer->1; (buffer->1)++; buffer->(i++) = ' ';
        #Ifnot; ! TARGET_GLULX
        i = WORDSIZE + buffer-->0;
        (buffer-->0)++; buffer->(i++) = ' ';
        #Endif; ! TARGET_

        #Ifdef DEBUG;
        if (parser_trace >= 5)
        	print "[Gluing in inference with pattern code ", pattern-->j, "]^";
        #Endif; ! DEBUG

        ! Conveniently, parse2-->1 is the first word in both ZCODE and GLULX.

        parse2-->1 = 0;

        ! An inferred object.  Best we can do is glue in a pronoun.
        ! (This is imperfect, but it's very seldom needed anyway.)

        if (pattern-->j >= 2 && pattern-->j < REPARSE_CODE) {
            PronounNotice(pattern-->j);
            for (k=1 : k<=LanguagePronouns-->0 : k=k+3)
                if (pattern-->j == LanguagePronouns-->(k+2)) {
                    parse2-->1 = LanguagePronouns-->k;
                    #Ifdef DEBUG;
                    if (parser_trace >= 5)
                    	print "[Using pronoun '", (address) parse2-->1, "']^";
                    #Endif; ! DEBUG
                    break;
                }
        }
        else {
            ! An inferred preposition.
            parse2-->1 = VM_NumberToDictionaryAddress(pattern-->j - REPARSE_CODE);
            #Ifdef DEBUG;
            if (parser_trace >= 5)
            	print "[Using preposition '", (address) parse2-->1, "']^";
            #Endif; ! DEBUG
        }

        ! parse2-->1 now holds the dictionary address of the word to glue in.

        if (parse2-->1 ~= 0) {
            k = buffer + i;
            #Ifdef TARGET_ZCODE;
            @output_stream 3 k;
             print (address) parse2-->1;
            @output_stream -3;
            k = k-->0;
            for (l=i : l<i+k : l++) buffer->l = buffer->(l+2);
            i = i + k; buffer->1 = i-2;
            #Ifnot; ! TARGET_GLULX
            k = Glulx_PrintAnyToArray(buffer+i, INPUT_BUFFER_LEN-i, parse2-->1);
            i = i + k; buffer-->0 = i - WORDSIZE;
            #Endif; ! TARGET_
        }
    }
}

! (2) we must glue the newly-typed text onto the end.

#Ifdef TARGET_ZCODE;
i = 2+buffer->1; (buffer->1)++; buffer->(i++) = ' ';
for (j=0 : j<buffer2->1 : i++,j++) {
    buffer->i = buffer2->(j+2);
    (buffer->1)++;
    if (buffer->1 == INPUT_BUFFER_LEN) break;
}
#Ifnot; ! TARGET_GLULX
i = WORDSIZE + buffer-->0;
(buffer-->0)++; buffer->(i++) = ' ';
for (j=0 : j<buffer2-->0 : i++,j++) {
    buffer->i = buffer2->(j+WORDSIZE);
    (buffer-->0)++;
    if (buffer-->0 == INPUT_BUFFER_LEN) break;
}
#Endif; ! TARGET_

! (3) we fill up the buffer with spaces, which is unnecessary, but may
!     help incorrectly-written interpreters to cope.

#Ifdef TARGET_ZCODE;
for (: i<INPUT_BUFFER_LEN : i++) buffer->i = ' ';
#Endif; ! TARGET_ZCODE

jump RECONSTRUCT_INPUT;

]; ! end of NounDomain

[ PARSER_CLARIF_INTERNAL_R; ];
-) instead of “Noun Domain” in “Parser.i6t”.

Section 4 - Parser Letter H Replacement

Include
(-
.GiveError;
! RD: If we hit a parser error while processing disambiguation, that means we failed to understand
! RD: the answer to the question as a disambiguation response.
! RD: So we reprocess that as a new command.
if (processing_disambiguation == 1) {
print “I couldn’t understand that as a response to the question, so I am treating that as a new command. (This should be a library message.)”;
! RD: now since we’ve given up on processing this as a disambiguation command
! RD: we reset the flags to note that we aren’t processing a disambiguation anymore
! RD: copy the secondary buffer (which contained the typed command) to the primary buffer
! RD: and then start over with parsing
processing_disambiguation = 0;
asked_for_disambiguation = 0;
VM_CopyBuffer(buffer, buffer2);
! RD: at this point we would like to jump RECONSTRUCT_INPUT;
! RD: but that’s in a different routine
! RD: so we just copy that code (and, er, hope that the return makes sense)
num_words = WordCount(); players_command = 100 + num_words;
wn = 1;
#Ifdef LanguageToInformese;
LanguageToInformese();
! Re-tokenise:
VM_Tokenise(buffer,parse);
#Endif; ! LanguageToInformese
num_words = WordCount(); players_command = 100 + num_words;
actors_location = ScopeCeiling(player);
FollowRulebook(Activity_after_rulebooks–>READING_A_COMMAND_ACT);

return REPARSE_CODE;

}
! RD: That's the end of the Responsive Disambiguation code
! RD: if we weren't processing disambiguation, we give a parser error as usual
etype = best_etype;
if (actor ~= player) {
    if (usual_grammar_after ~= 0) {
        verb_wordnum = usual_grammar_after;
        jump AlmostReParse;
    }
    wn = verb_wordnum;
    special_word = NextWord();
    if (special_word == comma_word) {
        special_word = NextWord();
        verb_wordnum++;
    }
    parser_results-->ACTION_PRES = ##Answer;
    parser_results-->NO_INPS_PRES = 2;
    parser_results-->INP1_PRES = actor;
    parser_results-->INP2_PRES = 1; special_number1 = special_word;
    actor = player;
    consult_from = verb_wordnum; consult_words = num_words-consult_from+1;
    rtrue;
}

-) instead of “Parser Letter H” in “Parser.i6t”.

Responsive Disambiguation for 6M62 ends here.[/code][/spoiler]

which with this stub program:

[code]Include Responsive Disambiguation for 6M62 by Matt Weiner.

Games room is a room. A chess board and a go board are in Games room.[/code]

yields this:

The comment about “This should be a library message” is intended (right now it’s an I6 print statement that I’ll replace with a rule response if I ever get this working.)

(It’s also not doing what it’s supposed to, but I’ll worry about that later.)

That output is the GlkList debug command, which is the first verb defined (when compiling in debug mode). So my first guess is that you’re getting into the parser with some important verb/action global set to zero.

Thanks!

You know what, instead of messing around with trying to get the parser to reparse the command from the parser error routine, I should probably see if there’s a way to write a “For reading a command” rule to make the game think that the player typed in the disambiguation buffer again.

…along those lines, is there a nice way to access the contents of buffer2 in I7, for instance by copying them into a global text variable? Or any other quick way to plug the contents of buffer2 into a For reading a command rule?

Good thought, but not possible. The “for reading a command” activity is only run for the main input, not the disambig input.

(There’s a synthetic “after reading a command” stage after the disambig input, but this is only “after”, not “for”/“before”.)

Well, what I was thinking was something like this.

Change Parser Letter H to something looking like this:

Include (- .GiveError; ! RD: If we hit a parser error while processing disambiguation, that means we failed to understand ! RD: the answer to the question as a disambiguation response. ! RD: So we reprocess that as a new command. if (processing_disambiguation == 1) { print "I couldn't understand that as a response to the question, so I am treating that as a new command. (This should be a library message.)"; ! RD: now since we've given up on processing this as a disambiguation command ! RD: we reset the flags to note that we aren't processing a disambiguation anymore ! RD NEW COMMENT: and set another flag so instead of trying to read a command on the next turn, we just read in the secondary buffer processing_disambiguation = 0; asked_for_disambiguation = 0; new_magic_flag = 1; ! RD NEW COMMENT: I'm guessing I need to do rtrue here to get this to stop nicely without printing anything rtrue; } ! RD: That's the end of the Responsive Disambiguation code ! RD: if we weren't processing disambiguation, we give a parser error as usual etype = best_etype; if (actor ~= player) { if (usual_grammar_after ~= 0) { verb_wordnum = usual_grammar_after; jump AlmostReParse; } wn = verb_wordnum; special_word = NextWord(); if (special_word == comma_word) { special_word = NextWord(); verb_wordnum++; } parser_results-->ACTION_PRES = ##Answer; parser_results-->NO_INPS_PRES = 2; parser_results-->INP1_PRES = actor; parser_results-->INP2_PRES = 1; special_number1 = special_word; actor = player; consult_from = verb_wordnum; consult_words = num_words-consult_from+1; rtrue; } -)

where, instead of the stuff where I tried to reparse when I hit a parser error while disambiguating, I just set a flag “new_magic_flag” and end quietly. (At least I think “rtrue” ends quietly; surely there must be some way to end quietly at this point. If worst comes to worst I could write a rule for printing a parser error that suppresses all output when new_magic_flag is set.) New comments in there are marked with “RD NEW COMMENT:”.

And then I would do a For reading a command rule something like this, where “reprocessing a failed disambiguation” translates the I6 variable your_magic_flag (I might need to be more careful about truth states versus number variables there):

For reading a command when reprocessing a failed disambiguation is true: change the player's command to [the contents of buffer2, however I can access them; or possibly I can have Parser Letter H copy buffer2 into buffer and then change the layer's command to the contents of buffer, if that's easier].

So I’m not actually trying to do “for reading a command” on the disambig input. The sequence is supposed to be like this:
player inputs “x board”
game asks for disambiguation
player inputs “jump”
game attempts to process “x jump board” as usual
command fails to parse, sending us to Parser Letter H
that code in parser letter H sets new_magic_flag/reprocessing a failed disambiguation, and prints the message saying it’s trying to reparse the disambiguation
the input loop ends, and we go to the next one, which calls the Reading A Command activity as usual
our new For Reading A Command rule runs and reads in “jump” from buffer2 (or wherever we managed to store it)
the parser runs on “jump”
this gets processed into the jumping activity, as usual.

Does that make more sense? I don’t think I’m trying to do the impossible thing.

This seems strictly more complicated than a “jump ReParse”. It doesn’t look obviously wrong, but if jumping to reparse isn’t working, this might not fix it.

Well, my fond hope is that by starting again with “For reading a command” the parser will take care of whatever it needs to do with a Jump ReParse.

Anyway, the specific question I need to try to get this going is pretty simple. Well, one simple one and one complicated one.

Simple question: How could I get the contents of buffer or buffer2 into an I7 text variable?

Complicated question, which you should feel free to pass on: Looking at the I6 SetPlayersCommand routine, it looks like what it’s doing is taking the indexed text and copying it into buffer. Since I’m actually taking the text out of buffer2 in the first place, and I think I know how to copy buffer2 into buffer, is there an obvious reason why I can’t just copy buffer2 into buffer and then have my For Reading A Command rule just leave buffer untouched?

Well, my naïve attempt to copy buffer2 into buffer and then have the For Reading A Command rule do nothing is still producing the GlkList output, but it’s also producing the correct output. Like this:

So if I can track down where GlkList is coming from, I might be OK.

This seems kind of like the bug I had in Terminator (where it printed “You’ll have to say which direction to go in” every turn in the release build), so maybe I should try figuring out how Daniel fixed that.

Update, for those who care: So it seems as though the issue with the revised code was with that rtrue that I put at the end of that pseudo-code version of Parser Letter H. That seems to send the results of the parsing along to the action generation mechanism, with something important set to zero. Whereas if I leave that rtrue out, the command goes along to Parser Letter I to be processed as a parser error instead. I don’t want a parser error message to print, but that can be suppressed with a rule for printing a parser error that fires when the “we’re about to reprocess a failed disambiguation answer” flag is set.

So here’s where the code stands, along with sections 2 and 3 from above (untouched, I think):

[spoiler][code]Responsive Disambiguation for 6M62 by Matt Weiner begins here.

Section 1 - New Globals

Include
(- Global processing_disambiguation; ! set to 1 if we are currently processing a disambiguation request
Global asked_for_disambiguation; ! set to 1 if we just asked for disambiguation
Global processing_failed_disambig; ! set to 1 if we are processing a failed disambiguation
-) before “Parser.i6t”.

Processing failed disambiguation is a number that varies. The processing failed disambiguation variable translates into I6 as “processing_failed_disambig”.

[and sections 2 and 3]

Section 4 - Parser Letter H Replacement

Include
(-
.GiveError;
! RD: If we hit a parser error while processing disambiguation, that means we failed to understand
! RD: the answer to the question as a disambiguation response.
! RD: So we reprocess that as a new command.
if (processing_disambiguation == 1) {
print “I couldn’t understand that as a response to the question, so I am treating that as a new command. (This should be a library message.)^”;
! RD: now since we’ve given up on processing this as a disambiguation command
! RD: we reset the flags to note that we aren’t processing a disambiguation anymore
! RD: copy the secondary buffer (which contained the typed command) to the primary buffer
! RD: set the flag that tells the next for reading a command rule to just read the primary buffer
! RD: and let things move along to Parser Letter I, which will produce a parser error
! RD: which we squash with a Rule for printing a parser error, in the next section
processing_disambiguation = 0;
asked_for_disambiguation = 0;
VM_CopyBuffer(buffer, buffer2);
processing_failed_disambig = 1;
}
! RD: That’s the end of the Responsive Disambiguation code
! RD: if we weren’t processing disambiguation, we give a parser error as usual
etype = best_etype;
if (actor ~= player) {
if (usual_grammar_after ~= 0) {
verb_wordnum = usual_grammar_after;
jump AlmostReParse;
}
wn = verb_wordnum;
special_word = NextWord();
if (special_word == comma_word) {
special_word = NextWord();
verb_wordnum++;
}
parser_results–>ACTION_PRES = ##Answer;
parser_results–>NO_INPS_PRES = 2;
parser_results–>INP1_PRES = actor;
parser_results–>INP2_PRES = 1; special_number1 = special_word;
actor = player;
consult_from = verb_wordnum; consult_words = num_words-consult_from+1;
rtrue;
}
-) instead of “Parser Letter H” in “Parser.i6t”.

Section 5 - Processing the failed disambiguation

[when disambiguation fails, the outcome is technically a parser error (usually “you can’t see any such thing”), but we don’t want that to print]
For printing a parser error when processing failed disambiguation is 1: do nothing.

[and then we just want to process the answer to the disambiguation prompt as a normal command. Since the modified Parser Letter H has already loaded that answer into buffer, we don’t have to do anything; just let the “for reading a command” rule run and it will interrupt the normal process of reading a command and send the contents of buffer into the parser. This is a good place to reset the processing failed disambiguation flag, so that’s what we do here, but the main effect of the rule is that it preempts the normal operation of the reading a command activity.]
For reading a command when processing failed disambiguation is 1:
now processing failed disambiguation is 0.

Responsive Disambiguation for 6M62 ends here.
[/code][/spoiler]

Still not quite ready for prime time–I need to fix that library message thing, I think the asked_for_disambiguation global is probably redundant right now, and it’s pretty ugly because I basically don’t know what’s happening. But it’s working better than I’d feared.