From: Jason Self Date: Sun, 14 Jul 2019 15:56:57 +0000 (-0700) Subject: Import v6.12.3 of the Inform 6 standard library X-Git-Tag: v6.12.3 X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=1c818514af7258e1e228fb78ee8caa5b255d0405;p=informlib.git Import v6.12.3 of the Inform 6 standard library Modified to not print out the version of Inform and the version of the standard library in use in the game's banner. Also relicensed to AGPL per Section 4(c)(ii) of the Artistic License 2.0. --- diff --git a/english.h b/english.h index 30031cb..647188b 100644 --- a/english.h +++ b/english.h @@ -1,9 +1,9 @@ ! ============================================================================== ! ENGLISH: Language Definition File ! -! Supplied for use with Inform 6 -- Release 6.12.2 -- Serial number 180520 +! Supplied for use with Inform 6 -- Release 6.12.3 -- Serial number 190320 ! -! Copyright Graham Nelson 1993-2004 and David Griffith 2012-2018 +! Copyright Graham Nelson 1993-2004 and David Griffith 2012-2019 ! ! This file is free software: you can redistribute it and/or modify ! it under the terms of the GNU Affero General Public License as @@ -360,6 +360,9 @@ Constant QKEY2__KY = 'q'; Constant SCORE__TX = "Score: "; Constant MOVES__TX = "Moves: "; Constant TIME__TX = "Time: "; +Constant SCORE_S__TX = "S: "; +Constant MOVES_S__TX = "M: "; +Constant TIME_S__TX = "T: "; Constant CANTGO__TX = "You can't go that way."; Constant FORMER__TX = "your former self"; Constant MYFORMER__TX = "my former self"; @@ -592,10 +595,10 @@ Constant COLON__TX = ": "; [ CSubjectWill obj reportage nocaps; if (obj == player) { if (player provides narrative_voice) switch (player.narrative_voice) { - 1: Tense("I'll", "I would've"); return; + 1: Tense("I'll", "I would"); return; 2: ! Do nothing. 3: CDefart(player); - Tense(" will", " would've"); return; + Tense(" will", " would"); return; default: RunTimeError(16, player.narrative_voice); } if (nocaps) Tense("you'll", "you'd"); @@ -647,10 +650,22 @@ Constant COLON__TX = ": "; if (caps) print "Y"; else print "y"; print "our"; return; } - if (caps) print "H"; else print "h"; - if (obj has male) { print "is"; return; } - if (obj has female) { print "er"; return; } - if (caps) print "I"; else { print "i"; print "ts"; return; } + if (obj has pluralname) { + if (caps) print "T"; else print "t"; + print "heir"; return; + } + if (obj has female) { + if (caps) print "H"; else print "h"; + print "er"; return; + } + if (obj has male or animate) { + if (obj hasnt neuter) { + if (caps) print "H"; else print "h"; + print "is"; return; + } + } + if (caps) print "I"; else { print "i"; } + print "ts"; return; ]; [ PossessiveCaps obj; @@ -902,9 +917,9 @@ Constant COLON__TX = ": "; 1: print "There "; Tense("isn't", "wasn't"); " anything obvious with which to fill ", (the) x1, "."; - 2: print "Filling ", (the) x1, " from ", (the) x2; - Tense(" doesn't", " didn't"); - " make sense."; + 2: print "Filling ", (the) x1, " from ", (the) x2, " wouldn't "; + Tense("make", "have made"); + " sense."; } FullScore: switch (n) { 1: if (deadflag) print "The score was "; else print "The score is "; @@ -927,7 +942,7 @@ Constant COLON__TX = ": "; } Go: switch (n) { 1: CSubjectWill(actor,true); - Tense(" have", " had"); + Tense(" have", " have had"); " to get ", (nop) SupportObj(x1,"off","out of"), " ", (the) x1, " first."; 2: CSubjectCant(actor,true); " go that way."; 3: CSubjectIs (actor,true); " unable to climb ", (the) x1, "."; @@ -944,11 +959,11 @@ Constant COLON__TX = ": "; 2: CSubjectCant(x1,true); " contain things."; 3: CSubjectIs (x1,true); " closed."; 4: CSubjectWill(actor,true); - Tense(" need", " needed"); + Tense(" need", " have needed"); " to take ", (ItOrThem) x1, " off first."; 5: CSubjectCant(actor,true); " put something inside itself."; 6: "(first taking ", (ItOrThem) x1, " off)"; - 7: print "There "; + 7: print "There"; Tense(" is", " was"); " no more room in ", (the) x1, "."; 8: "Done."; @@ -961,16 +976,22 @@ Constant COLON__TX = ": "; 4: "."; } Jump: CSubjectVerb(actor,false,false,"jump",0,"jumps","jumped"); " on the spot, fruitlessly."; - JumpIn: - print "Jumping in ", (the) x1, " "; - Tense("would achieve", "would have achieved"); - " nothing here."; - JumpOn: - print "Jumping upon ", (the) x1, " "; - Tense("would achieve", "would have achieved"); - " nothing here."; + JumpIn: switch (n) { + 1: print "Jumping in ", (the) x1, " "; + Tense("would achieve", "would have achieved"); + " nothing here."; + 2: DecideAgainst(); + } + JumpOn: switch (n) { + 1: print "Jumping upon ", (the) x1, " "; + Tense("would achieve", "would have achieved"); + " nothing here."; + 2: DecideAgainst(); + } JumpOver: switch (n) { - 1: CSubjectVerb(actor,true,false,"achieve",0,"achieve","achieved"); " nothing by this."; + 1: print "Jumping over ", (the) x1, " "; + Tense("would achieve", "would have achieved"); + " nothing here."; 2: DecideAgainst(); } Kiss: "Keep your mind on the game."; @@ -1225,9 +1246,9 @@ Constant COLON__TX = ": "; } ! Push: see Pull PushDir: switch (n) { - 1: print "That really "; - Tense("wouldn't", "didn't"); - " serve any purpose."; + 1: print "That really wouldn't "; + Tense("serve", "have served"); + " any purpose."; 2: print "That's "; Tense("not", "wasn't"); " a direction."; @@ -1412,9 +1433,9 @@ Constant COLON__TX = ": "; Touch: switch (n) { 1: DecideAgainst(); 2: CSubjectVerb(actor,true,false,"feel",0,"feels","felt"); " nothing unexpected."; - 3: print "That really "; - Tense("wouldn't", "didn't"); - " serve any purpose."; + 3: print "That really wouldn't "; + Tense("serve", "have served"); + " any purpose."; } ! Turn: see Pull. Unlock: switch (n) { diff --git a/grammar.h b/grammar.h index 5dd98cf..c7807c5 100644 --- a/grammar.h +++ b/grammar.h @@ -1,9 +1,7 @@ ! ============================================================================== ! GRAMMAR: Grammar table entries for the standard verbs library. ! -! Supplied for use with Inform 6 -- Release 6.12.2 -- Serial number 180520 -! -! Copyright Graham Nelson 1993-2004 and David Griffith 2012-2018 +! Supplied for use with Inform 6 -- Release 6.12.3 -- Serial number 190320 ! ! This file is free software: you can redistribute it and/or modify ! it under the terms of the GNU Affero General Public License as @@ -252,6 +250,7 @@ Verb 'drop' 'discard' * multiexcept 'on'/'onto' noun -> PutOn; Verb 'throw' + * noun -> ThrowAt * held 'at'/'against'/'on'/'onto' noun -> ThrowAt; Verb 'eat' diff --git a/infix.h b/infix.h deleted file mode 100644 index af6c18e..0000000 --- a/infix.h +++ /dev/null @@ -1,1211 +0,0 @@ -! ============================================================================== -! INFIX: Support for the optional library debugger extension "Infix". -! -! Supplied for use with Inform 6 -- Release 6.12.2 -- Serial number 180520 -! -! Copyright Graham Nelson 1993-2004 and David Griffith 2012-2018 -! -! This file is free software: you can redistribute it and/or modify -! it under the terms of the GNU Affero General Public License as -! published by the Free Software Foundation, either version 3 of the -! License, or (at your option) any later version. -! -! This file is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -! Affero General Public License for more details. -! -! You should have received a copy of the GNU Affero General Public -! License along with this program. If not, see -! https://gnu.org/licenses/ -! -! This file is automatically Included in your game file by "grammar" if you -! supply the -X compiler switch. -! ============================================================================== - -System_file; - -! ------------------------------------------------------------------------------ - -#Ifdef DEBUG; - -Constant INFIXTT_NUMBER 0; -Constant INFIXTT_ARRAY 1; -Constant INFIXTT_ROUTINE 2; -Constant INFIXTT_CONSTANT 3; -Constant INFIXTT_DWORD 4; -Constant INFIXTT_ACTION 5; -Constant INFIXTT_ATTRIBUTE 6; -Constant INFIXTT_PROPERTY 7; -Constant INFIXTT_GLOBAL 8; -Constant INFIXTT_NAMEDOBJECT 9; -Constant INFIXTT_SYSFUN 10; -Constant INFIXTT_STATICSTRING 11; -Constant INFIXTT_LOGICAL 12; - -Global infix_term_type; -Global infix_data1; -Global infix_data2; -Global infix_lvalue; -Global infix_parsed_lvalue; -Array infix_tolowercase -> 256; -#Ifdef VN_1630; -Array infix_text buffer 126; -#Ifnot; -Array infix_text -> 128; -#Endif; ! VN_ - - -[ InfixPrintAttribute x; print (string) #attribute_names_array-->x; ]; - -[ InfixPrintProperty x; print (property) x; ]; - -#Ifdef TARGET_GLULX; -[ InfixPrintGIProperty x; print (property) x; ]; -#Endif; ! TARGET_ - -[ InfixPrintGlobal x; print (string) #global_names_array-->x; ]; - -[ InfixPrintAction x; print (string) #action_names_array-->(x-#lowest_action_number); ]; - -[ InfixPrintRoutine x; print (string) #routine_names_array-->(x-#lowest_routine_number); ]; - -[ InfixPrintConstant x; print (string) #constant_names_array-->(x-#lowest_constant_number); ]; - -[ InfixPrintArray x; print (string) #array_names_array-->(x-#lowest_array_number); ]; - -[ InfixPrintFakeAction x; - print (string) #fake_action_names_array-->(x-#lowest_fake_action_number); ]; - -[ InfixPrintPA x n; - for (n=#lowest_routine_number : n<=#highest_routine_number : n++) { - if (x == Symb__Tab(INFIXTT_ROUTINE, n)) { - print (InfixPrintRoutine) n; return; - } - } - print "Routine(", x, ")"; -]; - -[ InfixMatchPrule PrintingRule range1 range2 wa wl t i i2 it2 itlc j k plus; - itlc = infix_tolowercase; - if (itlc->255 == 0) { - for (j=0 : j<256 : j++) itlc->j = j; - itlc->'A' = 'a'; itlc->'B' = 'b'; - itlc->'C' = 'c'; itlc->'D' = 'd'; - itlc->'E' = 'e'; itlc->'F' = 'f'; - itlc->'G' = 'g'; itlc->'H' = 'h'; - itlc->'I' = 'i'; itlc->'J' = 'j'; - itlc->'K' = 'k'; itlc->'L' = 'l'; - itlc->'M' = 'm'; itlc->'N' = 'n'; - itlc->'O' = 'o'; itlc->'P' = 'p'; - itlc->'Q' = 'q'; itlc->'R' = 'r'; - itlc->'S' = 's'; itlc->'T' = 't'; - itlc->'U' = 'u'; itlc->'V' = 'v'; - itlc->'W' = 'w'; itlc->'X' = 'x'; - itlc->'Y' = 'y'; itlc->'Z' = 'z'; - } - switch (PrintingRule) { - InfixPrintAttribute: - if (wa->0 == '~') { wl--; wa++; plus = 100; } ! A tilde - t = #attribute_names_array; - InfixPrintProperty: t = #property_names_array; - #Ifdef TARGET_GLULX; - InfixPrintGIProperty: t = #identifiers_table-->2; - #Endif; ! TARGET_ - InfixPrintAction: t = #action_names_array; - InfixPrintFakeAction: t = #fake_action_names_array; - InfixPrintGlobal: t = #global_names_array; - InfixPrintRoutine: t = #routine_names_array; - InfixPrintAction: t = #constant_names_array; - InfixPrintArray: t = #array_names_array; - } - - i2 = range2-range1; it2 = infix_text+WORDSIZE; - for (i=0 : i<=i2 : i++) { - #ifdef TARGET_ZCODE; - infix_text-->0 = 62; @output_stream 3 infix_text; - if (t) print (string) t-->i; else PrintingRule(i+range1); - @output_stream -3; - #ifnot; ! TARGET_GLULX - if (t) PrintToBuffer(infix_text, 62, t-->i); - else PrintToBuffer(infix_text, 62, PrintingRule, i+range1); - #endif; ! TARGET_ - k = infix_text-->0; - if (k ~= wl) jump XL; - if (itlc->(it2->0) ~= itlc->(wa->0)) jump XL; - for (j=1 : j(it2->j) ~= itlc->(wa->j)) jump XL; - parsed_number = i + range1 + plus; - rtrue; - .XL; - } - rfalse; -]; - -[ InfixActionToken; - if (InfixMatchPrule(InfixPrintAction, #lowest_action_number, - #highest_action_number, WordAddress(wn), WordLength(wn))) { - wn++; infix_lvalue = parsed_number; return 0; - } - if (InfixMatchPrule(InfixPrintFakeAction, #lowest_fake_action_number, - #highest_fake_action_number, WordAddress(wn), WordLength(wn))) { - wn++; infix_lvalue = parsed_number; return 0; - } - return -1; -]; - -[ InfixRvalueTerm n w i initial_wn wa wl sign base digit dcount; - - initial_wn = wn; - - infix_parsed_lvalue = -1; - infix_term_type = INFIXTT_NUMBER; - - w = NextWordStopped(); - if (w == -1) return -1; - - wa = WordAddress(wn-1); - wl = WordLength(wn-1); - if (wa->0 == '-' or '$' or '0' or '1' or '2' or '3' - or '4' or '5' or '6' or '7' or '8' or '9') { - ! Parse decimal, hex or binary number - - sign = 1; base = 10; dcount = 0; - if (wa->0 == '-') { sign = -1; wl--; wa++; } - else { - if (wa->0 == '$') { base = 16; wl--; wa++; } - if (wa->0 == '$') { base = 2; wl--; wa++; } - } - if (wl == 0) return -1; - n = 0; - while (wl > 0) { - if (wa->0 >= 'a') digit = wa->0 - 'a' + 10; - else digit = wa->0 - '0'; - dcount++; - #Ifdef TARGET_ZCODE; - switch (base) { - 2: - if (dcount == 17) return -1; - 10: - if (dcount == 6) return -1; - if (dcount == 5) { - if (n > 3276) return -1; - if (n == 3276) { - if (sign == 1 && digit > 7) return -1; - if (sign == -1 && digit > 8) return -1; - } - } - 16: - if (dcount == 5) return -1; - } - #Ifnot; ! TARGET_GLULX - switch (base) { - 2: - if (dcount == 33) return -1; - 10: - if (dcount == 11) return -1; - if (dcount == 10) { - if (n > 214748363) return -1; - } - 16: - if (dcount == 9) return -1; - } - #Endif; ! TARGET_ - if (digit >= 0 && digit < base) n = base*n + digit; - else return -1; - wl--; wa++; - } - parsed_number = n*sign; return 1; - } - - ! Parse character constant 'a' - - if (wl == 3 && wa->0 == ''' && wa->2 == ''') { - parsed_number = wa->1; return 1; - } - - ! ##Action, 'dword' - - switch (w) { - '##': - infix_term_type = INFIXTT_ACTION; - w = NextWordStopped(); if (w == -1) return -1; - wn--; - if (InfixActionToken() == 0) return 1; - return -1; - '^^': - infix_term_type = INFIXTT_DWORD; - w = NextWordStopped(); if (w == -1) return -1; - parsed_number = w; return 1; - } - - ! Test for attribute, property, class name, variable name, array name, routine - ! name, constant name - - wn--; - if ((wa->0 >= 'a' && wa->0 <= 'z') || - (wa->0 >= 'A' && wa->0 <= 'Z') || - wa->0 == '_') { - - - infix_term_type = INFIXTT_ATTRIBUTE; - if (InfixMatchPrule(InfixPrintAttribute, #lowest_attribute_number, - #highest_attribute_number, wa, wl)) { - wn++; return 1; } - - infix_term_type = INFIXTT_PROPERTY; - #Ifdef TARGET_ZCODE; - if (InfixMatchPrule(InfixPrintProperty, #lowest_property_number, - #highest_property_number, wa, wl)) { - wn++; return 1; - } - #Ifnot; ! TARGET_ - if (InfixMatchPrule(InfixPrintProperty, #lowest_property_number, - #identifiers_table-->1 - 1, wa, wl)) { - wn++; return 1; - } - if (InfixMatchPrule(InfixPrintGIProperty, INDIV_PROP_START, - #highest_property_number, wa, wl)) { - wn++; return 1; - } - #Endif; ! TARGET_ - - - infix_term_type = INFIXTT_GLOBAL; - if (InfixMatchPrule(InfixPrintGlobal, #lowest_global_number, - #highest_global_number, wa, wl)) { - infix_parsed_lvalue = parsed_number-16; - parsed_number = #globals_array-->infix_parsed_lvalue; - wn++; return 1; - } - - infix_term_type = INFIXTT_ARRAY; - if (InfixMatchPrule(InfixPrintArray, #lowest_array_number, - #highest_array_number, wa, wl)) { - infix_parsed_lvalue = parsed_number; - parsed_number = Symb__Tab(INFIXTT_ARRAY,parsed_number); - infix_data1 = temp__global3; - infix_data2 = temp__global2; - wn++; return 1; - } - - infix_term_type = INFIXTT_ROUTINE; - if (InfixMatchPrule(InfixPrintRoutine, #lowest_routine_number, - #highest_routine_number, wa, wl)) { - infix_parsed_lvalue = parsed_number; - parsed_number = Symb__Tab(INFIXTT_ROUTINE,parsed_number); - infix_data1 = temp__global3; - infix_data2 = temp__global2; - wn++; return 1; - } - - infix_term_type = INFIXTT_CONSTANT; - if (InfixMatchPrule(InfixPrintConstant, #lowest_constant_number, - #highest_constant_number, wa, wl)) { - infix_parsed_lvalue = parsed_number; - parsed_number = Symb__Tab(INFIXTT_CONSTANT,parsed_number); - infix_data1 = temp__global3; - infix_data2 = temp__global2; - wn++; return 1; - } - - switch (w) { - 'parent', 'child', 'children', - 'random', 'metaclass', 'sibling': - parsed_number = w; - infix_parsed_lvalue = INFIXTT_SYSFUN; - wn++; return 1; - } - } - - infix_term_type = INFIXTT_NAMEDOBJECT; - - wn = initial_wn; i = ParseToken(SCOPE_TT, InfixBigScope); - - if (i == GPR_REPARSE) return i; - if (i > GPR_MULTIPLE) { - print "(", (name) i, " (", i, "))^"; - parsed_number = i; return 1; - } - return -1; -]; ! end of InfixRvalueTerm - -[ InfixBigScope x; - if (scope_stage == 1) return false; ! No multiples here - if (scope_stage == 2) { - objectloop (x ofclass Object) PlaceInScope(x); - return true; ! That's the whole scope - } - print "; I'm unable to make any sense of that term.^"; -]; - -[ InfixCheckLineSpaced wa wl i force altered; - for (i=1 : i<=NumberWords() : i++) { - wa = WordAddress(i); - wl = WordLength(i); - if (wl > 3 && wa->0 == ''' && wa->(wl-1) == ''') { - wa->(wl-1) = ' '; - if (wa->(wl-2) == '/' && wa->(wl-3) == '/') { - wa->(wl-2) = ' '; - wa->(wl-3) = ' '; - } - LTI_Insert(wa-buffer, '''); - LTI_Insert(wa-buffer + 2, ' '); - altered = true; break; - } - } - for (i=WORDSIZE : ii = LowerCase(buffer->i); - #Endif; ! TARGET_ - force = false; - if (buffer->i == '-' && buffer->(i+1) == '-' && buffer->(i+2) == '>') - force = true; - if (force) { - if (i>WORDSIZE && buffer->(i-1) ~= ' ') { - LTI_Insert(i++, ' '); altered = true; - } - if (buffer->(i+3) ~= ' ') { - LTI_Insert(i+3, ' '); i++; altered = true; - } - i = i + 2; continue; - } - - if (buffer->i == ':' && buffer->(i+1) == ':') force = true; - if (buffer->i == '-' && buffer->(i+1) == '>') force = true; - if (buffer->i == '.' && buffer->(i+1) == '&') { - buffer->i = ']'; force = true; - } - if (buffer->i == '.' && buffer->(i+1) == '#') { - buffer->i = ']'; force = true; - } - if (buffer->i == ']' && buffer->(i+1) == '&') force = true; - if (buffer->i == ']' && buffer->(i+1) == '#') force = true; - if (buffer->i == '+' && buffer->(i+1) == '+') force = true; - if (buffer->i == '-' && buffer->(i+1) == '-') force = true; - if (buffer->i == '&' && buffer->(i+1) == '&') force = true; - if (buffer->i == '|' && buffer->(i+1) == '|') force = true; - if (buffer->i == '~' && buffer->(i+1) == '~') force = true; - - if (buffer->i == '=' && buffer->(i+1) == '=') force = true; - if (buffer->i == '~' && buffer->(i+1) == '=') force = true; - if (buffer->i == '>' && buffer->(i+1) == '=') force = true; - if (buffer->i == '<' && buffer->(i+1) == '=') force = true; - if (buffer->i == '#' && buffer->(i+1) == '#') force = true; - - if (force) { - if (i > WORDSIZE && buffer->(i-1) ~= ' ') { - LTI_Insert(i++, ' '); altered = true; - } - if (buffer->(i+2) ~= ' ') { - LTI_Insert(i+2, ' '); i++; altered = true; - } - i = i + 1; continue; - } - - if (buffer->i == '+') force = true; - if (buffer->i == '-') force = true; - if (buffer->i == '*') force = true; - if (buffer->i == '/') force = true; - if (buffer->i == '%') force = true; - if (buffer->i == '(') force = true; - if (buffer->i == ')') force = true; - if (buffer->i == '<' && buffer->(i-1) ~= ';') force = true; - if (buffer->i == '>') force = true; - if (buffer->i == ',') force = true; - if (buffer->i == '.') force = true; - if (buffer->i == '&') force = true; - if (buffer->i == '|') force = true; - if (buffer->i == '~') force = true; - if (buffer->i == '=') force = true; - if (force) { - if (i > WORDSIZE && buffer->(i-1) ~= ' ') { - LTI_Insert(i++, ' '); altered = true; - } - if (buffer->(i+1) ~= ' ') { - LTI_Insert(i+1, ' '); i++; altered = true; - } - } - } - for (i=WORDSIZE : ii == '~') { buffer->i = '['; altered = true; } - return altered; -]; ! end of InfixCheckLineSpaced - -Array InfixRV_rvals --> 32; -Array InfixRV_lvals --> 32; -Array InfixRV_op --> 32; -Array InfixRV_lop --> 32; -Array InfixRV_rop --> 32; -Array InfixRV_types --> 32; -Array InfixRV_commas --> 32; - -[ InfixInBounds addr index n; - if (addr < #array__start || addr > #array__end) - rtrue; - for (n=#lowest_array_number : n<=#highest_array_number : n++) { - if (addr == Symb__Tab(INFIXTT_ARRAY, n)) { - if (temp__global3 == 1 or 3) - temp__global2=temp__global2*WORDSIZE+WORDSIZE-1; - if (index > temp__global2) { - print "Array index out of range"; - rfalse; - } - } - } - rtrue; -]; - -[ InfixRvalue acc w i n flag base expecting_term max maxi lop rop lvalside - a b sysfun_f; - - if (InfixCheckLineSpaced()) return GPR_REPARSE; - -! w = wn; for (i=0 : i<10 : i++) { wn = w; InfixRvalueTerm(); print i, "^"; } -! wn = w; - - expecting_term = true; base = 0; - do { - w = NextWordStopped(); - if (expecting_term) { - switch (w) { - '-//': - InfixRV_rvals-->n = 'unary-'; InfixRV_types-->n = base + 8; - '[//': - InfixRV_rvals-->n = w; InfixRV_types-->n = base + 6; - '[[': - InfixRV_rvals-->n = w; InfixRV_types-->n = base + 2; - '++': - InfixRV_rvals-->n = 'pre++'; InfixRV_types-->n = base + 9; - '--': - InfixRV_rvals-->n = 'pre--'; InfixRV_types-->n = base + 9; - '(//': - InfixRV_rvals-->n = w; InfixRV_types-->n = -3; base=base+100; - ')//': - InfixRV_rvals-->n = w; InfixRV_types-->n = -3; base=base-100; - if (base < 0) { wn--; flag = true; } - -1: - flag = true; - default: - wn--; - if (InfixRValueTerm() == 1) { - InfixRV_rvals-->n = parsed_number; - InfixRV_lvals-->n = infix_parsed_lvalue; - InfixRV_types-->n = -1; - expecting_term = false; - } - else flag = true; - } - } - else { - expecting_term = true; - switch (w) { - comma_word: - InfixRV_rvals-->n = w; InfixRV_types-->n = base; - '=//': - InfixRV_rvals-->n = w; InfixRV_types-->n = base + 1; - '&&', '||': - InfixRV_rvals-->n = w; InfixRV_types-->n = base + 2; - '==', '[=', '>//', '>=', 'n = w; InfixRV_types-->n = base + 3; - 'or': - InfixRV_rvals-->n = w; InfixRV_types-->n = base + 4; - '+//', '-//': - InfixRV_rvals-->n = w; InfixRV_types-->n = base + 5; - '*//', '@{2f}//', '%//', '&//', '|//': - InfixRV_rvals-->n = w; InfixRV_types-->n = base + 6; - '->', '-->': - InfixRV_rvals-->n = w; InfixRV_types-->n = base + 7; - ']&', ']#': - InfixRV_rvals-->n = w; InfixRV_types-->n = base + 10; - THEN1__WD: - InfixRV_rvals-->n = w; InfixRV_types-->n = base + 12; - '::': - InfixRV_rvals-->n = w; InfixRV_types-->n = base + 13; - '(//': - InfixRV_rvals-->n = '(rcall'; - InfixRV_types-->n = base + 11; base = base + 100; - ')//': - InfixRV_rvals-->n = w; InfixRV_types-->n = -3; - base = base - 100; - if (base < 0) { wn--; flag = true; } - expecting_term = false; - '++': - InfixRV_rvals-->n = 'post++'; InfixRV_types-->n = base + 9; - expecting_term = false; - '--': - InfixRV_rvals-->n = 'post--'; InfixRV_types-->n = base + 9; - expecting_term = false; - default: - flag = true; - } - } - n++; - } until (flag || n == 32); - if (base > 0) return -1; - n--; if (n == 0) return -1; - wn--; - - for (i=0 : ii ~= -3) acc = InfixRV_rvals-->i; - InfixRV_op-->i = acc; - } - - for (::) { - -! for (i=0 : ii == -1) print InfixRV_rvals-->i, " "; -! else if (InfixRV_types-->i == -3) print " # "; -! else if (InfixRV_types-->i == -2) print " ## "; -! else print (address) InfixRV_rvals-->i, "_", InfixRV_types-->i, " "; -! } -! new_line; - - max = -2; - for (i=0 : ii > max) { - max = InfixRV_types-->i; maxi = i; } - if (max == -1) { parsed_number = InfixRV_rvals-->maxi; return 1; } - - lop = maxi-1; rop = maxi+1; - while (lop >= 0 && InfixRV_types-->lop < -1) lop--; - while (rop < n && InfixRV_types-->rop < -1) rop++; - if (lop >= 0) InfixRV_lop-->maxi = InfixRV_rvals-->lop; - if (rop < n) InfixRV_rop-->maxi = InfixRV_rvals-->rop; - flag = false; - infix_term_type = INFIXTT_NUMBER; - switch (InfixRV_rvals-->maxi) { - comma_word: - acc = (InfixRV_rvals-->rop); - '=//', 'pre++', 'post++', 'pre--', 'post--': - lvalside = lop; - switch (InfixRV_rvals-->maxi) { - '=//': acc = (InfixRV_rvals-->rop); - 'pre++': acc = (InfixRV_rvals-->rop) + 1; lvalside = rop; - 'pre--': acc = (InfixRV_rvals-->rop) - 1; lvalside = rop; - 'post++': acc = (InfixRV_rvals-->lop) + 1; - 'post--': acc = (InfixRV_rvals-->lop) - 1; - } - switch (InfixRV_op-->lvalside) { - THEN1__WD: - (InfixRV_lop-->lvalside).(InfixRV_rop-->lvalside) = acc; - '->': - if (InfixInBounds(InfixRV_lop-->lvalside, InfixRV_rop-->lvalside)) - (InfixRV_lop-->lvalside)->(InfixRV_rop-->lvalside) = acc; - '-->': - if (InfixInBounds(InfixRV_lop-->lvalside, WORDSIZE * InfixRV_rop-->lvalside)) - (InfixRV_lop-->lvalside)-->(InfixRV_rop-->lvalside) = acc; - default: - w = InfixRV_lvals-->lvalside; if (w == -1) return -1; - #ifdef TARGET_ZCODE; - @storew #globals_array w acc; - #ifnot; - @astore #globals_array w acc; - #endif; - } - switch(InfixRV_rvals-->maxi) { - 'post++': acc--; - 'post--': acc++; - } - '(rcall': - sysfun_f = false; - switch (InfixRV_op-->lop) { - THEN1__WD: - a = InfixRV_lop-->lop; b = InfixRV_rop-->lop; - default: - a = InfixRV_rvals-->lop; b = call; - if (InfixRV_lvals-->lop == INFIXTT_SYSFUN) - sysfun_f = true; - } - w = 0; - i = maxi + 1; base = 100; - if (InfixRV_types-->i == -1 && InfixRV_rvals-->i == ')//') { - if (sysfun_f) return -1; - acc = a.b(); - } - else { - while (base > 0) { - if (InfixRV_types-->i == -3 && InfixRV_rvals-->i == ')//') base = base - 100; - if (InfixRV_types-->i == -3 && InfixRV_rvals-->i == '(//') base = base + 100; - if (InfixRV_op-->i == '(rcall') base = base + 100; - if (base == 100 && InfixRV_op-->i == comma_word) { - InfixRV_commas-->(w++) = i; -! print "Comma found at ", i, "^"; - } - i++; - } -! print "Num args = ", w + 1, "^"; -! for (i=0 : i(InfixRV_commas-->i), "^"; -! print "arg: ", InfixRV_rvals-->rop, "^"; - switch (w+1) { - 1: - if (sysfun_f) { - b = InfixRV_rvals-->rop; - infix_term_type = INFIXTT_NAMEDOBJECT; - switch(a) { - 'metaclass': - acc = metaclass(b); - 'parent': - acc = parent(b); - 'child': - acc = child(b); - 'children': - acc = children(b); - infix_term_type = INFIXTT_NUMBER; - 'random': - acc = random(b); - infix_term_type = INFIXTT_NUMBER; - 'sibling': - acc = sibling(b); - } - } - else - acc = a.b(InfixRV_rvals-->rop); - 2: - if (sysfun_f) return -1; - acc = a.b(InfixRV_lop-->(InfixRV_commas-->0), - InfixRV_rvals-->rop); - 3: - if (sysfun_f) return -1; - acc = a.b(InfixRV_lop-->(InfixRV_commas-->0), - InfixRV_lop-->(InfixRV_commas-->1), - InfixRV_rvals-->rop); - 4: - if (sysfun_f) return -1; - acc = a.b(InfixRV_lop-->(InfixRV_commas-->0), - InfixRV_lop-->(InfixRV_commas-->1), - InfixRV_lop-->(InfixRV_commas-->2), - InfixRV_rvals-->rop); - 5: - if (sysfun_f) return -1; - acc = a.b(InfixRV_lop-->(InfixRV_commas-->0), - InfixRV_lop-->(InfixRV_commas-->1), - InfixRV_lop-->(InfixRV_commas-->2), - InfixRV_lop-->(InfixRV_commas-->3), - InfixRV_rvals-->rop); - default: - return -1; - } - } - '+//': acc = (InfixRV_rvals-->lop) + (InfixRV_rvals-->rop); - '-//': acc = (InfixRV_rvals-->lop) - (InfixRV_rvals-->rop); - '*//': acc = (InfixRV_rvals-->lop) * (InfixRV_rvals-->rop); - '@{2f}//': acc = (InfixRV_rvals-->lop) / (InfixRV_rvals-->rop); - '%//': acc = (InfixRV_rvals-->lop) % (InfixRV_rvals-->rop); - THEN1__WD: acc = (InfixRV_rvals-->lop) . (InfixRV_rvals-->rop); - '->': acc = (InfixRV_rvals-->lop) -> (InfixRV_rvals-->rop); - '-->': acc = (InfixRV_rvals-->lop) --> (InfixRV_rvals-->rop); - ']&': acc = (InfixRV_rvals-->lop) .& (InfixRV_rvals-->rop); - ']#': acc = (InfixRV_rvals-->lop) .# (InfixRV_rvals-->rop); - '::': acc = (InfixRV_rvals-->lop) :: (InfixRV_rvals-->rop); - '&//': acc = (InfixRV_rvals-->lop) & (InfixRV_rvals-->rop); - '|//': acc = (InfixRV_rvals-->lop) | (InfixRV_rvals-->rop); - '&&': acc = (InfixRV_rvals-->lop) && (InfixRV_rvals-->rop); - infix_term_type = INFIXTT_LOGICAL; - '||': acc = (InfixRV_rvals-->lop) || (InfixRV_rvals-->rop); - infix_term_type = INFIXTT_LOGICAL; - 'lop) < (InfixRV_rvals-->rop); - infix_term_type = INFIXTT_LOGICAL; - '<=': acc = (InfixRV_rvals-->lop) <= (InfixRV_rvals-->rop); - infix_term_type = INFIXTT_LOGICAL; - '>//': acc = (InfixRV_rvals-->lop) > (InfixRV_rvals-->rop); - infix_term_type = INFIXTT_LOGICAL; - '>=': acc = (InfixRV_rvals-->lop) >= (InfixRV_rvals-->rop); - infix_term_type = INFIXTT_LOGICAL; - '==': acc = (InfixRV_rvals-->lop) == (InfixRV_rvals-->rop); - infix_term_type = INFIXTT_LOGICAL; - '[=': acc = (InfixRV_rvals-->lop) ~= (InfixRV_rvals-->rop); - infix_term_type = INFIXTT_LOGICAL; - 'has': acc = (InfixRV_rvals-->lop) has (InfixRV_rvals-->rop); - infix_term_type = INFIXTT_LOGICAL; - 'hasnt': acc = (InfixRV_rvals-->lop) hasnt (InfixRV_rvals-->rop); - infix_term_type = INFIXTT_LOGICAL; - 'in': acc = (InfixRV_rvals-->lop) in (InfixRV_rvals-->rop); - infix_term_type = INFIXTT_LOGICAL; - 'notin': acc = (InfixRV_rvals-->lop) notin (InfixRV_rvals-->rop); - infix_term_type = INFIXTT_LOGICAL; - 'provides': acc = (InfixRV_rvals-->lop) provides (InfixRV_rvals-->rop); - infix_term_type = INFIXTT_LOGICAL; - 'ofclass': acc = (InfixRV_rvals-->lop) ofclass (InfixRV_rvals-->rop); - infix_term_type = INFIXTT_LOGICAL; - '[[': acc = ~~ (InfixRV_rvals-->rop); flag = true; - '[//': acc = ~ (InfixRV_rvals-->rop); flag = true; - 'unary-': acc = - (InfixRV_rvals-->rop); flag = true; - } ! end of switch(InfixRV_rvals-->maxi) - InfixRV_rvals-->maxi = acc; - InfixRV_types-->maxi = -1; - if (rop < n) InfixRV_types-->rop = -2; - if (flag == false && lop >= 0) InfixRV_types-->lop = -2; - } ! end of for (::) -]; ! end of InfixRvalue - -! ------------------------------------------------------------------------ - -[ InfixWelcomeSub; - print "; Welcome to the ~Infix~ debugger (1/040828), which makes the - following verbs available:^^ - ~; ~: evaluates this Inform expression: e.g. - ~; location~ will print the value of the variable ~location~, - ~; 3*5+1~ will print 16, ~; children(old cloth bag)~ will tell you - how many items are in it. (You can name objects either by their - names inside the source code, such as ~d_obj~, or by typing the - names by which the game's parser would normally know them, such - as ~floor~: the effect is the same.)^ - Any expression is allowed except that you can't use double-quoted - strings of text: but you can send messages, call routines or - assign values to variables, properties and array entries. - ^ ~; score++~ is one way to get on in the world. - ^ ~; deadflag = true~ is one way to get out of it. - ^ ~; StopDaemon(nasty little dwarf)~ will keep you from being pestered.^ - Conditions like ~; score>20~ are also allowed and print - either 1 (if true) or 0 (if false).^^"; - print "~;examine ~ or ~;x ~ gives full details - of whatever it is. For instance, ~;x ##Take~ describes the Take - action; ~;x Class~ the class Class; ~;x 'drop'~ the dictionary - word ~drop~ and so on for numbers, routines, arrays and of course - objects. ~;xo~ examines something as an object, so for instance - ~;x location~ tells you about the variable ~location~, but ~;xo - location~ tells you what object it refers to.^^"; - print "~;give~, ~;remove~ and ~;move~ work like the corresponding - Inform statements.^^"; - print "~;<~ causes an action: for instance, ~;< Eat cheese~.^^"; - print "~;watch~ or ~;w~ can set a watch on various activities: - type just ~;w~ for details.^^"; - print "~;inventory~ or ~;i~ describes the contents of this story file.^"; -]; - -[ InfixEvalSub; InfixExamineP(true); ]; - -[ InfixActionSub; - print "; <", (InfixPrintAction) infix_lvalue; - if (noun) print " (", (the) noun, ")"; - if (second) print " (", (the) second, ")"; - print ">^"; - if (second) <<(infix_lvalue) noun second>>; - if (noun) <<(infix_lvalue) noun>>; - <<(infix_lvalue)>>; -]; - -[ InfixGiveSub f t; - print "; give (", (the) noun, ") "; - if (second < 0) { second = ~second; f=true; } - #Ifdef VN_1630; - t = NUM_ATTR_BYTES * 8; - #Ifnot; - t = 48; - #Endif; ! VN_ - if (second < 0 || second >= t) ""; - if (f) print "@@126"; - print (DebugAttribute) second; - #Ifdef TARGET_ZCODE; - if (f) @clear_attr noun second; - else @set_attr noun second; - #Ifnot; ! TARGET_GLULX - t = second + 8; - if (f) @astorebit noun t 0; ! give noun ~second; - else @astorebit noun t 1; ! give noun second; - #Endif; ! TARGET_ - if (t); ! quell unused n variable warning - new_line; -]; - -[ InfixMoveSub; - print "; move (", (the) noun, ") to (", (the) second, ")^"; - move noun to second; -]; - -[ InfixRemoveSub; - print "; remove (", (the) noun, ")^"; - remove noun; -]; - -[ InfixHex x y; - #Ifdef TARGET_ZCODE; - y = (x & $7f00) / $100; - if (x < 0) y = y + $80; - #Ifnot; ! TARGET_GLULX - y = (x & $7f000000) / $1000000; - if (x < 0) y = y + $80; - print (Infixhexdigit) y/$10, (Infixhexdigit) y; - y = x & $ff0000 / $10000; - print (Infixhexdigit) y/$10, (Infixhexdigit) y; - y = (x & $ff00) / $100; - #Endif; ! TARGET_ - x = x & $ff; - print (Infixhexdigit) y/$10, (Infixhexdigit) y, (Infixhexdigit) x/$10, (Infixhexdigit) x; -]; - -[ Infixhexdigit x; x = x % $10; if (x < 10) print x; else print (char) 'a'+x-10; ]; - -[ InfixExamineOSub; - infix_data1 = metaclass(noun); - #Ifdef TARGET_GLULX; ! different coding for Glulx - if (infix_data1 == Object) infix_data1 = 2; - if (infix_data1 == Class) infix_data1 = 1; - #Endif; ! TARGET_ - infix_term_type = INFIXTT_CONSTANT; - InfixExamineP(false); -]; - -[ InfixExamineSSub; - infix_term_type = INFIXTT_STATICSTRING; - InfixExamineP(false); -]; - -[ InfixExamineSub; InfixExamineP(false); ]; - -[ InfixExamineP brief x a b w flag lines; - switch (infix_term_type) { - INFIXTT_NUMBER: - if (brief) "; == ", noun; - print "; The number ", noun, " == $", (InfixHex) noun; - if (noun >= 32 && noun < 127) print " == '", (char) noun, "'"; - new_line; - INFIXTT_NAMEDOBJECT: - print "~", (name) noun, "~ (", noun, ")^"; if (brief) return; - <>; - INFIXTT_CONSTANT: - if (brief) "; == ", noun; - switch (infix_data1 & 15) { - nothing: - print "; Constant ", (InfixPrintConstant) infix_parsed_lvalue, - " == ", noun, "^"; - 2: <>; - 1: - print "Class ", (name) noun, "^"; - objectloop (a ofclass noun) { - if (flag) print ", "; else print "Contains: "; - print (name) a, " (", a, ")"; flag=true; - } - if (flag == false) "No object is of this class"; - } - new_line; - INFIXTT_ATTRIBUTE: - if (brief) "; == ", noun; - if (noun >= 48 || noun < 0) "; No such attribute"; - print "; Attribute ", (InfixPrintAttribute) noun, - " (numbered ", noun, ")^"; - objectloop (x has noun) { - if (flag) print ", "; - else print "Each of these ~has ", (InfixPrintAttribute) noun, "~: "; - print (name) x, " (", x, ")"; flag = true; - } - if (flag == false) "No object ~has ", (InfixPrintAttribute) noun, "~"; - new_line; - INFIXTT_PROPERTY: - if (brief) "; == ", noun; - print "; Property ", (property) noun, " (numbered ", noun, ")^"; - objectloop (x provides noun) { - if (flag) print ", "; else print "Provided by: "; - print (name) x, " (", x, ")"; flag = true; - } - if (flag == false) "Which is not provided by any object"; - new_line; - INFIXTT_DWORD: - if (brief) "; == ", noun; - if (noun == 0) "; This word is not in the dictionary"; - a = noun->#dict_par1; - print "; Dictionary word '", (address) noun; - if (a & 4) print "//p"; - print "' (address ", noun, ")"; - if (a) { - print ": "; - if (a & 2) print "meta "; - if (a & 1) print "verb "; - if (a & 8) print "preposition "; - if (a & 4) print "pluralising "; - if (a & 128) print "noun "; - } - new_line; - if (a & 1) <>; - INFIXTT_ROUTINE: - if (brief) "; == ", noun; - print "; Routine ", (InfixPrintRoutine) infix_parsed_lvalue, " (number ", - infix_parsed_lvalue, ", packed address ", noun, ")^"; - INFIXTT_GLOBAL: - if (brief) "; == ", noun; - print "; Global ", (InfixPrintGlobal) infix_parsed_lvalue, " == ", noun, "^"; - INFIXTT_ARRAY: - if (brief) "; == ", noun; - print "; Array ", (InfixPrintArray) infix_parsed_lvalue, " "; - infix_data1 = infix_data1 % 16; - switch (infix_data1) { - 0: print "->"; a=0; - 1: print "-->"; a=0; - 2: print "string"; a=1; - 3: print "table"; a=1; - 4: print "buffer"; a=WORDSIZE; - } - print " ", infix_data2 + 1 - a, "^; == "; b = infix_data2; - for (w=b : w>=a : w--) - if (infix_data1 == 0 or 2 or 4) { if (noun->w) break; } - else { if (noun-->w) break; } - if (b-w < 5) w=b; - for (: x<=w : x++) { - if (infix_data1 == 0 or 2 or 4) print noun->x, " "; - else print noun-->x, " "; - if (x+1 == a) print ": "; - } - if (w < b) print "(then ", b-w, " zero entries)"; - new_line; - INFIXTT_ACTION: - if (brief) "; == ", noun; - if (noun >= #lowest_fake_action_number && noun <= #highest_fake_action_number) - "; Fake action ", (InfixPrintFakeAction) noun, - " (numbered ", noun, ")^Is not generated by any grammar"; - print "; Action ", (InfixPrintAction) noun, - " (numbered ", noun, ")^"; - #Ifdef TARGET_ZCODE; - w = HDR_DICTIONARY-->0; - for (b=0 : b<(HDR_DICTIONARY-->0 + 5)-->0 : b++) { - w = HDR_DICTIONARY-->0 + 7 + b*9; - if ((w->#dict_par1) & 1) { - a = (HDR_STATICMEMORY-->0)-->($ff-(w->#dict_par2)); - lines = a->0; a++; - for (: lines>0 : lines--) { - a = UnpackGrammarLine(a); - if (action_to_be == noun) { - print "'", (address) w, "' "; DebugGrammarLine(); - new_line; - flag = true; - } - } - } - } - #Ifnot; ! TARGET_GLULX - for (b=0 : b < #dictionary_table-->0 : b++) { - w = #dictionary_table + WORDSIZE + b*(DICT_WORD_SIZE + 7); - if ((w->#dict_par1) & 1) { - a = (#grammar_table)-->(DictionaryWordToVerbNum(w) + 1); - lines = a->0; a++; - for (: lines>0 : lines--) { - a = UnpackGrammarLine(a); - if (action_to_be == noun) { - print "'", (address) w, "' "; DebugGrammarLine(); - new_line; - flag = true; - } - } - } - } - #Endif; ! TARGET_ - - if (flag == 0) "Is not generated by any grammar"; - INFIXTT_SYSFUN: - if (brief) "; == ", noun; - "; System function ~", (address) infix_parsed_lvalue, "~ has - not been overridden by any routine and so has its standard definition."; - INFIXTT_STATICSTRING: - if (brief) "; == ", noun; - if (metaclass(noun) ~= String) "; ", noun, " is not a string."; - print "~", (string) noun, "~^"; - INFIXTT_LOGICAL: - if (noun == true) "; true"; if (noun == false) "; false"; - "; ", noun; - } - new_line; -]; ! end of InfixExamineP - -[ InfixDescribeWatchSub x y z s flag aflag; - print "; The Infix ~;watch~ verb allows you to set a watch on any named - routine(s) or objects: for instance ~;watch ScoreSub~ or - ~;watch silver bars~. You can also: - ^ ~;watch objects~: changes to attribute or property settings"; - if (debug_flag & 8) print " (on)"; else print " (off)"; - - print ";^ ~;watch timers~: the running of timers and daemons each turn"; - if (debug_flag & 4) print " (on)"; else print " (off)"; - - print ";^ ~;watch messages~: all messages sent"; - if (debug_flag & 1) print " (on)"; else print " (off)"; - - print ";^ ~;watch actions~: all actions generated"; - if (debug_flag & 2) print " (on)"; else print " (off)"; - - print ".^~~;watch~ can be abbreviated to ~;w~ and use ~off~ to stop - watching: for instance ~;w location off~.^"; - aflag = debug_flag; - objectloop (x has infix__watching) flag = true; aflag = aflag || flag; - if (flag) print "The following objects are currently being watched: "; - flag = false; - objectloop (x has infix__watching) { - if (flag) print ", "; flag = true; - print (name) x, " (", x, ")"; - } - if (flag) new_line; - s = (#highest_routine_number - #lowest_routine_number); - if (s%8 == 0) s=s/8; else s=s/8+1; - for (flag=false,x=0 : xx) flag = true; - aflag = aflag || flag; - if (flag) print "The following routines are currently being watched: "; - for (x=0,flag=false : xx) & y) { - if (flag) print ", "; flag = true; - print (InfixPrintRoutine) - #lowest_routine_number + x*8 + z; - } - } - } - if (flag) new_line; - if (aflag == false) "At present, nothing is being watched."; -]; - -[ InfixWatchOnSub i j k l; - if (noun == 0) return InfixDescribeWatchSub(); - if (infix_term_type == INFIXTT_ROUTINE) { - i = infix_parsed_lvalue/8; - for (j=0,k=1 : ji; - l = l | k; - #ifdef TARGET_ZCODE; - @storeb #routine_flags_array i l; - #ifnot; ! TARGET_GLULX - @astoreb #routine_flags_array i l; - #endif; ! TARGET_ - "; Watching routine ", (InfixPrintRoutine) infix_parsed_lvalue, "."; - } - if (metaclass(noun) == Object) { - give noun infix__watching; - "; Watching object ~", (name) noun, "~ (", noun, ")."; - } - InfixDescribeWatchSub(); - ]; - -[ InfixWatchOffSub i j k l; - if (noun == 0) return InfixDescribeWatchSub(); - if (infix_term_type == INFIXTT_ROUTINE) { - i = infix_parsed_lvalue/8; - for (j=0,k=1 : ji; - l = l & (~k); - #ifdef TARGET_ZCODE; - @storeb #routine_flags_array i l; - #ifnot; ! TARGET_GLULX - @astoreb #routine_flags_array i l; - #endif; ! TARGET - "; Not watching ", (InfixPrintRoutine) infix_parsed_lvalue, "."; - } - if (metaclass(noun) == Object) { - #ifdef TARGET_ZCODE; - @clear_attr noun infix__watching; - #ifnot; ! TARGET_GLULX - @astorebit noun (infix__watching+8) 0; - #endif; ! TARGET_ - "; Not watching object ~", (name) noun, "~ (", noun, ")."; - } - InfixDescribeWatchSub(); -]; - -[ InfixList from to tab filter i flag; - print "^ "; - for (i=from : i<=to : i++) - if (tab-->(i-from)) { - flag = true; - if (tab == #array_names_array) { - Symb__Tab(INFIXTT_ARRAY, i); - flag = ~~(temp__global3 & 16); - } - if (tab == #routine_names_array) { - Symb__Tab(INFIXTT_ROUTINE,i); - flag = ~~(temp__global3 & 16); - } - if (tab == #constant_names_array) { - Symb__Tab(INFIXTT_CONSTANT,i); - flag = (~~(temp__global3 & 16)) && (temp__global3 % 16 == filter); - } - if (flag) print (string) tab-->(i-from), " "; - } - new_line; -]; - -[ InfixInvSub i; - - print (string) Story, (string) Headline; - print " ", (number) #highest_object_number - #lowest_object_number + 1, - " objects;^"; - - print " non-library object-name constants:"; - InfixList(#lowest_constant_number, #highest_constant_number, #constant_names_array, 2); - - print " ", (number) #highest_class_number - #lowest_class_number + 1, " classes:^ "; - for (i=#lowest_class_number : i<=#highest_class_number : i++) - print (name) #class_objects_array-->i, " "; - new_line; - - print " non-library arrays:"; - InfixList(#lowest_array_number, #highest_array_number, #array_names_array); - - print " non-library routines:"; - InfixList(#lowest_routine_number, #highest_routine_number, #routine_names_array); - - print " non-library constants:"; - InfixList(#lowest_constant_number, #highest_constant_number, #constant_names_array, 0); - - print " (common) properties:"; - #Ifdef TARGET_ZCODE; - InfixList(#lowest_property_number, INDIV_PROP_START-1, #property_names_array); - #Ifnot; ! TARGET_GLULX - InfixList(#lowest_property_number, #identifiers_table-->1 - 1, #property_names_array); - #Endif; ! TARGET_ - - print " (individual) properties:"; - #Ifdef TARGET_ZCODE; - InfixList(INDIV_PROP_START, #highest_property_number, #property_names_array + 126); - #Ifnot; ! TARGET_GLULX - InfixList(INDIV_PROP_START, #highest_property_number, #identifiers_table-->2); - #Endif; ! TARGET_ - - print " attributes:"; - InfixList(#lowest_attribute_number, #highest_attribute_number, #attribute_names_array); - - if (true) return; - - print " variables:"; - InfixList(#lowest_global_number, #highest_global_number, #global_names_array); - - print " actions:"; - InfixList(#lowest_action_number, #highest_action_number, #action_names_array); - - print " fake actions:"; - InfixList(#lowest_fake_action_number, #highest_fake_action_number, #fake_action_names_array); -]; - -Verb meta ';i' ';inv' ';inventory' - * -> InfixInv; -Verb meta ';x' ';examine' - * InfixRvalue -> InfixExamine; -Verb meta ';xo' ';examineo' - * InfixRvalue -> InfixExamineO; -Verb meta ';xs' ';examines' - * InfixRvalue -> InfixExamineS; -Verb meta ';<' - * InfixActionToken -> InfixAction - * InfixActionToken InfixRvalue -> InfixAction - * InfixActionToken InfixRvalue InfixRvalue -> InfixAction; -Verb meta ';//' - * -> InfixWelcome - * InfixRvalue -> InfixEval; -Verb meta ';give' - * InfixRvalue InfixRvalue -> InfixGive; -Verb meta ';move' - * InfixRvalue "to" InfixRvalue -> InfixMove; -Verb meta ';remove' - * InfixRvalue -> InfixRemove; -Verb meta ';watch' ';w' - * -> InfixWatchOn - * "timers"/"daemons" -> TimersOn - * "timers"/"daemons" "off" -> TimersOff - * "actions" -> ActionsOn - * "actions" "off" -> ActionsOff - * "messages" -> RoutinesOn - * "messages" "off" -> RoutinesOff - * "objects" -> ChangesOn - * "objects" "off" -> ChangesOff - * InfixRvalueTerm -> InfixWatchOn - * InfixRvalueTerm "off" -> InfixWatchOff; - -#Endif; ! DEBUG - -! ============================================================================== diff --git a/linklpa.h b/linklpa.h index e2f744b..2525bc9 100644 --- a/linklpa.h +++ b/linklpa.h @@ -1,9 +1,9 @@ ! ============================================================================== ! LINKLPA: Link declarations of common properties and attributes. ! -! Supplied for use with Inform 6 -- Release 6.12.2 -- Serial number 180520 +! Supplied for use with Inform 6 -- Release 6.12.3 -- Serial number 190320 ! -! Copyright Graham Nelson 1993-2004 and David Griffith 2012-2018 +! Copyright Graham Nelson 1993-2004 and David Griffith 2012-2019 ! ! This file is free software: you can redistribute it and/or modify ! it under the terms of the GNU Affero General Public License as diff --git a/linklv.h b/linklv.h deleted file mode 100644 index 55d4a7a..0000000 --- a/linklv.h +++ /dev/null @@ -1,207 +0,0 @@ -! ============================================================================== -! LINKLV: Link declarations of library variables. -! -! Supplied for use with Inform 6 -- Release 6.12.1 -- Serial number 160429 -! -! Copyright Graham Nelson 1993-2004 and David Griffith 2012-2015 -! -! This file is free software: you can redistribute it and/or modify -! it under the terms of the GNU Affero General Public License as -! published by the Free Software Foundation, either version 3 of the -! License, or (at your option) any later version. -! -! This file is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -! Affero General Public License for more details. -! -! You should have received a copy of the GNU Affero General Public -! License along with this program. If not, see -! https://gnu.org/licenses/ -! -! This file is automatically Included in your game file by "verblibm" only if -! you supply the -U compiler switch to use pre-compiled Modules. -! ============================================================================== - -System_file; - -! ------------------------------------------------------------------------------ - -Import global location; -Import global sline1; -Import global sline2; - -Import global top_object; -Import global standard_interpreter; -Import global undo_flag; -Import global just_undone; -Import global transcript_mode; -Import global xcommsdir; - -Import global sys_statusline_flag; -Import global turns; -Import global the_time; -Import global time_rate; -Import global time_step; -Import global active_timers; - -Import global score; -Import global last_score; -Import global notify_mode; -Import global places_score; -Import global things_score; - -Import global player; -Import global deadflag; - -Import global lightflag; -Import global real_location; -Import global prev_location; -Import global visibility_ceiling; -Import global lookmode; -Import global print_player_flag; -Import global lastdesc; - -Import global c_style; -Import global lt_value; -Import global listing_together; -Import global listing_size; -Import global wlf_indent; -Import global inventory_stage; -Import global inventory_style; -Import global pretty_flag; -Import global menu_nesting; -Import global menu_item; -Import global item_width; -Import global item_name; -Import global lm_n; -Import global lm_o; -Import global lm_s; - -#Ifdef COLOUR; -Import global clr_fg; -Import global clr_bg; -Import global clr_fgstatus; -Import global clr_bgstatus; -#Endif; ! COLOUR -Import global statuswin_current; - -#Ifdef DEBUG; -Import global debug_flag; -Import global x_scope_count; -#Endif; ! DEBUG - -Import global action; -Import global inp1; -Import global inp2; -Import global noun; -Import global second; -Import global keep_silent; -Import global reason_code; -Import global receive_action; - -Import global parser_trace; -Import global parser_action; -Import global parser_one; -Import global parser_two; -Import global parser_inflection; -Import global actor; -Import global actors_location; -Import global meta; -Import global multiflag; -Import global toomany_flag; -Import global special_word; -Import global special_number; -Import global parsed_number; -Import global consult_from; -Import global consult_words; -Import global asking_player; - -Import global notheld_mode; -Import global onotheld_mode; -Import global not_holding; - -Import global etype; -Import global best_etype; -Import global nextbest_etype; -Import global pcount; -Import global pcount2; -Import global parameters; -Import global nsns; -Import global special_number1; -Import global special_number2; - -Import global params_wanted; -Import global inferfrom; -Import global inferword; -Import global dont_infer; -Import global action_to_be; -Import global action_reversed; -Import global advance_warning; -Import global found_ttype; -Import global found_tdata; -Import global token_filter; -Import global length_of_noun; -Import global lookahead; -Import global multi_mode; -Import global multi_wanted; -Import global multi_had; -Import global multi_context; -Import global indef_mode; -Import global indef_type; -Import global indef_wanted; -Import global indef_guess_p; -Import global indef_owner; -Import global indef_cases; -Import global indef_possambig; -Import global indef_nspec_at; -Import global allow_plurals; -Import global take_all_rule; -Import global dict_flags_of_noun; -Import global pronoun_word; -Import global pronoun_obj; -Import global pronoun__word; -Import global pronoun__obj; - -Import global scope_reason; -Import global scope_token; -Import global scope_error; -Import global scope_stage; -Import global ats_flag; -Import global ats_hls; -Import global placed_in_flag; -Import global number_matched; -Import global number_of_classes; -Import global match_length; -Import global match_from; -Import global bestguess_score; - -Import global wn; -Import global num_words; -Import global verb_word; -Import global verb_wordnum; -Import global usual_grammar_after; -Import global oops_from; -Import global saved_oops; -Import global held_back_mode; -Import global hb_wn; -Import global caps_mode; -Import global print_anything_result; -Import global initial_lookmode; -Import global before_first_turn; - -Import global short_name_case; -Import global dict_start; -Import global dict_entry_size; -Import global dict_end; - -#Ifdef EnglishNaturalLanguage; -Import global itobj; -Import global himobj; -Import global herobj; -Import global old_itobj; -Import global old_himobj; -Import global old_herobj; -#Endif; ! EnglishNaturalLanguage - -! ============================================================================== diff --git a/parser.h b/parser.h index d0b427e..e7165ec 100644 --- a/parser.h +++ b/parser.h @@ -1,9 +1,9 @@ ! ============================================================================== ! PARSER: Front end to parser. ! -! Supplied for use with Inform 6 -- Release 6.12.2 -- Serial number 180520 +! Supplied for use with Inform 6 -- Release 6.12.3 -- Serial number 190320 ! -! Copyright Graham Nelson 1993-2004 and David Griffith 2012-2018 +! Copyright Graham Nelson 1993-2004 and David Griffith 2012-2019 ! ! This file is free software: you can redistribute it and/or modify ! it under the terms of the GNU Affero General Public License as @@ -70,11 +70,11 @@ System_file; ! ------------------------------------------------------------------------------ #Ifndef VN_1633; -Message fatalerror "*** Library 6.12.2 needs Inform v6.33 or later to work ***"; +Message fatalerror "*** Library 6.12.3 needs Inform v6.33 or later to work ***"; #Endif; ! VN_ -Constant LibSerial "180520"; -Constant LibRelease "6.12.2"; +Constant LibSerial "190320"; +Constant LibRelease "6.12.3pre"; Constant LIBRARY_VERSION 612; Constant Grammar__Version 2; @@ -6429,7 +6429,7 @@ Object InformLibrary "(Inform Library)" #Endif; ! TARGET_ZCODE #Ifndef DrawStatusLine; -[ DrawStatusLine width posa posb; +[ DrawStatusLine width posa posb posc; #Ifdef TARGET_GLULX; ! If we have no status window, we must not try to redraw it. if (gg_statuswin == 0) @@ -6444,7 +6444,9 @@ Object InformLibrary "(Inform Library)" MoveCursor(1, 1); width = ScreenWidth(); - posa = width-26; posb = width-13; + posa = width-26; + posb = width-13; + posc = width-5; spaces width; MoveCursor(1, 2); @@ -6473,12 +6475,22 @@ Object InformLibrary "(Inform Library)" MoveCursor(1, posb); print (string) MOVES__TX, sline2; } - #Ifndef NO_SCORE; - if (width > 53 && width <= 66) { - MoveCursor(1, posb); - print sline1, "/", sline2; - } - #Endif; + if (width > 53 && width <= 66) { + MoveCursor(1, posb); + #Ifdef NO_SCORE; + print (string) MOVES__TX, sline2; + #Ifnot; + print sline1, "/", sline2; + #Endif; + } + if (width < 53) { + MoveCursor(1, posc); + #Ifdef NO_SCORE; + print (string) MOVES_S__TX, sline2; + #Ifnot; + print sline1, "/", sline2; + #Endif; + } } MainWindow(); ! set_window @@ -6629,10 +6641,8 @@ Object InformLibrary "(Inform Library)" gg_scriptstr = 0; gg_savestr = 0; gg_statuswin_cursize = 0; - #Ifdef DEBUG; gg_commandstr = 0; gg_command_reading = false; - #Endif; ! DEBUG ! Also tell the game to clear its object references. if (IdentifyGlkObject(0) == false) LibraryExtensions.RunWhile(ext_identifyglkobject, 0, 0); @@ -6641,12 +6651,10 @@ Object InformLibrary "(Inform Library)" switch (gg_arguments-->0) { GG_SAVESTR_ROCK: gg_savestr = id; GG_SCRIPTSTR_ROCK: gg_scriptstr = id; - #Ifdef DEBUG; GG_COMMANDWSTR_ROCK: gg_commandstr = id; gg_command_reading = false; GG_COMMANDRSTR_ROCK: gg_commandstr = id; gg_command_reading = true; - #Endif; ! DEBUG default: if (IdentifyGlkObject(1, 1, id, gg_arguments-->0) == false) LibraryExtensions.RunWhile(ext_identifyglkobject, false, 1, 1, id, gg_arguments-->0); } diff --git a/parserm.h b/parserm.h deleted file mode 100644 index 3db013f..0000000 --- a/parserm.h +++ /dev/null @@ -1,7132 +0,0 @@ -! ============================================================================== -! PARSERM: Core of parser. -! -! Supplied for use with Inform 6 -- Release 6.12.1 -- Serial number 160605 -! -! Copyright Graham Nelson 1993-2004 and David Griffith 2012-2016 -! -! This file is free software: you can redistribute it and/or modify -! it under the terms of the GNU Affero General Public License as -! published by the Free Software Foundation, either version 3 of the -! License, or (at your option) any later version. -! -! This file is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -! Affero General Public License for more details. -! -! You should have received a copy of the GNU Affero General Public -! License along with this program. If not, see -! https://gnu.org/licenses/ -! -! This file is automatically Included in your game file by "parser". -! ------------------------------------------------------------------------------ -! Inclusion of "linklpa" (which defines properties and attributes) -! Global variables, constants and arrays -! 1: outside of the parser -! 2: used within the parser -! Inclusion of natural language definition file -! (which creates a compass and direction-objects) -! Darkness and player objects -! Definition of grammar token numbering system used by Inform -! -! The InformParser object -! keyboard reading -! level 0: outer shell, conversation, errors -! 1: grammar lines -! 2: tokens -! 3: object lists -! 4: scope and ambiguity resolving -! 5: object comparisons -! 6: word comparisons -! 7: reading words and moving tables about -! pronoun management -! -! The InformLibrary object -! main game loop -! action processing -! end of turn sequence -! scope looping, before/after sequence, sending messages out -! timers, daemons, time of day, score notification -! light and darkness -! changing player personality -! tracing code (only present if DEBUG is set) -! -! Status line printing, menu display -! Printing object names with articles -! Miscellaneous utility routines -! Game banner, "version" verb, run-time errors -! ============================================================================== - -System_file; - -#Ifdef MODULE_MODE; -Constant DEBUG; -Constant Grammar__Version 2; -Include "linklpa"; -#Endif; ! MODULE_MODE - -#Ifdef COLOR; -Constant COLOUR; -#Endif; - -#Ifdef COLOUR; -Global clr_on = 1; -#Ifnot; -Global clr_on = 0; -#Endif; - -! ------------------------------------------------------------------------------ -! Global variables and their associated Constant and Array declarations -! ------------------------------------------------------------------------------ - -Global location = InformLibrary; ! Must be first global defined -Global sline1; ! Must be second -Global sline2; ! Must be third - ! (for status line display) - -! ------------------------------------------------------------------------------ -! Z-Machine and interpreter issues -! ------------------------------------------------------------------------------ - -#Ifdef TARGET_ZCODE; -Global top_object; ! Largest valid number of any tree object -! ### these globals are not meaningful... well, maybe standard_interpreter, -! but I'll decide that later (AP). -Constant INDIV_PROP_START 64; ! Equivalent of a Glulx constant - -#Endif; ! TARGET_ZCODE - -Global standard_interpreter; ! The version number of the Z-Machine Standard which the - ! interpreter claims to support, in form (upper byte).(lower) - -Global undo_flag; ! Can the interpreter provide "undo"? -Global just_undone; ! Can't have two successive UNDOs - -Global transcript_mode; ! true when game scripting is on - -#Ifdef TARGET_ZCODE; -Global xcommsdir; ! true if command recording is on -#Endif; ! TARGET_ZCODE - -#Ifdef TARGET_GLULX; -Constant GG_MAINWIN_ROCK 201; -Constant GG_STATUSWIN_ROCK 202; -Constant GG_QUOTEWIN_ROCK 203; -Constant GG_SAVESTR_ROCK 301; -Constant GG_SCRIPTSTR_ROCK 302; -Constant GG_COMMANDWSTR_ROCK 303; -Constant GG_COMMANDRSTR_ROCK 304; -Constant GG_SCRIPTFREF_ROCK 401; -Array gg_event --> 4; -#Ifdef VN_1630; -Array gg_arguments buffer 28; -#Ifnot; -Array gg_arguments --> 8; -#Endif; ! VN_ -Global gg_mainwin = 0; -Global gg_statuswin = 0; -Global gg_quotewin = 0; -Global gg_scriptfref = 0; -Global gg_scriptstr = 0; -Global gg_savestr = 0; -Global gg_commandstr = 0; -Global gg_command_reading = 0; ! true if gg_commandstr is being replayed -#Endif; ! TARGET_GLULX - -Global gg_statuswin_cursize = 0; -Global gg_statuswin_size = 1; - -! ------------------------------------------------------------------------------ -! Time and score -! (for linkage reasons, the task_* arrays are created not here but in verblib.h) -! ------------------------------------------------------------------------------ - -#Ifndef sys_statusline_flag; -Global sys_statusline_flag = 0; ! non-zero if status line displays time -#Endif; - -#Ifndef START_MOVE; -Constant START_MOVE 0; ! Traditionally 0 for Infocom, 1 for Inform -#Endif; - -Global turns = START_MOVE; ! Number of turns of play so far -Global the_time = NULL; ! Current time (in minutes since midnight) -Global time_rate = 1; ! How often time is updated -Global time_step; ! By how much - -#Ifndef MAX_TIMERS; -Constant MAX_TIMERS 32; ! Max number timers/daemons active at once -#Endif; ! MAX_TIMERS -Array the_timers --> MAX_TIMERS; -Global active_timers; ! Number of timers/daemons actives - -Global score; ! The current score -Global last_score; ! Score last turn (for testing for changes) -Global notify_mode = true; ! Score notification -Global places_score; ! Contribution to score made by visiting -Global things_score; ! Contribution made by acquisition - -! ------------------------------------------------------------------------------ -! The player -! ------------------------------------------------------------------------------ - -Global player; ! Which object the human is playing through -Global deadflag; ! Normally 0, or false; 1 for dead - ! 2 for victorious, and higher numbers - ! represent exotic forms of death - -! ------------------------------------------------------------------------------ -! Light and room descriptions -! ------------------------------------------------------------------------------ - -Global lightflag = true; ! Is there currently light to see by? -Global real_location; ! When in darkness, location = thedark - ! and this holds the real location -Global prev_location; ! The previous value of real_location -Global visibility_ceiling; ! Highest object in tree visible from the - ! player's point of view (usually the room, - ! sometimes darkness, sometimes a closed - ! non-transparent container). - -Global lookmode = 2; ! 1=brief, 2=verbose, 3=superbrief - ! room descriptions -Global print_player_flag; ! If set, print something like "(as Fred)" - ! in room descriptions, to reveal whom the - ! player is playing through -Global lastdesc; ! Value of location at time of most recent - ! room description printed out - -! ------------------------------------------------------------------------------ -! List writing (style bits are defined as Constants in "verblibm.h") -! ------------------------------------------------------------------------------ - -Global c_style; ! Current list-writer style -Global lt_value; ! Common value of list_together -Global listing_together; ! Object number of one member of a group - ! being listed together -Global listing_size; ! Size of such a group -Global wlf_indent; ! Current level of indentation printed by - ! WriteListFrom() - -Global inventory_stage = 1; ! 1 or 2 according to the context in which - ! "invent" routines of objects are called -Global inventory_style; ! List-writer style currently used while - ! printing inventories -! ------------------------------------------------------------------------------ -! Menus and printing -! ------------------------------------------------------------------------------ - -Global pretty_flag = true; ! Use character graphics, or plain text? -Global menu_nesting; ! Level of nesting (0 = root menu) -Global menu_item; ! These are used in communicating -Global item_width = 8; ! with the menu-creating routines -Global item_name = "---"; - -Global lm_n; ! Parameters used by LibraryMessages -Global lm_o; ! mechanism -Global lm_s; - -#Ifdef DEBUG; -Constant DEBUG_MESSAGES $0001; -Constant DEBUG_ACTIONS $0002; -Constant DEBUG_TIMERS $0004; -Constant DEBUG_CHANGES $0008; -Constant DEBUG_VERBOSE $0080; -Global debug_flag; ! Bitmap of flags for tracing actions, - ! calls to object routines, etc. -Global x_scope_count; ! Used in printing a list of everything -#Endif; ! DEBUG ! in scope - -! five for colour control -! see http://www.inform-fiction.org/patches/L61007.html -! To enable colour define a constant or Global: COLOR or COLOUR -!Global clr_on; ! has colour been enabled by the player? -#Ifdef COLOUR; -Global clr_fg = 1; ! foreground colour -Global clr_bg = 1; ! background colour -Global clr_fgstatus = 1; ! foreground colour of statusline -Global clr_bgstatus = 1; ! background colour of statusline -#Endif; ! COLOUR -Global statuswin_current; ! if writing to top window - -Constant CLR_CURRENT 0; -Constant CLR_DEFAULT 1; -Constant CLR_BLACK 2; -Constant CLR_RED 3; -Constant CLR_GREEN 4; -Constant CLR_YELLOW 5; -Constant CLR_BLUE 6; -Constant CLR_MAGENTA 7; -Constant CLR_CYAN 8; -Constant CLR_WHITE 9; -Constant CLR_PURPLE 7; -Constant CLR_AZURE 8; - -Constant WIN_ALL 0; -Constant WIN_STATUS 1; -Constant WIN_MAIN 2; - -! ------------------------------------------------------------------------------ -! Action processing -! ------------------------------------------------------------------------------ - -Global action; ! Action currently being asked to perform -Global inp1; ! 0 (nothing), 1 (number) or first noun -Global inp2; ! 0 (nothing), 1 (number) or second noun -Global noun; ! First noun or numerical value -Global second; ! Second noun or numerical value - -Global keep_silent; ! If true, attempt to perform the action - ! silently (e.g. for implicit takes, - ! implicit opening of unlocked doors) - -Global reason_code; ! Reason for calling a "life" rule - ! (an action or fake such as ##Kiss) - -Global receive_action; ! Either ##PutOn or ##Insert, whichever is - ! action being tried when an object's - ! "before" rule is checking "Receive" - -Global no_implicit_actions; ! Don't implicitly do things. - -! ============================================================================== -! Parser variables: first, for communication to the parser -! ------------------------------------------------------------------------------ - -Global parser_trace = 0; ! Set this to 1 to make the parser trace - ! tokens and lines -Global parser_action; ! For the use of the parser when calling -Global parser_one; ! user-supplied routines -Global parser_two; ! -Array inputobjs --> 16; ! For parser to write its results in -Global parser_inflection; ! A property (usually "name") to find - ! object names in -Global parser_inflection_func; ! Programmer sets this to true when - ! parser_infection is a function - -! ------------------------------------------------------------------------------ -! Parser output -! ------------------------------------------------------------------------------ - -Global actor; ! Person asked to do something -Global actors_location; ! Like location, but for the actor -Global meta; ! Verb is a meta-command (such as "save") - -#Ifdef INFIX; -Global infix_verb; ! Verb is an Infix command -#Endif; - -Array multiple_object --> 64; ! List of multiple parameters -Global multiflag; ! Multiple-object flag passed to actions - ! Also used to prevent misleading MULTI_PE -Global toomany_flag; ! Flag for "multiple match too large" - ! (e.g. if "take all" took over 100 things) - -Global special_word; ! Dictionary address for "special" token -Global special_number; ! Number typed for "special" token -Global parsed_number; ! For user-supplied parsing routines -Global consult_from; ! Word that a "consult" topic starts on -Global consult_words; ! ...and number of words in topic -Global asking_player; ! True during disambiguation question - -! ------------------------------------------------------------------------------ -! Implicit taking -! ------------------------------------------------------------------------------ - -Global notheld_mode; ! To do with implicit taking -Global onotheld_mode; ! "old copy of notheld_mode", ditto -Global not_holding; ! Object to be automatically taken as an - ! implicit command -Array kept_results --> 16; ! Delayed command (while the take happens) - -! ------------------------------------------------------------------------------ -! Error numbers when parsing a grammar line -! ------------------------------------------------------------------------------ - -Global etype; ! Error number on current line -Global best_etype; ! Preferred error number so far -Global nextbest_etype; ! Preferred one, if ASKSCOPE_PE disallowed - -Constant STUCK_PE = 1; -Constant UPTO_PE = 2; -Constant NUMBER_PE = 3; -Constant CANTSEE_PE = 4; -Constant TOOLIT_PE = 5; -Constant NOTHELD_PE = 6; -Constant MULTI_PE = 7; -Constant MMULTI_PE = 8; -Constant VAGUE_PE = 9; -Constant EXCEPT_PE = 10; -Constant ANIMA_PE = 11; -Constant VERB_PE = 12; -Constant SCENERY_PE = 13; -Constant ITGONE_PE = 14; -Constant JUNKAFTER_PE = 15; -Constant TOOFEW_PE = 16; -Constant NOTHING_PE = 17; -Constant ASKSCOPE_PE = 18; - -! ------------------------------------------------------------------------------ -! Pattern-matching against a single grammar line -! ------------------------------------------------------------------------------ - -Array pattern --> 32; ! For the current pattern match -Global pcount; ! and a marker within it -Array pattern2 --> 32; ! And another, which stores the best match -Global pcount2; ! so far -Constant PATTERN_NULL = $ffff; ! Entry for a token producing no text - -Array line_ttype-->32; ! For storing an analysed grammar line -Array line_tdata-->32; -Array line_token-->32; - -Global parameters; ! Parameters (objects) entered so far -Global nsns; ! Number of special_numbers entered so far -Global special_number1; ! First number, if one was typed -Global special_number2; ! Second number, if two were typed - -! ------------------------------------------------------------------------------ -! Inferences and looking ahead -! ------------------------------------------------------------------------------ - -Global params_wanted; ! Number of parameters needed - ! (which may change in parsing) - -Global inferfrom; ! The point from which the rest of the - ! command must be inferred -Global inferword; ! And the preposition inferred -Global dont_infer; ! Another dull flag -Global no_infer_message = false; ! Use in ChooseObjects to suppress - ! an inference message. - -Global action_to_be; ! (If the current line were accepted.) -Global action_reversed; ! (Parameters would be reversed in order.) -Global advance_warning; ! What a later-named thing will be - -! ------------------------------------------------------------------------------ -! At the level of individual tokens now -! ------------------------------------------------------------------------------ - -Global found_ttype; ! Used to break up tokens into type -Global found_tdata; ! and data (by AnalyseToken) -Global token_filter; ! For noun filtering by user routines - -Global length_of_noun; ! Set by NounDomain to no of words in noun - -#Ifdef TARGET_ZCODE; -Constant REPARSE_CODE = 10000; ! Signals "reparse the text" as a reply - ! from NounDomain -#Ifnot; ! TARGET_GLULX -Constant REPARSE_CODE = $40000000; ! The parser rather gunkily adds addresses - ! to REPARSE_CODE for some purposes and - ! expects the result to be greater than - ! REPARSE_CODE (signed comparison). - ! So Glulx Inform is limited to a single - ! gigabyte of storage, for the moment. -#Endif; ! TARGET_ - -Global lookahead; ! The token after the one now being matched - -Global multi_mode; ! Multiple mode -Global multi_wanted; ! Number of things needed in multitude -Global multi_had; ! Number of things actually found -Global multi_context; ! What token the multi-obj was accepted for - -Global indef_mode; ! "Indefinite" mode - ie, "take a brick" - ! is in this mode -Global indef_type; ! Bit-map holding types of specification -Global indef_wanted; ! Number of items wanted (100 for all) -Global indef_guess_p; ! Plural-guessing flag -Global indef_owner; ! Object which must hold these items -Global indef_cases; ! Possible gender and numbers of them -Global indef_possambig; ! Has a possibly dangerous assumption - ! been made about meaning of a descriptor? -Global indef_nspec_at; ! Word at which a number like "two" was - ! parsed (for backtracking) -Global allow_plurals; ! Whether plurals presently allowed or not - -Global take_all_rule; ! Slightly different rules apply to - ! "take all" than other uses of multiple - ! objects, to make adjudication produce - ! more pragmatically useful results - ! (Not a flag: possible values 0, 1, 2) - -Global dict_flags_of_noun; ! Of the noun currently being parsed - ! (a bitmap in #dict_par1 format) -Constant DICT_VERB $01; -Constant DICT_META $02; -Constant DICT_PLUR $04; -Constant DICT_PREP $08; -Constant DICT_X654 $70; -Constant DICT_NOUN $80; - -Global pronoun_word; ! Records which pronoun ("it", "them", ...) - ! caused an error -Global pronoun_obj; ! And what obj it was thought to refer to -Global pronoun__word; ! Saved value -Global pronoun__obj; ! Saved value - -! ------------------------------------------------------------------------------ -! Searching through scope and parsing "scope=Routine" grammar tokens -! ------------------------------------------------------------------------------ - -Constant PARSING_REASON = 0; ! Possible reasons for searching scope -Constant TALKING_REASON = 1; -Constant EACH_TURN_REASON = 2; -Constant REACT_BEFORE_REASON = 3; -Constant REACT_AFTER_REASON = 4; -Constant LOOPOVERSCOPE_REASON = 5; -Constant TESTSCOPE_REASON = 6; - -Global scope_reason = PARSING_REASON; ! Current reason for searching scope - -Global scope_token; ! For "scope=Routine" grammar tokens -Global scope_error; -Global scope_stage; ! 1, 2 then 3 - -Global ats_flag = 0; ! For AddToScope routines -Global ats_hls; ! - -Global placed_in_flag; ! To do with PlaceInScope - -! ------------------------------------------------------------------------------ -! The match list of candidate objects for a given token -! ------------------------------------------------------------------------------ - -Constant MATCH_LIST_SIZE = 64; -Array match_list --> MATCH_LIST_SIZE; ! An array of matched objects so far -Array match_classes --> MATCH_LIST_SIZE; ! An array of equivalence classes for them -Array match_scores --> MATCH_LIST_SIZE; ! An array of match scores for them -Global number_matched; ! How many items in it? (0 means none) -Global number_of_classes; ! How many equivalence classes? -Global match_length; ! How many words long are these matches? -Global saved_ml; -Global match_from; ! At what word of the input do they begin? -Global bestguess_score; ! What did the best-guess object score? - -! ------------------------------------------------------------------------------ -! Low level textual manipulation -! ------------------------------------------------------------------------------ - -#Ifdef TARGET_ZCODE; - -! 'buffer' holds the input line as typed by the player -! -! buffer->0 INPUT_BUFFER_LEN - WORDSIZE -! buffer->1 Number of characters input by player -! buffer->2 ... buffer->121 The actual characters -! buffer->122 Spare byte to allow for 'terp bugs -! -! 'parse' holds the result of parsing that line into dictionary words -! -! parse->0 MAX_BUFFER_WORDS -! parse->1 Number of words input by player -! -! parse-->1 Dictionary addr of first input word -! parse->4 Number of characters in the word -! parse->5 Start position in 'buffer' of the word -! -! parse-->3 parse->8,9 Same data for second input word -! ... -! parse-->29 parse->60,61 Same data for MAX_BUFFER_WORDS input word -! parse->62,63,64 Spare bytes (not sure why) - - -Constant INPUT_BUFFER_LEN = WORDSIZE + 120; ! 120 is limit on input chars -Constant MAX_BUFFER_WORDS = 15; ! Limit on input words - -Array buffer -> INPUT_BUFFER_LEN + 1; ! For main line of input -Array buffer2 -> INPUT_BUFFER_LEN + 1; ! For supplementary questions -Array buffer3 -> INPUT_BUFFER_LEN + 1; ! Retaining input for "AGAIN" - -#Ifdef VN_1630; -Array parse buffer (MAX_BUFFER_WORDS * 4) + 3; ! Parsed data from 'buffer' -Array parse2 buffer (MAX_BUFFER_WORDS * 4) + 3; ! Parsed data from 'buffer2' -#Ifnot; -Array parse -> 2 + (MAX_BUFFER_WORDS * 4) + 3; -Array parse2 -> 2 + (MAX_BUFFER_WORDS * 4) + 3; -#Endif; ! VN_ - -#Ifnot; ! TARGET_GLULX - -! 'buffer' holds the input line as typed by the player -! -! buffer-->0 Number of characters input by player -! buffer->4 ... buffer->259 The actual characters -! -! 'parse' holds the result of parsing that line into dictionary words -! -! parse-->0 Number of words input by player -! -! parse-->1 Dictionary addr of first input word -! parse-->2 Number of characters in the word -! parse-->3 Start position in 'buffer' of the word -! -! parse-->4,5,6 Same data for second input word -! ... -! parse-->58,59,60 Same data for MAX_BUFFER_WORDS input word - -Constant INPUT_BUFFER_LEN = WORDSIZE + 256; ! 256 is limit on input chars -Constant MAX_BUFFER_WORDS = 20; ! Limit on input words - -#Ifdef VN_1630; -Array buffer buffer (INPUT_BUFFER_LEN-WORDSIZE); ! For main line of input -Array buffer2 buffer (INPUT_BUFFER_LEN-WORDSIZE); ! For supplementary questions -Array buffer3 buffer (INPUT_BUFFER_LEN-WORDSIZE); ! Retaining input for "AGAIN" -#Ifnot; -Array buffer -> INPUT_BUFFER_LEN; -Array buffer2 -> INPUT_BUFFER_LEN; -Array buffer3 -> INPUT_BUFFER_LEN; -#Endif; ! VN_ -Array parse --> 1 + (MAX_BUFFER_WORDS * 3); ! Parsed data from 'buffer' -Array parse2 --> 1 + (MAX_BUFFER_WORDS * 3); ! Parsed data from 'buffer2' - -#Endif; ! TARGET_ - -Constant comma_word = 'comma,'; ! An "untypeable word" used to substitute - ! for commas in parse buffers - -Global wn; ! Word number within "parse" (from 1) -Global num_words; ! Number of words typed -Global num_desc; ! Number of descriptors typed -Global verb_word; ! Verb word (eg, take in "take all" or - ! "dwarf, take all") - address in dict -Global verb_wordnum; ! its number in typing order (eg, 1 or 3) -Global usual_grammar_after; ! Point from which usual grammar is parsed (it may vary from the - ! above if user's routines match multi-word verbs) - -Global oops_from; ! The "first mistake" word number -Global saved_oops; ! Used in working this out - -Constant OOPS_WORKSPACE_LEN 64; ! Used temporarily by "oops" routine -Array oops_workspace -> OOPS_WORKSPACE_LEN; - -Global held_back_mode; ! Flag: is there some input from last time -Global hb_wn; ! left over? (And a save value for wn.) - ! (Used for full stops and "then".) - -Global caps_mode; ! Keep track of (The) with 'proper' caps -Global print_anything_result; ! Return value from a PrintAny() routine -Global initial_lookmode; ! Default, or set in Initialise() -Global before_first_turn; ! True until after initial LOOK - -! ---------------------------------------------------------------------------- - -Array PowersOfTwo_TB ! Used in converting case numbers to case - --> $$100000000000 ! bitmaps - $$010000000000 - $$001000000000 - $$000100000000 - $$000010000000 - $$000001000000 - $$000000100000 - $$000000010000 - $$000000001000 - $$000000000100 - $$000000000010 - $$000000000001; - -! ============================================================================ -! Constants, and one variable, needed for the language definition file -! ---------------------------------------------------------------------------- - -Constant POSSESS_PK = $100; -Constant DEFART_PK = $101; -Constant INDEFART_PK = $102; -Global short_name_case; - -Global dict_start; -Global dict_entry_size; -Global dict_end; - -! ---------------------------------------------------------------------------- - -Include "language__"; ! The natural language definition, whose filename is taken from - ! the ICL language_name variable - -! ---------------------------------------------------------------------------- - -#Ifndef LanguageCases; -Constant LanguageCases = 1; -#Endif; ! LanguageCases - -! ------------------------------------------------------------------------------ -! Pronouns support for the cruder (library 6/2 and earlier) version: -! only needed in English -! ------------------------------------------------------------------------------ - -#Ifdef EnglishNaturalLanguage; -Global itobj = NULL; ! The object which is currently "it" -Global himobj = NULL; ! The object which is currently "him" -Global herobj = NULL; ! The object which is currently "her" - -Global old_itobj = NULL; ! The object which is currently "it" -Global old_himobj = NULL; ! The object which is currently "him" -Global old_herobj = NULL; ! The object which is currently "her" -#Endif; ! EnglishNaturalLanguage - -! ============================================================================ -! For present and past tenses -! ---------------------------------------------------------------------------- -Constant PRESENT_TENSE 0; -Constant PAST_TENSE 1; - -! ============================================================================ -! For InformLibrary.actor_act() to control what happens when it aborts. -! ---------------------------------------------------------------------------- -Constant ACTOR_ACT_OK 0; -Constant ACTOR_ACT_ABORT_NOTUNDERSTOOD 1; -Constant ACTOR_ACT_ABORT_ORDER 2; - -! ============================================================================ -! "Darkness" is not really a place: but it has to be an object so that the -! location-name on the status line can be "Darkness". -! ---------------------------------------------------------------------------- - -Object thedark "(darkness object)" - with initial 0, - short_name DARKNESS__TX, - description [; return L__M(##Miscellany, 17); ]; - -! If you want to use the third-person of the narrative voice, you will -! need to replace this selfobj with your own. - -Class SelfClass - with name ',a' ',b' ',c' ',d' ',e', - short_name YOURSELF__TX, - description [; return L__M(##Miscellany, 19); ], - before NULL, - after NULL, - life NULL, - each_turn NULL, - time_out NULL, - describe NULL, - article "the", - add_to_scope 0, - capacity 100, - parse_name 0, - orders 0, - number 0, - narrative_voice 2, - narrative_tense PRESENT_TENSE, - nameless true, - posture 0, - before_implicit [;Take: return 2;], - has concealed animate proper transparent; - -SelfClass selfobj "(self object)"; - -! ============================================================================ -! The definition of the token-numbering system used by Inform. -! ---------------------------------------------------------------------------- - -Constant ILLEGAL_TT = 0; ! Types of grammar token: illegal -Constant ELEMENTARY_TT = 1; ! (one of those below) -Constant PREPOSITION_TT = 2; ! e.g. 'into' -Constant ROUTINE_FILTER_TT = 3; ! e.g. noun=CagedCreature -Constant ATTR_FILTER_TT = 4; ! e.g. edible -Constant SCOPE_TT = 5; ! e.g. scope=Spells -Constant GPR_TT = 6; ! a general parsing routine - -Constant NOUN_TOKEN = 0; ! The elementary grammar tokens, and -Constant HELD_TOKEN = 1; ! the numbers compiled by Inform to -Constant MULTI_TOKEN = 2; ! encode them -Constant MULTIHELD_TOKEN = 3; -Constant MULTIEXCEPT_TOKEN = 4; -Constant MULTIINSIDE_TOKEN = 5; -Constant CREATURE_TOKEN = 6; -Constant SPECIAL_TOKEN = 7; -Constant NUMBER_TOKEN = 8; -Constant TOPIC_TOKEN = 9; - - -Constant GPR_FAIL = -1; ! Return values from General Parsing -Constant GPR_PREPOSITION = 0; ! Routines -Constant GPR_NUMBER = 1; -Constant GPR_MULTIPLE = 2; -Constant GPR_REPARSE = REPARSE_CODE; -Constant GPR_NOUN = $ff00; -Constant GPR_HELD = $ff01; -Constant GPR_MULTI = $ff02; -Constant GPR_MULTIHELD = $ff03; -Constant GPR_MULTIEXCEPT = $ff04; -Constant GPR_MULTIINSIDE = $ff05; -Constant GPR_CREATURE = $ff06; - -Constant ENDIT_TOKEN = 15; ! Value used to mean "end of grammar line" - -#Iftrue (Grammar__Version == 1); - -[ AnalyseToken token m; - found_tdata = token; - if (token < 0) { found_ttype = ILLEGAL_TT; return; } - if (token <= 8) { found_ttype = ELEMENTARY_TT; return; } - if (token < 15) { found_ttype = ILLEGAL_TT; return; } - if (token == 15) { found_ttype = ELEMENTARY_TT; return; } - if (token < 48) { found_ttype = ROUTINE_FILTER_TT; - found_tdata = token - 16; - return; - } - if (token < 80) { found_ttype = GPR_TT; - found_tdata = #preactions_table-->(token-48); - return; - } - if (token < 128) { found_ttype = SCOPE_TT; - found_tdata = #preactions_table-->(token-80); - return; - } - if (token < 180) { found_ttype = ATTR_FILTER_TT; - found_tdata = token - 128; - return; - } - - found_ttype = PREPOSITION_TT; - m = #adjectives_table; - for (::) { - if (token == m-->1) { found_tdata = m-->0; return; } - m = m+4; - } - m = #adjectives_table; RunTimeError(1); - found_tdata = m; -]; - -[ UnpackGrammarLine line_address i m; - for (i=0 : i<32 : i++) { - line_token-->i = ENDIT_TOKEN; - line_ttype-->i = ELEMENTARY_TT; - line_tdata-->i = ENDIT_TOKEN; - } - for (i=0 : i<=5 : i++) { - line_token-->i = line_address->(i+1); - AnalyseToken(line_token-->i); - if ((found_ttype == ELEMENTARY_TT) && (found_tdata == NOUN_TOKEN) - && (m == line_address->0)) { - line_token-->i = ENDIT_TOKEN; - break; - } - line_ttype-->i = found_ttype; - line_tdata-->i = found_tdata; - if (found_ttype ~= PREPOSITION_TT) m++; - } - action_to_be = line_address->7; - action_reversed = false; - params_wanted = line_address->0; - return line_address + 8; -]; - -#Ifnot; ! Grammar__Version == 2 - -[ AnalyseToken token; - if (token == ENDIT_TOKEN) { - found_ttype = ELEMENTARY_TT; - found_tdata = ENDIT_TOKEN; - return; - } - found_ttype = (token->0) & $$1111; - found_tdata = (token+1)-->0; -]; - -#Ifdef TARGET_ZCODE; - -[ UnpackGrammarLine line_address i; - for (i=0 : i<32 : i++) { - line_token-->i = ENDIT_TOKEN; - line_ttype-->i = ELEMENTARY_TT; - line_tdata-->i = ENDIT_TOKEN; - } - action_to_be = 256*(line_address->0) + line_address->1; - action_reversed = ((action_to_be & $400) ~= 0); - action_to_be = action_to_be & $3ff; - line_address--; - params_wanted = 0; - for (i=0 : : i++) { - line_address = line_address + 3; - if (line_address->0 == ENDIT_TOKEN) break; - line_token-->i = line_address; - AnalyseToken(line_address); - if (found_ttype ~= PREPOSITION_TT) params_wanted++; - line_ttype-->i = found_ttype; - line_tdata-->i = found_tdata; - } - return line_address + 1; -]; - -#Ifnot; ! TARGET_GLULX - -[ UnpackGrammarLine line_address i; - for (i=0 : i<32 : i++) { - line_token-->i = ENDIT_TOKEN; - line_ttype-->i = ELEMENTARY_TT; - line_tdata-->i = ENDIT_TOKEN; - } - @aloads line_address 0 action_to_be; - action_reversed = (((line_address->2) & 1) ~= 0); - line_address = line_address - 2; - params_wanted = 0; - for (i=0 : : i++) { - line_address = line_address + 5; - if (line_address->0 == ENDIT_TOKEN) break; - line_token-->i = line_address; - AnalyseToken(line_address); - if (found_ttype ~= PREPOSITION_TT) params_wanted++; - line_ttype-->i = found_ttype; - line_tdata-->i = found_tdata; - } - return line_address + 1; -]; - -#Endif; ! TARGET_ -#Endif; ! Grammar__Version - -! To protect against a bug in early versions of the "Zip" interpreter: -! Of course, in Glulx, this routine actually performs work. - -#Ifdef TARGET_ZCODE; - -[ Tokenise__ b p; b->(2 + b->1) = 0; @tokenise b p; ]; - -#Ifnot; ! TARGET_GLULX - -Array gg_tokenbuf -> DICT_WORD_SIZE; - -[ GGWordCompare str1 str2 ix jx; - for (ix=0 : ixix) - (str2->ix); - if (jx ~= 0) return jx; - } - return 0; -]; - -[ Tokenise__ buf tab - cx numwords len bx ix wx wpos wlen val res dictlen entrylen; - len = buf-->0; - buf = buf+WORDSIZE; - - ! First, split the buffer up into words. We use the standard Infocom - ! list of word separators (comma, period, double-quote). - - cx = 0; - numwords = 0; - while (cx < len) { - while (cx < len && buf->cx == ' ') cx++; - if (cx >= len) break; - bx = cx; - if (buf->cx == '.' or ',' or '"') cx++; - else { - while (cx < len && buf->cx ~= ' ' or '.' or ',' or '"') cx++; - } - tab-->(numwords*3+2) = (cx-bx); - tab-->(numwords*3+3) = WORDSIZE+bx; - numwords++; - if (numwords >= MAX_BUFFER_WORDS) break; - } - tab-->0 = numwords; - - ! Now we look each word up in the dictionary. - - dictlen = #dictionary_table-->0; - entrylen = DICT_WORD_SIZE + 7; - - for (wx=0 : wx(wx*3+2); - wpos = tab-->(wx*3+3); - - ! Copy the word into the gg_tokenbuf array, clipping to DICT_WORD_SIZE - ! characters and lower case. - if (wlen > DICT_WORD_SIZE) wlen = DICT_WORD_SIZE; - cx = wpos - WORDSIZE; - for (ix=0 : ixix = glk_char_to_lower(buf->(cx+ix)); - for (: ixix = 0; - - val = #dictionary_table + WORDSIZE; - @binarysearch gg_tokenbuf DICT_WORD_SIZE val entrylen dictlen 1 1 res; - tab-->(wx*3+1) = res; - } -]; - -#Endif; ! TARGET_ - -! ============================================================================ -! The InformParser object abstracts the front end of the parser. -! -! InformParser.parse_input(results) -! returns only when a sensible request has been made, and puts into the -! "results" buffer: -! -! --> 0 = The action number -! --> 1 = Number of parameters -! --> 2, 3, ... = The parameters (object numbers), but -! 0 means "put the multiple object list here" -! 1 means "put one of the special numbers here" -! -! ---------------------------------------------------------------------------- - -Object InformParser "(Inform Parser)" - with parse_input [ results; Parser__parse(results); ], - has proper; - -! ---------------------------------------------------------------------------- -! The Keyboard routine actually receives the player's words, -! putting the words in "a_buffer" and their dictionary addresses in -! "a_table". It is assumed that the table is the same one on each -! (standard) call. -! -! It can also be used by miscellaneous routines in the game to ask -! yes-no questions and the like, without invoking the rest of the parser. -! -! Return the number of words typed -! ---------------------------------------------------------------------------- - -#Ifdef TARGET_ZCODE; - -[ GetNthChar a_buffer n i; - for (i = 0: a_buffer->(2+i) == ' ': i++) { - if (i > a_buffer->(1)) return false; - } - return a_buffer->(2+i+n); -]; - -[ KeyboardPrimitive a_buffer a_table; - read a_buffer a_table; - - #Iftrue (#version_number == 6); - @output_stream -1; - @loadb a_buffer 1 -> sp; - @add a_buffer 2 -> sp; - @print_table sp sp; - new_line; - @output_stream 1; - #Endif; -]; - -[ KeyCharPrimitive win key; - if (win) @set_window win; - @read_char 1 -> key; - return key; -]; - -[ KeyTimerInterrupt; - rtrue; -]; - -[ KeyDelay tenths key; - @read_char 1 tenths KeyTimerInterrupt -> key; - return key; -]; - -#Ifnot; ! TARGET_GLULX - -[ GetNthChar a_buffer n i; - for (i = 0: a_buffer->(4+i) == ' ': i++) { - if (i > a_buffer->(1)) return false; - } - return a_buffer->(4+i+n); -]; - -[ KeyCharPrimitive win nostat done res ix jx ch; - jx = ch; ! squash compiler warnings - if (win == 0) win = gg_mainwin; - if (gg_commandstr ~= 0 && gg_command_reading ~= false) { - ! get_line_stream - done = glk_get_line_stream(gg_commandstr, gg_arguments, 31); - if (done == 0) { - glk_stream_close(gg_commandstr, 0); - gg_commandstr = 0; - gg_command_reading = false; - ! fall through to normal user input. - } - else { - ! Trim the trailing newline - if (gg_arguments->(done-1) == 10) done = done-1; - res = gg_arguments->0; - if (res == '\') { - res = 0; - for (ix=1 : ixix; - if (ch >= '0' && ch <= '9') { - @shiftl res 4 res; - res = res + (ch-'0'); - } - else if (ch >= 'a' && ch <= 'f') { - @shiftl res 4 res; - res = res + (ch+10-'a'); - } - else if (ch >= 'A' && ch <= 'F') { - @shiftl res 4 res; - res = res + (ch+10-'A'); - } - } - } - jump KCPContinue; - } - } - done = false; - glk_request_char_event(win); - while (~~done) { - glk_select(gg_event); - switch (gg_event-->0) { - 5: ! evtype_Arrange - if (nostat) { - glk_cancel_char_event(win); - res = $80000000; - done = true; - break; - } - DrawStatusLine(); - 2: ! evtype_CharInput - if (gg_event-->1 == win) { - res = gg_event-->2; - done = true; - } - } - ix = HandleGlkEvent(gg_event, 1, gg_arguments); - if (ix == 0) ix = LibraryExtensions.RunWhile(ext_handleglkevent, 0, gg_event, 1, gg_arguments); - if (ix == 2) { - res = gg_arguments-->0; - done = true; - } - else if (ix == -1) { - done = false; - } - } - if (gg_commandstr ~= 0 && gg_command_reading == false) { - if (res < 32 || res >= 256 || (res == '\' or ' ')) { - glk_put_char_stream(gg_commandstr, '\'); - done = 0; - jx = res; - for (ix=0 : ix<8 : ix++) { - @ushiftr jx 28 ch; - @shiftl jx 4 jx; - ch = ch & $0F; - if (ch ~= 0 || ix == 7) done = 1; - if (done) { - if (ch >= 0 && ch <= 9) ch = ch + '0'; - else ch = (ch - 10) + 'A'; - glk_put_char_stream(gg_commandstr, ch); - } - } - } - else { - glk_put_char_stream(gg_commandstr, res); - } - glk_put_char_stream(gg_commandstr, 10); - } - .KCPContinue; - return res; -]; - -[ KeyDelay tenths key done ix; - glk_request_char_event(gg_mainwin); - glk_request_timer_events(tenths*100); - while (~~done) { - glk_select(gg_event); - ix = HandleGlkEvent(gg_event, 1, gg_arguments); - if (ix == 0) ix = LibraryExtensions.RunWhile(ext_handleglkevent, 0, gg_event, 1, gg_arguments); - if (ix == 2) { - key = gg_arguments-->0; - done = true; - } - else if (ix >= 0 && gg_event-->0 == 1 or 2) { - key = gg_event-->2; - done = true; - } - } - glk_cancel_char_event(gg_mainwin); - glk_request_timer_events(0); - return key; -]; - -[ KeyboardPrimitive a_buffer a_table done ix; - if (gg_commandstr ~= 0 && gg_command_reading ~= false) { - ! get_line_stream - done = glk_get_line_stream(gg_commandstr, a_buffer+WORDSIZE, (INPUT_BUFFER_LEN-WORDSIZE)-1); - if (done == 0) { - glk_stream_close(gg_commandstr, 0); - gg_commandstr = 0; - gg_command_reading = false; - ! L__M(##CommandsRead, 5); would come after prompt - ! fall through to normal user input. - } - else { - ! Trim the trailing newline - if ((a_buffer+WORDSIZE)->(done-1) == 10) done = done-1; - a_buffer-->0 = done; - glk_set_style(style_Input); - glk_put_buffer(a_buffer+WORDSIZE, done); - glk_set_style(style_Normal); - print "^"; - jump KPContinue; - } - } - done = false; - glk_request_line_event(gg_mainwin, a_buffer+WORDSIZE, INPUT_BUFFER_LEN-WORDSIZE, 0); - while (~~done) { - glk_select(gg_event); - switch (gg_event-->0) { - 5: ! evtype_Arrange - DrawStatusLine(); - 3: ! evtype_LineInput - if (gg_event-->1 == gg_mainwin) { - a_buffer-->0 = gg_event-->2; - done = true; } - } - ix = HandleGlkEvent(gg_event, 0, a_buffer); - if (ix == 0) ix = LibraryExtensions.RunWhile(ext_handleglkevent, 0, gg_event, 0, a_buffer); - if (ix == 2) done = true; - else if (ix == -1) done = false; - } - if (gg_commandstr ~= 0 && gg_command_reading == false) { - ! put_buffer_stream - - glk_put_buffer_stream(gg_commandstr, a_buffer+WORDSIZE, a_buffer-->0); - glk_put_char_stream(gg_commandstr, 10); - } - .KPContinue; - Tokenise__(a_buffer,a_table); - ! It's time to close any quote window we've got going. - if (gg_quotewin) { - glk_window_close(gg_quotewin, 0); - gg_quotewin = 0; - } -]; - -#Endif; ! TARGET_ - -[ Keyboard a_buffer a_table nw i w w2 x1 x2; - DisplayStatus(); - - .FreshInput; - - ! Save the start of the buffer, in case "oops" needs to restore it - ! to the previous time's buffer - - for (i=0 : ii = a_buffer->i; - - ! In case of an array entry corruption that shouldn't happen, but would be - ! disastrous if it did: - - #Ifdef TARGET_ZCODE; - a_buffer->0 = INPUT_BUFFER_LEN - WORDSIZE; - a_table->0 = MAX_BUFFER_WORDS; ! Allow to split input into this many words - #Endif; ! TARGET_ - - ! Print the prompt, and read in the words and dictionary addresses - - L__M(##Prompt); - if (AfterPrompt() == 0) LibraryExtensions.RunAll(ext_afterprompt); - #IfV5; - DrawStatusLine(); - #Endif; ! V5 - - KeyboardPrimitive(a_buffer, a_table); - nw = NumberWords(a_table); - - ! If the line was blank, get a fresh line - if (nw == 0) { - L__M(##Miscellany, 10); - jump FreshInput; - } - - ! Unless the opening word was "oops", return - ! Conveniently, a_table-->1 is the first word in both ZCODE and GLULX. - - w = a_table-->1; - if (w == OOPS1__WD or OOPS2__WD or OOPS3__WD) jump DoOops; - - if (a_buffer->WORDSIZE == COMMENT_CHARACTER) { - #Ifdef TARGET_ZCODE; - if ((HDR_GAMEFLAGS-->0) & $0001 || xcommsdir) - L__M(##Miscellany, 54); - else L__M(##Miscellany, 55); - #Ifnot; ! TARGET_GLULX - if (gg_scriptstr || gg_commandstr) L__M(##Miscellany, 54); - else L__M(##Miscellany, 55); - #Endif; ! TARGET_ - - jump FreshInput; - } - - #IfV5; - ! Undo handling - - if ((w == UNDO1__WD or UNDO2__WD or UNDO3__WD) && (nw==1)) { - i = PerformUndo(); - if (i == 0) jump FreshInput; - } - #Ifdef TARGET_ZCODE; - @save_undo i; - #Ifnot; ! TARGET_GLULX - @saveundo i; - if (i == -1) { - GGRecoverObjects(); - i = 2; - } - else i = (~~i); - #Endif; ! TARGET_ - just_undone = 0; - undo_flag = 2; - if (i == -1) undo_flag = 0; - if (i == 0) undo_flag = 1; - if (i == 2) { - RestoreColours(); - #Ifdef TARGET_ZCODE; - style bold; - #Ifnot; ! TARGET_GLULX - glk_set_style(style_Subheader); - #Endif; ! TARGET_ - print (name) location, "^"; - #Ifdef TARGET_ZCODE; - style roman; - #Ifnot; ! TARGET_GLULX - glk_set_style(style_Normal); - #Endif; ! TARGET_ - L__M(##Miscellany, 13); - just_undone = 1; - jump FreshInput; - } - #Endif; ! V5 - - return nw; - - .DoOops; - if (oops_from == 0) { - L__M(##Miscellany, 14); - jump FreshInput; - } - if (nw == 1) { - L__M(##Miscellany, 15); - jump FreshInput; - } - if (nw > 2) { - L__M(##Miscellany, 16); - jump FreshInput; - } - - ! So now we know: there was a previous mistake, and the player has - ! attempted to correct a single word of it. - - for (i=0 : ii = a_buffer->i; - #Ifdef TARGET_ZCODE; - x1 = a_table->9; ! Start of word following "oops" - x2 = a_table->8; ! Length of word following "oops" - #Ifnot; ! TARGET_GLULX - x1 = a_table-->6; ! Start of word following "oops" - x2 = a_table-->5; ! Length of word following "oops" - #Endif; ! TARGET_ - - ! Repair the buffer to the text that was in it before the "oops" - ! was typed: - - for (i=0 : i < OOPS_WORKSPACE_LEN : i++) a_buffer->i = oops_workspace->i; - Tokenise__(a_buffer, a_table); - - ! Work out the position in the buffer of the word to be corrected: - - #Ifdef TARGET_ZCODE; - w = a_table->(4*oops_from + 1); ! Start of word to go - w2 = a_table->(4*oops_from); ! Length of word to go - #Ifnot; ! TARGET_GLULX - w = a_table-->(3*oops_from); ! Start of word to go - w2 = a_table-->(3*oops_from - 1); ! Length of word to go - #Endif; ! TARGET_ - -#IfDef OOPS_CHECK; - print "[~"; - for (i=0 : i(i+w); - print "~ --> ~"; -#Endif; - - ! Write spaces over the word to be corrected: - - for (i=0 : i(i+w) = ' '; - - if (w2 < x2) { - ! If the replacement is longer than the original, move up... - for (i=INPUT_BUFFER_LEN-1 : i>=w+x2 : i--) - a_buffer->i = a_buffer->(i-x2+w2); - - ! ...increasing buffer size accordingly. - SetKeyBufLength(GetKeyBufLength(a_buffer) + (x2-w2), a_buffer); - } - - ! Write the correction in: - - for (i=0 : i(i+w) = buffer2->(i+x1); -#IfDef OOPS_CHECK; - print (char) buffer2->(i+x1); -#Endif; - } - -#IfDef OOPS_CHECK; - print "~]^^"; -#Endif; - - Tokenise__(a_buffer, a_table); - nw=NumberWords(a_table); - -! saved_ml = 0; - return nw; -]; ! end of Keyboard - -[ PerformUndo i; - if (turns == START_MOVE) { L__M(##Miscellany, 11); return 0; } - if (undo_flag == 0) { L__M(##Miscellany, 6); return 0; } - if (undo_flag == 1) { L__M(##Miscellany, 7); return 0; } - #Ifdef TARGET_ZCODE; - @restore_undo i; - #Ifnot; ! TARGET_GLULX - @restoreundo i; - i = (~~i); - #Endif; ! TARGET_ - if (i == 0) { L__M(##Miscellany, 7); return 0; } - L__M(##Miscellany, 1); - return 1; -]; - -! ---------------------------------------------------------------------------- -! To simplify the picture a little, a rough map of the main routine: -! -! (A) Get the input, do "oops" and "again" -! (B) Is it a direction, and so an implicit "go"? If so go to (K) -! (C) Is anyone being addressed? -! (D) Get the verb: try all the syntax lines for that verb -! (E) Break down a syntax line into analysed tokens -! (F) Look ahead for advance warning for multiexcept/multiinside -! (G) Parse each token in turn (calling ParseToken to do most of the work) -! (H) Cheaply parse otherwise unrecognised conversation and return -! (I) Print best possible error message -! (J) Retry the whole lot -! (K) Last thing: check for "then" and further instructions(s), return. -! -! The strategic points (A) to (K) are marked in the commentary. -! -! Note that there are three different places where a return can happen. -! ---------------------------------------------------------------------------- - -[ Parser__parse results syntax line num_lines line_address i j k - token l m line_etype vw; - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! A: Get the input, do "oops" and "again" - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! Firstly, in "not held" mode, we still have a command left over from last - ! time (eg, the user typed "eat biscuit", which was parsed as "take biscuit" - ! last time, with "eat biscuit" tucked away until now). So we return that. - - if (notheld_mode == 1) { - for (i=0 : i<8 : i++) results-->i = kept_results-->i; - notheld_mode = 0; - rtrue; - } - - if (held_back_mode ~= 0) { - held_back_mode = 0; - Tokenise__(buffer, parse); - jump ReParse; - } - - .ReType; - - Keyboard(buffer, parse); - -#Ifdef INFIX; - ! An Infix verb is a special kind of meta verb. We mark them here. - if (GetNthChar(buffer, 0) == ';') - infix_verb = true; - else - infix_verb = false; -#Endif; - - .ReParse; - - parser_inflection = name; - parser_inflection_func = false; - - ! Initially assume the command is aimed at the player, and the verb - ! is the first word - - num_words = NumberWords(); - wn = 1; - - #Ifdef LanguageToInformese; - LanguageToInformese(); - #IfV5; - ! Re-tokenise: - Tokenise__(buffer,parse); - #Endif; ! V5 - #Endif; ! LanguageToInformese - - if (BeforeParsing() == false) { - LibraryExtensions.ext_number_1 = wn; ! Set "between calls" functionality to restore wn each pass - LibraryExtensions.BetweenCalls = LibraryExtensions.RestoreWN; - LibraryExtensions.RunWhile(ext_beforeparsing, false); - LibraryExtensions.BetweenCalls = 0; ! Turn off "between calls" functionality - } - num_words = NumberWords(); - - k=0; - #Ifdef DEBUG; - if (parser_trace >= 2) { - print "[ "; - for (i=0 : im; 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; - } - - ! 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) { - L__M(##Miscellany, 20); - jump ReType; - } - if (GetKeyBufLength(buffer3) == 0) { - L__M(##Miscellany, 21); - jump ReType; - } - - if (WordAddress(verb_wordnum) == buffer + WORDSIZE) { ! not held back - ! splice rest of buffer onto end of buffer3 - i = GetKeyBufLength(buffer3); - while (buffer3 -> (i + WORDSIZE - 1) == ' ' or '.') - i--; - j = i - WordLength(verb_wordnum); ! amount to move buffer up by - if (j > 0) { - for (m=INPUT_BUFFER_LEN-1 : m>=WORDSIZE+j : m--) - buffer->m = buffer->(m-j); - SetKeyBufLength(GetKeyBufLength()+j); - } - for (m=WORDSIZE : mm = buffer3->m; - if (j < 0) for (:mm = ' '; - } - else - for (i=0 : ii = buffer3->i; - jump ReParse; - } - - ! Save the present input in case of an "again" next time - - if (verb_word ~= AGAIN1__WD) - for (i=0 : ii = 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 - - #Ifdef TARGET_ZCODE; - if ((i ~= 0 or 1) && - (UnsignedCompare(i, dict_start) < 0 || - UnsignedCompare(i, dict_end) >= 0 || - (i - dict_start) % dict_entry_size ~= 0)) { - usual_grammar_after = j; - i=-i; - } - - #Ifnot; ! TARGET_GLULX - if (i < 0) { usual_grammar_after = j; i=-i; } - #Endif; - - if (i == 1) { - results-->0 = action; - results-->1 = 0; ! Number of parameters - results-->2 = noun; - results-->3 = second; - if (noun) results-->1 = 1; - if (second) results-->1 = 2; - rtrue; - } - if (i ~= 0) { verb_word = i; wn--; verb_wordnum--; } - else { wn = verb_wordnum; verb_word = NextWord(); } - } - else usual_grammar_after = 0; - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! B: Is it a direction, and so an implicit "go"? If so go to (K) - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - #Ifdef LanguageIsVerb; - if (verb_word == 0) { - i = wn; verb_word = LanguageIsVerb(buffer, parse, verb_wordnum); - wn = i; - } - #Endif; ! LanguageIsVerb - - ! If the first word is not listed as a verb, it must be a direction - ! or the name of someone to talk to - - if (verb_word == 0 || ((verb_word->#dict_par1) & DICT_VERB) == 0) { - - ! So is the first word an object contained in the special object "compass" - ! (i.e., a direction)? This needs use of NounDomain, a routine which - ! does the object matching, returning the object number, or 0 if none found, - ! or REPARSE_CODE if it has restructured the parse table so the whole parse - ! must be begun again... - - wn = verb_wordnum; indef_mode = false; token_filter = 0; - l = NounDomain(compass, 0, NOUN_TOKEN); - if (l == REPARSE_CODE) jump ReParse; - - ! If it is a direction, send back the results: - ! action=GoSub, no of arguments=1, argument 1=the direction. - - if (l ~= 0) { - results-->0 = ##Go; - action_to_be = ##Go; - results-->1 = 1; - results-->2 = l; - jump LookForMore; - } - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! C: Is anyone being addressed? - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! Only check for a comma (a "someone, do something" command) if we are - ! not already in the middle of one. (This simplification stops us from - ! worrying about "robot, wizard, you are an idiot", telling the robot to - ! tell the wizard that she is an idiot.) - - if (actor == player) { - for (j=2 : j<=num_words : j++) { - i=NextWord(); - if (i == comma_word) jump Conversation; - } - } - vw = verb_word; - verb_word = UnknownVerb(vw); - if (verb_word == false) verb_word = LibraryExtensions.RunWhile(ext_unknownverb, false, vw); - if (verb_word) jump VerbAccepted; - best_etype = VERB_PE; - jump GiveError; - - ! NextWord nudges the word number wn on by one each time, so we've now - ! advanced past a comma. (A comma is a word all on its own in the table.) - - .Conversation; - - j = wn - 1; - if (j == 1) { - L__M(##Miscellany, 22); - jump ReType; - } - - ! Use NounDomain (in the context of "animate creature") to see if the - ! words make sense as the name of someone held or nearby - - wn = 1; lookahead = HELD_TOKEN; - scope_reason = TALKING_REASON; - l = NounDomain(player,actors_location,CREATURE_TOKEN); - scope_reason = PARSING_REASON; - if (l == REPARSE_CODE) jump ReParse; - if (l == 0) { - L__M(##Miscellany, 23); - jump ReType; - } - - .Conversation2; - - ! The object addressed must at least be "talkable" if not actually "animate" - ! (the distinction allows, for instance, a microphone to be spoken to, - ! without the parser thinking that the microphone is human). - - if (l hasnt animate && l hasnt talkable) { - L__M(##Miscellany, 24, l); - jump ReType; - } - - ! Check that there aren't any mystery words between the end of the person's - ! name and the comma (eg, throw out "dwarf sdfgsdgs, go north"). - - if (wn ~= j) { - L__M(##Miscellany, 25); - jump ReType; - } - - ! The player has now successfully named someone. Adjust "him", "her", "it": - - PronounNotice(l); - - ! Set the global variable "actor", adjust the number of the first word, - ! and begin parsing again from there. - - verb_wordnum = j + 1; - - ! Stop things like "me, again": - - if (l == player) { - wn = verb_wordnum; - if (NextWordStopped() == AGAIN1__WD or AGAIN2__WD or AGAIN3__WD) { - L__M(##Miscellany, 20); - jump ReType; - } - } - - actor = l; - actors_location = ScopeCeiling(l); - #Ifdef DEBUG; - if (parser_trace >= 1) - print "[Actor is ", (the) actor, " in ", (name) actors_location, "]^"; - #Endif; ! DEBUG - jump BeginCommand; - - } ! end of first-word-not-a-verb - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! D: Get the verb: try all the syntax lines for that verb - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - .VerbAccepted; - - ! We now definitely have a verb, not a direction, whether we got here by the - ! "take ..." or "person, take ..." method. Get the meta flag for this verb: - - meta = (verb_word->#dict_par1) & DICT_META; - - ! You can't order other people to "full score" for you, and so on... - - if (meta && actor ~= player) { - best_etype = VERB_PE; - meta = false; - jump GiveError; - } - - ! Now let i be the corresponding verb number, stored in the dictionary entry - ! (in a peculiar 255-n fashion for traditional Infocom reasons)... - - i = $ff-(verb_word->#dict_par2); - - ! ...then look up the i-th entry in the verb table, whose address is at word - ! 7 in the Z-machine (in the header), so as to get the address of the syntax - ! table for the given verb... - - #Ifdef TARGET_ZCODE; - syntax = (HDR_STATICMEMORY-->0)-->i; - #Ifnot; ! TARGET_GLULX - syntax = (#grammar_table)-->(i+1); - #Endif; ! TARGET_ - - ! ...and then see how many lines (ie, different patterns corresponding to the - ! same verb) are stored in the parse table... - - num_lines = (syntax->0) - 1; - - ! ...and now go through them all, one by one. - ! To prevent pronoun_word 0 being misunderstood, - - pronoun_word = NULL; pronoun_obj = NULL; - - #Ifdef DEBUG; - if (parser_trace >= 1) print "[Parsing for the verb '", (address) verb_word, "' (", num_lines+1, " lines)]^"; - #Endif; ! DEBUG - - best_etype = STUCK_PE; nextbest_etype = STUCK_PE; - multiflag = false; saved_oops = 0; - - ! "best_etype" is the current failure-to-match error - it is by default - ! the least informative one, "don't understand that sentence". - ! "nextbest_etype" remembers the best alternative to having to ask a - ! scope token for an error message (i.e., the best not counting ASKSCOPE_PE). - ! multiflag is used here to prevent inappropriate MULTI_PE errors - ! in addition to its unrelated duties passing information to action routines - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! E: Break down a syntax line into analysed tokens - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - line_address = syntax + 1; - - for (line=0 : line<=num_lines : line++) { - - for (i=0 : i<32 : i++) { - line_token-->i = ENDIT_TOKEN; - line_ttype-->i = ELEMENTARY_TT; - line_tdata-->i = ENDIT_TOKEN; - } - - ! Unpack the syntax line from Inform format into three arrays; ensure that - ! the sequence of tokens ends in an ENDIT_TOKEN. - - line_address = UnpackGrammarLine(line_address); - - #Ifdef DEBUG; - if (parser_trace >= 1) { - if (parser_trace >= 2) new_line; - print "[line ", line; DebugGrammarLine(); - print "]^"; - } - #Endif; ! DEBUG - - ! We aren't in "not holding" or inferring modes, and haven't entered - ! any parameters on the line yet, or any special numbers; the multiple - ! object is still empty. - - token_filter = 0; - not_holding = 0; - inferfrom = 0; - parameters = 0; - nsns = 0; special_word = 0; special_number = 0; - multiple_object-->0 = 0; - multi_context = 0; - etype = STUCK_PE; line_etype = 100; - - ! Put the word marker back to just after the verb - - wn = verb_wordnum+1; - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! F: Look ahead for advance warning for multiexcept/multiinside - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! There are two special cases where parsing a token now has to be - ! affected by the result of parsing another token later, and these - ! two cases (multiexcept and multiinside tokens) are helped by a quick - ! look ahead, to work out the future token now. We can only carry this - ! out in the simple (but by far the most common) case: - ! - ! multiexcept noun - ! - ! and similarly for multiinside. - - advance_warning = NULL; indef_mode = false; - for (i=0,m=false,pcount=0 : line_token-->pcount ~= ENDIT_TOKEN : pcount++) { - scope_token = 0; - - if (line_ttype-->pcount ~= PREPOSITION_TT) i++; - - if (line_ttype-->pcount == ELEMENTARY_TT) { - if (line_tdata-->pcount == MULTI_TOKEN) m = true; - if (line_tdata-->pcount == MULTIEXCEPT_TOKEN or MULTIINSIDE_TOKEN && i == 1) { - ! First non-preposition is "multiexcept" or - ! "multiinside", so look ahead. - - #Ifdef DEBUG; - if (parser_trace >= 2) print " [Trying look-ahead]^"; - #Endif; ! DEBUG - - ! We need this to be followed by 1 or more prepositions. - - pcount++; - if (line_ttype-->pcount == PREPOSITION_TT) { - ! skip ahead to a preposition word in the input - do { - l = NextWord(); - } until ((wn > num_words) || - (l && (l->#dict_par1) & DICT_PREP ~= 0)); - - if (wn > num_words) { - #Ifdef DEBUG; - if (parser_trace >= 2) - print " [Look-ahead aborted: prepositions missing]^"; - #Endif; - jump EmptyLine; - } - - do { - if (PrepositionChain(l, pcount) ~= -1) { - ! advance past the chain - if ((line_token-->pcount)->0 & $20 ~= 0) { - pcount++; - while ((line_token-->pcount ~= ENDIT_TOKEN) && - ((line_token-->pcount)->0 & $10 ~= 0)) - pcount++; - } else { - pcount++; - } - } else { - ! try to find another preposition word - do { - l = NextWord(); - } until ((wn >= num_words) || - (l && (l->#dict_par1) & 8 ~= 0)); - - if (l && (l->#dict_par1) & 8) continue; - - ! lookahead failed - #Ifdef DEBUG; - if (parser_trace >= 2) - print " [Look-ahead aborted: prepositions don't match]^"; - #Endif; - jump LineFailed; - } - l = NextWord(); - } until (line_ttype-->pcount ~= PREPOSITION_TT); - - .EmptyLine; - ! put back the non-preposition we just read - wn--; - - if ((line_ttype-->pcount == ELEMENTARY_TT) && (line_tdata-->pcount == NOUN_TOKEN)) { - l = Descriptors(); ! skip past THE etc - if (l~=0) etype=l; ! don't allow multiple objects - l = NounDomain(actors_location, actor, NOUN_TOKEN); - - #Ifdef DEBUG; - if (parser_trace >= 2) { - print " [Advanced to ~noun~ token: "; - if (l == REPARSE_CODE) print "re-parse request]^"; - if (l == 1) print "but multiple found]^"; - if (l == 0) print "error ", etype, "]^"; - if (l >= 2) print (the) l, "]^"; - } - #Endif; ! DEBUG - if (l == REPARSE_CODE) jump ReParse; - if (l >= 2) advance_warning = l; - } - } - break; - } - } - } - - ! Slightly different line-parsing rules will apply to "take multi", to - ! prevent "take all" behaving correctly but misleadingly when there's - ! nothing to take. - - take_all_rule = 0; - if (m && params_wanted == 1 && action_to_be == ##Take) - take_all_rule = 1; - - ! And now start again, properly, forearmed or not as the case may be. - ! As a precaution, we clear all the variables again (they may have been - ! disturbed by the call to NounDomain, which may have called outside - ! code, which may have done anything!). - - not_holding = 0; - inferfrom = 0; - inferword = 0; - parameters = 0; - nsns = 0; special_word = 0; special_number = 0; - multiple_object-->0 = 0; - etype = STUCK_PE; line_etype = 100; - wn = verb_wordnum+1; - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! G: Parse each token in turn (calling ParseToken to do most of the work) - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! "Pattern" gradually accumulates what has been recognised so far, - ! so that it may be reprinted by the parser later on - - for (pcount=1 : : pcount++) { - pattern-->pcount = PATTERN_NULL; scope_token = 0; - - token = line_token-->(pcount-1); - lookahead = line_token-->pcount; - - #Ifdef DEBUG; - if (parser_trace >= 2) - print " [line ", line, " token ", pcount, " word ", wn, " : ", (DebugToken) token, - "]^"; - #Endif; ! DEBUG - - if (token ~= ENDIT_TOKEN) { - scope_reason = PARSING_REASON; - parser_inflection = name; - parser_inflection_func = false; - AnalyseToken(token); - - if (action_to_be == ##AskTo && found_ttype == ELEMENTARY_TT && - found_tdata == TOPIC_TOKEN && line_etype == 100) { - if (actor ~= player) { - best_etype = VERB_PE; jump GiveError; - } - l = inputobjs-->2; - wn--; - j = wn; - jump Conversation2; - } - - l = ParseToken__(found_ttype, found_tdata, pcount-1, token); - while (l<-200) l = ParseToken__(ELEMENTARY_TT, l + 256); - scope_reason = PARSING_REASON; - - if (l == GPR_PREPOSITION) { - if (found_ttype~=PREPOSITION_TT && (found_ttype~=ELEMENTARY_TT || - found_tdata~=TOPIC_TOKEN)) params_wanted--; - l = true; - } - else - if (l < 0) l = false; - else - if (l ~= GPR_REPARSE) { - if (l == GPR_NUMBER) { - if (nsns == 0) special_number1 = parsed_number; - else special_number2 = parsed_number; - nsns++; l = 1; - } - if (l == GPR_MULTIPLE) l = 0; - results-->(parameters+2) = l; - parameters++; - pattern-->pcount = l; - l = true; - } - - #Ifdef DEBUG; - if (parser_trace >= 3) { - print " [token resulted in "; - if (l == REPARSE_CODE) print "re-parse request]^"; - if (l == 0) print "failure with error type ", etype, "]^"; - if (l == 1) print "success]^"; - } - #Endif; ! DEBUG - - if (l == REPARSE_CODE) jump ReParse; - if (l == false) { - if (etype < line_etype) line_etype = etype; - if (etype == STUCK_PE || wn >= num_words) break; - } - } - else { - - ! If the player has entered enough already but there's still - ! text to wade through: store the pattern away so as to be able to produce - ! a decent error message if this turns out to be the best we ever manage, - ! and in the mean time give up on this line - - ! However, if the superfluous text begins with a comma or "then" then - ! take that to be the start of another instruction - - if (line_etype < 100) break; - if (wn <= num_words) { - l = NextWord(); - if (l == THEN1__WD or THEN2__WD or THEN3__WD or comma_word or AND1__WD) { - held_back_mode = 1; hb_wn = wn-1; - } - else { - for (m=0 : m<32 : m++) pattern2-->m = pattern-->m; - pcount2 = pcount; - etype = UPTO_PE; - break; - } - } - - ! Now, we may need to revise the multiple object because of the single one - ! we now know (but didn't when the list was drawn up). - - if (parameters >= 1 && results-->2 == 0) { - l = ReviseMulti(results-->3); - if (l ~= 0) { etype = l; results-->0 = action_to_be; break; } - } - if (parameters >= 2 && results-->3 == 0) { - l = ReviseMulti(results-->2); - if (l ~= 0) { etype = l; break; } - } - - ! To trap the case of "take all" inferring only "yourself" when absolutely - ! nothing else is in the vicinity... - - if (take_all_rule == 2 && results-->2 == actor) { - best_etype = NOTHING_PE; - jump GiveError; - } - - #Ifdef DEBUG; - if (parser_trace >= 1) print "[Line successfully parsed]^"; - #Endif; ! DEBUG - - ! The line has successfully matched the text. Declare the input error-free... - - oops_from = 0; - - ! ...explain any inferences made (using the pattern)... - - if (inferfrom ~= 0 && no_infer_message == false) { - print "("; PrintCommand(inferfrom); print ")^"; - } - no_infer_message = false; - - ! ...copy the action number, and the number of parameters... - - results-->0 = action_to_be; - results-->1 = parameters; - - ! ...reverse first and second parameters if need be... - - if (action_reversed && parameters == 2) { - i = results-->2; results-->2 = results-->3; - results-->3 = i; - if (nsns == 2) { - i = special_number1; special_number1 = special_number2; - special_number2 = i; - } - } - - ! ...and to reset "it"-style objects to the first of these parameters, if - ! there is one (and it really is an object)... - - if (parameters > 0 && results-->2 >= 2) - PronounNotice(results-->2); - - ! ...and worry about the case where an object was allowed as a parameter - ! even though the player wasn't holding it and should have been: in this - ! event, keep the results for next time round, go into "not holding" mode, - ! and for now tell the player what's happening and return a "take" request - ! instead... - - if (not_holding ~= 0 && actor == player) { - action = ##Take; - i = RunRoutines(not_holding, before_implicit); - ! i = 0: Take the object, tell the player (default) - ! i = 1: Take the object, don't tell the player - ! i = 2: don't Take the object, continue - ! i = 3: don't Take the object, don't continue - if (i > 2 || no_implicit_actions) { best_etype = NOTHELD_PE; jump GiveError; } - ! perform the implicit Take - if (i < 2) { - if (i ~= 1) ! and tell the player - L__M(##Miscellany, 26, not_holding); - notheld_mode = 1; - for (i=0 : i<8 : i++) kept_results-->i = results-->i; - results-->0 = ##Take; - results-->1 = 1; - results-->2 = not_holding; - } - } - - ! (Notice that implicit takes are only generated for the player, and not - ! for other actors. This avoids entirely logical, but misleading, text - ! being printed.) - - ! ...and return from the parser altogether, having successfully matched - ! a line. - - if (held_back_mode == 1) { - wn=hb_wn; - jump LookForMore; - } - rtrue; - - } ! end of if(token ~= ENDIT_TOKEN) else - } ! end of for(pcount++) - - .LineFailed; - ! The line has failed to match. - ! We continue the outer "for" loop, trying the next line in the grammar. - - if (line_etype < 100) etype = line_etype; - if (etype > best_etype) best_etype = etype; - if (etype ~= ASKSCOPE_PE && etype > nextbest_etype) nextbest_etype = etype; - - ! ...unless the line was something like "take all" which failed because - ! nothing matched the "all", in which case we stop and give an error now. - - if (take_all_rule == 2 && etype==NOTHING_PE) break; - - } ! end of for(line++) - - ! The grammar is exhausted: every line has failed to match. - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! H: Cheaply parse otherwise unrecognised conversation and return - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - .GiveError; - - etype = best_etype; - - ! Errors are handled differently depending on who was talking. - ! If the command was addressed to somebody else (eg, "dwarf, sfgh") then - ! it is taken as conversation which the parser has no business in disallowing. - - 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++; - } - special_number = TryNumber(verb_wordnum); - results-->0 = ##NotUnderstood; - results-->1 = 2; - results-->2 = 1; special_number1 = special_word; - results-->3 = actor; - consult_from = verb_wordnum; consult_words = num_words-consult_from+1; - rtrue; - } - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! I: Print best possible error message - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! If the player was the actor (eg, in "take dfghh") the error must be - ! printed, and fresh input called for. In four cases the oops word - ! must be jiggled (where oops_from is set to something). - - if (ParserError(etype)) jump ReType; - if (LibraryExtensions.RunWhile(ext_parsererror, false, etype)) jump ReType; - pronoun_word = pronoun__word; pronoun_obj = pronoun__obj; - - if (etype == STUCK_PE) { L__M(##Miscellany, 27); oops_from = 1; } - if (etype == UPTO_PE) { L__M(##Miscellany, 28); - for (m=0 : m<32 : m++) pattern-->m = pattern2-->m; - pcount = pcount2; PrintCommand(0); L__M(##Miscellany, 56); - oops_from = wn-1; - } - if (etype == NUMBER_PE) L__M(##Miscellany, 29); - if (etype == CANTSEE_PE) { L__M(##Miscellany, 30); oops_from=saved_oops;} - if (etype == TOOLIT_PE) L__M(##Miscellany, 31); - if (etype == NOTHELD_PE) { L__M(##Miscellany, 32, not_holding); oops_from=saved_oops; } - if (etype == MULTI_PE) L__M(##Miscellany, 33); - if (etype == MMULTI_PE) L__M(##Miscellany, 34); - if (etype == VAGUE_PE) L__M(##Miscellany, 35, pronoun_word); - if (etype == EXCEPT_PE) L__M(##Miscellany, 36); - if (etype == ANIMA_PE) L__M(##Miscellany, 37); - if (etype == VERB_PE) L__M(##Miscellany, 38); - if (etype == SCENERY_PE) L__M(##Miscellany, 39); - if (etype == ITGONE_PE) { - if (pronoun_obj == NULL) - L__M(##Miscellany, 35, pronoun_word); - else L__M(##Miscellany, 40, pronoun_word, pronoun_obj); - } - if (etype == JUNKAFTER_PE) L__M(##Miscellany, 41); - if (etype == TOOFEW_PE) L__M(##Miscellany, 42, multi_had); - if (etype == NOTHING_PE) { - if (results-->0 == ##Remove && results-->3 ofclass Object) { - noun = results-->3; ! ensure valid for messages - if (noun has animate) L__M(##Miscellany, 44, verb_word); - else if (noun hasnt container or supporter) L__M(##Insert, 2, noun); - else if (noun has container && noun hasnt open) L__M(##Take, 9, noun); - else if (children(noun)==0) L__M(##Search, 6, noun); - else results-->0 = 0; - } - if (results-->0 ~= ##Remove) { - if (multi_wanted == 100) L__M(##Miscellany, 43); - else { - #Ifdef NO_TAKE_ALL; - if (take_all_rule == 2) L__M(##Miscellany, 59); - else L__M(##Miscellany, 44, verb_word); - #Ifnot; - L__M(##Miscellany, 44, verb_word); - #Endif; ! NO_TAKE_ALL - } - } - } - if (etype == ASKSCOPE_PE) { - scope_stage = 3; - if (scope_error() == -1) { - best_etype = nextbest_etype; - jump GiveError; - } - } - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! J: Retry the whole lot - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! And go (almost) right back to square one... - - jump ReType; - - ! ...being careful not to go all the way back, to avoid infinite repetition - ! of a deferred command causing an error. - - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! K: Last thing: check for "then" and further instructions(s), return. - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! At this point, the return value is all prepared, and we are only looking - ! to see if there is a "then" followed by subsequent instruction(s). - - .LookForMore; - - if (wn > num_words) rtrue; - - i = NextWord(); - if (i == THEN1__WD or THEN2__WD or THEN3__WD or comma_word or AND1__WD) { - if (wn > num_words) { - held_back_mode = false; - return; - } - i = WordAddress(verb_wordnum); - j = WordAddress(wn); - for (: i0 = ' '; - 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 (: ii = ' '; - } - Tokenise__(buffer,parse); - held_back_mode = true; - return; - } - best_etype = UPTO_PE; - jump GiveError; - -]; ! end of Parser__parse - -[ ScopeCeiling person act; - act = parent(person); - if (act == 0) return person; - if (person == player && location == thedark) return thedark; - while (parent(act)~=0 && (act has transparent || act has supporter || - (act has container && act has open))) - act = parent(act); - return act; -]; - -! ---------------------------------------------------------------------------- -! Descriptors() -! -! Handles descriptive words like "my", "his", "another" and so on. -! Skips "the", and leaves wn pointing to the first misunderstood word. -! -! Allowed to set up for a plural only if allow_p is set -! -! Returns error number, or 0 if no error occurred -! ---------------------------------------------------------------------------- - -Constant OTHER_BIT = 1; ! These will be used in Adjudicate() -Constant MY_BIT = 2; ! to disambiguate choices -Constant THAT_BIT = 4; -Constant PLURAL_BIT = 8; -Constant LIT_BIT = 16; -Constant UNLIT_BIT = 32; - -[ ResetDescriptors; - indef_mode = 0; indef_type = 0; indef_wanted = 0; indef_guess_p = 0; - indef_possambig = false; - indef_owner = nothing; - indef_cases = $$111111111111; - indef_nspec_at = 0; -]; - -[ Descriptors allows_multiple o x flag cto type m n; - ResetDescriptors(); - if (wn > num_words) return 0; - m = wn; - for (flag=true : flag :) { - o = NextWordStopped(); flag = false; - for (x=1 : x<=LanguageDescriptors-->0 : x=x+4) - if (o == LanguageDescriptors-->x) { - flag = true; - type = LanguageDescriptors-->(x+2); - if (type ~= DEFART_PK) indef_mode = true; - indef_possambig = true; - indef_cases = indef_cases & (LanguageDescriptors-->(x+1)); - if (type == POSSESS_PK) { - cto = LanguageDescriptors-->(x+3); - switch (cto) { - 0: indef_type = indef_type | MY_BIT; - 1: indef_type = indef_type | THAT_BIT; - default: - indef_owner = PronounValue(cto); - if (indef_owner == NULL) indef_owner = InformParser; - } - } - if (type == light) indef_type = indef_type | LIT_BIT; - if (type == -light) indef_type = indef_type | UNLIT_BIT; - } - if (o == OTHER1__WD or OTHER2__WD or OTHER3__WD) { - indef_mode = 1; flag = 1; - indef_type = indef_type | OTHER_BIT; - } - if (o == ALL1__WD or ALL2__WD or ALL3__WD or ALL4__WD or ALL5__WD) { - indef_mode = 1; flag = 1; indef_wanted = 100; - if (take_all_rule == 1) take_all_rule = 2; - indef_type = indef_type | PLURAL_BIT; - } - if (allow_plurals && allows_multiple) { - n = TryNumber(wn-1); - if (n == 1) { indef_mode = 1; flag = 1; indef_wanted = 1; } - if (n > 1) { - indef_guess_p = 1; - indef_mode = 1; flag = 1; indef_wanted = n; - indef_nspec_at = wn-1; - indef_type = indef_type | PLURAL_BIT; - } - } - if (flag == 1 && NextWordStopped() ~= OF1__WD or OF2__WD or OF3__WD or OF4__WD) - wn--; ! Skip 'of' after these - } - wn--; - num_desc = wn - m; - return 0; -]; - -! ---------------------------------------------------------------------------- -! CreatureTest: Will this person do for a "creature" token? -! ---------------------------------------------------------------------------- - -[ CreatureTest obj; - if (actor ~= player) rtrue; - if (obj has animate) rtrue; - if (obj hasnt talkable) rfalse; - if (action_to_be == ##Ask or ##Answer or ##Tell or ##AskFor) rtrue; - rfalse; -]; - -[ PrepositionChain wd index; - if (line_tdata-->index == wd) return wd; - if ((line_token-->index)->0 & $20 == 0) return -1; - do { - if (line_tdata-->index == wd) return wd; - index++; - } until ((line_token-->index == ENDIT_TOKEN) || (((line_token-->index)->0 & $10) == 0)); - return -1; -]; - -! ---------------------------------------------------------------------------- -! ParseToken(type, data): -! Parses the given token, from the current word number wn, with exactly -! the specification of a general parsing routine. -! (Except that for "topic" tokens and prepositions, you need to supply -! a position in a valid grammar line as third argument.) -! -! Returns: -! GPR_REPARSE for "reconstructed input, please re-parse from scratch" -! GPR_PREPOSITION for "token accepted with no result" -! $ff00 + x for "please parse ParseToken(ELEMENTARY_TT, x) instead" -! 0 for "token accepted, result is the multiple object list" -! 1 for "token accepted, result is the number in parsed_number" -! object num for "token accepted with this object as result" -! -1 for "token rejected" -! -! (A) Analyse the token; handle all tokens not involving -! object lists and break down others into elementary tokens -! (B) Begin parsing an object list -! (C) Parse descriptors (articles, pronouns, etc.) in the list -! (D) Parse an object name -! (E) Parse connectives ("and", "but", etc.) and go back to (C) -! (F) Return the conclusion of parsing an object list -! ---------------------------------------------------------------------------- - -[ ParseToken given_ttype given_tdata token_n x y; - x = lookahead; lookahead = NOUN_TOKEN; - y = ParseToken__(given_ttype,given_tdata,token_n); - if (y == GPR_REPARSE) Tokenise__(buffer,parse); - lookahead = x; return y; -]; - -[ ParseToken__ given_ttype given_tdata token_n - token l o i j k and_parity single_object desc_wn many_flag - token_allows_multiple prev_indef_wanted; - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! A: Analyse token; handle all not involving object lists, break down others - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - token_filter = 0; - - switch (given_ttype) { - ELEMENTARY_TT: - switch (given_tdata) { - SPECIAL_TOKEN: - l = TryNumber(wn); - special_word = NextWord(); - #Ifdef DEBUG; - if (l ~= -1000) - if (parser_trace >= 3) print " [Read special as the number ", l, "]^"; - #Endif; ! DEBUG - if (l == -1000) { - #Ifdef DEBUG; - if (parser_trace >= 3) print " [Read special word at word number ", wn, "]^"; - #Endif; ! DEBUG - l = special_word; - } - parsed_number = l; return GPR_NUMBER; - - NUMBER_TOKEN: - l=TryNumber(wn++); - if (l == -1000) { etype = NUMBER_PE; return GPR_FAIL; } - #Ifdef DEBUG; - if (parser_trace>=3) print " [Read number as ", l, "]^"; - #Endif; ! DEBUG - parsed_number = l; return GPR_NUMBER; - - CREATURE_TOKEN: - if (action_to_be == ##Answer or ##Ask or ##AskFor or ##Tell) - scope_reason = TALKING_REASON; - - TOPIC_TOKEN: - consult_from = wn; - if ((line_ttype-->(token_n+1) ~= PREPOSITION_TT) && - (line_token-->(token_n+1) ~= ENDIT_TOKEN)) - RunTimeError(13); - do o = NextWordStopped(); - until (o == -1 || PrepositionChain(o, token_n+1) ~= -1); - wn--; - consult_words = wn-consult_from; - if (consult_words == 0) return GPR_FAIL; - if (action_to_be == ##Ask or ##Answer or ##Tell) { - o = wn; wn = consult_from; parsed_number = NextWord(); - #Ifdef EnglishNaturalLanguage; - if (parsed_number == 'the' && consult_words > 1) parsed_number=NextWord(); - #Endif; ! EnglishNaturalLanguage - wn = o; return 1; - } - if (o==-1 && (line_ttype-->(token_n+1) == PREPOSITION_TT)) - return GPR_FAIL; ! don't infer if required preposition is absent - return GPR_PREPOSITION; - } - - PREPOSITION_TT: - #Iffalse (Grammar__Version == 1); - ! Is it an unnecessary alternative preposition, when a previous choice - ! has already been matched? - if ((token->0) & $10) return GPR_PREPOSITION; - #Endif; ! Grammar__Version - - ! If we've run out of the player's input, but still have parameters to - ! specify, we go into "infer" mode, remembering where we are and the - ! preposition we are inferring... - - if (wn > num_words) { - if (inferfrom==0 && parameterspcount = REPARSE_CODE + Dword__No(given_tdata); - } - - ! If we are not inferring, then the line is wrong... - - if (inferfrom == 0) return -1; - - ! If not, then the line is right but we mark in the preposition... - - pattern-->pcount = REPARSE_CODE + Dword__No(given_tdata); - return GPR_PREPOSITION; - } - - o = NextWord(); - - pattern-->pcount = REPARSE_CODE + Dword__No(o); - - ! Whereas, if the player has typed something here, see if it is the - ! required preposition... if it's wrong, the line must be wrong, - ! but if it's right, the token is passed (jump to finish this token). - - if (o == given_tdata) return GPR_PREPOSITION; - #Iffalse (Grammar__Version == 1); - if (PrepositionChain(o, token_n) ~= -1) return GPR_PREPOSITION; - #Endif; ! Grammar__Version - return -1; - - GPR_TT: - l = given_tdata(); - #Ifdef DEBUG; - if (parser_trace >= 3) print " [Outside parsing routine returned ", l, "]^"; - #Endif; ! DEBUG - return l; - - SCOPE_TT: - scope_token = given_tdata; - scope_stage = 1; - l = scope_token(); - #Ifdef DEBUG; - if (parser_trace >= 3) print " [Scope routine returned multiple-flag of ", l, "]^"; - #Endif; ! DEBUG - if (l == 1) given_tdata = MULTI_TOKEN; else given_tdata = NOUN_TOKEN; - - ATTR_FILTER_TT: - token_filter = 1 + given_tdata; - given_tdata = NOUN_TOKEN; - - ROUTINE_FILTER_TT: - token_filter = given_tdata; - given_tdata = NOUN_TOKEN; - - } ! end of switch(given_ttype) - - token = given_tdata; - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! B: Begin parsing an object list - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! There are now three possible ways we can be here: - ! parsing an elementary token other than "special" or "number"; - ! parsing a scope token; - ! parsing a noun-filter token (either by routine or attribute). - ! - ! In each case, token holds the type of elementary parse to - ! perform in matching one or more objects, and - ! token_filter is 0 (default), an attribute + 1 for an attribute filter - ! or a routine address for a routine filter. - - token_allows_multiple = false; - if (token == MULTI_TOKEN or MULTIHELD_TOKEN or MULTIEXCEPT_TOKEN or MULTIINSIDE_TOKEN) - token_allows_multiple = true; - - many_flag = false; and_parity = true; dont_infer = false; - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! C: Parse descriptors (articles, pronouns, etc.) in the list - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! We expect to find a list of objects next in what the player's typed. - - .ObjectList; - - #Ifdef DEBUG; - if (parser_trace >= 3) print " [Object list from word ", wn, "]^"; - #Endif; ! DEBUG - - ! Take an advance look at the next word: if it's "it" or "them", and these - ! are unset, set the appropriate error number and give up on the line - ! (if not, these are still parsed in the usual way - it is not assumed - ! that they still refer to something in scope) - - o = NextWord(); wn--; - - pronoun_word = NULL; pronoun_obj = NULL; - l = PronounValue(o); - if (l ~= 0) { - pronoun_word = o; pronoun_obj = l; - if (l == NULL) { - ! Don't assume this is a use of an unset pronoun until the - ! descriptors have been checked, because it might be an - ! article (or some such) instead - - for (l=1 : l<=LanguageDescriptors-->0 : l=l+4) - if (o == LanguageDescriptors-->l) jump AssumeDescriptor; - pronoun__word = pronoun_word; pronoun__obj = pronoun_obj; - etype = VAGUE_PE; return GPR_FAIL; - } - } - - .AssumeDescriptor; - - if (o == ME1__WD or ME2__WD or ME3__WD) { pronoun_word = o; pronoun_obj = player; } - - allow_plurals = true; - desc_wn = wn; - - .TryAgain; - - ! First, we parse any descriptive words (like "the", "five" or "every"): - l = Descriptors(token_allows_multiple); - if (l ~= 0) { etype = l; return GPR_FAIL; } - - .TryAgain2; - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! D: Parse an object name - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! This is an actual specified object, and is therefore where a typing error - ! is most likely to occur, so we set: - - oops_from = wn; - - ! So, two cases. Case 1: token not equal to "held" - ! but we may well be dealing with multiple objects - - ! In either case below we use NounDomain, giving it the token number as - ! context, and two places to look: among the actor's possessions, and in the - ! present location. (Note that the order depends on which is likeliest.) - if (token ~= HELD_TOKEN) { - i = multiple_object-->0; - #Ifdef DEBUG; - if (parser_trace >= 3) print " [Calling NounDomain on location and actor]^"; - #Endif; ! DEBUG - l = NounDomain(actors_location, actor, token); - if (l == REPARSE_CODE) return l; ! Reparse after Q&A - if (l ~= nothing && l ~= 1 && l notin actor && token == MULTIHELD_TOKEN or MULTIEXCEPT_TOKEN) { - if (ImplicitTake(l)) { - etype = NOTHELD_PE; - jump FailToken; - } - } - - if (indef_wanted == 100 && l == 0 && number_matched == 0) - l = 1; ! ReviseMulti if TAKE ALL FROM empty container - - if (token_allows_multiple && ~~multiflag) { - if (best_etype==MULTI_PE) best_etype=STUCK_PE; - multiflag = true; - } - if (l == 0) { - if (indef_possambig) { - saved_ml = match_length; - ResetDescriptors(); - wn = desc_wn; - jump TryAgain2; - } - if (etype ~=TOOFEW_PE && (multiflag || etype ~= MULTI_PE)) - etype = CantSee(); - jump FailToken; - } ! Choose best error - - #Ifdef DEBUG; - if (parser_trace >= 3) { - if (l > 1) print " [NounDomain returned ", (the) l, "]^"; - else { - print " [NounDomain appended to the multiple object list:^"; - k = multiple_object-->0; - for (j=i+1 : j<=k : j++) - print " Entry ", j, ": ", (The) multiple_object-->j, - " (", multiple_object-->j, ")^"; - print " List now has size ", k, "]^"; - } - } - #Endif; ! DEBUG - - if (l == 1) { - if (~~many_flag) many_flag = true; - else { ! Merge with earlier ones - k = multiple_object-->0; ! (with either parity) - multiple_object-->0 = i; - for (j=i+1 : j<=k : j++) { - if (and_parity) MultiAdd(multiple_object-->j); - else MultiSub(multiple_object-->j); - } - #Ifdef DEBUG; - if (parser_trace >= 3) print " [Merging ", k-i, " new objects to the ", i, " old ones]^"; - #Endif; ! DEBUG - } - } - else { - ! A single object was indeed found - - if (match_length == 0 && indef_possambig) { - ! So the answer had to be inferred from no textual data, - ! and we know that there was an ambiguity in the descriptor - ! stage (such as a word which could be a pronoun being - ! parsed as an article or possessive). It's worth having - ! another go. - - ResetDescriptors(); - wn = desc_wn; - jump TryAgain2; - } - - if (token == CREATURE_TOKEN && CreatureTest(l) == 0) { - etype = ANIMA_PE; - jump FailToken; - } ! Animation is required - - if (~~many_flag) single_object = l; - else { - if (and_parity) MultiAdd(l); else MultiSub(l); - #Ifdef DEBUG; - if (parser_trace >= 3) print " [Combining ", (the) l, " with list]^"; - #Endif; ! DEBUG - } - } - - } else { - ! Case 2: token is "held" (which fortunately can't take multiple objects) - ! and may generate an implicit take - l = NounDomain(actor,actors_location,token); ! Same as above... - if (l == REPARSE_CODE) return GPR_REPARSE; - if (l == 0) { - if (indef_possambig) { - ResetDescriptors(); - wn = desc_wn; - jump TryAgain2; - } - etype = CantSee(); jump FailToken; ! Choose best error - } - - ! ...until it produces something not held by the actor. Then an implicit - ! take must be tried. If this is already happening anyway, things are too - ! confused and we have to give up (but saving the oops marker so as to get - ! it on the right word afterwards). - ! The point of this last rule is that a sequence like - ! - ! > read newspaper - ! (taking the newspaper first) - ! The dwarf unexpectedly prevents you from taking the newspaper! - ! - ! should not be allowed to go into an infinite repeat - read becomes - ! take then read, but take has no effect, so read becomes take then read... - ! Anyway for now all we do is record the number of the object to take. - - o = parent(l); - - if (o ~= actor) { - if (notheld_mode == 1) { - saved_oops = oops_from; - etype = NOTHELD_PE; - jump FailToken; - } - not_holding = l; - #Ifdef DEBUG; - if (parser_trace >= 3) print " [Allowing object ", (the) l, " for now]^"; - #Endif; ! DEBUG - } - single_object = l; - } ! end of if (token ~= HELD_TOKEN) else - - ! The following moves the word marker to just past the named object... - - wn = oops_from + match_length; - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! E: Parse connectives ("and", "but", etc.) and go back to (C) - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! Object(s) specified now: is that the end of the list, or have we reached - ! "and", "but" and so on? If so, create a multiple-object list if we - ! haven't already (and are allowed to). - - .NextInList; - - o = NextWord(); - - if (o == AND1__WD or AND2__WD or AND3__WD or BUT1__WD or BUT2__WD or BUT3__WD or comma_word) { - - #Ifdef DEBUG; - if (parser_trace >= 3) print " [Read connective '", (address) o, "']^"; - #Endif; ! DEBUG - - k = NextWord(); - if (k ~= AND1__WD) wn--; ! allow Serial commas in input - if (k > 0 && (k->#dict_par1) & (DICT_NOUN+DICT_VERB) == DICT_VERB) { - wn--; ! player meant 'THEN' - jump PassToken; - } - if (~~token_allows_multiple) { - if (multiflag) jump PassToken; ! give UPTO_PE error - etype=MULTI_PE; - jump FailToken; - } - - if (o == BUT1__WD or BUT2__WD or BUT3__WD) and_parity = 1-and_parity; - - if (~~many_flag) { - multiple_object-->0 = 1; - multiple_object-->1 = single_object; - many_flag = true; - #Ifdef DEBUG; - if (parser_trace >= 3) print " [Making new list from ", (the) single_object, "]^"; - #Endif; ! DEBUG - } - dont_infer = true; inferfrom=0; ! Don't print (inferences) - jump ObjectList; ! And back around - } - - wn--; ! Word marker back to first not-understood word - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! F: Return the conclusion of parsing an object list - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! Happy or unhappy endings: - - .PassToken; - - if (many_flag) { - single_object = GPR_MULTIPLE; - multi_context = token; - } - else { - if (indef_mode == 1 && indef_type & PLURAL_BIT ~= 0) { - if (indef_wanted < 100 && indef_wanted > 1) { - multi_had = 1; multi_wanted = indef_wanted; - etype = TOOFEW_PE; - jump FailToken; - } - } - } - return single_object; - - .FailToken; - - ! If we were only guessing about it being a plural, try again but only - ! allowing singulars (so that words like "six" are not swallowed up as - ! Descriptors) - - if (allow_plurals && indef_guess_p == 1) { - #Ifdef DEBUG; - if (parser_trace >= 4) print " [Retrying singulars after failure ", etype, "]^"; - #Endif; - prev_indef_wanted = indef_wanted; - allow_plurals = false; - wn = desc_wn; - jump TryAgain; - } - - if ((indef_wanted > 0 || prev_indef_wanted > 0) && (~~multiflag)) etype = MULTI_PE; - - return GPR_FAIL; - -]; ! end of ParseToken__ - -! ---------------------------------------------------------------------------- -! NounDomain does the most substantial part of parsing an object name. -! -! It is given two "domains" - usually a location and then the actor who is -! looking - and a context (i.e. token type), and returns: -! -! 0 if no match at all could be made, -! 1 if a multiple object was made, -! k if object k was the one decided upon, -! REPARSE_CODE if it asked a question of the player and consequently rewrote -! the player's input, so that the whole parser should start again -! on the rewritten input. -! -! In the case when it returns 1= 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 == 100) 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; placed_in_flag = 0; - - SearchScope(domain1, domain2, context); - - #Ifdef DEBUG; - if (parser_trace >= 4) print " [NounDomain 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; - if (indef_mode) { - if ((indef_type & LIT_BIT) && i hasnt light) rfalse; - if ((indef_type & UNLIT_BIT) && i has light) rfalse; - } - 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 (match_length == 0 && indef_mode && indef_wanted ~= 100) - number_matched = 0; ! ask question for 'take three' - if (number_matched == 1) i = match_list-->0; - if (number_matched > 1) { - 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 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; - return AskPlayer(context); - - ! 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 (best_etype == NOTHING_PE && pattern-->1 == 0) rfalse; ! for DROP when empty-handed - if (context == CREATURE_TOKEN) L__M(##Miscellany, 48, actor); - else L__M(##Miscellany, 49, actor); - - #Ifdef TARGET_ZCODE; - for (i=2 : ii = ' '; - #Endif; ! TARGET_ZCODE - answer_words = Keyboard(buffer2, parse2); - - first_word = WordValue(1, parse2); - #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... - - ! Once again, if the reply looks like a command - ! (that is, VERB ... or XXX,VERB ...), give it to the parser to get - ! on with and forget about the question... - - if (first_word) { - if ((first_word->#dict_par1) & DICT_VERB) { - CopyBuffer(buffer, buffer2); - return REPARSE_CODE; - } - if (NumberWords(parse2) > 2) { - j = WordValue(2, parse2); - k = WordValue(3, parse2); - if (j == ',//' && k && (k->#dict_par1) & DICT_VERB) { - CopyBuffer(buffer, buffer2); - return REPARSE_CODE; - } - } - } - - ! ...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 : jj == PATTERN_NULL) continue; - i = WORDSIZE + GetKeyBufLength(); - SetKeyBufLength(i-WORDSIZE + 1); - buffer->(i++) = ' '; - - #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) { - ! was the inference made from some noun words? - ! In which case, we can infer again. - if ((WordValue(NumberWords())->#dict_par1) & DICT_NOUN) continue; - 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 = No__Dword(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 : ll = buffer->(l+2); - #Ifnot; ! TARGET_GLULX - k = PrintAnyToArray(buffer+i, INPUT_BUFFER_LEN-i, parse2-->1); - l=l; ! suppress compiler warning - #Endif; ! TARGET_ - i = i + k; SetKeyBufLength(i-WORDSIZE); - } - } - } - - ! (2) we must glue the newly-typed text onto the end. - - i = WORDSIZE + GetKeyBufLength(); - buffer->(i++) = ' '; - SetKeyBufLength(GetKeyBufLength()+1); - for (j=0 : ji = buffer2->(j+WORDSIZE); - SetKeyBufLength(GetKeyBufLength()+1); - if (i-WORDSIZE == INPUT_BUFFER_LEN-1) break; - } - - ! (3) we fill up the buffer with spaces, which is unnecessary, but may - ! help incorrectly-written interpreters to cope. - - #Ifdef TARGET_ZCODE; - for (: ii = ' '; - #Endif; ! TARGET_ZCODE - - return REPARSE_CODE; - -]; ! end of NounDomain - - -[ AskPlayer context i j k l first_word answer_words marker; - ! Now we print up the question, using the equivalence classes as worked - ! out by Adjudicate() so as not to repeat ourselves on plural objects... - - asking_player = true; - if (context == CREATURE_TOKEN) L__M(##Miscellany, 45); - else L__M(##Miscellany, 46); - - 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 (string) COMMA__TX; - if (i == j-1) print (SerialComma) j, (string) OR__TX; - } - L__M(##Miscellany, 57); - - ! ...and get an answer: - - .WhichOne; - #Ifdef TARGET_ZCODE; - for (i=WORDSIZE : ii = ' '; - #Endif; ! TARGET_ZCODE - answer_words = Keyboard(buffer2, parse2); - - first_word = WordValue(1, parse2); - asking_player = false; - - ! 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 : ii; - multiple_object-->(i+1+l) = k; - } - multiple_object-->0 = i+l; - rtrue; - } - L__M(##Miscellany, 47); - jump WhichOne; - } - - ! If the first word of the reply can be interpreted as a verb, then - ! assume that the player has ignored the question and given a new - ! command altogether. - ! (This is one time when it's convenient that the directions are - ! not themselves verbs - thus, "north" as a reply to "Which, the north - ! or south door" is not treated as a fresh command but as an answer.) - - #Ifdef LanguageIsVerb; - if (first_word == 0) { - j = wn; first_word = LanguageIsVerb(buffer2, parse2, 1); wn = j; - } - #Endif; ! LanguageIsVerb - if (first_word) { - if (((first_word->#dict_par1) & DICT_VERB) && ~~LanguageVerbMayBeName(first_word)) { - CopyBuffer(buffer, buffer2); - return REPARSE_CODE; - } - if (NumberWords(parse2) > 2) { - j = WordValue(2, parse2); - k = WordValue(3, parse2); - if (j == ',//' && k && (k->#dict_par1) & DICT_VERB) { - CopyBuffer(buffer, buffer2); - return REPARSE_CODE; - } - } - } - - ! 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.) - - k = WordAddress(match_from) - buffer; - l = GetKeyBufLength(buffer2) +1; - for (j=buffer + INPUT_BUFFER_LEN - 1 : j>=buffer+k+l : j--) j->0 = j->(-l); - for (i=0 : i(k+i) = buffer2->(WORDSIZE+i); - buffer->(k+l-1) = ' '; - SetKeyBufLength(GetKeyBufLength() + l); - - ! Having reconstructed the input, we warn the parser accordingly - ! and get out. - - return REPARSE_CODE; -]; - - -! ---------------------------------------------------------------------------- -! The Adjudicate routine tries to see if there is an obvious choice, when -! faced with a list of objects (the match_list) each of which matches the -! player's specification equally well. -! -! To do this it makes use of the context (the token type being worked on). -! It counts up the number of obvious choices for the given context -! (all to do with where a candidate is, except for 6 (animate) which is to -! do with whether it is animate or not); -! -! if only one obvious choice is found, that is returned; -! -! if we are in indefinite mode (don't care which) one of the obvious choices -! is returned, or if there is no obvious choice then an unobvious one is -! made; -! -! at this stage, we work out whether the objects are distinguishable from -! each other or not: if they are all indistinguishable from each other, -! then choose one, it doesn't matter which; -! -! otherwise, 0 (meaning, unable to decide) is returned (but remember that -! the equivalence classes we've just worked out will be needed by other -! routines to clear up this mess, so we can't economise on working them -! out). -! -! Returns -1 if an error occurred -! ---------------------------------------------------------------------------- - -Constant SCORE__CHOOSEOBJ = 1000; -Constant SCORE__IFGOOD = 500; -Constant SCORE__UNCONCEALED = 100; -Constant SCORE__BESTLOC = 60; -Constant SCORE__NEXTBESTLOC = 40; -Constant SCORE__NOTCOMPASS = 20; -Constant SCORE__NOTSCENERY = 10; -Constant SCORE__NOTACTOR = 5; -Constant SCORE__GNA = 1; -Constant SCORE__DIVISOR = 20; - -[ Adjudicate context i j k good_flag good_ones last n flag offset sovert; - #Ifdef DEBUG; - if (parser_trace >= 4) { - print " [Adjudicating match list of size ", number_matched, " in context ", context, "]^"; - print " "; - if (indef_mode) { - print "indefinite type: "; - 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 == 100) print "all"; else print indef_wanted; - new_line; - print " most likely GNAs of names: ", indef_cases, "^"; - } - else print "definite object^"; - } - #Endif; ! DEBUG - - j = number_matched-1; good_ones = 0; last = match_list-->0; - for (i=0 : i<=j : i++) { - n = match_list-->i; - match_scores-->i = 0; - - good_flag = false; - - switch (context) { - HELD_TOKEN, MULTIHELD_TOKEN: - if (parent(n) == actor) good_flag = true; - MULTIEXCEPT_TOKEN: - if (advance_warning == -1) { - good_flag = true; - } - else { - if (n ~= advance_warning) good_flag = true; - } - MULTIINSIDE_TOKEN: - if (advance_warning == -1) { - if (parent(n) ~= actor) good_flag = true; - } - else { - if (n in advance_warning) good_flag = true; - } - CREATURE_TOKEN: - if (CreatureTest(n) == 1) good_flag = true; - default: - good_flag = true; - } - - if (good_flag) { - match_scores-->i = SCORE__IFGOOD; - good_ones++; last = n; - } - } - if (good_ones == 1) return last; - - ! If there is ambiguity about what was typed, but it definitely wasn't - ! animate as required, then return anything; higher up in the parser - ! a suitable error will be given. (This prevents a question being asked.) - - if (context == CREATURE_TOKEN && good_ones == 0) return match_list-->0; - - if (indef_mode == 0) indef_type=0; - - ScoreMatchL(context); - if (number_matched == 0) return -1; - - if (indef_mode == 1 && indef_type & PLURAL_BIT ~= 0) { - if (context ~= MULTI_TOKEN or MULTIHELD_TOKEN or MULTIEXCEPT_TOKEN - or MULTIINSIDE_TOKEN) { - etype = MULTI_PE; - return -1; - } - i = 0; offset = multiple_object-->0; sovert = -1; - for (j=BestGuess() : j~=-1 && i(i+offset) = j; - #Ifdef DEBUG; - if (parser_trace >= 4) print " Accepting it^"; - #Endif; ! DEBUG - } - else { - i = i; - #Ifdef DEBUG; - if (parser_trace >= 4) print " Rejecting it^"; - #Endif; ! DEBUG - } - } - if (i < indef_wanted && indef_wanted < 100) { - etype = TOOFEW_PE; multi_wanted = indef_wanted; - multi_had=i; - return -1; - } - multiple_object-->0 = i+offset; - multi_context = context; - #Ifdef DEBUG; - if (parser_trace >= 4) - print " Made multiple object of size ", i, "]^"; - #Endif; ! DEBUG - return 1; - } - - for (i=0 : ii = 0; - - n = 1; - for (i=0 : ii == 0) { - match_classes-->i = n++; flag = 0; - for (j=i+1 : jj == 0 && Identical(match_list-->i, match_list-->j) == 1) { - flag=1; - match_classes-->j = match_classes-->i; - } - if (flag == 1) match_classes-->i = 1-n; - } - n--; number_of_classes = n; - - #Ifdef DEBUG; - if (parser_trace >= 4) { - print " Grouped into ", n, " possibilities by name:^"; - for (i=0 : ii > 0) - print " ", (The) match_list-->i, " (", match_list-->i, ") --- group ", - match_classes-->i, "^"; - } - #Endif; ! DEBUG - if (n == 1) dont_infer = true; - - if (indef_mode == 0) { - ! Is there now a single highest-scoring object? - i = SingleBestGuess(); - if (i >= 0) { - - #Ifdef DEBUG; - if (parser_trace >= 4) print " Single best-scoring object returned.]^"; - #Endif; ! DEBUG - return i; - } - } - - if (indef_mode == 0) { - if (n > 1) { - k = -1; - for (i=0 : ii > k) { - k = match_scores-->i; - j = match_classes-->i; j = j*j; - flag = 0; - } - else - if (match_scores-->i == k) { - if ((match_classes-->i) * (match_classes-->i) ~= j) - flag = 1; - } - } - - if (flag) { - #Ifdef DEBUG; - if (parser_trace >= 4) print " Unable to choose best group, so ask player.]^"; - #Endif; ! DEBUG - return 0; - } - #Ifdef DEBUG; - if (parser_trace >= 4) print " Best choices are all from the same group.^"; - #Endif; ! DEBUG - } - } - - ! When the player is really vague, or there's a single collection of - ! indistinguishable objects to choose from, choose the one the player - ! most recently acquired, or if the player has none of them, then - ! the one most recently put where it is. - - return BestGuess(); - -]; ! Adjudicate - -! ---------------------------------------------------------------------------- -! ReviseMulti revises the multiple object which already exists, in the -! light of information which has come along since then (i.e., the second -! parameter). It returns a parser error number, or else 0 if all is well. -! This only ever throws things out, never adds new ones. -! ---------------------------------------------------------------------------- - -[ ReviseMulti second_p i low; - #Ifdef DEBUG; - if (parser_trace >= 4) print " Revising multiple object list of size ", multiple_object-->0, - " with 2nd ", (name) second_p, "^"; - #Endif; ! DEBUG - - if (multi_context == MULTIEXCEPT_TOKEN or MULTIINSIDE_TOKEN) { - for (i=1,low=0 : i<=multiple_object-->0 : i++) { - if ( (multi_context==MULTIEXCEPT_TOKEN && multiple_object-->i ~= second_p) || - (multi_context==MULTIINSIDE_TOKEN && multiple_object-->i in second_p)) { - low++; - multiple_object-->low = multiple_object-->i; - } - } - multiple_object-->0 = low; - } - - if (multi_context == MULTI_TOKEN && action_to_be == ##Take) { - for (i=1,low=0 : i<=multiple_object-->0 : i++) - if (ScopeCeiling(multiple_object-->i)==ScopeCeiling(actor)) low++; - #Ifdef DEBUG; - if (parser_trace >= 4) print " Token 2 plural case: number with actor ", low, "^"; - #Endif; ! DEBUG - if (take_all_rule == 2 || low > 0) { - for (i=1,low=0 : i<=multiple_object-->0 : i++) { - if (ScopeCeiling(multiple_object-->i) == ScopeCeiling(actor)) { - low++; - multiple_object-->low = multiple_object-->i; - } - } - multiple_object-->0 = low; - } - } - - i = multiple_object-->0; - #Ifdef DEBUG; - if (parser_trace >= 4) print " Done: new size ", i, "^"; - #Endif; ! DEBUG - if (i == 0) return NOTHING_PE; - return 0; -]; - -! ---------------------------------------------------------------------------- -! ScoreMatchL scores the match list for quality in terms of what the -! player has vaguely asked for. Points are awarded for conforming with -! requirements like "my", and so on. Remove from the match list any -! entries which fail the basic requirements of the descriptors. -! ---------------------------------------------------------------------------- - -[ ScoreMatchL context its_owner its_score obj i j threshold met a_s l_s; -! if (indef_type & OTHER_BIT ~= 0) threshold++; - if (indef_type & MY_BIT ~= 0) threshold++; - if (indef_type & THAT_BIT ~= 0) threshold++; - if (indef_type & LIT_BIT ~= 0) threshold++; - if (indef_type & UNLIT_BIT ~= 0) threshold++; - if (indef_owner ~= nothing) threshold++; - - #Ifdef DEBUG; - if (parser_trace >= 4) print " Scoring match list: indef mode ", indef_mode, " type ", - indef_type, ", satisfying ", threshold, " requirements:^"; - #Endif; ! DEBUG - - if (action_to_be ~= ##Take) - a_s = SCORE__NEXTBESTLOC; - l_s = SCORE__BESTLOC; - if (context == HELD_TOKEN or MULTIHELD_TOKEN or MULTIEXCEPT_TOKEN) { - a_s = SCORE__BESTLOC; l_s = SCORE__NEXTBESTLOC; - } - - for (i=0 : ii; its_owner = parent(obj); its_score=0; met=0; - - ! if (indef_type & OTHER_BIT ~= 0 - ! && obj ~= itobj or himobj or herobj) met++; - if (indef_type & MY_BIT ~= 0 && its_owner == actor) met++; - if (indef_type & THAT_BIT ~= 0 && its_owner == actors_location) met++; - if (indef_type & LIT_BIT ~= 0 && obj has light) met++; - if (indef_type & UNLIT_BIT ~= 0 && obj hasnt light) met++; - if (indef_owner ~= 0 && its_owner == indef_owner) met++; - - if (met < threshold) { - #Ifdef DEBUG; - if (parser_trace >= 4) print " ", (The) match_list-->i, " (", match_list-->i, ") in ", - (the) its_owner, " is rejected (doesn't match descriptors)^"; - #Endif; ! DEBUG - match_list-->i = -1; - } - else { - its_score = 0; - if (obj hasnt concealed) its_score = SCORE__UNCONCEALED; - - if (its_owner == actor) its_score = its_score + a_s; - else - if (its_owner == actors_location) its_score = its_score + l_s; - else { - #Ifdef TRADITIONAL_TAKE_ALL; - if (its_owner ~= compass) its_score = its_score + SCORE__NOTCOMPASS; - #Ifnot; - if (its_owner ~= compass) - if (take_all_rule && its_owner && - its_owner has static or scenery && - (its_owner has supporter || - (its_owner has container && its_owner has open))) - its_score = its_score + l_s; - else - its_score = its_score + SCORE__NOTCOMPASS; - #Endif; ! TRADITIONAL_TAKE_ALL - } - j = ChooseObjects(obj, 2); - if (j == 0) j = LibraryExtensions.RunAll(ext_chooseobjects, obj, 2); - its_score = its_score + SCORE__CHOOSEOBJ * j; - - if (obj hasnt scenery) its_score = its_score + SCORE__NOTSCENERY; - if (obj ~= actor) its_score = its_score + SCORE__NOTACTOR; - - ! A small bonus for having the correct GNA, - ! for sorting out ambiguous articles and the like. - - if (indef_cases & (PowersOfTwo_TB-->(GetGNAOfObject(obj)))) - its_score = its_score + SCORE__GNA; - - match_scores-->i = match_scores-->i + its_score; - #Ifdef DEBUG; - if (parser_trace >= 4) print " ", (The) match_list-->i, " (", match_list-->i, - ") in ", (the) its_owner, " : ", match_scores-->i, " points^"; - #Endif; ! DEBUG - } - } - - for (i=0 : ii == -1) { - if (i == number_matched-1) { number_matched--; break; } - for (j=i : jj = match_list-->(j+1); - match_scores-->j = match_scores-->(j+1); - } - number_matched--; - } - } -]; - -! ---------------------------------------------------------------------------- -! BestGuess makes the best guess it can out of the match list, assuming that -! everything in the match list is textually as good as everything else; -! however it ignores items marked as -1, and so marks anything it chooses. -! It returns -1 if there are no possible choices. -! ---------------------------------------------------------------------------- - -[ BestGuess earliest its_score best i; - earliest = 0; best = -1; - for (i=0 : ii >= 0) { - its_score = match_scores-->i; - if (its_score > best) { best = its_score; earliest = i; } - } - } - #Ifdef DEBUG; - if (parser_trace >= 4) - if (best < 0) print " Best guess ran out of choices^"; - else print " Best guess ", (the) match_list-->earliest, " (", match_list-->earliest, ")^"; - #Endif; ! DEBUG - if (best < 0) return -1; - i = match_list-->earliest; - match_list-->earliest = -1; - bestguess_score = best; - return i; -]; - -! ---------------------------------------------------------------------------- -! SingleBestGuess returns the highest-scoring object in the match list -! if it is the clear winner, or returns -1 if there is no clear winner -! ---------------------------------------------------------------------------- - -[ SingleBestGuess earliest its_score best i; - earliest = -1; best = -1000; - for (i=0 : ii; - if (its_score == best) earliest = -1; - if (its_score > best) { best = its_score; earliest = match_list-->i; } - } - bestguess_score = best; - return earliest; -]; - -! ---------------------------------------------------------------------------- -! Identical decides whether or not two objects can be distinguished from -! each other by anything the player can type. If not, it returns true. -! ---------------------------------------------------------------------------- - -[ Identical o1 o2 p1 p2 n1 n2 i j flag; - if (o1 == o2) rtrue; ! This should never happen, but to be on the safe side - if (o1 == 0 || o2 == 0) rfalse; ! Similarly - if (parent(o1) == compass || parent(o2) == compass) rfalse; ! Saves time - - ! What complicates things is that o1 or o2 might have a parsing routine, - ! so the parser can't know from here whether they are or aren't the same. - ! If they have different parsing routines, we simply assume they're - ! different. If they have the same routine (which they probably got from - ! a class definition) then the decision process is as follows: - ! - ! the routine is called (with self being o1, not that it matters) - ! with noun and second being set to o1 and o2, and action being set - ! to the fake action TheSame. If it returns -1, they are found - ! identical; if -2, different; and if >=0, then the usual method - ! is used instead. - - if (o1.parse_name ~= 0 || o2.parse_name ~= 0) { - if (o1.parse_name ~= o2.parse_name) rfalse; - parser_action = ##TheSame; parser_one = o1; parser_two = o2; - j = wn; i = RunRoutines(o1,parse_name); wn = j; - if (i == -1) rtrue; - if (i == -2) rfalse; - } - - ! This is the default algorithm: do they have the same words in their - ! "name" (i.e. property no. 1) properties. (Note that the following allows - ! for repeated words and words in different orders.) - - p1 = o1.&1; n1 = (o1.#1)/WORDSIZE; - p2 = o2.&1; n2 = (o2.#1)/WORDSIZE; - - ! for (i=0 : ii, " "; } new_line; - ! for (i=0 : ii, " "; } new_line; - - for (i=0 : ii == p2-->j) flag = 1; - if (flag == 0) rfalse; - } - - for (j=0 : ji == p2-->j) flag = 1; - if (flag == 0) rfalse; - } - - ! print "Which are identical!^"; - rtrue; -]; - -! ---------------------------------------------------------------------------- -! PrintCommand reconstructs the command as it presently reads, from -! the pattern which has been built up -! -! If from is 0, it starts with the verb: then it goes through the pattern. -! The other parameter is "emptyf" - a flag: if 0, it goes up to pcount: -! if 1, it goes up to pcount-1. -! -! Note that verbs and prepositions are printed out of the dictionary: -! and that since the dictionary may only preserve the first six characters -! of a word (in a V3 game), we have to hand-code the longer words needed. -! -! (Recall that pattern entries are 0 for "multiple object", 1 for "special -! word", 2 to REPARSE_CODE-1 are object numbers and REPARSE_CODE+n means the -! preposition n) -! ---------------------------------------------------------------------------- - -[ PrintCommand from i k spacing_flag; - #Ifdef LanguageCommand; - LanguageCommand(from); - i = k = spacing_flag = 0; ! suppress warning - #Ifnot; - if (from == 0) { - i = verb_word; - if (LanguageVerb(i) == 0 && PrintVerb(i) == false && LibraryExtensions.RunWhile(ext_printverb, false, i) == 0) - print (address) i; - from++; spacing_flag = true; - } - - for (k=from : kk; - if (i == PATTERN_NULL) continue; - if (spacing_flag) print (char) ' '; - if (i == 0) { print (string) THOSET__TX; jump TokenPrinted; } - if (i == 1) { print (string) THAT__TX; jump TokenPrinted; } - if (i >= REPARSE_CODE) - print (address) No__Dword(i-REPARSE_CODE); - else - if (i in compass && LanguageVerbLikesAdverb(verb_word)) - LanguageDirection (i.door_dir); ! the direction name as adverb - else - print (the) i; - .TokenPrinted; - spacing_flag = true; - } - #Endif; ! LanguageCommand -]; - -! ---------------------------------------------------------------------------- -! The CantSee routine returns a good error number for the situation where -! the last word looked at didn't seem to refer to any object in context. -! -! The idea is that: if the actor is in a location (but not inside something -! like, for instance, a tank which is in that location) then an attempt to -! refer to one of the words listed as meaningful-but-irrelevant there -! will cause "you don't need to refer to that in this game" rather than -! "no such thing" or "what's 'it'?". -! (The advantage of not having looked at "irrelevant" local nouns until now -! is that it stops them from clogging up the ambiguity-resolving process. -! Thus game objects always triumph over scenery.) -! ---------------------------------------------------------------------------- - -[ CantSee i w e; - if (scope_token ~= 0) { - scope_error = scope_token; - return ASKSCOPE_PE; - } - - wn--; w = NextWord(); - e = CANTSEE_PE; - if (w == pronoun_word) { - pronoun__word = pronoun_word; pronoun__obj = pronoun_obj; - e = ITGONE_PE; - } - i = actor; while (parent(i) ~= 0) i = parent(i); - - wn--; - if (i has visited && Refers(i,wn) == 1) e = SCENERY_PE; - else { - Descriptors(); ! skip past THE etc - if (i has visited && Refers(i,wn) == 1) e = SCENERY_PE; - } - - if (saved_ml) - saved_oops = num_desc + match_from + saved_ml; - else - saved_oops = num_desc + match_from + match_length; - - wn++; - return e; -]; - -! ---------------------------------------------------------------------------- -! The MultiAdd routine adds object "o" to the multiple-object-list. -! -! This is only allowed to hold 63 objects at most, at which point it ignores -! any new entries (and sets a global flag so that a warning may later be -! printed if need be). -! ---------------------------------------------------------------------------- - -[ MultiAdd o i j; - i = multiple_object-->0; - if (i == 63) { toomany_flag = 1; rtrue; } - for (j=1 : j<=i : j++) - if (o == multiple_object-->j) rtrue; - i++; - multiple_object-->i = o; - multiple_object-->0 = i; -]; - -! ---------------------------------------------------------------------------- -! The MultiSub routine deletes object "o" from the multiple-object-list. -! -! It returns 0 if the object was there in the first place, and 9 (because -! this is the appropriate error number in Parser()) if it wasn't. -! ---------------------------------------------------------------------------- - -[ MultiSub o i j k et; - i = multiple_object-->0; et = 0; - for (j=1 : j<=i : j++) - if (o == multiple_object-->j) { - for (k=j : k<=i : k++) - multiple_object-->k = multiple_object-->(k+1); - multiple_object-->0 = --i; - return et; - } - et = 9; return et; -]; - -! ---------------------------------------------------------------------------- -! The MultiFilter routine goes through the multiple-object-list and throws -! out anything without the given attribute "attr" set. -! ---------------------------------------------------------------------------- - -[ MultiFilter attr i j o; - - .MFiltl; - - i = multiple_object-->0; - for (j=1 : j<=i : j++) { - o = multiple_object-->j; - if (o hasnt attr) { - MultiSub(o); - jump Mfiltl; - } - } -]; - -! ---------------------------------------------------------------------------- -! The UserFilter routine consults the user's filter (or checks on attribute) -! to see what already-accepted nouns are acceptable -! ---------------------------------------------------------------------------- - -[ UserFilter obj; - if (token_filter > 0 && token_filter < 49) { - if (obj has (token_filter-1)) rtrue; - rfalse; - } - noun = obj; - return token_filter(); -]; - -! ---------------------------------------------------------------------------- -! MoveWord copies word at2 from parse buffer b2 to word at1 in "parse" -! (the main parse buffer) -! ---------------------------------------------------------------------------- - -#Ifdef TARGET_ZCODE; - -[ MoveWord at1 b2 at2 x y; - x = at1*2-1; y = at2*2-1; - parse-->x++ = b2-->y++; - parse-->x = b2-->y; -]; - -#Ifnot; ! TARGET_GLULX - -[ MoveWord at1 b2 at2 x y; - x = at1*3-2; y = at2*3-2; - parse-->x++ = b2-->y++; - parse-->x++ = b2-->y++; - parse-->x = b2-->y; -]; - -#Endif; ! TARGET_ - -! ---------------------------------------------------------------------------- -! SearchScope domain1 domain2 context -! -! Works out what objects are in scope (possibly asking an outside routine), -! but does not look at anything the player has typed. -! ---------------------------------------------------------------------------- - -[ SearchScope domain1 domain2 context i is; - i = 0; - ! Everything is in scope to the debugging commands - - #Ifdef DEBUG; - if (scope_reason == PARSING_REASON - && LanguageVerbIsDebugging(verb_word)) { - - #Ifdef TARGET_ZCODE; - for (i=selfobj : i<=top_object : i++) - if (i ofclass Object && (parent(i) == 0 || parent(i) ofclass Object)) - PlaceInScope(i); - #Ifnot; ! TARGET_GLULX - objectloop (i) - if (i ofclass Object && (parent(i) == 0 || parent(i) ofclass Object)) - PlaceInScope(i); - #Endif; ! TARGET_ - rtrue; - } - #Endif; ! DEBUG - - ! First, a scope token gets priority here: - - if (scope_token ~= 0) { - scope_stage = 2; - if (scope_token()) rtrue; - } - - ! Pick up everything in the location except the actor's possessions; - ! then go through those. (This ensures the actor's possessions are in - ! scope even in Darkness.) - - if (context == MULTIINSIDE_TOKEN && advance_warning ~= -1) { - if (IsSeeThrough(advance_warning) == 1) - ScopeWithin(advance_warning, 0, context); - } - else { - ! Next, call any user-supplied routine adding things to the scope, - ! which may circumvent the usual routines altogether - ! if they return true: - - if (actor == domain1 or domain2) { - is = InScope(actor); - if (is == false) is = LibraryExtensions.RunWhile(ext_inscope, false, actor); - if (is) rtrue; - } - - if (domain1 ~= 0 && domain1 has supporter or container) - ScopeWithin_O(domain1, domain1, context); - ScopeWithin(domain1, domain2, context); - if (domain2 ~= 0 && domain2 has supporter or container) - ScopeWithin_O(domain2, domain2, context); - ScopeWithin(domain2, 0, context); - } - - ! A special rule applies: - ! in Darkness as in light, the actor is always in scope to himself. - - if (thedark == domain1 or domain2) { - ScopeWithin_O(actor, actor, context); - if (parent(actor) has supporter or container) - ScopeWithin_O(parent(actor), parent(actor), context); - } -]; - -! ---------------------------------------------------------------------------- -! IsSeeThrough is used at various places: roughly speaking, it determines -! whether o being in scope means that the contents of o are in scope. -! ---------------------------------------------------------------------------- - -[ IsSeeThrough o; - if (o has supporter or transparent || - (o has container && o has open)) - rtrue; - rfalse; -]; - -! ---------------------------------------------------------------------------- -! PlaceInScope is provided for routines outside the library, and is not -! called within the parser (except for debugging purposes). -! ---------------------------------------------------------------------------- - -[ PlaceInScope thing; - if (scope_reason~=PARSING_REASON or TALKING_REASON) { - DoScopeAction(thing); rtrue; - } - wn = match_from; TryGivenObject(thing); placed_in_flag = 1; -]; - -! ---------------------------------------------------------------------------- -! DoScopeAction -! ---------------------------------------------------------------------------- - -[ DoScopeAction thing s p1; - s = scope_reason; p1 = parser_one; - #Ifdef DEBUG; - if (parser_trace >= 6) - print "[DSA on ", (the) thing, " with reason = ", scope_reason, - " p1 = ", parser_one, " p2 = ", parser_two, "]^"; - #Endif; ! DEBUG - switch (scope_reason) { - REACT_BEFORE_REASON: - if (thing.react_before == 0 or NULL) return; - #Ifdef DEBUG; - if (parser_trace >= 2) - print "[Considering react_before for ", (the) thing, "]^"; - #Endif; ! DEBUG - if (parser_one == 0) parser_one = RunRoutines(thing, react_before); - REACT_AFTER_REASON: - if (thing.react_after == 0 or NULL) return; - #Ifdef DEBUG; - if (parser_trace >= 2) - print "[Considering react_after for ", (the) thing, "]^"; - #Endif; ! DEBUG - if (parser_one == 0) parser_one = RunRoutines(thing, react_after); - EACH_TURN_REASON: - if (thing.each_turn == 0) return; - #Ifdef DEBUG; - if (parser_trace >= 2) - print "[Considering each_turn for ", (the) thing, "]^"; - #Endif; ! DEBUG - PrintOrRun(thing, each_turn); - TESTSCOPE_REASON: - if (thing == parser_one) parser_two = 1; - LOOPOVERSCOPE_REASON: - parser_one(thing); - parser_one=p1; - } - scope_reason = s; -]; - -! ---------------------------------------------------------------------------- -! ScopeWithin looks for objects in the domain which make textual sense -! and puts them in the match list. (However, it does not recurse through -! the second argument.) -! ---------------------------------------------------------------------------- - -[ ScopeWithin domain nosearch context x y; - if (domain == 0) rtrue; - - ! Special rule: the directions (interpreted as the 12 walls of a room) are - ! always in context. (So, e.g., "examine north wall" is always legal.) - ! (Unless we're parsing something like "all", because it would just slow - ! things down then, or unless the context is "creature".) - - if (indef_mode==0 && domain==actors_location - && scope_reason==PARSING_REASON && context~=CREATURE_TOKEN) - ScopeWithin(compass); - - ! Look through the objects in the domain, avoiding "objectloop" in case - ! movements occur, e.g. when trying each_turn. - - x = child(domain); - while (x ~= 0) { - y = sibling(x); - ScopeWithin_O(x, nosearch, context); - x = y; - } -]; - -[ ScopeWithin_O domain nosearch context i ad n; - - ! If the scope reason is unusual, don't parse. - - if (scope_reason ~= PARSING_REASON or TALKING_REASON) { - DoScopeAction(domain); - jump DontAccept; - } - - ! "it" or "them" matches to the it-object only. (Note that (1) this means - ! that "it" will only be understood if the object in question is still - ! in context, and (2) only one match can ever be made in this case.) - - if (match_from <= num_words) { ! If there's any text to match, that is - wn = match_from; - i = NounWord(); - if (i == 1 && player == domain) MakeMatch(domain, 1); - if (i >= 2 && i < 128 && (LanguagePronouns-->i == domain)) MakeMatch(domain, 1); - } - - ! Construing the current word as the start of a noun, can it refer to the - ! object? - - wn = match_from; - if (TryGivenObject(domain) > 0) - if (indef_nspec_at > 0 && match_from ~= indef_nspec_at) { - ! This case arises if the player has typed a number in - ! which is hypothetically an indefinite descriptor: - ! e.g. "take two clubs". We have just checked the object - ! against the word "clubs", in the hope of eventually finding - ! two such objects. But we also backtrack and check it - ! against the words "two clubs", in case it turns out to - ! be the 2 of Clubs from a pack of cards, say. If it does - ! match against "two clubs", we tear up our original - ! assumption about the meaning of "two" and lapse back into - ! definite mode. - - wn = indef_nspec_at; - if (TryGivenObject(domain) > 0) { - match_from = indef_nspec_at; - ResetDescriptors(); - } - wn = match_from; - } - - .DontAccept; - - ! Shall we consider the possessions of the current object, as well? - ! Only if it's a container (so, for instance, if a dwarf carries a - ! sword, then "drop sword" will not be accepted, but "dwarf, drop sword" - ! will). - ! Also, only if there are such possessions. - ! - ! Notice that the parser can see "into" anything flagged as - ! transparent - such as a dwarf whose sword you can get at. - - if (child(domain) ~= 0 && domain ~= nosearch && IsSeeThrough(domain) == 1) - ScopeWithin(domain,nosearch,context); - - ! Drag any extras into context - - ad = domain.&add_to_scope; - if (ad ~= 0) { - - ! Test if the property value is not an object. - #Ifdef TARGET_ZCODE; - i = (UnsignedCompare(ad-->0, top_object) > 0); - #Ifnot; ! TARGET_GLULX - i = (((ad-->0)->0) ~= $70); - #Endif; ! TARGET_ - - if (i) { - ats_flag = 2+context; - RunRoutines(domain, add_to_scope); - ats_flag = 0; - } - else { - n = domain.#add_to_scope; - for (i=0 : (WORDSIZE*i)i) - ScopeWithin_O(ad-->i, 0, context); - } - } -]; - -[ AddToScope obj; - if (ats_flag >= 2) - ScopeWithin_O(obj, 0, ats_flag-2); - if (ats_flag == 1) { - if (HasLightSource(obj)==1) ats_hls = 1; - } -]; - -! ---------------------------------------------------------------------------- -! MakeMatch looks at how good a match is. If it's the best so far, then -! wipe out all the previous matches and start a new list with this one. -! If it's only as good as the best so far, add it to the list. -! If it's worse, ignore it altogether. -! -! The idea is that "red panic button" is better than "red button" or "panic". -! -! number_matched (the number of words matched) is set to the current level -! of quality. -! -! We never match anything twice, and keep at most 64 equally good items. -! ---------------------------------------------------------------------------- - -[ MakeMatch obj quality i; - #Ifdef DEBUG; - if (parser_trace >= 6) print " Match with quality ",quality,"^"; - #Endif; ! DEBUG - if (token_filter ~= 0 && UserFilter(obj) == 0) { - #Ifdef DEBUG; - if (parser_trace >= 6) print " Match filtered out: token filter ", token_filter, "^"; - #Endif; ! DEBUG - rtrue; - } - if (quality < match_length) rtrue; - if (quality > match_length) { match_length = quality; number_matched = 0; } - else { - if (number_matched >= MATCH_LIST_SIZE) rtrue; - for (i=0 : ii == obj) rtrue; - } - match_list-->number_matched++ = obj; - #Ifdef DEBUG; - if (parser_trace >= 6) print " Match added to list^"; - #Endif; ! DEBUG -]; - -! ---------------------------------------------------------------------------- -! TryGivenObject tries to match as many words as possible in what has been -! typed to the given object, obj. If it manages any words matched at all, -! it calls MakeMatch to say so, then returns the number of words (or 1 -! if it was a match because of inadequate input). -! ---------------------------------------------------------------------------- - -[ TryGivenObject obj threshold k w j; - #Ifdef DEBUG; - if (parser_trace >= 5) print " Trying ", (the) obj, " (", obj, ") at word ", wn, "^"; - #Endif; ! DEBUG - - dict_flags_of_noun = 0; - - ! If input has run out then always match, with only quality 0 (this saves - ! time). - - if (wn > num_words) { - if (indef_mode ~= 0) - dict_flags_of_noun = DICT_X654; ! Reject "plural" bit - MakeMatch(obj,0); - #Ifdef DEBUG; - if (parser_trace >= 5) print " Matched (0)^"; - #Endif; ! DEBUG - return 1; - } - - ! Ask the object to parse itself if necessary, sitting up and taking notice - ! if it says the plural was used: - - if (obj.parse_name~=0) { - parser_action = NULL; j=wn; - k = RunRoutines(obj,parse_name); - if (k > 0) { - wn=j+k; - - .MMbyPN; - - if (parser_action == ##PluralFound) - dict_flags_of_noun = dict_flags_of_noun | DICT_PLUR; - - if (dict_flags_of_noun & DICT_PLUR) { - if (~~allow_plurals) k = 0; - else { - if (indef_mode == 0) { - indef_mode = 1; indef_type = 0; indef_wanted = 0; - } - indef_type = indef_type | PLURAL_BIT; - if (indef_wanted == 0) indef_wanted = 100; - } - } - - #Ifdef DEBUG; - if (parser_trace >= 5) print " Matched (", k, ")^"; - #Endif; ! DEBUG - MakeMatch(obj,k); - return k; - } - if (k == 0) jump NoWordsMatch; - wn = j; - } - - ! The default algorithm is simply to count up how many words pass the - ! Refers test: - - parser_action = NULL; - - w = NounWord(); - - if (w == 1 && player == obj) { k=1; jump MMbyPN; } - - if (w >= 2 && w < 128 && (LanguagePronouns-->w == obj)) { k = 1; jump MMbyPN; } - - j = --wn; - threshold = ParseNoun(obj); - if (threshold == -1) { - LibraryExtensions.ext_number_1 = wn; ! Set the "between calls" functionality to - LibraryExtensions.BetweenCalls = LibraryExtensions.RestoreWN; - threshold = LibraryExtensions.RunWhile(ext_parsenoun, -1, obj); - LibraryExtensions.BetweenCalls = 0; ! Turn off the "between calls" functionality - } - #Ifdef DEBUG; - if (threshold >= 0 && parser_trace >= 5) print " ParseNoun returned ", threshold, "^"; - #Endif; ! DEBUG - if (threshold < 0) wn++; - if (threshold > 0) { k = threshold; jump MMbyPN; } - - if (threshold == 0 || Refers(obj,wn-1) == 0) { - .NoWordsMatch; - if (indef_mode ~= 0) { - k = 0; parser_action = NULL; - jump MMbyPN; - } - rfalse; - } - - if (threshold < 0) { - threshold = 1; - dict_flags_of_noun = (w->#dict_par1) & (DICT_X654+DICT_PLUR);!$$01110100; - w = NextWord(); - while (Refers(obj, wn-1)) { - threshold++; - if (w) - dict_flags_of_noun = dict_flags_of_noun | ((w->#dict_par1) & (DICT_X654+DICT_PLUR)); - w = NextWord(); - } - } - - k = threshold; - jump MMbyPN; -]; - -! ---------------------------------------------------------------------------- -! Refers works out whether the word at number wnum can refer to the object -! obj, returning true or false. The standard method is to see if the -! word is listed under "name" for the object, but this is more complex -! in languages other than English. -! ---------------------------------------------------------------------------- - -[ Refers obj wnum wd k l m; - if (obj == 0) rfalse; - - #Ifdef LanguageRefers; - k = LanguageRefers(obj,wnum); if (k >= 0) return k; - #Endif; ! LanguageRefers - - k = wn; wn = wnum; wd = NextWordStopped(); wn = k; - - if (parser_inflection_func) { - k = parser_inflection(obj, wd); - if (k >= 0) return k; - m = -k; - } - else - m = parser_inflection; - - k = obj.&m; l = (obj.#m)/WORDSIZE-1; - for (m=0 : m<=l : m++) - if (wd == k-->m) rtrue; - rfalse; -]; - -[ WordInProperty wd obj prop k l m; - k = obj.∝ l = (obj.#prop)/WORDSIZE-1; - for (m=0 : m<=l : m++) - if (wd == k-->m) rtrue; - rfalse; -]; - -[ DictionaryLookup b l i; - for (i=0 : i(WORDSIZE+i) = b->i; - SetKeyBufLength(l, buffer2); - Tokenise__(buffer2, parse2); - return parse2-->1; -]; - -! ---------------------------------------------------------------------------- -! NounWord (which takes no arguments) returns: -! -! 0 if the next word is unrecognised or does not carry the "noun" bit in -! its dictionary entry, -! 1 if a word meaning "me", -! the index in the pronoun table (plus 2) of the value field of a pronoun, -! if the word is a pronoun, -! the address in the dictionary if it is a recognised noun. -! -! The "current word" marker moves on one. -! ---------------------------------------------------------------------------- - -[ NounWord i j s; - i = NextWord(); - if (i == 0) rfalse; - if (i == ME1__WD or ME2__WD or ME3__WD) return 1; - s = LanguagePronouns-->0; - for (j=1 : j<=s : j=j+3) - if (i == LanguagePronouns-->j) - return j+2; - if ((i->#dict_par1) & DICT_NOUN == 0) rfalse; - return i; -]; - -! ---------------------------------------------------------------------------- -! NextWord (which takes no arguments) returns: -! -! 0 if the next word is unrecognised, -! comma_word if a comma -! THEN1__WD if a full stop -! or the dictionary address if it is recognised. -! The "current word" marker is moved on. -! -! NextWordStopped does the same, but returns -1 when input has run out -! ---------------------------------------------------------------------------- - -#Ifdef TARGET_ZCODE; - -[ NextWord i j; - if (wn > parse->1) { wn++; rfalse; } - i = wn*2-1; wn++; - j = parse-->i; - if (j == ',//') j = comma_word; - if (j == './/') j = THEN1__WD; - return j; -]; - -[ NextWordStopped; - if (wn > parse->1) { wn++; return -1; } - return NextWord(); -]; - -[ WordAddress wordnum p b; ! Absolute addr of 'wordnum' string in buffer - if (p==0) p=parse; - if (b==0) b=buffer; - return b + p->(wordnum*4+1); -]; - -[ WordLength wordnum p; ! Length of 'wordnum' string in buffer - if (p==0) p=parse; - return p->(wordnum*4); -]; - -[ WordValue wordnum p; ! Dictionary value of 'wordnum' string in buffer - if (p==0) p=parse; - return p-->(wordnum*2-1); -]; - -[ NumberWords p; ! Number of parsed strings in buffer - if (p==0) p=parse; - return p->1; -]; - -[ GetKeyBufLength b; ! Number of typed chars in buffer - if (b==0) b=buffer; - return b->1; -]; - -[ SetKeyBufLength n b; ! Update number of typed chars in buffer - if (b==0) b=buffer; - if (n > INPUT_BUFFER_LEN-WORDSIZE) n=INPUT_BUFFER_LEN-WORDSIZE; - b->1 = n; -]; - -#Ifnot; ! TARGET_GLULX - -[ NextWord i j; - if (wn > parse-->0) { wn++; rfalse; } - i = wn*3-2; wn++; - j = parse-->i; - if (j == ',//') j=comma_word; - if (j == './/') j=THEN1__WD; - return j; -]; - -[ NextWordStopped; - if (wn > parse-->0) { - wn++; - return -1; - } - return NextWord(); -]; - -[ WordAddress wordnum p b; ! Absolute addr of 'wordnum' string in buffer - if (p==0) p=parse; - if (b==0) b=buffer; - return b + p-->(wordnum*3); -]; - -[ WordLength wordnum p; ! Length of 'wordnum' string in buffer - if (p==0) p=parse; - return p-->(wordnum*3-1); -]; - -[ WordValue wordnum p; ! Dictionary value of 'wordnum' string in buffer - if (p==0) p=parse; - return p-->(wordnum*3-2); -]; - -[ NumberWords p; ! Number of parsed strings in buffer - if (p==0) p=parse; - return p-->0; -]; - -[ GetKeyBufLength b; ! Number of typed chars in buffer - if (b==0) b=buffer; - return b-->0; -]; - -[ SetKeyBufLength n b; ! Update number of typed chars in buffer - if (b==0) b=buffer; - if (n > INPUT_BUFFER_LEN-WORDSIZE) n=INPUT_BUFFER_LEN-WORDSIZE; - b-->0 = n; -]; - -#Endif; ! TARGET_ - -! ---------------------------------------------------------------------------- -! TryNumber is the only routine which really does any character-level -! parsing, since that's normally left to the Z-machine. -! It takes word number "wordnum" and tries to parse it as an (unsigned) -! decimal number, returning -! -! -1000 if it is not a number -! the number if it has between 1 and 4 digits -! 10000 if it has 5 or more digits. -! -! (The danger of allowing 5 digits is that Z-machine integers are only -! 16 bits long, and anyway this isn't meant to be perfect.) -! -! Using NumberWord, it also catches "one" up to "twenty". -! -! Note that a game can provide a ParseNumber routine which takes priority, -! to enable parsing of odder numbers ("x45y12", say). -! ---------------------------------------------------------------------------- - -[ TryNumber wordnum i j c num len mul tot d digit; - i = wn; wn = wordnum; j = NextWord(); wn = i; - j = NumberWord(j); - if (j >= 1) return j; - - num = WordAddress(wordnum); len = WordLength(wordnum); - - tot = ParseNumber(num, len); - if (tot == 0) tot = LibraryExtensions.RunWhile(ext_parsenumber, 0, num, len); - - if (tot ~= 0) return tot; - - if (len >= 4) mul=1000; - if (len == 3) mul=100; - if (len == 2) mul=10; - if (len == 1) mul=1; - - tot = 0; c = 0; - - for (c = 0 : c < len : c++) { - digit=num->c; - if (digit == '0') { d = 0; jump digok; } - if (digit == '1') { d = 1; jump digok; } - if (digit == '2') { d = 2; jump digok; } - if (digit == '3') { d = 3; jump digok; } - if (digit == '4') { d = 4; jump digok; } - if (digit == '5') { d = 5; jump digok; } - if (digit == '6') { d = 6; jump digok; } - if (digit == '7') { d = 7; jump digok; } - if (digit == '8') { d = 8; jump digok; } - if (digit == '9') { d = 9; jump digok; } - return -1000; - .digok; - tot = tot+mul*d; mul = mul/10; - } - if (len > 4) tot=10000; - return tot; -]; - -! ---------------------------------------------------------------------------- -! AnyNumber is a general parsing routine which accepts binary, hexadecimal -! and decimal numbers up to the full Zcode/Glulx ranges. -! ---------------------------------------------------------------------------- - -#Ifdef TARGET_ZCODE; ! decimal range is -32768 to 32767 -Constant MAX_DECIMAL_SIZE 5; -Constant MAX_DECIMAL_BASE 3276; -#Ifnot; ! TARGET_GLULX ! decimal range is -2147483648 to 2147483647 -Constant MAX_DECIMAL_SIZE 10; -Constant MAX_DECIMAL_BASE 214748364; -#Endif; ! TARGET_ - -[ AnyNumber - wa we sign base digit digit_count num; - - wa = WordAddress(wn); we = wa + WordLength(wn); - sign = 1; base = 10; - if (wa->0 == '-') { sign = -1; wa++; } - else { - if (wa->0 == '$') { base = 16; wa++; } - if (wa->0 == '$') { base = 2; wa++; } - } - if (wa >= we) return GPR_FAIL; ! no digits after -/$ - while (wa->0 == '0') wa++; ! skip leading zeros - for (num=0,digit_count=1 : wa0) { - '0' to '9': digit = wa->0 - '0'; - 'A' to 'F': digit = wa->0 - 'A' + 10; - 'a' to 'f': digit = wa->0 - 'a' + 10; - default: return GPR_FAIL; - } - if (digit >= base) return GPR_FAIL; - digit_count++; - switch (base) { - 16: if (digit_count > 2*WORDSIZE) return GPR_FAIL; - 2: if (digit_count > 8*WORDSIZE) return GPR_FAIL; - 10: - if (digit_count > MAX_DECIMAL_SIZE) return GPR_FAIL; - if (digit_count == MAX_DECIMAL_SIZE) { - if (num > MAX_DECIMAL_BASE) return GPR_FAIL; - if (num == MAX_DECIMAL_BASE) { - if (sign == 1 && digit > 7) return GPR_FAIL; - if (sign == -1 && digit > 8) return GPR_FAIL; - } - } - } - num = base*num + digit; - } - parsed_number = num * sign; - wn++; - return GPR_NUMBER; -]; - -! ---------------------------------------------------------------------------- -! GetGender returns 0 if the given animate object is female, and 1 if male -! (not all games will want such a simple decision function!) -! ---------------------------------------------------------------------------- - -[ GetGender person; - if (person hasnt female) rtrue; - rfalse; -]; - -[ GetGNAOfObject obj case gender; - if (obj hasnt animate) case = 6; - if (obj has male) gender = male; - if (obj has female) gender = female; - if (obj has neuter) gender = neuter; - if (gender == 0) { - if (case == 0) gender = LanguageAnimateGender; - else gender = LanguageInanimateGender; - } - if (gender == female) case = case + 1; - if (gender == neuter) case = case + 2; - if (obj has pluralname) case = case + 3; - return case; -]; - -! ---------------------------------------------------------------------------- -! Converting between dictionary addresses and entry numbers -! ---------------------------------------------------------------------------- - -#Ifdef TARGET_ZCODE; - -[ Dword__No w; return (w-(HDR_DICTIONARY-->0 + 7))/9; ]; -[ No__Dword n; return HDR_DICTIONARY-->0 + 7 + 9*n; ]; - -#Ifnot; ! TARGET_GLULX - -! In Glulx, dictionary entries *are* addresses. -[ Dword__No w; return w; ]; -[ No__Dword n; return n; ]; - -#Endif; ! TARGET_ - -! ---------------------------------------------------------------------------- -! For copying buffers -! ---------------------------------------------------------------------------- - -#Ifdef TARGET_ZCODE; - -[ CopyBuffer bto bfrom i size; - size = bto->0; - for (i=1 : i<=size : i++) bto->i = bfrom->i; -]; - -#Ifnot; ! TARGET_GLULX - -[ CopyBuffer bto bfrom i; - for (i=0 : ii = bfrom->i; -]; - -#Endif; ! TARGET_ - -! ---------------------------------------------------------------------------- -! Provided for use by language definition files -! ---------------------------------------------------------------------------- - -#Ifdef TARGET_ZCODE; - -[ LTI_Insert i ch b y; - - ! Protect us from strict mode, as this isn't an array in quite the - ! sense it expects - b = buffer; - - ! Insert character ch into buffer at point i. - ! Being careful not to let the buffer possibly overflow: - y = b->1; - if (y > b->0) y = b->0; - - ! Move the subsequent text along one character: - for (y=y+2 : y>i : y--) b->y = b->(y-1); - b->i = ch; - - ! And the text is now one character longer: - if (b->1 < b->0) (b->1)++; -]; - -#Ifnot; ! TARGET_GLULX - -[ LTI_Insert i ch b y; - - ! Protect us from strict mode, as this isn't an array in quite the - ! sense it expects - b = buffer; - - ! Insert character ch into buffer at point i. - ! Being careful not to let the buffer possibly overflow: - y = b-->0; - if (y > INPUT_BUFFER_LEN) y = INPUT_BUFFER_LEN; - - ! Move the subsequent text along one character: - for (y=y+WORDSIZE : y>i : y--) b->y = b->(y-1); - b->i = ch; - - ! And the text is now one character longer: - if (b-->0 < INPUT_BUFFER_LEN) (b-->0)++; -]; - -#Endif; ! TARGET_ - -! ============================================================================ - -[ PronounsSub x y c d; - L__M(##Pronouns, 1); - - c = (LanguagePronouns-->0)/3; - if (player ~= selfobj) c++; - - if (c == 0) return L__M(##Pronouns, 4); - - for (x=1,d=0 : x<=LanguagePronouns-->0 : x=x+3) { - print "~", (address) LanguagePronouns-->x, "~ "; - y = LanguagePronouns-->(x+2); - if (y == NULL) L__M(##Pronouns, 3); - else { - L__M(##Pronouns, 2); - print (the) y; - } - d++; - if (d < c-1) print (string) COMMA__TX; - if (d == c-1) print (SerialComma) c, (string) AND__TX; - } - if (player ~= selfobj) { - print "~", (address) ME1__WD, "~ "; L__M(##Pronouns, 2); - c = player; player = selfobj; - print (the) c; player = c; - } - L__M(##Pronouns, 5); -]; - -[ SetPronoun dword value x; - for (x=1 : x<=LanguagePronouns-->0 : x=x+3) - if (LanguagePronouns-->x == dword) { - LanguagePronouns-->(x+2) = value; return; - } - RunTimeError(12); -]; - -[ PronounValue dword x; - for (x=1 : x<=LanguagePronouns-->0 : x=x+3) - if (LanguagePronouns-->x == dword) - return LanguagePronouns-->(x+2); - return 0; -]; - -[ ResetVagueWords obj; PronounNotice(obj); ]; - -#Ifdef EnglishNaturalLanguage; - -[ PronounOldEnglish; - if (itobj ~= old_itobj) SetPronoun('it', itobj); - if (himobj ~= old_himobj) SetPronoun('him', himobj); - if (herobj ~= old_herobj) SetPronoun('her', herobj); - old_itobj = itobj; old_himobj = himobj; old_herobj = herobj; -]; - -#Endif; !EnglishNaturalLanguage - -[ PronounNotice obj x bm; - if (obj == player) return; - - #Ifdef EnglishNaturalLanguage; - PronounOldEnglish(); - #Endif; ! EnglishNaturalLanguage - - bm = PowersOfTwo_TB-->(GetGNAOfObject(obj)); - - for (x=1 : x<=LanguagePronouns-->0 : x=x+3) - if (bm & (LanguagePronouns-->(x+1)) ~= 0) - LanguagePronouns-->(x+2) = obj; - - #Ifdef EnglishNaturalLanguage; - itobj = PronounValue('it'); old_itobj = itobj; - himobj = PronounValue('him'); old_himobj = himobj; - herobj = PronounValue('her'); old_herobj = herobj; - #Endif; ! EnglishNaturalLanguage -]; - -! ============================================================================ -! End of the parser proper: the remaining routines are its front end. -! ---------------------------------------------------------------------------- - -Object InformLibrary "(Inform Library)" - with play [ i j k l; - - #Ifdef TARGET_ZCODE; - ZZInitialise(); - #Ifnot; ! TARGET_GLULX - GGInitialise(); - #Endif; ! TARGET_ - - GamePrologue(); - while (~~deadflag) { ! everything happens in this loop - - #Ifdef EnglishNaturalLanguage; - PronounOldEnglish(); - old_itobj = PronounValue('it'); - old_himobj = PronounValue('him'); - old_herobj = PronounValue('her'); - #Endif; ! EnglishNaturalLanguage - - .very__late__error; - - if (score ~= last_score) { - if (notify_mode == 1) NotifyTheScore(); - last_score = score; - } - - .late__error; - - inputobjs-->0 = 0; inputobjs-->1 = 0; - inputobjs-->2 = 0; inputobjs-->3 = 0; meta = false; - - ! The Parser writes its results into inputobjs and meta, - ! a flag indicating a "meta-verb". This can only be set for - ! commands by the player, not for orders to others. - - InformParser.parse_input(inputobjs); - - action = inputobjs-->0; - - ! -------------------------------------------------------------- - - ! Reverse "give fred biscuit" into "give biscuit to fred" - - if (action == ##GiveR or ##ShowR) { - i = inputobjs-->2; inputobjs-->2 = inputobjs-->3; inputobjs-->3 = i; - if (action == ##GiveR) action = ##Give; else action = ##Show; - } - - ! Convert "P, tell me about X" to "ask P about X" - - if (action == ##Tell && inputobjs-->2 == player && actor ~= player) { - inputobjs-->2 = actor; actor = player; action = ##Ask; - } - - ! Convert "ask P for X" to "P, give X to me" - - if (action == ##AskFor && inputobjs-->2 ~= player && actor == player) { - actor = inputobjs-->2; inputobjs-->2 = inputobjs-->3; - inputobjs-->3 = player; action = ##Give; - } - - ! For old, obsolete code: special_word contains the topic word - ! in conversation - - if (action == ##Ask or ##Tell or ##Answer) - special_word = special_number1; - - ! -------------------------------------------------------------- - - multiflag = false; onotheld_mode = notheld_mode; notheld_mode = false; - ! For implicit taking and multiple object detection - - .begin__action; - inp1 = 0; inp2 = 0; i = inputobjs-->1; - if (i >= 1) inp1 = inputobjs-->2; - if (i >= 2) inp2 = inputobjs-->3; - - ! inp1 and inp2 hold: object numbers, or 0 for "multiple object", - ! or 1 for "a number or dictionary address" - - if (inp1 == 1) noun = special_number1; else noun = inp1; - if (inp2 == 1) { - if (inp1 == 1) second = special_number2; - else second = special_number1; - } - else second = inp2; - - ! ------------------------------------------------------------- - -!print "inp1: ", (name) inp1, "^"; -!print "inp2: ", (name) inp2, "^"; -!print "inputobjs-->1: ", (name) inputobjs-->1, "^"; -!print "inputobjs-->2: ", (name) inputobjs-->2, "^"; -!print "inputobjs-->3: ", (name) inputobjs-->3, "^"; -!print "noun: ", (name) noun, "^"; -!print "second: ", (name) second, "^"; -!print "actor: ", (name) actor, "^"; -!print "---^"; - - ! -------------------------------------------------------------- - ! Generate the action... - - if ((i == 0) || - (i == 1 && inp1 ~= 0) || - (i == 2 && inp1 ~= 0 && inp2 ~= 0)) { - - if (actor ~= player) { - switch (self.actor_act(actor, action, noun, second)) { - ACTOR_ACT_ABORT_NOTUNDERSTOOD: jump begin__action; - default: jump turn__end; - } - - } - - - self.begin_action(action, noun, second, 0); - jump turn__end; - } - - ! ...unless a multiple object must be substituted. First: - ! (a) check the multiple list isn't empty; - ! (b) warn the player if it has been cut short because too long; - ! (c) generate a sequence of actions from the list - ! (stopping in the event of death or movement away). - - multiflag = true; - j = multiple_object-->0; - if (j == 0) { - L__M(##Miscellany, 2); - jump late__error; - } - if (toomany_flag) { - toomany_flag = false; - L__M(##Miscellany, 1); - } - i = location; - for (k=1 : k<=j : k++) { - if (deadflag) break; - if (location ~= i) { - L__M(##Miscellany, 51); - break; - } - l = multiple_object-->k; - PronounNotice(l); - print (name) l, (string) COLON__TX; - if (inp1 == 0) { - inp1 = l; - switch (self.actor_act(actor, action, l, second)) { - ACTOR_ACT_ABORT_NOTUNDERSTOOD: jump begin__action; - ACTOR_ACT_ABORT_ORDER: jump turn__end; - } - inp1 = 0; - } - else { - inp2 = l; - if (self.actor_act(actor, action, noun, l) == ACTOR_ACT_ABORT_NOTUNDERSTOOD) - jump begin__action; - inp2 = 0; - } - } - - ! -------------------------------------------------------------- - - .turn__end; - - ! No time passes if either (i) the verb was meta, or - ! (ii) we've only had the implicit take before the "real" - ! action to follow. - - if (notheld_mode == 1) { NoteObjectAcquisitions(); continue; } - if (meta) continue; - if (~~deadflag) self.end_turn_sequence(); - else if (START_MOVE ~= 1) turns++; - } ! end of while() - - if (deadflag ~= 2 && AfterLife() == false) - LibraryExtensions.RunAll(ext_afterlife); - if (deadflag == 0) jump very__late__error; - GameEpilogue(); - ], ! end of 'play' property - - end_turn_sequence [; - AdvanceWorldClock(); if (deadflag) return; - RunTimersAndDaemons(); if (deadflag) return; - RunEachTurnProperties(); if (deadflag) return; - if (TimePasses() == 0) LibraryExtensions.RunAll(ext_timepasses); - if (deadflag) return; - AdjustLight(); if (deadflag) return; - NoteObjectAcquisitions(); - ], - - ! The first time we call self.actor_act(), set the fifth - ! parameter to true. Details can be seen in - ! 1d95759b1bd6674509d6cf9161e6db3da3831f10 and in Issues #23 and - ! #30 (Mantis 1813 and 1885) - actor_act [ p a n s ft j sp sa sn ss; - sp = actor; actor = p; - if (p ~= player) { - ! The player's "orders" property can refuse to allow - ! conversation here, by returning true. If not, the order is - ! sent to the other person's "orders" property. If that also - ! returns false, then: if it was a misunderstood command - ! anyway, it is converted to an Answer action (thus - ! "floyd, grrr" ends up as "say grrr to floyd"). If it was a - ! good command, it is finally offered to the Order: part of - ! the other person's "life" property, the old-fashioned - ! way of dealing with conversation. - - sa = action; sn = noun; ss = second; - action = a; noun = n; second = s; - j = RunRoutines(player, orders); - if (j == 0) { - j = RunRoutines(actor, orders); - if (j == 0) { - if (action == ##NotUnderstood) { - inputobjs-->3 = actor; actor = player; action = ##Answer; - ! abort, not resetting action globals - return ACTOR_ACT_ABORT_NOTUNDERSTOOD; - } - if (RunLife(actor, ##Order) == 0) { - L__M(##Order, 1, actor); - if (~~ft) - return ACTOR_ACT_ABORT_ORDER; - } - } - } - action = sa; noun = sn; second = ss; - if (ft) - return ACTOR_ACT_ABORT_ORDER; - } - else - if (~~ft) - self.begin_action(a, n, s, 0); - - actor = sp; - return ACTOR_ACT_OK; - ], - - begin_action [ a n s source sa sn ss; - sa = action; sn = noun; ss = second; - action = a; noun = n; second = s; - #Ifdef DEBUG; - if (debug_flag & DEBUG_ACTIONS) TraceAction(source); - #Ifnot; - source = 0; - #Endif; ! DEBUG - - #Iftrue (Grammar__Version == 1); - if ((meta || BeforeRoutines() == false) && action < 256) { - #Ifdef INFIX; - if (infix_verb) { - if (BeforeRoutines() == false) - ActionPrimitive(); - } else ActionPrimitive(); - #Ifnot; - ActionPrimitive(); - #Endif; - } - #Ifnot; - if ((meta || BeforeRoutines() == false) && action < 4096) { - #Ifdef INFIX; - if (infix_verb) { - if (BeforeRoutines() == false) - ActionPrimitive(); - } else ActionPrimitive(); - #Ifnot; - ActionPrimitive(); - #Endif; - } - #Endif; ! Grammar__Version - action = sa; noun = sn; second = ss; - ], - has proper; - -! ---------------------------------------------------------------------------- -! Routines called before and after main 'play' loop - -[ GamePrologue i j; - before_first_turn = true; - for (i=1 : i<=100 : i++) j = random(i); - - ChangeDefault(cant_go, CANTGO__TX); - - real_location = thedark; - player = selfobj; actor = player; - selfobj.capacity = MAX_CARRIED; ! ### change? - - #Ifdef LanguageInitialise; - LanguageInitialise(); - #Endif; ! LanguageInitialise - - #Ifdef EnglishNaturalLanguage; - old_itobj = itobj; old_himobj = himobj; old_herobj = herobj; - #Endif;! EnglishNaturalLanguage - - new_line; - LibraryExtensions.RunAll(ext_initialise); - j = Initialise(); - last_score = score; - initial_lookmode = lookmode; - - objectloop (i in player) give i moved ~concealed; - move player to location; - while (parent(location)) location = parent(location); - real_location = location; - MoveFloatingObjects(); - - actor = player; ! resync, because player may have been changed in Initialise() - actors_location = location; - - lightflag = OffersLight(parent(player)); - if (lightflag == 0) location = thedark; - - if (j ~= 2) Banner(); -#ifndef NOINITIAL_LOOK; - ; -#endif; - before_first_turn = false; -]; - -[ GameEpilogue; - print "^^ "; - #Ifdef TARGET_ZCODE; - #IfV5; style bold; #Endif; ! V5 - #Ifnot; ! TARGET_GLULX - glk_set_style(style_Alert); - #Endif; ! TARGET_ - print "***"; - switch (deadflag) { - 1: L__M(##Miscellany, 3); - 2: L__M(##Miscellany, 4); - default: print " "; - if (DeathMessage() == false) - LibraryExtensions.RunAll(ext_deathmessage); - print " "; - } - print "***"; - #Ifdef TARGET_ZCODE; - #IfV5; style roman; #Endif; ! V5 - #Ifnot; ! TARGET_GLULX - glk_set_style(style_Normal); - #Endif; ! TARGET_ - print "^^"; - #Ifndef NO_SCORE; - print "^"; - #Endif; ! NO_SCORE - Epilogue(); - ScoreSub(); - DisplayStatus(); - AfterGameOver(); -]; - -! ---------------------------------------------------------------------------- -! Routines called at end of each turn - -[ AdvanceWorldClock; - turns++; - if (the_time ~= NULL) { - if (time_rate >= 0) the_time=the_time+time_rate; - else { - time_step--; - if (time_step == 0) { - the_time++; - time_step = -time_rate; - } - } - the_time = the_time % 1440; - } -]; - -[ RunTimersAndDaemons i j; - #Ifdef DEBUG; - if (debug_flag & DEBUG_TIMERS) { - for (i=0 : ii; - if (j ~= 0) { - print (name) (j&~WORD_HIGHBIT), ": "; - if (j & WORD_HIGHBIT) print "daemon"; - else - print "timer with ", j.time_left, " turns to go"; - new_line; - } - } - } - #Endif; ! DEBUG - - for (i=0 : ii; - if (j ~= 0) { - if (j & WORD_HIGHBIT) RunRoutines(j&~WORD_HIGHBIT, daemon); - else { - if (j.time_left == 0) { - StopTimer(j); - RunRoutines(j, time_out); - } - else - j.time_left = j.time_left-1; - } - } - } -]; - -[ RunEachTurnProperties; - scope_reason = EACH_TURN_REASON; verb_word = 0; - DoScopeAction(location); - SearchScope(ScopeCeiling(player), player, 0); - scope_reason = PARSING_REASON; -]; - -! ---------------------------------------------------------------------------- - -#Ifdef TARGET_ZCODE; - -[ ActionPrimitive; (#actions_table-->action)(); ]; - -#Ifnot; ! TARGET_GLULX - -[ ActionPrimitive; (#actions_table-->(action+1))(); ]; - -#Endif; ! TARGET_ - -[ AfterGameOver i amus_ret; - - .RRQPL; - - L__M(##Miscellany,5); - - .RRQL; - - L__M(##Prompt); - #Ifdef TARGET_ZCODE; - #IfV3; read buffer parse; #Endif; ! V3 - temp_global=0; - #IfV5; read buffer parse DrawStatusLine; #Endif; ! V5 - #Ifnot; ! TARGET_GLULX - KeyboardPrimitive(buffer, parse); - #Endif; ! TARGET_ - i = parse-->1; - if (i == QUIT1__WD or QUIT2__WD) { - #Ifdef TARGET_ZCODE; - quit; - #Ifnot; ! TARGET_GLULX - quit; - #Endif; ! TARGET_ - } - if (i == RESTART__WD) { - #Ifdef TARGET_ZCODE; - @restart; - #Ifnot; ! TARGET_GLULX - @restart; - #Endif; ! TARGET_ - } - if (i == RESTORE__WD) { - RestoreSub(); - jump RRQPL; - } - if (i == FULLSCORE1__WD or FULLSCORE2__WD && TASKS_PROVIDED==0) { - new_line; FullScoreSub(); - jump RRQPL; - } - if (deadflag == 2 && i == AMUSING__WD) { - amus_ret = false; - if (AMUSING_PROVIDED == 0) { - new_line; - amus_ret = Amusing(); - } - if (amus_ret == false) LibraryExtensions.RunAll(ext_amusing); - jump RRQPL; - } - #IfV5; - if (i == UNDO1__WD or UNDO2__WD or UNDO3__WD) { - i = PerformUndo(); - if (i == 0) jump RRQPL; - } - #Endif; ! V5 - L__M(##Miscellany, 8); - jump RRQL; -]; - -[ NoteObjectAcquisitions i; - objectloop (i in player) - if (i hasnt moved) { - give i moved; - if (i has scored) { - score = score + OBJECT_SCORE; - things_score = things_score + OBJECT_SCORE; - } - } -]; - -! ---------------------------------------------------------------------------- -! R_Process is invoked by the <...> and <<...>> statements, whose syntax is: -! ! traditional -! ! introduced at compiler 6.33 - -[ R_Process a n s p - s1 s2 s3; - s1 = inp1; s2 = inp2; s3 = actor; - inp1 = n; inp2 = s; if (p) actor = p; else actor = player; - InformLibrary.begin_action(a, n, s, 1); - inp1 = s1; inp2 = s2; actor = s3; -]; - -! ---------------------------------------------------------------------------- - -[ TestScope obj act a al sr x y; - x = parser_one; y = parser_two; - parser_one = obj; parser_two = 0; a = actor; al = actors_location; - sr = scope_reason; scope_reason = TESTSCOPE_REASON; - if (act == 0) actor = player; else actor = act; - actors_location = ScopeCeiling(actor); - SearchScope(actors_location, actor, 0); scope_reason = sr; actor = a; - actors_location = al; parser_one = x; x = parser_two; parser_two = y; - return x; -]; - -[ LoopOverScope routine act x y a al; - x = parser_one; y = scope_reason; a = actor; al = actors_location; - parser_one = routine; - if (act == 0) actor = player; else actor = act; - actors_location = ScopeCeiling(actor); - scope_reason = LOOPOVERSCOPE_REASON; - SearchScope(actors_location, actor, 0); - parser_one = x; scope_reason = y; actor = a; actors_location = al; -]; - -[ BeforeRoutines rv; - if (GamePreRoutine()) rtrue; - if (rv == false) rv=LibraryExtensions.RunWhile(ext_gamepreroutine, 0); - if (rv) rtrue; - if (RunRoutines(player, orders)) rtrue; - scope_reason = REACT_BEFORE_REASON; parser_one = 0; - SearchScope(ScopeCeiling(player), player, 0); - scope_reason = PARSING_REASON; - if (parser_one) rtrue; - if (location && RunRoutines(location, before)) rtrue; - if (inp1 > 1 && RunRoutines(inp1, before)) rtrue; - rfalse; -]; - -[ AfterRoutines rv; - scope_reason = REACT_AFTER_REASON; parser_one = 0; - SearchScope(ScopeCeiling(player), player, 0); scope_reason = PARSING_REASON; - if (parser_one) rtrue; - if (location && RunRoutines(location, after)) rtrue; - if (inp1 > 1 && RunRoutines(inp1, after)) rtrue; - rv = GamePostRoutine(); - if (rv == false) rv=LibraryExtensions.RunWhile(ext_gamepostroutine, false); - return rv; -]; - -[ RunLife a j; - #Ifdef DEBUG; - if (debug_flag & DEBUG_ACTIONS) TraceAction(2, j); - #Endif; ! DEBUG - reason_code = j; return RunRoutines(a,life); -]; - -[ ZRegion addr; - switch (metaclass(addr)) { ! Left over from Inform 5 - nothing: return 0; - Object, Class: return 1; - Routine: return 2; - String: return 3; - } -]; - -[ PrintOrRun obj prop flag; - if (obj.#prop > WORDSIZE) return RunRoutines(obj, prop); - if (obj.prop == NULL) rfalse; - switch (metaclass(obj.prop)) { - Class, Object, nothing: - return RunTimeError(2,obj,prop); - String: - print (string) obj.prop; - if (flag == 0) new_line; - rtrue; - Routine: - return RunRoutines(obj, prop); - } -]; - -[ PrintOrRunVar var flag; - switch (metaclass(var)) { - Object: - print (name) var; - String: - print (string) var; - if (flag == 0) new_line; - Routine: - return var(); - default: - print (char) '(', var, (char) ')'; - } - rtrue; -]; - -[ ValueOrRun obj prop; - !### this is entirely unlikely to work. Does anyone care? (AP) - ! Well, it's certainly used three times in verblibm.h (RF) - ! Update: now not used (RF) - if (obj.prop < 256) return obj.prop; - return RunRoutines(obj, prop); -]; - -[ RunRoutines obj prop; - if (obj == thedark && prop ~= initial or short_name or description) obj = real_location; - if (obj.&prop == 0 && prop >= INDIV_PROP_START) rfalse; - return obj.prop(); -]; - -#Ifdef TARGET_ZCODE; - -[ ChangeDefault prop val a b; - ! Use assembly-language here because -S compilation won't allow this: - @loadw 0 5 -> a; - b = prop-1; - @storew a b val; -]; - -#Ifnot; ! TARGET_GLULX - -[ ChangeDefault prop val; - ! Use assembly-language here because -S compilation won't allow this: - ! #cpv__start-->prop = val; - @astore #cpv__start prop val; -]; - -#Endif; ! TARGET_ - -! ---------------------------------------------------------------------------- - -[ StartTimer obj timer i; - for (i=0 : ii == obj) rfalse; - for (i=0 : ii == 0) jump FoundTSlot; - i = active_timers++; - if (i >= MAX_TIMERS) { RunTimeError(4); return; } - .FoundTSlot; - if (obj.&time_left == 0) { RunTimeError(5, obj, time_left); return; } - the_timers-->i = obj; obj.time_left = timer; -]; - -[ StopTimer obj i; - for (i=0 : ii == obj) jump FoundTSlot2; - rfalse; - .FoundTSlot2; - if (obj.&time_left == 0) { RunTimeError(5, obj, time_left); return; } - the_timers-->i = 0; obj.time_left = 0; -]; - -[ StartDaemon obj i; - for (i=0 : ii == WORD_HIGHBIT + obj) rfalse; - for (i=0 : ii == 0) jump FoundTSlot3; - i = active_timers++; - if (i >= MAX_TIMERS) RunTimeError(4); - .FoundTSlot3; - the_timers-->i = WORD_HIGHBIT + obj; -]; - -[ StopDaemon obj i; - for (i=0 : ii == WORD_HIGHBIT + obj) jump FoundTSlot4; - rfalse; - .FoundTSlot4; - the_timers-->i = 0; -]; - -! ---------------------------------------------------------------------------- - -[ DisplayStatus; - if (sys_statusline_flag == 0) { sline1 = score; sline2 = turns; } - else { sline1 = the_time/60; sline2 = the_time%60;} -]; - -[ SetTime t s; - the_time = t; time_rate = s; time_step = 0; - if (s < 0) time_step = 0-s; -]; - -[ NotifyTheScore; - #Ifdef TARGET_GLULX; - glk_set_style(style_Note); - #Endif; ! TARGET_GLULX - print "^["; L__M(##Miscellany, 50, score-last_score); print ".]^"; - #Ifdef TARGET_GLULX; - glk_set_style(style_Normal); - #Endif; ! TARGET_GLULX -]; - -! ---------------------------------------------------------------------------- - -[ AdjustLight flag i; - i = lightflag; - lightflag = OffersLight(parent(player)); - - if (i == 0 && lightflag == 1) { - location = real_location; - if (flag == 0) ; - } - - if (i == 1 && lightflag == 0) { - real_location = location; location = thedark; - if (flag == 0) { - NoteArrival(); - return L__M(##Miscellany, 9); - } - } - if (i == 0 && lightflag == 0) location = thedark; -]; - -[ OffersLight i j; - if (i == 0) rfalse; - if (i has light) rtrue; - objectloop (j in i) - if (HasLightSource(j) == 1) rtrue; - if (i has container) { - if (i has open || i has transparent) - return OffersLight(parent(i)); - } - else { - if (i has enterable || i has transparent || i has supporter) - return OffersLight(parent(i)); - } - rfalse; -]; - -[ HidesLightSource obj; - if (obj == player) rfalse; - if (obj has transparent or supporter) rfalse; - if (obj has container) return (obj hasnt open); - return (obj hasnt enterable); -]; - -[ HasLightSource i j ad; - if (i == 0) rfalse; - if (i has light) rtrue; - if (i has enterable || IsSeeThrough(i) == 1) - if (~~(HidesLightSource(i))) - objectloop (j in i) - if (HasLightSource(j) == 1) rtrue; - ad = i.&add_to_scope; - if (parent(i) ~= 0 && ad ~= 0) { - if (metaclass(ad-->0) == Routine) { - ats_hls = 0; ats_flag = 1; - RunRoutines(i, add_to_scope); - ats_flag = 0; if (ats_hls == 1) rtrue; - } - else { - for (j=0 : (WORDSIZE*j)j) == 1) rtrue; - } - } - rfalse; -]; - -[ ChangePlayer obj flag i; -! if (obj.&number == 0) return RunTimeError(7, obj); - - if (obj == nothing) obj = selfobj; - if (actor == player) actor=obj; - give player ~transparent ~concealed; - i = obj; while (parent(i) ~= 0) { - if (i has animate) give i transparent; - i = parent(i); - } - if (player == selfobj && player provides nameless && player.nameless == true) { - if (player provides narrative_voice) { - if (player.narrative_voice == 1) { - player.short_name = MYFORMER__TX; - (player.&name)-->0 = 'my'; - (player.&name)-->1 = 'former'; - (player.&name)-->2 = 'self'; - } else if (player.narrative_voice == 2) { - player.short_name = FORMER__TX; - (player.&name)-->0 = 'my'; - (player.&name)-->1 = 'former'; - (player.&name)-->2 = 'self'; - } - } - } - - - player = obj; - - give player transparent concealed animate; - i = player; while (parent(i) ~= 0) i = parent(i); - location = i; real_location = location; - if (parent(player) == 0) return RunTimeError(10); - MoveFloatingObjects(); - lightflag = OffersLight(parent(player)); - if (lightflag == 0) location = thedark; - print_player_flag = flag; -]; - -! ---------------------------------------------------------------------------- - -#Ifdef DEBUG; - -#Ifdef TARGET_ZCODE; - -[ DebugParameter w; - print w; - if (w >= 1 && w <= top_object) print " (", (name) w, ")"; - if (UnsignedCompare(w, dict_start) >= 0 && - UnsignedCompare(w, dict_end) < 0 && - (w - dict_start) % dict_entry_size == 0) - print " ('", (address) w, "')"; -]; - -[ DebugAction a anames; - #Iftrue (Grammar__Version == 1); - if (a >= 256) { print ""; return; } - #Ifnot; - if (a >= 4096) { print ""; return; } - #Endif; ! Grammar__Version - anames = #identifiers_table; - anames = anames + 2*(anames-->0) + 2*48; - print (string) anames-->a; -]; - -[ DebugAttribute a anames; - if (a < 0 || a >= 48) print ""; - else { - anames = #identifiers_table; anames = anames + 2*(anames-->0); - print (string) anames-->a; - } -]; - -#Ifnot; ! TARGET_GLULX - -[ DebugParameter w endmem; - print w; - @getmemsize endmem; - if (w >= 1 && w < endmem) { - if (w->0 >= $70 && w->0 < $7F) print " (", (name) w, ")"; - if (w->0 >= $60 && w->0 < $6F) print " ('", (address) w, "')"; - } -]; - -[ DebugAction a str; - if (a >= 4096) { print ""; return; } - if (a < 0 || a >= #identifiers_table-->7) print ""; - else { - str = #identifiers_table-->6; - str = str-->a; - if (str) print (string) str; else print ""; - } -]; - -[ DebugAttribute a str; - if (a < 0 || a >= NUM_ATTR_BYTES*8) print ""; - else { - str = #identifiers_table-->4; - str = str-->a; - if (str) print (string) str; else print ""; - } -]; - -#Endif; ! TARGET_ - -[ TraceAction source ar; - if (source < 2) print "[ Action ", (DebugAction) action; - else { - if (ar == ##Order) - print "[ Order to ", (name) actor, ": ", (DebugAction) action; - else - print "[ Life rule ", (DebugAction) ar; - } - if (noun ~= 0) print " with noun ", (DebugParameter) noun; - if (second ~= 0) print " and second ", (DebugParameter) second; - if (source == 0) print " "; - if (source == 1) print " (from < > statement) "; - print "]^"; -]; - -[ DebugToken token; - AnalyseToken(token); - switch (found_ttype) { - ILLEGAL_TT: - print ""; - ELEMENTARY_TT: - switch (found_tdata) { - NOUN_TOKEN: print "noun"; - HELD_TOKEN: print "held"; - MULTI_TOKEN: print "multi"; - MULTIHELD_TOKEN: print "multiheld"; - MULTIEXCEPT_TOKEN: print "multiexcept"; - MULTIINSIDE_TOKEN: print "multiinside"; - CREATURE_TOKEN: print "creature"; - SPECIAL_TOKEN: print "special"; - NUMBER_TOKEN: print "number"; - TOPIC_TOKEN: print "topic"; - ENDIT_TOKEN: print "END"; - } - PREPOSITION_TT: - print "'", (address) found_tdata, "'"; - ROUTINE_FILTER_TT: - #Ifdef INFIX; - print "noun=", (InfixPrintPA) found_tdata; - #Ifnot; - print "noun=Routine(", found_tdata, ")"; - #Endif; ! INFIX - ATTR_FILTER_TT: - print (DebugAttribute) found_tdata; - SCOPE_TT: - #Ifdef INFIX; - print "scope=", (InfixPrintPA) found_tdata; - #Ifnot; - print "scope=Routine(", found_tdata, ")"; - #Endif; ! INFIX - GPR_TT: - #Ifdef INFIX; - print (InfixPrintPA) found_tdata; - #Ifnot; - print "Routine(", found_tdata, ")"; - #Endif; ! INFIX - } -]; - -[ DebugGrammarLine pcount; - print " * "; - for (: line_token-->pcount ~= ENDIT_TOKEN : pcount++) { - if ((line_token-->pcount)->0 & $10) print "/ "; - print (DebugToken) line_token-->pcount, " "; - } - print "-> ", (DebugAction) action_to_be; - if (action_reversed) print " reverse"; -]; - -#Ifdef TARGET_ZCODE; - -[ ShowVerbSub grammar lines j; - if (noun == 0 || ((noun->#dict_par1) & DICT_VERB) == 0) - "Try typing ~showverb~ and then the name of a verb."; - print "Verb"; - if ((noun->#dict_par1) & DICT_META) print " meta"; - for (j=dict_start : j#dict_par2 == noun->#dict_par2) - print " '", (address) j, "'"; - new_line; - grammar = (HDR_STATICMEMORY-->0)-->($ff-(noun->#dict_par2)); - lines = grammar->0; - grammar++; - if (lines == 0) "has no grammar lines."; - for (: lines>0 : lines--) { - grammar = UnpackGrammarLine(grammar); - print " "; DebugGrammarLine(); new_line; - } -]; - -#Ifnot; ! TARGET_GLULX - -[ ShowVerbSub grammar lines j wd dictlen entrylen; - if (noun == 0 || ((noun->#dict_par1) & DICT_VERB) == 0) - "Try typing ~showverb~ and then the name of a verb."; - print "Verb"; - if ((noun->#dict_par1) & DICT_META) print " meta"; - dictlen = #dictionary_table-->0; - entrylen = DICT_WORD_SIZE + 7; - for (j=0 : j#dict_par2 == noun->#dict_par2) - print " '", (address) wd, "'"; - } - new_line; - grammar = (#grammar_table)-->($ff-(noun->#dict_par2)+1); - lines = grammar->0; - grammar++; - if (lines == 0) "has no grammar lines."; - for (: lines>0 : lines--) { - grammar = UnpackGrammarLine(grammar); - print " "; DebugGrammarLine(); new_line; - } -]; - -#Endif; ! TARGET_ - -[ ShowObjSub c f l a n x numattr; - if (noun == 0) noun = location; - objectloop (c ofclass Class) if (noun ofclass c) { f++; l=c; } - if (f == 1) print (name) l, " ~"; else print "Object ~"; - print (name) noun, "~ (", noun, ")"; - if (parent(noun)) print " in ~", (name) parent(noun), "~ (", parent(noun), ")"; - new_line; - if (f > 1) { - print " class "; - objectloop (c ofclass Class) if (noun ofclass c) print (name) c, " "; - new_line; - } - #Ifdef TARGET_ZCODE; - numattr = 48; - #Ifnot; ! TARGET_GLULX - numattr = NUM_ATTR_BYTES * 8; - #Endif; ! TARGET_ - for (a=0,f=0 : a0; - #Ifnot; ! TARGET_GLULX - l = INDIV_PROP_START + #identifiers_table-->3; - #Endif; ! TARGET_ - for (a=1 : a<=l : a++) { - if ((a ~= 2 or 3) && noun.&a) { - if (f == 0) { print " with "; f=1; } - print (property) a; - n = noun.#a; - for (c=0 : WORDSIZE*cc; - if (a == name) print "'", (address) x, "'"; - else { - if (a == number or capacity or time_left) print x; - else { - switch (x) { - NULL: print "NULL"; - 0: print "0"; - 1: print "1"; - default: - switch (metaclass(x)) { - Class, Object: - print (name) x; - String: - print "~", (string) x, "~"; - Routine: - print "[...]"; - } - print " (", x, ")"; - } - } - } - } - print ",^ "; - } - } -! if (f==1) new_line; -]; - -[ ShowDictSub_helper x; print (address) x; ]; -[ ShowDictSub - dp el ne f x y z; - - #Ifdef TARGET_ZCODE; - dp = HDR_DICTIONARY-->0; ! start of dictionary - dp = dp + dp->0 + 1; ! skip over word-separators table - el = dp->0; dp = dp + 1; ! entry length - ne = dp-->0; dp = dp + WORDSIZE; ! number of entries - #Ifnot; ! TARGET_GLULX; - dp = #dictionary_table; ! start of dictionary - el = DICT_WORD_SIZE + 7; ! entry length - ne = dp-->0; dp = dp + WORDSIZE; ! number of entries - #Endif; ! TARGET_ - ! dp now at first entry - wn = 2; x = NextWordStopped(); - switch (x) { - 0: - "That word isn't in the dictionary."; - -1: - ; ! show all entries - THEN1__WD: - dp = './/'; ne = 1; ! show '.' - COMMA_WORD: - dp = ',//'; ne = 1; ! show ',' - default: - dp = x; ne = 1; f = true; ! show specified entry, plus associated objects - } - for ( : ne-- : dp=dp+el) { - print (address) dp, " --> "; - x = dp->#dict_par1; ! flag bits - y = PrintToBuffer(StorageForShortName, SHORTNAMEBUF_LEN, ShowDictSub_helper, dp) + WORDSIZE; - for (z=WORDSIZE : zz = UpperCase(StorageForShortName->z); - if (y > WORDSIZE+1 && StorageForShortName->z == ' ' or '.' or ',') x = x | $8000; - print (char) StorageForShortName->z; - } - print " --> "; - if (x == 0) - print " no flags"; - else { - !if (x & $0040) print " BIT_6"; - !if (x & $0020) print " BIT_5"; - !if (x & $0010) print " BIT_4"; - if (x & $8000) print " UNTYPEABLE"; - if (x & DICT_NOUN) print " noun"; - if (x & DICT_PLUR) print "+plural"; - if (x & DICT_VERB) print " verb"; - if (x & DICT_META) print "+meta"; - if (x & DICT_PREP) print " preposition"; - if (f && (x & DICT_NOUN)) { - print " --> refers to these objects:"; - objectloop (x) - if (WordInProperty(dp, x, name)) print "^ ", (name) x, " (", x, ")"; - } - } - new_line; - } -]; - -#Endif; ! DEBUG - -! ---------------------------------------------------------------------------- -! Miscellaneous display routines used by DrawStatusLine and available for -! user. Most of these vary according to which machine is being compiled to -! ---------------------------------------------------------------------------- - -#Ifdef TARGET_ZCODE; - -[ ClearScreen window; - switch (window) { - WIN_ALL: @erase_window -1; - WIN_STATUS: @erase_window 1; - WIN_MAIN: @erase_window 0; - } -]; - -#Iftrue (#version_number == 6); -[ MoveCursorV6 line column charw; ! 1-based postion on text grid - @get_wind_prop 1 13 -> charw; ! font size - charw = charw & $FF; - line = 1 + charw*(line-1); - column = 1 + charw*(column-1); - @set_cursor line column; -]; -#Endif; - -#Ifndef MoveCursor; -[ MoveCursor line column; ! 1-based postion on text grid - if (~~statuswin_current) { - @set_window 1; - #Ifdef COLOUR; - if (clr_on && clr_bgstatus > 1) - @set_colour clr_fgstatus clr_bgstatus; - else - #Endif; ! COLOUR - style reverse; - } - if (line == 0) { line = 1; column = 1; } - #Iftrue (#version_number == 6); - MoveCursorV6(line, column); - #Ifnot; - @set_cursor line column; - #Endif; - statuswin_current = true; -]; -#Endif; - -[ MainWindow; - if (statuswin_current) { -#Ifdef COLOUR; - if (clr_on && clr_bgstatus > 1) @set_colour clr_fg clr_bg; - else -#Endif; ! COLOUR - style roman; - @set_window 0; - } - statuswin_current = false; -]; - -#Iftrue (#version_number == 6); -[ ScreenWidth width charw; - @get_wind_prop 1 3 -> width; - @get_wind_prop 1 13 -> charw; - charw = charw & $FF; - if (charw == 0) return width; - return (width+charw-1) / charw; -]; -#Ifnot; -[ ScreenWidth; - return (HDR_SCREENWCHARS->0); -]; -#Endif; - -[ ScreenHeight; - return (HDR_SCREENHLINES->0); -]; - -#Iftrue (#version_number == 6); -[ StatusLineHeight height wx wy x y charh; - ! Split the window. Standard 1.0 interpreters should keep the window 0 - ! cursor in the same absolute position, but older interpreters, - ! including Infocom's don't - they keep the window 0 cursor in the - ! same position relative to its origin. We therefore compensate - ! manually. - @get_wind_prop 0 0 -> wy; @get_wind_prop 0 1 -> wx; - @get_wind_prop 0 13 -> charh; @log_shift charh $FFF8 -> charh; - @get_wind_prop 0 4 -> y; @get_wind_prop 0 5 -> x; - height = height * charh; - @split_window height; - y = y - height + wy - 1; - if (y < 1) y = 1; - x = x + wx - 1; - @set_cursor y x 0; - gg_statuswin_cursize = height; -]; -#Ifnot; -[ StatusLineHeight height; - if (gg_statuswin_cursize ~= height) - @split_window height; - gg_statuswin_cursize = height; -]; -#Endif; - -#Ifdef COLOUR; -[ SetColour f b window; - if (window == 0) { ! if setting both together, set reverse - clr_fgstatus = b; - clr_bgstatus = f; - } - if (window == 1) { - clr_fgstatus = f; - clr_bgstatus = b; - } - if (window == 0 or 2) { - clr_fg = f; - clr_bg = b; - } - if (clr_on) { - if (statuswin_current) - @set_colour clr_fgstatus clr_bgstatus; - else - @set_colour clr_fg clr_bg; - } -]; -#Endif; ! COLOUR - - -#Ifnot; ! TARGET_GLULX - -[ ClearScreen window; - if (window == WIN_ALL or WIN_MAIN) { - glk_window_clear(gg_mainwin); - if (gg_quotewin) { - glk_window_close(gg_quotewin, 0); - gg_quotewin = 0; - } - } - if (gg_statuswin && window == WIN_ALL or WIN_STATUS) - glk_window_clear(gg_statuswin); -]; - -[ MoveCursor line column; ! 0-based postion on text grid - if (gg_statuswin) { - glk_set_window(gg_statuswin); - } - if (line == 0) { line = 1; column = 1; } - glk_window_move_cursor(gg_statuswin, column-1, line-1); - statuswin_current=1; -]; - -[ MainWindow; - glk_set_window(gg_mainwin); - statuswin_current=0; -]; - -[ MakeColourWord c; - if (c > 9) return c; - c = c-2; - return $ff0000*(c&1) + $ff00*(c&2 ~= 0) + $ff*(c&4 ~= 0); -]; - -[ ScreenWidth id; - id=gg_mainwin; - if (gg_statuswin && statuswin_current) id = gg_statuswin; - glk_window_get_size(id, gg_arguments, 0); - return gg_arguments-->0; -]; - -[ ScreenHeight; - glk_window_get_size(gg_mainwin, 0, gg_arguments); - return gg_arguments-->0; -]; - -#Ifdef COLOUR; -[ SetColour f b window doclear i fwd bwd swin; - if (window) swin = 5-window; ! 4 for TextGrid, 3 for TextBuffer - - if (clr_on) { - fwd = MakeColourWord(f); - bwd = MakeColourWord(b); - for (i=0 : i<=10: i++) { - if (f == CLR_DEFAULT || b == CLR_DEFAULT) { ! remove style hints - glk_stylehint_clear(swin, i, 7); - glk_stylehint_clear(swin, i, 8); - } - else { - glk_stylehint_set(swin, i, 7, fwd); - glk_stylehint_set(swin, i, 8, bwd); - } - } - ! Now re-open the windows to apply the hints - if (gg_statuswin) glk_window_close(gg_statuswin, 0); - - if (doclear || ( window ~= 1 && (clr_fg ~= f || clr_bg ~= b) ) ) { - glk_window_close(gg_mainwin, 0); - gg_mainwin = glk_window_open(0, 0, 0, 3, GG_MAINWIN_ROCK); - if (gg_scriptstr ~= 0) - glk_window_set_echo_stream(gg_mainwin, gg_scriptstr); - } - - gg_statuswin = glk_window_open($12, gg_statuswin_cursize, - 4, GG_STATUSWIN_ROCK); - if (statuswin_current && gg_statuswin) - MoveCursor(); else MainWindow(); - } - - if (window ~= 2) { - clr_fgstatus = f; - clr_bgstatus = b; - } - if (window ~= 1) { - clr_fg = f; - clr_bg = b; - } -]; -#Endif; ! COLOUR -#Endif; ! TARGET_ - -#Ifndef COLOUR; -[ SetColour f b window doclear; - f = b = window = doclear = 0; -]; -#Endif; - -[ SetClr f b w; - SetColour (f, b, w); -]; - -[ RestoreColours; ! L61007, L61113 - gg_statuswin_cursize = -1; ! Force window split in StatusLineHeight() - #Ifdef COLOUR; - if (clr_on) { ! check colour has been used - SetColour(clr_fg, clr_bg, 2); ! make sure both sets of variables are restored - SetColour(clr_fgstatus, clr_bgstatus, 1, true); - ClearScreen(); - } - #Endif; - #Ifdef TARGET_ZCODE; - #Iftrue (#version_number == 6); ! request screen update - (0-->8) = (0-->8) | $$00000100; - #Endif; - #Endif; ! TARGET_ -]; - -! ---------------------------------------------------------------------------- -! Except in Version 3, the DrawStatusLine routine does just that: this is -! provided explicitly so that it can be Replace'd to change the style, and -! as written it emulates the ordinary Standard game status line, which is -! drawn in hardware -! ---------------------------------------------------------------------------- - -#Ifdef TARGET_ZCODE; - -#IfV5; - -#Iftrue (#version_number == 6); -[ DrawStatusLine width x charw scw mvw; - HDR_GAMEFLAGS-->0 = (HDR_GAMEFLAGS-->0) & ~$0004; - - StatusLineHeight(gg_statuswin_size); - ! Now clear the window. This isn't totally trivial. Our approach is to - ! select the fixed space font, measure its width, and print an appropriate - ! number of spaces. We round up if the screen isn't a whole number of - ! characters wide, and rely on window 1 being set to clip by default. - MoveCursor(1, 1); - @set_font 4 -> x; - width = ScreenWidth(); - spaces width; - ! Back to standard font for the display. We use output_stream 3 to - ! measure the space required, the aim being to get 50 characters - ! worth of space for the location name. - MoveCursor(1, 2); - @set_font 1 -> x; - if (location == thedark) - print (name) location; - else { - FindVisibilityLevels(); - if (visibility_ceiling == location) print (name) location; - else print (The) visibility_ceiling; - } - @get_wind_prop 1 3 -> width; - @get_wind_prop 1 13 -> charw; - charw = charw & $FF; - @output_stream 3 StorageForShortName; - print (string) SCORE__TX, "00000"; - @output_stream -3; scw = HDR_PIXELSTO3-->0 + charw; - @output_stream 3 StorageForShortName; - print (string) MOVES__TX, "00000"; - @output_stream -3; mvw = HDR_PIXELSTO3-->0 + charw; - if (width - scw - mvw >= 50*charw) { - x = 1+width-scw-mvw; - @set_cursor 1 x; print (string) SCORE__TX, sline1; - x = x+scw; - @set_cursor 1 x; print (string) MOVES__TX, sline2; - } - else { - @output_stream 3 StorageForShortName; - print "00000/00000"; - @output_stream -3; scw = HDR_PIXELSTO3-->0 + charw; - if (width - scw >= 50*charw) { - x = 1+width-scw; - @set_cursor 1 x; print sline1, "/", sline2; - } - } - ! Reselect roman, as Infocom's interpreters interpreters go funny - ! if reverse is selected twice. - MainWindow(); -]; - -#Endif; ! #version_number == 6 - -#Endif; ! V5 - -#Endif; ! TARGET_ZCODE - -#Ifndef DrawStatusLine; -[ DrawStatusLine width posa posb; - #Ifdef TARGET_GLULX; - ! If we have no status window, we must not try to redraw it. - if (gg_statuswin == 0) - return; - #Endif; - - ! If there is no player location, we shouldn't try to draw status window - if (location == nothing || parent(player) == nothing) - return; - - StatusLineHeight(gg_statuswin_size); - MoveCursor(1, 1); - - width = ScreenWidth(); - posa = width-26; posb = width-13; - spaces width; - - MoveCursor(1, 2); - if (location == thedark) { - print (name) location; - } - else { - FindVisibilityLevels(); - if (visibility_ceiling == location) - print (name) location; - else - print (The) visibility_ceiling; - } - - if (sys_statusline_flag && width > 53) { - MoveCursor(1, posa); - print (string) TIME__TX; - LanguageTimeOfDay(sline1, sline2); - } - else { - if (width > 66) { - #Ifndef NO_SCORE; - MoveCursor(1, posa); - print (string) SCORE__TX, sline1; - #Endif; - MoveCursor(1, posb); - print (string) MOVES__TX, sline2; - } - #Ifndef NO_SCORE; - if (width > 53 && width <= 66) { - MoveCursor(1, posb); - print sline1, "/", sline2; - } - #Endif; - } - - MainWindow(); ! set_window -]; -#Endif; - -#Ifdef TARGET_GLULX; - -[ StatusLineHeight hgt parwin; - if (gg_statuswin == 0) return; - if (hgt == gg_statuswin_cursize) return; - parwin = glk_window_get_parent(gg_statuswin); - glk_window_set_arrangement(parwin, $12, hgt, 0); - gg_statuswin_cursize = hgt; -]; - -[ Box__Routine maxwid arr ix lines lastnl parwin; - maxwid = 0; ! squash compiler warning - lines = arr-->0; - - if (gg_quotewin == 0) { - gg_arguments-->0 = lines; - ix = InitGlkWindow(GG_QUOTEWIN_ROCK); - if (ix == false) ix = LibraryExtensions.RunWhile(ext_InitGlkWindow, 0, GG_QUOTEWIN_ROCK); - if (ix == false) - gg_quotewin = glk_window_open(gg_mainwin, $12, lines, 3, - GG_QUOTEWIN_ROCK); ! window_open - } - else { - parwin = glk_window_get_parent(gg_quotewin); - glk_window_set_arrangement(parwin, $12, lines, 0); - } - - lastnl = true; - if (gg_quotewin) { - glk_window_clear(gg_quotewin); - glk_set_window(gg_quotewin); - lastnl = false; - } - - ! If gg_quotewin is zero here, the quote just appears in the story window. - - glk_set_style(style_BlockQuote); - for (ix=0 : ix(ix+1); - if (ix < lines-1 || lastnl) new_line; - } - glk_set_style(style_Normal); - - if (gg_quotewin) { - glk_set_window(gg_mainwin); - } -]; - -#Endif; ! TARGET_GLULX - - -#Ifdef TARGET_ZCODE; - -[ ZZInitialise; - standard_interpreter = HDR_TERPSTANDARD-->0; - transcript_mode = ((HDR_GAMEFLAGS-->0) & $0001); - sys_statusline_flag = ( (HDR_TERPFLAGS->0) & $0002 ) / 2; - top_object = #largest_object-255; - - dict_start = HDR_DICTIONARY-->0; - dict_entry_size = dict_start->(dict_start->0 + 1); - dict_start = dict_start + dict_start->0 + 4; - dict_end = dict_start + (dict_start - 2)-->0 * dict_entry_size; - #Ifdef DEBUG; - if (dict_start > 0 && dict_end < 0 && - ((-dict_start) - dict_end) % dict_entry_size == 0) - print "** Warning: grammar properties might not work correctly **^"; - #Endif; ! DEBUG - - buffer->0 = INPUT_BUFFER_LEN - WORDSIZE; - buffer2->0 = INPUT_BUFFER_LEN - WORDSIZE; - buffer3->0 = INPUT_BUFFER_LEN - WORDSIZE; - parse->0 = MAX_BUFFER_WORDS; - parse2->0 = MAX_BUFFER_WORDS; -]; - -#Ifnot; ! TARGET_GLULX; - -[ GGInitialise res; - @gestalt 4 2 res; ! Test if this interpreter has Glk. - if (res == 0) { - ! Without Glk, we're entirely screwed. - quit; - } - ! Set the VM's I/O system to be Glk. - @setiosys 2 0; - - ! First, we must go through all the Glk objects that exist, and see - ! if we created any of them. One might think this strange, since the - ! program has just started running, but remember that the player might - ! have just typed "restart". - - GGRecoverObjects(); - res = InitGlkWindow(0); - if (res == false) res = LibraryExtensions.RunWhile(ext_InitGlkWindow, 0, 0); - if (res) return; - - ! Now, gg_mainwin and gg_storywin might already be set. If not, set them. - - if (gg_mainwin == 0) { - ! Open the story window. - res = InitGlkWindow(GG_MAINWIN_ROCK); - if (res == false) res = LibraryExtensions.RunWhile(ext_InitGlkWindow, 0, GG_MAINWIN_ROCK); - if (res == false) - gg_mainwin = glk_window_open(0, 0, 0, 3, GG_MAINWIN_ROCK); - if (gg_mainwin == 0) { - ! If we can't even open one window, there's no point in going on. - quit; - } - } - else { - ! There was already a story window. We should erase it. - glk_window_clear(gg_mainwin); - } - - if (gg_statuswin == 0) { - res = InitGlkWindow(GG_STATUSWIN_ROCK); - if (res == false) res = LibraryExtensions.RunWhile(ext_InitGlkWindow, 0, GG_STATUSWIN_ROCK); - if (res == false) { - gg_statuswin_cursize = gg_statuswin_size; - gg_statuswin = glk_window_open(gg_mainwin, $12, - gg_statuswin_cursize, 4, GG_STATUSWIN_ROCK); - } - } - ! It's possible that the status window couldn't be opened, in which case - ! gg_statuswin is now zero. We must allow for that later on. - - glk_set_window(gg_mainwin); - - if (InitGlkWindow(1) == false) LibraryExtensions.RunWhile(ext_InitGlkWindow, 0, 1); -]; - -[ GGRecoverObjects id; - ! If GGRecoverObjects() has been called, all these stored IDs are - ! invalid, so we start by clearing them all out. - ! (In fact, after a restoreundo, some of them may still be good. - ! For simplicity, though, we assume the general case.) - gg_mainwin = 0; - gg_statuswin = 0; - gg_quotewin = 0; - gg_scriptfref = 0; - gg_scriptstr = 0; - gg_savestr = 0; - gg_statuswin_cursize = 0; - #Ifdef DEBUG; - gg_commandstr = 0; - gg_command_reading = false; - #Endif; ! DEBUG - ! Also tell the game to clear its object references. - if (IdentifyGlkObject(0) == false) LibraryExtensions.RunWhile(ext_identifyglkobject, 0, 0); - - id = glk_stream_iterate(0, gg_arguments); - while (id) { - switch (gg_arguments-->0) { - GG_SAVESTR_ROCK: gg_savestr = id; - GG_SCRIPTSTR_ROCK: gg_scriptstr = id; - #Ifdef DEBUG; - GG_COMMANDWSTR_ROCK: gg_commandstr = id; - gg_command_reading = false; - GG_COMMANDRSTR_ROCK: gg_commandstr = id; - gg_command_reading = true; - #Endif; ! DEBUG - default: if (IdentifyGlkObject(1, 1, id, gg_arguments-->0) == false) - LibraryExtensions.RunWhile(ext_identifyglkobject, false, 1, 1, id, gg_arguments-->0); - } - id = glk_stream_iterate(id, gg_arguments); - } - - id = glk_window_iterate(0, gg_arguments); - while (id) { - switch (gg_arguments-->0) { - GG_MAINWIN_ROCK: gg_mainwin = id; - GG_STATUSWIN_ROCK: gg_statuswin = id; - GG_QUOTEWIN_ROCK: gg_quotewin = id; - default: if (IdentifyGlkObject(1, 0, id, gg_arguments-->0) == false) - LibraryExtensions.RunWhile(ext_identifyglkobject, false, 1, 0, id, gg_arguments-->0); - } - id = glk_window_iterate(id, gg_arguments); - } - - id = glk_fileref_iterate(0, gg_arguments); - while (id) { - switch (gg_arguments-->0) { - GG_SCRIPTFREF_ROCK: gg_scriptfref = id; - default: if (IdentifyGlkObject(1, 2, id, gg_arguments-->0) == false) - LibraryExtensions.RunWhile(ext_identifyglkobject, false, 1, 2, id, gg_arguments-->0); - } - id = glk_fileref_iterate(id, gg_arguments); - } - - ! Tell the game to tie up any loose ends. - if (IdentifyGlkObject(2) == false) - LibraryExtensions.RunWhile(ext_identifyglkobject, 0, 2); -]; - -! This somewhat obfuscated function will print anything. -! It handles strings, functions (with optional arguments), objects, -! object properties (with optional arguments), and dictionary words. -! It does *not* handle plain integers, but you can use -! DecimalNumber or EnglishNumber to handle that case. -! -! Calling: Is equivalent to: -! ------- ---------------- -! PrintAnything() -! PrintAnything(0) -! PrintAnything("string"); print (string) "string"; -! PrintAnything('word') print (address) 'word'; -! PrintAnything(obj) print (name) obj; -! PrintAnything(obj, prop) obj.prop(); -! PrintAnything(obj, prop, args...) obj.prop(args...); -! PrintAnything(func) func(); -! PrintAnything(func, args...) func(args...); - -[ PrintAnything _vararg_count obj mclass; - print_anything_result = 0; - if (_vararg_count == 0) return; - @copy sp obj; - _vararg_count--; - if (obj == 0) return; - - if (obj->0 == $60) { - ! Dictionary word. Metaclass() can't catch this case, so we do - ! it manually. - print (address) obj; - return; - } - - mclass = metaclass(obj); - switch (mclass) { - nothing: - return; - String: - print (string) obj; - return; - Routine: - ! Call the function with all the arguments which are already - ! on the stack. - @call obj _vararg_count print_anything_result; - return; - Object: - if (_vararg_count == 0) { - print (name) obj; - } - else { - ! Push the object back onto the stack, and call the - ! veneer routine that handles obj.prop() calls. - @copy obj sp; - _vararg_count++; - @call CA__Pr _vararg_count print_anything_result; - } - return; - } -]; - -! This does the same as PrintAnything, but the output is sent to a -! byte array in memory. The first two arguments must be the array -! address and length; the following arguments are interpreted as -! for PrintAnything. The return value is the number of characters -! output. -! If the output is longer than the array length given, the extra -! characters are discarded, so the array does not overflow. -! (However, the return value is the total length of the output, -! including discarded characters.) - -[ PrintAnyToArray _vararg_count arr arrlen str oldstr len; - @copy sp arr; - @copy sp arrlen; - _vararg_count = _vararg_count - 2; - - oldstr = glk_stream_get_current(); ! stream_get_current - str = glk_stream_open_memory(arr, arrlen, 1, 0); - if (str == 0) return 0; - - glk_stream_set_current(str); - - @call PrintAnything _vararg_count 0; - - glk_stream_set_current(oldstr); - @copy $ffffffff sp; - @copy str sp; - @glk $0044 2 0; - @copy sp len; - @copy sp 0; - - return len; -]; - -! And this calls PrintAnyToArray on a particular array, jiggering -! the result to be a Glulx C-style ($E0) string. - -Constant GG_ANYTOSTRING_LEN 66; -Array AnyToStrArr -> GG_ANYTOSTRING_LEN+1; - -[ ChangeAnyToCString _vararg_count ix len; - ix = GG_ANYTOSTRING_LEN-2; - @copy ix sp; - ix = AnyToStrArr+1; - @copy ix sp; - ix = _vararg_count+2; - @call PrintAnyToArray ix len; - AnyToStrArr->0 = $E0; - if (len >= GG_ANYTOSTRING_LEN) - len = GG_ANYTOSTRING_LEN-1; - AnyToStrArr->(len+1) = 0; - return AnyToStrArr; -]; - -#Endif; ! TARGET_ - -! This is a trivial function which just prints a number, in decimal -! digits. It may be useful as a stub to pass to PrintAnything. - -[ DecimalNumber num; print num; ]; - -#Ifndef SHORTNAMEBUF_LEN; ! Can't use 'Default', unfortunately, -Constant SHORTNAMEBUF_LEN 160; ! but this is functionally equivalent -#Endif; - -#IfV5; -#Ifdef VN_1630; -Array StorageForShortName buffer SHORTNAMEBUF_LEN; -#Ifnot; -Array StorageForShortName -> WORDSIZE + SHORTNAMEBUF_LEN; -#Endif; ! VN_1630 - -#Endif; ! V5 - -#Ifdef TARGET_ZCODE; - -! Platform-independent way of printing strings, routines and properties -! to a buffer (defined as length word followed by byte characters). - -[ PrintToBuffer buf len a b c d e; - print_anything_result = 0; - @output_stream 3 buf; - switch (metaclass(a)) { - String: - print (string) a; - Routine: - print_anything_result = a(b, c, d, e); - Object,Class: - if (b) - print_anything_result = PrintOrRun(a, b, true); - else - print (name) a; - } - @output_stream -3; - if (buf-->0 > len) RunTimeError(14, len, "in PrintToBuffer()"); - return buf-->0; -]; - -#Ifnot; ! TARGET_GLULX - -[ PrintToBuffer buf len a b c d e; - if (b) { - if (metaclass(a) == Object && a.#b == WORDSIZE - && metaclass(a.b) == String) - buf-->0 = PrintAnyToArray(buf+WORDSIZE, len, a.b); - else - buf-->0 = PrintAnyToArray(buf+WORDSIZE, len, a, b, c, d, e); - } - else - buf-->0 = PrintAnyToArray(buf+WORDSIZE, len, a); - if (buf-->0 > len) buf-->0 = len; - return buf-->0; -]; - -#Endif; ! TARGET_ - -! Print contents of buffer (defined as length word followed by byte characters). -! no_break == 1: omit trailing newline. -! set_case == 1: capitalise first letter; -! == 2: capitalise first letter, remainder lower case; -! == 3: all lower case; -! == 4: all upper case. -! centred == 1: add leading spaces. - -[ PrintFromBuffer buf no_break set_case centred - i j k; - j = (buf-->0) - 1; - if (buf->(j+WORDSIZE) ~= 10 or 13) j++; ! trim any trailing newline - if (centred) { - k = (ScreenWidth() - j) / 2; - if (k>0) spaces k; - } - for (i=0 : i(WORDSIZE+i); - switch (set_case) { - 0: break; - 1: if (i) set_case = 0; - else k = UpperCase(k); - 2: if (i) k = LowerCase(k); - else k = UpperCase(k); - 3: k = LowerCase(k); - 4: k = UpperCase(k); - } - print (char) k; - } - if (no_break == false) new_line; - return j; -]; - -! None of the following functions should be called for zcode if the -! output exceeds the size of the buffer. - -[ StringSize a b c d e; - PrintToBuffer(StorageForShortName, 160, a, b, c, d, e); - return StorageForShortName-->0; -]; - -[ PrintCapitalised a b no_break no_caps centred; - if (metaclass(a) == Routine or String || b == 0 || metaclass(a.b) == Routine or String) - PrintToBuffer(StorageForShortName, SHORTNAMEBUF_LEN, a, b); - else - if (a.b == NULL) rfalse; - else return RunTimeError(2, a, b); - if (no_caps == 0 or 1) no_caps = ~~no_caps; - PrintFromBuffer(StorageForShortName, no_break, no_caps, centred); - return print_anything_result; -]; - -[ Centre a b; - PrintCapitalised(a, b, false, true, true); -]; - -[ CapitRule str no_caps; - if (no_caps) print (string) str; - else PrintCapitalised(str,0,true); -]; - -[ PrefaceByArticle o acode pluralise capitalise i artform findout artval; - if (o provides articles) { - artval=(o.&articles)-->(acode+short_name_case*LanguageCases); - if (capitalise) - print (CapitRule) artval; - else - print (string) artval; - if (pluralise) return; - print (PSN__) o; return; - } - - i = GetGNAOfObject(o); - if (pluralise) { - if (i < 3 || (i >= 6 && i < 9)) i = i + 3; - } - i = LanguageGNAsToArticles-->i; - - artform = LanguageArticles - + 3*WORDSIZE*LanguageContractionForms*(short_name_case + i*LanguageCases); - - #Iftrue (LanguageContractionForms == 2); - if (artform-->acode ~= artform-->(acode+3)) findout = true; - #Endif; ! LanguageContractionForms - #Iftrue (LanguageContractionForms == 3); - if (artform-->acode ~= artform-->(acode+3)) findout = true; - if (artform-->(acode+3) ~= artform-->(acode+6)) findout = true; - #Endif; ! LanguageContractionForms - #Iftrue (LanguageContractionForms == 4); - if (artform-->acode ~= artform-->(acode+3)) findout = true; - if (artform-->(acode+3) ~= artform-->(acode+6)) findout = true; - if (artform-->(acode+6) ~= artform-->(acode+9)) findout = true; - #Endif; ! LanguageContractionForms - #Iftrue (LanguageContractionForms > 4); - findout = true; - #Endif; ! LanguageContractionForms - - #Ifdef TARGET_ZCODE; - if (standard_interpreter && findout) { - StorageForShortName-->0 = SHORTNAMEBUF_LEN; - @output_stream 3 StorageForShortName; - if (pluralise) print (number) pluralise; else print (PSN__) o; - @output_stream -3; - acode = acode + 3*LanguageContraction(StorageForShortName + 2); - } - #Ifnot; ! TARGET_GLULX - if (findout) { - if (pluralise) - PrintAnyToArray(StorageForShortName, SHORTNAMEBUF_LEN, EnglishNumber, pluralise); - else - PrintAnyToArray(StorageForShortName, SHORTNAMEBUF_LEN, PSN__, o); - acode = acode + 3*LanguageContraction(StorageForShortName); - } - #Endif; ! TARGET_ - - CapitRule (artform-->acode, ~~capitalise); ! print article - if (pluralise) return; - print (PSN__) o; -]; - -[ PSN__ o; - if (o == 0) { print (string) NOTHING__TX; rtrue; } - switch (metaclass(o)) { - Routine: print ""; rtrue; - String: print ""; rtrue; - nothing: print ""; rtrue; - } - #Ifdef LanguagePrintShortName; - if (LanguagePrintShortName(o)) rtrue; - #Endif; ! LanguagePrintShortName - if (indef_mode && o.&short_name_indef ~= 0 && PrintOrRun(o, short_name_indef, 1) ~= 0) rtrue; - if (o.&short_name ~= 0 && PrintOrRun(o, short_name, 1) ~= 0) rtrue; - print (object) o; -]; - -[ Indefart o saveIndef; - saveIndef = indef_mode; indef_mode = true; caps_mode = false; - if (o has proper) { - indef_mode = NULL; - print (PSN__) o; - indef_mode = saveIndef; - return; - } - - if (o provides article) { - PrintOrRun(o, article, 1); - print " ", (PSN__) o; - indef_mode = saveIndef; - return; - } - PrefaceByArticle(o, 2); - indef_mode = saveIndef; -]; - -[ CInDefArt o saveIndef saveCaps; - saveIndef = indef_mode; indef_mode = true; - saveCaps = caps_mode; caps_mode = true; - - if (o has proper) { - indef_mode = NULL; - PrintToBuffer(StorageForShortName, SHORTNAMEBUF_LEN, PSN__, o); - PrintFromBuffer(StorageForShortName, true, caps_mode); - caps_mode = saveCaps; - return; - } - - if (o provides article) { - PrintCapitalised(o, article, true); - print " ", (PSN__) o; - indef_mode = saveIndef; - caps_mode = saveCaps; - return; - } - PrefaceByArticle(o, 2, 0, 1); - caps_mode = saveCaps; - indef_mode = saveIndef; -]; - -[ Defart o saveIndef; - saveIndef = indef_mode; - indef_mode = false; - caps_mode = false; - if ((~~o ofclass Object) || o has proper) { - indef_mode = NULL; - if (o == player) { - if (player provides narrative_voice) { - switch (player.narrative_voice) { - 1: print (string) MYSELF__TX; - 2: print (string) YOURSELF__TX; - 3: print (PSN__) o; - default: RunTimeError(16, player.narrative_voice); - } - } - else ThatOrThose(player); - } else { - print (PSN__) o; - } - indef_mode = saveIndef; - return; - } - PrefaceByArticle(o, 1); - indef_mode = saveIndef; -]; - -[ CDefart o saveIndef saveCaps; - saveIndef = indef_mode; indef_mode = false; - saveCaps = caps_mode; caps_mode = true; - if (~~o ofclass Object) { - indef_mode = NULL; print (PSN__) o; - } - else - if (o has proper) { - indef_mode = NULL; - PrintToBuffer(StorageForShortName, SHORTNAMEBUF_LEN, PSN__, o); - PrintFromBuffer(StorageForShortName, true, caps_mode); - } - else - PrefaceByArticle(o, 0); - indef_mode = saveIndef; caps_mode = saveCaps; -]; - -[ PrintShortName o saveIndef; - saveIndef = indef_mode; indef_mode = NULL; - PSN__(o); indef_mode = saveIndef; -]; - -[ EnglishNumber n; LanguageNumber(n); ]; - -[ SerialComma n; - #Ifdef SERIAL_COMMAS; - if (n>2) print ","; - #Endif; - n=0; ! quell unused n variable warning -]; - -[ NumberWord o i n; - n = LanguageNumbers-->0; - for (i=1 : i<=n : i=i+2) - if (o == LanguageNumbers-->i) return LanguageNumbers-->(i+1); - return 0; -]; - -[ RandomEntry tab; - if (tab-->0 == 0) return RunTimeError(8); - return tab-->(random(tab-->0)); -]; - -! ---------------------------------------------------------------------------- -! Useful routine: unsigned comparison (for addresses in Z-machine) -! Returns 1 if x>y, 0 if x=y, -1 if x= 0) return 1; - if (x >= 0 && y < 0) return -1; - u = x&~WORD_HIGHBIT; v= y&~WORD_HIGHBIT; - if (u > v) return 1; - return -1; -]; - -! ============================================================================== - -#Ifdef NITFOL_HOOKS; ! Code contributed by Evin Robertson -#Ifdef TARGET_GLULX; ! Might be nice for Z-machine games too, - ! but I'm not going to try to make this work - ! given #Ifdef funniness. - -Array magic_array --> ! This is so nitfol can do typo correction / - ! automapping / debugging on Glulx games - $6e66726d $4d616763 $ff0010 ! Goes to 'NfrmMagc' 10 refers to length - Magic_Global_Dispatch__ - DI__check_word ! DI__check_word(buf, length) - PrintShortName - WV__Pr RV__Pr CA__Pr ! obj.prop = x; x = obj.prop; obj.prop(x) - RA__Pr RL__Pr RA__Sc ! obj.∝ obj.#prop; class::prop - OP__Pr OC__Cl ! obj provides prop; obj ofclass class - OB__Move OB__Remove - OB__Parent__ OB__Child__ OB__Sibling__ ! No explicit veneer for these - ; - -[ OB__Parent__ obj; return parent(obj); ]; - -[ OB__Child__ obj; return child(obj); ]; - -[ OB__Sibling__ obj; return sibling(obj); ]; - -[ Magic_Global_Dispatch__ glbl; - switch (glbl) { - 0: - if (location == TheDark) return real_location; return location; - 1: - return Player; - -1: - return CompassDirection::number; ! Silliness to make exist RA__Sc - ! Should never be called. - } - return magic_array; ! Silences a warning. -]; - -[ DI__check_word buf wlen ix val res dictlen entrylen; - ! Just like in Tokenise__. In fact, Tokenise__ could call this if - ! it wanted, instead of doing this itself. - if (wlen > DICT_WORD_SIZE) wlen = DICT_WORD_SIZE; - for (ix=0 : ixix = glk_char_to_lower(buf->ix); - } - for (: ixix = 0; - } - val = #dictionary_table + WORDSIZE; - entrylen = DICT_WORD_SIZE + 7; - @binarysearch gg_tokenbuf DICT_WORD_SIZE val entrylen dictlen 1 1 res; - return res; -]; - -#Endif; ! TARGET_ -#Endif; ! NITFOL_HOOKS - -! ============================================================================== - -Object LibraryExtensions "(Library Extensions)" - with RunAll [ prop a1 a2 a3 - obj rval max; - objectloop (obj in self) - if (obj provides prop && obj.prop ofclass Routine) { - rval = obj.prop(a1, a2, a3); - if (rval > max) max = rval; - if (self.BetweenCalls) self.BetweenCalls(); - } - return max; - ], - RunUntil [ prop exitval a1 a2 a3 - obj rval; - objectloop (obj in self) - if (obj provides prop && obj.prop ofclass Routine) { - rval = obj.prop(a1, a2, a3); - if (rval == exitval) return rval; - if (self.BetweenCalls) self.BetweenCalls(); - } - return ~~exitval; - ], - RunWhile [ prop exitval a1 a2 a3 - obj rval; - objectloop (obj in self) - if (obj provides prop && obj.prop ofclass Routine) { - rval = obj.prop(a1, a2, a3); - if (rval ~= exitval) return rval; - if (self.BetweenCalls) self.BetweenCalls(); - } - return exitval; - ], - - ext_number_1 0, ! general temporary workspace - - ! can be set to a function (e.g. RestoreWN) meant for execution - ! after non-terminating calls to extension objects - ! (via RunUntil/While/All) - BetweenCalls 0, - RestoreWN [; wn = self.ext_number_1; ], - - ! Special interception points - ext_messages 0, ! Called if LibraryMessages.before() - ! returns false - ! Extensions run while they return false - - ! Cross-platform entry points - ! Called/Runs - ext_afterlife 0, ! [C2/R1] - ext_afterprompt 0, ! [C2/R1] - ext_amusing 0, ! [C2/R1] - ext_beforeparsing 0, ! [C2/R2] - ext_chooseobjects 0, ! [C2/R2] - ext_darktodark 0, ! [C2/R1] - ext_deathmessage 0, ! [C2/R1] - ext_gamepostroutine 0, ! [C2/R2] - ext_gamepreroutine 0, ! [C2/R2] - ext_initialise 0, ! [C1/R1] - ext_inscope 0, ! [C2/R2] - ext_lookroutine 0, ! [C2/R1] - ext_newroom 0, ! [C2/R1] - ext_objectdoesnotfit 0, ! [C2/R2] - ext_parsenoun 0, ! [C3/R3] - ext_parsenumber 0, ! [C2/R2] - ext_parsererror 0, ! [C2/R2] - ext_printrank 0, ! [C2/R1] - ext_printtaskname 0, ! [C2/R1] - ext_printverb 0, ! [C2/R2] - ext_timepasses 0, ! [C2/R1] - ext_unknownverb 0, ! [C2/R2] - ! [C1] = Called in all cases - ! [C2] = Called if EP is undefined, or returns false - ! [C3] = called if EP is undefined, or returns -1 - ! [R1] = All extensions run - ! [R2] = Extensions run while they return false - ! [R3] = Extensions run while they return -1 - - #Ifdef TARGET_GLULX; - ! Glulx entry points - ! Called: Runs: - ext_handleglkevent 0, ! if EP undefined while extensions return false - ext_identifyglkobject 0, ! if EP undefined while extensions return false - ext_initglkwindow 0, ! if EP undefined while extensions return false - #Endif; ! TARGET_GLULX; - - has proper; - -! ============================================================================== diff --git a/readme.txt b/readme.txt index a310544..eb09529 100644 --- a/readme.txt +++ b/readme.txt @@ -1,4 +1,4 @@ -This directory contains version 6.12.2 of the Inform 6 standard +This directory contains version 6.12.3 of the Inform 6 standard library. It has been modified slightly to not print out the version of Inform and the version of the standard library in use in the game's banner. diff --git a/verblib.h b/verblib.h index e3941e4..e98bb22 100644 --- a/verblib.h +++ b/verblib.h @@ -1,9 +1,9 @@ ! ============================================================================== ! VERBLIB: Front end to standard verbs library. ! -! Supplied for use with Inform 6 -- Release 6.12.2 -- Serial number 180520 +! Supplied for use with Inform 6 -- Release 6.12.3 -- Serial number 190320 ! -! Copyright Graham Nelson 1993-2004 and David Griffith 2012-2018 +! Copyright Graham Nelson 1993-2004 and David Griffith 2012-2019 ! ! This file is free software: you can redistribute it and/or modify ! it under the terms of the GNU Affero General Public License as @@ -2558,7 +2558,7 @@ Constant ID_BIT $2000; ! Print object id after each entry [ JumpInSub; if (noun has animate) return L__M(##JumpIn, 2, noun); if (noun has enterable) <>; - L__M(##JumpOn, 1, noun); + L__M(##JumpIn, 1, noun); ]; [ JumpOnSub; @@ -2658,6 +2658,7 @@ Constant ID_BIT $2000; ! Print object id after each entry [ ThrowAtSub; if (ObjectIsUntouchable(noun)) return; + if (second == nothing) return L__M(##ThrowAt, 1, noun); if (second > 1) { action = ##ThrownAt; if (RunRoutines(second, before)) { action = ##ThrowAt; rtrue; } diff --git a/verblibm.h b/verblibm.h deleted file mode 100644 index b09bad1..0000000 --- a/verblibm.h +++ /dev/null @@ -1,2913 +0,0 @@ -! ============================================================================== -! VERBLIBM: Core of standard verbs library. -! -! Supplied for use with Inform 6 -- Release 6.12.1 -- Serial number 160605 -! -! Copyright Graham Nelson 1993-2004 and David Griffith 2012-2016 -! -! This file is free software: you can redistribute it and/or modify -! it under the terms of the GNU Affero General Public License as -! published by the Free Software Foundation, either version 3 of the -! License, or (at your option) any later version. -! -! This file is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -! Affero General Public License for more details. -! -! You should have received a copy of the GNU Affero General Public -! License along with this program. If not, see -! https://gnu.org/licenses/ -! -! This file is automatically Included in your game file by "verblib". -! ============================================================================== - -System_file; - -#Ifdef MODULE_MODE; -Constant DEBUG; -Constant Grammar__Version 2; -Include "linklpa"; -Include "linklv"; -#Endif; ! MODULE_MODE - -! ------------------------------------------------------------------------------ - -[ Banner i; - #Ifdef LanguageBanner; - LanguageBanner(); - i = 0; ! suppress warning - #Ifnot; - if (Story) { - #Ifdef TARGET_ZCODE; - #IfV5; style bold; #Endif; - print "^", (string) Story; - #IfV5; style roman; #Endif; - #Ifnot; ! TARGET_GLULX; - glk_set_style(style_Header); - print "^", (string) Story; - glk_set_style(style_Normal); - #Endif; ! TARGET_ - } - if (Headline) print (string) Headline; - #Ifdef TARGET_ZCODE; - print "Release ", (HDR_GAMERELEASE-->0) & $03ff, " / Serial number "; - for (i=0 : i<6 : i++) print (char) HDR_GAMESERIAL->i; - #Ifnot; ! TARGET_GLULX; - print "Release "; - @aloads ROM_GAMERELEASE 0 i; - print i; - print " / Serial number "; - for (i=0 : i<6 : i++) print (char) ROM_GAMESERIAL->i; - #Endif; ! TARGET_ - #Ifdef INFIX; - print "X"; - #Ifnot; - #Ifdef DEBUG; - print "D"; - #Endif; ! DEBUG - #Endif; ! INFIX - new_line; - #Endif; ! LanguageBanner -]; - -[ VersionSub ix; - #Ifdef LanguageVersionSub; - LanguageVersionSub(); - ix = 0; ! suppress warning - #Ifnot; - Banner(); - #Ifdef TARGET_ZCODE; - ix = 0; ! shut up compiler warning - if (standard_interpreter > 0) { - print "Standard interpreter ", standard_interpreter/256, ".", standard_interpreter%256, - " (", HDR_TERPNUMBER->0; - #Iftrue (#version_number == 6); - print (char) '.', HDR_TERPVERSION->0; - #Ifnot; - print (char) HDR_TERPVERSION->0; - #Endif; - print ") / "; - } - else { - print "Interpreter ", HDR_TERPNUMBER->0, " Version "; - #Iftrue (#version_number == 6); - print HDR_TERPVERSION->0; - #Ifnot; - print (char) HDR_TERPVERSION->0; - #Endif; - print " / "; - } - - #Ifnot; ! TARGET_GLULX; - @gestalt 1 0 ix; - print "Interpreter version ", ix / $10000, ".", (ix & $FF00) / $100, - ".", ix & $FF, " / "; - @gestalt 0 0 ix; - print "VM ", ix / $10000, ".", (ix & $FF00) / $100, ".", ix & $FF, " / "; - #Endif; ! TARGET_; - print "Library serial number ", (string) LibSerial, "^"; - #Ifdef LanguageVersion; - print (string) LanguageVersion, "^"; - #Endif; ! LanguageVersion - #Endif; ! LanguageVersionSub -]; - -[ RunTimeError n p1 p2; - #Ifdef LanguageError; - LanguageError(n, p1, p2); - #Ifnot; - #Ifdef DEBUG; - print "** Library error ", n, " (", p1, ", ", p2, ") **^** "; - switch (n) { - 1: print "preposition not found (this should not occur)"; - 2: print "Property value not routine or string: ~", (property) p2, "~ of ~", (name) p1, - "~ (", p1, ")"; - 3: print "Entry in property list not routine or string: ~", (property) p2, "~ list of ~", - (name) p1, "~ (", p1, ")"; - 4: print "Too many timers/daemons are active simultaneously. - The limit is the library constant MAX_TIMERS - (currently ", MAX_TIMERS, ") and should be increased"; - 5: print "Object ~", (name) p1, "~ has no ~", (property) p2, "~ property"; - 7: print "The object ~", (name) p1, "~ can only be used as a player object if it has - the ~number~ property"; - 8: print "Attempt to take random entry from an empty table array"; - 9: print p1, " is not a valid direction property number"; - 10: print "The player-object is outside the object tree"; - 11: print "The room ~", (name) p1, "~ has no ~", (property) p2, "~ property"; - 12: print "Tried to set a non-existent pronoun using SetPronoun"; - 13: print "A 'topic' token can only be followed by a preposition"; - 14: print "Overflowed buffer limit of ", p1, " using '@@64output_stream 3' ", (string) p2; - 15: print "LoopWithinObject broken because the object ", (name) p1, " was moved while the loop passed through it."; - 16: print "Attempt to use illegal narrative_voice of ", p1, "."; - default: - print "(unexplained)"; - } - " **"; - #Ifnot; - "** Library error ", n, " (", p1, ", ", p2, ") **"; - #Endif; ! DEBUG - #Endif; ! LanguageError -]; - -! ---------------------------------------------------------------------------- -! The WriteListFrom routine, a flexible object-lister taking care of -! plurals, inventory information, various formats and so on. This is used -! by everything in the library which ever wants to list anything. -! -! If there were no objects to list, it prints nothing and returns false; -! otherwise it returns true. -! -! o is the object, and style is a bitmap, whose bits are given by: -! ---------------------------------------------------------------------------- - - -Constant NEWLINE_BIT $0001; ! New-line after each entry -Constant INDENT_BIT $0002; ! Indent each entry by depth -Constant FULLINV_BIT $0004; ! Full inventory information after entry -Constant ENGLISH_BIT $0008; ! English sentence style, with commas and and -Constant RECURSE_BIT $0010; ! Recurse downwards with usual rules -Constant ALWAYS_BIT $0020; ! Always recurse downwards -Constant TERSE_BIT $0040; ! More terse English style -Constant PARTINV_BIT $0080; ! Only brief inventory information after entry -Constant DEFART_BIT $0100; ! Use the definite article in list -Constant WORKFLAG_BIT $0200; ! At top level (only), only list objects - ! which have the "workflag" attribute -Constant ISARE_BIT $0400; ! Print " is" or " are" before list -Constant CONCEAL_BIT $0800; ! Omit objects with "concealed" or "scenery": - ! if WORKFLAG_BIT also set, then does _not_ - ! apply at top level, but does lower down -Constant NOARTICLE_BIT $1000; ! Print no articles, definite or not -Constant ID_BIT $2000; ! Print object id after each entry - -[ NextEntry o odepth; - for (::) { - o = sibling(o); - if (o == 0) return 0; - if (lt_value && o.list_together ~= lt_value) continue; - if (c_style & WORKFLAG_BIT && odepth==0 && o hasnt workflag) continue; - if (c_style & CONCEAL_BIT && (o has concealed || o has scenery)) continue; - return o; - } -]; - -[ WillRecurs o; - if (c_style & ALWAYS_BIT) rtrue; - if (c_style & RECURSE_BIT == 0) rfalse; - if ((o has transparent or supporter) || (o has container && o has open)) rtrue; - rfalse; -]; - -[ ListEqual o1 o2; - if (child(o1) && WillRecurs(o1)) rfalse; - if (child(o2) && WillRecurs(o2)) rfalse; - if (c_style & (FULLINV_BIT + PARTINV_BIT)) { - if ((o1 hasnt worn && o2 has worn) || (o2 hasnt worn && o1 has worn)) rfalse; - if ((o1 hasnt light && o2 has light) || (o2 hasnt light && o1 has light)) rfalse; - if (o1 has container) { - if (o2 hasnt container) rfalse; - if ((o1 has open && o2 hasnt open) || (o2 has open && o1 hasnt open)) - rfalse; - } - else if (o2 has container) - rfalse; - } - return Identical(o1, o2); -]; - -[ SortTogether obj value; - ! print "Sorting together possessions of ", (object) obj, " by value ", value, "^"; - ! for (x=child(obj) : x : x=sibling(x)) - ! print (the) x, " no: ", x, " lt: ", x.list_together, "^"; - while (child(obj)) { - if (child(obj).list_together ~= value) move child(obj) to out_obj; - else move child(obj) to in_obj; - } - while (child(in_obj)) move child(in_obj) to obj; - while (child(out_obj)) move child(out_obj) to obj; -]; - -[ SortOutList obj i k l; - ! print "^^Sorting out list from ", (name) obj, "^ "; - ! for (i=child(location) : i : i=sibling(i)) - ! print (name) i, " --> "; - ! new_line; - - .AP_SOL; - - for (i=obj : i : i=sibling(i)) { - k = i.list_together; - if (k ~= 0) { - ! print "Scanning ", (name) i, " with lt=", k, "^"; - for (i=sibling(i) : i && i.list_together == k :) i = sibling(i); - if (i == 0) rfalse; - ! print "First not in block is ", (name) i, " with lt=", i.list_together, "^"; - for (l=sibling(i) : l : l=sibling(l)) - if (l.list_together == k) { - SortTogether(parent(obj), k); - ! print "^^After ST:^ "; - ! for (i=child(location) : i : i=sibling(i)) - ! print (name) i, " --> "; - ! new_line; - obj = child(parent(obj)); - jump AP_SOL; - } - } - } -]; - -#Ifdef TARGET_ZCODE; - -[ Print__Spaces n; ! To avoid a bug occurring in Inform 6.01 to 6.10 - if (n == 0) return; - spaces n; -]; - -#Ifnot; ! TARGET_GLULX; - -[ Print__Spaces n; - while (n > 0) { - @streamchar ' '; - n = n - 1; - } -]; - -#Endif; ! TARGET_ - -[ WriteListFrom o style depth - s1 s2 s3 s4 s5 s6; - - if (o == nothing) return 0; - - s1 = c_style; s2 = lt_value; s3 = listing_together; - s4 = listing_size; s5 = wlf_indent; s6 = inventory_stage; - - if (o == child(parent(o))) { - SortOutList(o); - o = child(parent(o)); - } - c_style = style; - wlf_indent = 0; - if (WriteListR(o, depth) == 0) return 0; - - c_style = s1; lt_value = s2; listing_together = s3; - listing_size = s4; wlf_indent = s5; inventory_stage = s6; - rtrue; -]; - -[ WriteListR o depth stack_pointer classes_p sizes_p i j k k2 l m n q senc mr; - if (depth > 0 && o == child(parent(o))) { - SortOutList(o); - o = child(parent(o)); - } - for (::) { - if (o == 0) rfalse; - if (c_style & WORKFLAG_BIT && depth==0 && o hasnt workflag) { - o = sibling(o); - continue; - } - if (c_style & CONCEAL_BIT && (o has concealed || o has scenery)) { - o = sibling(o); - continue; - } - break; - } - classes_p = match_classes + stack_pointer; - sizes_p = match_list + stack_pointer; - - for (i=o,j=0 : i && (j+stack_pointer)<128 : i=NextEntry(i,depth),j++) { - classes_p->j = 0; - if (i.plural) k++; - } - - if (c_style & ISARE_BIT) { - if (j == 1 && o hasnt pluralname) Tense(IS__TX, WAS__TX); - else Tense(ARE__TX, WERE__TX); - if (c_style & NEWLINE_BIT) print ":^"; - else print (char) ' '; - c_style = c_style - ISARE_BIT; - } - - stack_pointer = stack_pointer+j+1; - - if (k < 2) jump EconomyVersion; ! It takes two to plural - n = 1; - for (i=o,k=0 : kk == 0) { - classes_p->k = n; sizes_p->n = 1; - for (l=NextEntry(i,depth),m=k+1 : l && mm == 0 && i.plural && l.plural ~= 0) { - if (ListEqual(i, l) == 1) { - sizes_p->n = sizes_p->n + 1; - classes_p->m = n; - } - } - n++; - } - n--; - - for (i=1,j=o,k=0 : i<=n : i++,senc++) { - while (((classes_p->k) ~= i) && ((classes_p->k) ~= -i)) { - k++; j=NextEntry(j, depth); - } - m = sizes_p->i; - if (j == 0) mr = 0; - else { - if (j.list_together ~= 0 or lt_value && metaclass(j.list_together) == Routine or String && - j.list_together == mr) senc--; - mr = j.list_together; - } - } - senc--; - - for (i=1,j=o,k=0,mr=0 : senc>=0 : i++,senc--) { - while (((classes_p->k) ~= i) && ((classes_p->k) ~= -i)) { - k++; j=NextEntry(j, depth); - } - if (j.list_together ~= 0 or lt_value) { - if (j.list_together == mr) { - senc++; - jump Omit_FL2; - } - k2 = NextEntry(j, depth); - if (k2 == 0 || k2.list_together ~= j.list_together) jump Omit_WL2; - k2 = metaclass(j.list_together); - if (k2 == Routine or String) { - q = j; listing_size = 1; l = k; m = i; - while (m < n && q.list_together == j.list_together) { - m++; - while (((classes_p->l) ~= m) && ((classes_p->l) ~= -m)) { - l++; q = NextEntry(q, depth); - } - if (q.list_together == j.list_together) listing_size++; - } - ! print " [", listing_size, "] "; - if (listing_size == 1) jump Omit_WL2; - if (c_style & INDENT_BIT) Print__Spaces(2*(depth+wlf_indent)); - if (k2 == String) { - q = 0; - for (l=0 : l(l+i); - EnglishNumber(q); print " "; - print (string) j.list_together; - if (c_style & ENGLISH_BIT) print " ("; - if (c_style & INDENT_BIT) print ":^"; - } - q = c_style; - if (k2 ~= String) { - inventory_stage = 1; - parser_one = j; parser_two = depth+wlf_indent; - if (RunRoutines(j, list_together) == 1) jump Omit__Sublist2; - } - - #Ifdef TARGET_ZCODE; - @push lt_value; @push listing_together; @push listing_size; - #Ifnot; ! TARGET_GLULX; - @copy lt_value sp; @copy listing_together sp; @copy listing_size sp; - #Endif; ! TARGET_; - - lt_value = j.list_together; listing_together = j; wlf_indent++; - WriteListR(j, depth, stack_pointer); wlf_indent--; - - #Ifdef TARGET_ZCODE; - @pull listing_size; @pull listing_together; @pull lt_value; - #Ifnot; ! TARGET_GLULX; - @copy sp listing_size; - @copy sp listing_together; - @copy sp lt_value; - #Endif; ! TARGET_; - - if (k2 == String) { - if (q & ENGLISH_BIT) print ")"; - } - else { - inventory_stage = 2; - parser_one = j; parser_two = depth+wlf_indent; - RunRoutines(j, list_together); - } - - .Omit__Sublist2; - - if (q & NEWLINE_BIT && c_style & NEWLINE_BIT == 0) new_line; - c_style = q; - mr = j.list_together; - jump Omit_EL2; - } - } - - .Omit_WL2; - - if (WriteBeforeEntry(j, depth, 0, senc) == 1) jump Omit_FL2; - if (sizes_p->i == 1) { - if (c_style & NOARTICLE_BIT) print (name) j; - else { - if (c_style & DEFART_BIT) print (the) j; - else print (a) j; - } - if (c_style & ID_BIT) print " (", j, ")"; - } - else { - if (c_style & DEFART_BIT) PrefaceByArticle(j, 1, sizes_p->i); - print (number) sizes_p->i, " "; - PrintOrRun(j, plural, 1); - } - if (sizes_p->i > 1 && j hasnt pluralname) { - give j pluralname; - WriteAfterEntry(j, depth, stack_pointer); - give j ~pluralname; - } - else { - WriteAfterEntry(j,depth,stack_pointer); - } - .Omit_EL2; - - if (c_style & ENGLISH_BIT) { - if (senc == 1) print (SerialComma) i+senc, (string) AND__TX; - if (senc > 1) print (string) COMMA__TX; - } - .Omit_FL2; - } - rtrue; - - .EconomyVersion; - - n = j; - for (i=1,j=o : i<=n : j=NextEntry(j,depth),i++,senc++) { - if (j.list_together ~= 0 or lt_value && metaclass(j.list_together) == Routine or String && - j.list_together==mr) senc--; - mr = j.list_together; - } - - for (i=1,j=o,mr=0 : i<=senc : j=NextEntry(j,depth),i++) { - if (j.list_together ~= 0 or lt_value) { - if (j.list_together == mr) { - i--; - jump Omit_FL; - } - k = NextEntry(j, depth); - if (k == 0 || k.list_together ~= j.list_together) jump Omit_WL; - k = metaclass(j.list_together); - if (k == Routine or String) { - if (c_style & INDENT_BIT) Print__Spaces(2*(depth+wlf_indent)); - if (k == String) { - q = j; l = 0; - do { - q = NextEntry(q, depth); l++; - } until (q == 0 || q.list_together ~= j.list_together); - EnglishNumber(l); print " "; - print (string) j.list_together; - if (c_style & ENGLISH_BIT) print " ("; - if (c_style & INDENT_BIT) print ":^"; - } - q = c_style; - if (k ~= String) { - inventory_stage = 1; - parser_one = j; parser_two = depth+wlf_indent; - if (RunRoutines(j, list_together) == 1) jump Omit__Sublist; - } - - #Ifdef TARGET_ZCODE; - @push lt_value; @push listing_together; @push listing_size; - #Ifnot; ! TARGET_GLULX; - @copy lt_value sp; @copy listing_together sp; @copy listing_size sp; - #Endif; ! TARGET_; - - lt_value = j.list_together; listing_together = j; wlf_indent++; - WriteListR(j, depth, stack_pointer); wlf_indent--; - - #Ifdef TARGET_ZCODE; - @pull listing_size; @pull listing_together; @pull lt_value; - #Ifnot; ! TARGET_GLULX; - @copy sp listing_size; @copy sp listing_together; @copy sp lt_value; - #Endif; ! TARGET_; - - if (k == String) { - if (q & ENGLISH_BIT) print ")"; - } - else { - inventory_stage = 2; - parser_one = j; parser_two = depth+wlf_indent; - RunRoutines(j, list_together); - } - - .Omit__Sublist; - - if (q & NEWLINE_BIT && c_style & NEWLINE_BIT == 0) new_line; - c_style = q; - mr = j.list_together; - jump Omit_EL; - } - } - - .Omit_WL; - - if (WriteBeforeEntry(j, depth, i, senc) == 1) jump Omit_FL; - if (c_style & NOARTICLE_BIT) print (name) j; - else { - if (c_style & DEFART_BIT) print (the) j; - else print (a) j; - } - if (c_style & ID_BIT) print " (", j, ")"; - WriteAfterEntry(j, depth, stack_pointer); - - .Omit_EL; - - if (c_style & ENGLISH_BIT) { - if (i == senc-1) print (SerialComma) senc, (string) AND__TX; - if (i < senc-1) print (string) COMMA__TX; - } - - .Omit_FL; - - } -]; ! end of WriteListR - -[ WriteBeforeEntry o depth ipos sentencepos - flag; - - inventory_stage = 1; - if (c_style & INDENT_BIT) Print__Spaces(2*(depth+wlf_indent)); - if (o.invent && (c_style & (PARTINV_BIT|FULLINV_BIT))) { - flag = PrintOrRun(o, invent, 1); - if (flag) { - if (c_style & ENGLISH_BIT) { - if (ipos == sentencepos-1) - print (SerialComma) sentencepos, (string) AND__TX; - if (ipos < sentencepos-1) - print (string) COMMA__TX; - } - if (c_style & NEWLINE_BIT) new_line; - } - } - return flag; -]; - -[ WriteAfterEntry o depth stack_p - p recurse_flag parenth_flag eldest_child child_count combo i j; - - inventory_stage = 2; - if (c_style & PARTINV_BIT) { - if (o.invent && RunRoutines(o, invent)) - if (c_style & NEWLINE_BIT) ""; else rtrue; - - combo = 0; - if (o has light && location hasnt light) combo=combo+1; - if (o has container && o hasnt open) combo=combo+2; - if ((o has container && (o has open || o has transparent))) { - objectloop(i in o) { - if (i hasnt concealed && i hasnt scenery) { - j = true; break; - } - } - if (~~j) combo=combo+4; - } - if (combo) L__M(##ListMiscellany, combo, o); - } ! end of PARTINV_BIT processing - - if (c_style & FULLINV_BIT) { - if (o.invent && RunRoutines(o, invent)) - if (c_style & NEWLINE_BIT) ""; else rtrue; - - if (o has light && o has worn) { L__M(##ListMiscellany, 8, o); parenth_flag = true; } - else { - if (o has light) { L__M(##ListMiscellany, 9, o); parenth_flag = true; } - if (o has worn) { L__M(##ListMiscellany, 10, o); parenth_flag = true; } - } - - if (o has container) - if (o has openable) { - if (parenth_flag) print (string) AND__TX; - else L__M(##ListMiscellany, 11, o); - if (o has open) - if (child(o)) L__M(##ListMiscellany, 12, o); - else L__M(##ListMiscellany, 13, o); - else - if (o has lockable && o has locked) L__M(##ListMiscellany, 15, o); - else L__M(##ListMiscellany, 14, o); - parenth_flag = true; - } - else - if (child(o)==0 && o has transparent) - if (parenth_flag) L__M(##ListMiscellany, 16, o); - else L__M(##ListMiscellany, 17, o); - - if (parenth_flag) print ")"; - } ! end of FULLINV_BIT processing - - if (c_style & CONCEAL_BIT) { - child_count = 0; - objectloop (p in o) - if (p hasnt concealed && p hasnt scenery) { child_count++; eldest_child = p; } - } - else { child_count = children(o); eldest_child = child(o); } - - if (child_count && (c_style & ALWAYS_BIT)) { - if (c_style & ENGLISH_BIT) L__M(##ListMiscellany, 18, o); - recurse_flag = true; - } - - if (child_count && (c_style & RECURSE_BIT)) { - if (o has supporter) { - if (c_style & ENGLISH_BIT) { - if (c_style & TERSE_BIT) L__M(##ListMiscellany, 19, o); - else L__M(##ListMiscellany, 20, o); - if (o has animate) print (string) WHOM__TX; - else print (string) WHICH__TX; - } - recurse_flag = true; - } - if (o has container && (o has open || o has transparent)) { - if (c_style & ENGLISH_BIT) { - if (c_style & TERSE_BIT) L__M(##ListMiscellany, 21, o); - else L__M(##ListMiscellany, 22, o); - if (o has animate) print (string) WHOM__TX; - else print (string) WHICH__TX; - } - recurse_flag = true; - } - } - - if (recurse_flag && (c_style & ENGLISH_BIT)) - if (child_count > 1 || eldest_child has pluralname) Tense(ARE2__TX, WERE2__TX); - else Tense(IS2__TX, WAS2__TX); - - if (c_style & NEWLINE_BIT) new_line; - - if (recurse_flag) { - o = child(o); - #Ifdef TARGET_ZCODE; - @push lt_value; @push listing_together; @push listing_size; - #Ifnot; ! TARGET_GLULX; - @copy lt_value sp; @copy listing_together sp; @copy listing_size sp; - #Endif; - lt_value = 0; listing_together = 0; listing_size = 0; - WriteListR(o, depth+1, stack_p); - #Ifdef TARGET_ZCODE; - @pull listing_size; @pull listing_together; @pull lt_value; - #Ifnot; ! TARGET_GLULX; - @copy sp listing_size; @copy sp listing_together; @copy sp lt_value; - #Endif; - if (c_style & TERSE_BIT) print ")"; - } -]; - -! ---------------------------------------------------------------------------- -! LoopWithinObject(rtn,obj,arg) -! -! rtn is the address of a user-supplied routine. -! obj is an optional parent object whose dependents are to be processed; the -! default is the current actor (normally the player). -! arg is an optional argument passed to the rtn; this can be a single variable -! or constant, or the address of an array (which enables multiple values to be -! passed and returned). -! -! For each object o which is a child, grandchild, great-grandchild, etc, of the -! original obj, LoopWithinObject() calls rtn(o,arg). -! -! The rtn should perform any appropriate testing or processing on each object o, -! using the optional arg value if necessary. If the rtn returns true (or any -! positive value), the children of o, if any, are also tested; those children -! are skipped if rtn returns false. To terminate the loop before all objects -! have been processed, rtn should return a large negative number (eg -99). -! -! To deal with supporters and open containers, so that objects are processed -! only if they are accessible to the player, rtn might end with these -! statements: -! if ((o has transparent or supporter) || (o has container && o has open)) rtrue; -! rfalse; -! or alternatively with: -! c_style = RECURSE_BIT; return WillRecurs(o); -! -! LoopWithinObject() returns the number of objects which have been processed. -! ---------------------------------------------------------------------------- - -[ LoopWithinObject rtn obj arg - n o x y; - if (obj == 0) obj = actor; - o = child(obj); - while (o) { - y = parent(o); n++; - x = rtn(o, arg); ! user-supplied routine returning x. - ! if x < 0: skip up to next parent - ! if x = 0: jump across to next sibling - ! if x > 0: continue down to child objects - if (y ~= parent(o)) { RunTimeError(15, o); rfalse; } - if (x > 0 && child(o)) o = child(o); - else - while (o) { - if (++x > 0 && sibling(o)) { o = sibling(o); break; } - o = parent(o); - if (o == obj) return n; - } - } -]; - - -! ---------------------------------------------------------------------------- -! Much better menus can be created using one of the optional library -! extensions. These are provided for compatibility with previous practice: -! ---------------------------------------------------------------------------- - -[ LowKey_Menu menu_choices EntryR ChoiceR lines main_title i j; - menu_nesting++; - - .LKRD; - - menu_item = 0; - lines = EntryR(); - main_title = item_name; - - print "--- "; print (string) main_title; print " ---^^"; - - if (menu_choices ofclass Routine) menu_choices(); - else print (string) menu_choices; - - for (::) { - L__M(##Miscellany, 52, lines); - print "> "; - - #Ifdef TARGET_ZCODE; - #IfV3; - read buffer parse; - #Ifnot; - read buffer parse DrawStatusLine; - #Endif; ! V3 - j = parse->1; ! number of words - #Ifnot; ! TARGET_GLULX; - KeyboardPrimitive(buffer, parse); - j = parse-->0; ! number of words - #Endif; ! TARGET_ - - i = parse-->1; - if (j == 0 || (i == QUIT1__WD or QUIT2__WD)) { - menu_nesting--; if (menu_nesting > 0) rfalse; - if (deadflag == 0) <>; - rfalse; - } - i = TryNumber(1); - if (i == 0) jump LKRD; - if (i < 1 || i > lines) continue; - menu_item = i; - j = ChoiceR(); - if (j == 2) jump LKRD; - if (j == 3) rfalse; - } -]; - -#Ifdef TARGET_ZCODE; - -#IfV3; - -[ DoMenu menu_choices EntryR ChoiceR; LowKey_Menu(menu_choices, EntryR, ChoiceR); ]; - -#Endif; ! V3 - -#IfV5; - -[ DoMenu menu_choices EntryR ChoiceR - lines main_title main_wid cl i j oldcl pkey ch cw y x; - if (pretty_flag == 0) return LowKey_Menu(menu_choices, EntryR, ChoiceR); - menu_nesting++; - menu_item = 0; - lines = EntryR(); - main_title = item_name; main_wid = item_width; - cl = 7; - - .ReDisplay; - - oldcl = 0; - @erase_window $ffff; - #Iftrue (#version_number == 6); - @set_cursor -1; - ch = HDR_FONTWUNITS->0; - #Ifnot; - ch = 1; - #Endif; - i = ch * (lines+7); - @split_window i; - i = HDR_SCREENWCHARS->0; - if (i == 0) i = 80; - @set_window 1; - @set_cursor 1 1; - - #Iftrue (#version_number == 6); - @set_font 4 -> cw; - cw = HDR_FONTHUNITS->0; - #Ifnot; - cw = 1; - #Endif; - - style reverse; - spaces(i); j=1+(i/2-main_wid)*cw; - @set_cursor 1 j; - print (string) main_title; - y=1+ch; @set_cursor y 1; spaces(i); - x=1+cw; @set_cursor y x; print (string) NKEY__TX; - j=1+(i-13)*cw; @set_cursor y j; print (string) PKEY__TX; - y=y+ch; @set_cursor y 1; spaces(i); - @set_cursor y x; print (string) RKEY__TX; - j=1+(i-18)*cw; @set_cursor y j; - - if (menu_nesting == 1) print (string) QKEY1__TX; - else print (string) QKEY2__TX; - style roman; - y = y+2*ch; - @set_cursor y x; font off; - - if (menu_choices ofclass String) print (string) menu_choices; - else menu_choices(); - - x = 1+3*cw; - for (::) { - if (cl ~= oldcl) { - if (oldcl>0) { - y=1+(oldcl-1)*ch; @set_cursor y x; print " "; - } - y=1+(cl-1)*ch; @set_cursor y x; print ">"; - } - - oldcl = cl; - @read_char 1 -> pkey; - if (pkey == NKEY1__KY or NKEY2__KY or 130) { - cl++; if (cl == 7+lines) cl = 7; continue; - } - if (pkey == PKEY1__KY or PKEY2__KY or 129) { - cl--; if (cl == 6) cl = 6+lines; continue; - } - if (pkey == QKEY1__KY or QKEY2__KY or 27 or 131) break; - if (pkey == 10 or 13 or 132) { - @set_window 0; font on; - new_line; new_line; new_line; - - menu_item = cl-6; - EntryR(); - - @erase_window $ffff; - @split_window ch; - i = HDR_SCREENWCHARS->0; if ( i== 0) i = 80; - @set_window 1; @set_cursor 1 1; style reverse; spaces(i); - j=1+(i/2-item_width)*cw; - @set_cursor 1 j; - print (string) item_name; - style roman; @set_window 0; new_line; - - i = ChoiceR(); - if (i == 2) jump ReDisplay; - if (i == 3) break; - - L__M(##Miscellany, 53); - @read_char 1 -> pkey; jump ReDisplay; - } - } - - menu_nesting--; if (menu_nesting > 0) rfalse; - font on; @set_cursor 1 1; - @erase_window $ffff; @set_window 0; - #Iftrue (#version_number == 6); - @set_cursor -2; - #Endif; - new_line; new_line; new_line; - if (deadflag == 0) <>; -]; - -#Endif; ! V5 - -#Ifnot; ! TARGET_GLULX - -[ DoMenu menu_choices EntryR ChoiceR - winwid winhgt lines main_title main_wid cl i oldcl pkey; - - if (pretty_flag == 0 || gg_statuswin == 0) return LowKey_Menu(menu_choices, EntryR, ChoiceR); - - menu_nesting++; - menu_item = 0; - lines = EntryR(); - main_title = item_name; - main_wid = item_width; - - cl = 0; - - ! If we printed "hit arrow keys" here, it would be appropriate to - ! check for the availability of Glk input keys. But we actually - ! print "hit N/P/Q". So it's reasonable to silently accept Glk - ! arrow key codes as secondary options. - - .ReDisplay; - - glk_window_clear(gg_statuswin); - glk_window_clear(gg_mainwin); - glk_set_window(gg_statuswin); - StatusLineHeight(lines+7); - glk_window_get_size(gg_statuswin, gg_arguments, gg_arguments+4); - winwid = gg_arguments-->0; - winhgt = gg_arguments-->1; - glk_set_style(style_Subheader); - glk_window_move_cursor(gg_statuswin, winwid/2-main_wid, 0); - print (string) main_title; - glk_window_move_cursor(gg_statuswin, 1, 1); - print (string) NKEY__TX; - glk_window_move_cursor(gg_statuswin, winwid-13, 1); - print (string) PKEY__TX; - glk_window_move_cursor(gg_statuswin, 1, 2); - print (string) RKEY__TX; - glk_window_move_cursor(gg_statuswin, winwid-18, 2); - if (menu_nesting == 1) print (string) QKEY1__TX; - else print (string) QKEY2__TX; - glk_set_style(style_Normal); - glk_window_move_cursor(gg_statuswin, 1, 4); - if (menu_choices ofclass String) print (string) menu_choices; - else menu_choices(); - - oldcl = -1; - - for (::) { - if (cl ~= oldcl) { - if (cl < 0 || cl >= lines) cl = 0; - if (oldcl >= 0) { - glk_window_move_cursor(gg_statuswin, 3, oldcl+6); - print (char) ' '; - } - oldcl = cl; - glk_window_move_cursor(gg_statuswin, 3, oldcl+6); - print (char) '>'; - } - pkey = KeyCharPrimitive(gg_statuswin, true); - if (pkey == $80000000) jump ReDisplay; - if (pkey == NKEY1__KY or NKEY2__KY or $fffffffb) { - cl++; - if (cl >= lines) cl = 0; - continue; - } - if (pkey == PKEY1__KY or PKEY2__KY or $fffffffc) { - cl--; - if (cl < 0) cl = lines-1; - continue; - } - if (pkey == QKEY1__KY or QKEY2__KY or $fffffff8 or $fffffffe) break; - if (pkey == $fffffffa or $fffffffd) { - glk_set_window(gg_mainwin); - new_line; new_line; new_line; - menu_item = cl+1; - EntryR(); - glk_window_clear(gg_statuswin); - glk_window_clear(gg_mainwin); - glk_set_window(gg_statuswin); - StatusLineHeight(1); - glk_window_get_size(gg_statuswin, gg_arguments, gg_arguments+4); - winwid = gg_arguments-->0; - winhgt = gg_arguments-->1; - glk_set_style(style_Subheader); - glk_window_move_cursor(gg_statuswin, winwid/2-item_width, 0); - print (string) item_name; - glk_set_style(style_Normal); - glk_set_window(gg_mainwin); - new_line; - i = ChoiceR(); - if (i == 2) jump ReDisplay; - if (i == 3) break; - L__M(##Miscellany, 53); - pkey = KeyCharPrimitive(gg_mainwin, 1); - jump ReDisplay; - } - } - - ! done with this menu... - menu_nesting--; - if (menu_nesting > 0) rfalse; - glk_set_window(gg_mainwin); - glk_window_clear(gg_mainwin); - new_line; new_line; new_line; - if (deadflag == 0) <>; -]; - -#Endif; ! TARGET_ - -! ---------------------------------------------------------------------------- -! A cunning routine (which could have been a daemon, but isn't, for the -! sake of efficiency) to move objects which could be in many rooms about -! so that the player never catches one not in place -! ---------------------------------------------------------------------------- - -[ MoveFloatingObjects i k l m address flag; - if (location == player or nothing) return; - objectloop (i) { - address = i.&found_in; - if (address && i hasnt non_floating && ~~IndirectlyContains(player, i)) { - if (metaclass(address-->0) == Routine) - flag = i.found_in(); - else { - flag = false; - k = i.#found_in/WORDSIZE; - for (l=0 : ll; - if ((m in Class && location ofclass m) || - m == location || m in location) { - flag = true; - break; - } - } - } - if (flag) { - if (i notin location) move i to location; - } else { - if (parent(i)) remove i; - } - } - } -]; - -! ---------------------------------------------------------------------------- -! Two little routines for moving the player safely. -! ---------------------------------------------------------------------------- - -[ PlayerTo newplace flag; - NoteDeparture(); - move player to newplace; - while (parent(newplace)) newplace = parent(newplace); - location = real_location = newplace; - MoveFloatingObjects(); AdjustLight(1); - switch (flag) { - 0: ; - 1: NoteArrival(); ScoreArrival(); - 2: LookSub(1); - } -]; - -[ MovePlayer direc; ; ; ]; - -! ---------------------------------------------------------------------------- -! The handy YesOrNo routine, and some "meta" verbs -! ---------------------------------------------------------------------------- - -[ YesOrNo noStatusRedraw - i j; - for (::) { - #Ifdef TARGET_ZCODE; - if (location == nothing || parent(player) == nothing || noStatusRedraw) - read buffer parse; - else read buffer parse DrawStatusLine; - j = parse->1; - #Ifnot; ! TARGET_GLULX; - noStatusRedraw = 0; ! suppress warning - KeyboardPrimitive(buffer, parse); - j = parse-->0; - #Endif; ! TARGET_ - if (j) { ! at least one word entered - i = parse-->1; - if (i == YES1__WD or YES2__WD or YES3__WD) rtrue; - if (i == NO1__WD or NO2__WD or NO3__WD) rfalse; - } - L__M(##Quit, 1); print "> "; - } -]; - -#Ifdef TARGET_ZCODE; - -[ QuitSub; - L__M(##Quit, 2); - if (YesOrNo()) quit; -]; - -[ RestartSub; - L__M(##Restart, 1); - if (YesOrNo()) { @restart; L__M(##Restart, 2); } -]; - -[ RestoreSub; - restore Rmaybe; - return L__M(##Restore, 1); - .RMaybe; - L__M(##Restore, 2); -]; - -[ SaveSub flag; - #IfV5; - @save -> flag; - switch (flag) { - 0: L__M(##Save, 1); - 1: L__M(##Save, 2); - 2: - RestoreColours(); - L__M(##Restore, 2); - } - #Ifnot; - save Smaybe; - return L__M(##Save, 1); - .SMaybe; - L__M(##Save, 2); - #Endif; ! V5 -]; - -[ VerifySub; - @verify ?Vmaybe; - jump Vwrong; - .Vmaybe; - return L__M(##Verify, 1); - .Vwrong; - L__M(##Verify, 2); -]; - -[ ScriptOnSub; - transcript_mode = ((HDR_GAMEFLAGS-->0) & 1); - if (transcript_mode) return L__M(##ScriptOn, 1); - @output_stream 2; - if (((HDR_GAMEFLAGS-->0) & 1) == 0) return L__M(##ScriptOn, 3); - L__M(##ScriptOn, 2); VersionSub(); - transcript_mode = true; -]; - -[ ScriptOffSub; - transcript_mode = ((HDR_GAMEFLAGS-->0) & 1); - if (transcript_mode == false) return L__M(##ScriptOff, 1); - L__M(##ScriptOff, 2); - @output_stream -2; - if ((HDR_GAMEFLAGS-->0) & 1) return L__M(##ScriptOff, 3); - transcript_mode = false; -]; - -[ CommandsOnSub; - @output_stream 4; - xcommsdir = 1; - L__M(##CommandsOn, 1); -]; - -[ CommandsOffSub; - if (xcommsdir == 1) @output_stream -4; - xcommsdir = 0; - L__M(##CommandsOff, 1); -]; - -[ CommandsReadSub; - @input_stream 1; - xcommsdir = 2; - L__M(##CommandsRead, 1); -]; - -#Ifnot; ! TARGET_GLULX; - -[ QuitSub; - L__M(##Quit, 2); - if (YesOrNo()) quit; -]; - -[ RestartSub; - L__M(##Restart,1); - if (YesOrNo()) { @restart; L__M(##Restart, 2); } -]; - -[ RestoreSub res fref; - fref = glk_fileref_create_by_prompt($01, $02, 0); - if (fref == 0) jump RFailed; - gg_savestr = glk_stream_open_file(fref, $02, GG_SAVESTR_ROCK); - glk_fileref_destroy(fref); - if (gg_savestr == 0) jump RFailed; - @restore gg_savestr res; - glk_stream_close(gg_savestr, 0); - gg_savestr = 0; - .RFailed; - L__M(##Restore, 1); -]; - -[ SaveSub res fref; - fref = glk_fileref_create_by_prompt($01, $01, 0); - if (fref == 0) jump SFailed; - gg_savestr = glk_stream_open_file(fref, $01, GG_SAVESTR_ROCK); - glk_fileref_destroy(fref); - if (gg_savestr == 0) jump SFailed; - @save gg_savestr res; - if (res == -1) { - ! The player actually just typed "restore". We're going to print - ! L__M(##Restore,2); the Z-Code Inform library does this correctly - ! now. But first, we have to recover all the Glk objects; the values - ! in our global variables are all wrong. - GGRecoverObjects(); - glk_stream_close(gg_savestr, 0); - gg_savestr = 0; - return L__M(##Restore, 2); - } - glk_stream_close(gg_savestr, 0); - gg_savestr = 0; - if (res == 0) return L__M(##Save, 2); - .SFailed; - L__M(##Save, 1); -]; - -[ VerifySub res; - @verify res; - if (res == 0) return L__M(##Verify, 1); - L__M(##Verify, 2); -]; - -[ ScriptOnSub; - if (gg_scriptstr) return L__M(##ScriptOn, 1); - if (gg_scriptfref == 0) { - gg_scriptfref = glk_fileref_create_by_prompt($102, $05, GG_SCRIPTFREF_ROCK); - if (gg_scriptfref == 0) jump S1Failed; - } - gg_scriptstr = glk_stream_open_file(gg_scriptfref, $05, GG_SCRIPTSTR_ROCK); - if (gg_scriptstr == 0) jump S1Failed; - glk_window_set_echo_stream(gg_mainwin, gg_scriptstr); - L__M(##ScriptOn, 2); - VersionSub(); - return; - .S1Failed; - L__M(##ScriptOn, 3); -]; - -[ ScriptOffSub; - if (gg_scriptstr == 0) return L__M(##ScriptOff,1); - L__M(##ScriptOff, 2); - glk_stream_close(gg_scriptstr, 0); - gg_scriptstr = 0; -]; - -[ CommandsOnSub fref; - if (gg_commandstr) { - if (gg_command_reading) return L__M(##CommandsOn, 2); - else return L__M(##CommandsOn, 3); - } - fref = glk_fileref_create_by_prompt($103, $01, 0); - if (fref == 0) return L__M(##CommandsOn, 4); - gg_command_reading = false; - gg_commandstr = glk_stream_open_file(fref, $01, GG_COMMANDWSTR_ROCK); - glk_fileref_destroy(fref); - if (gg_commandstr == 0) return L__M(##CommandsOn, 4); - L__M(##CommandsOn, 1); -]; - -[ CommandsOffSub; - if (gg_commandstr == 0) return L__M(##CommandsOff, 2); - if (gg_command_reading) return L__M(##CommandsRead, 5); - glk_stream_close(gg_commandstr, 0); - gg_commandstr = 0; - gg_command_reading = false; - L__M(##CommandsOff, 1); -]; - -[ CommandsReadSub fref; - if (gg_commandstr) { - if (gg_command_reading) return L__M(##CommandsRead, 2); - else return L__M(##CommandsRead, 3); - } - fref = glk_fileref_create_by_prompt($103, $02, 0); - if (fref == 0) return L__M(##CommandsRead, 4); - gg_command_reading = true; - gg_commandstr = glk_stream_open_file(fref, $02, GG_COMMANDRSTR_ROCK); - glk_fileref_destroy(fref); - if (gg_commandstr == 0) return L__M(##CommandsRead, 4); - L__M(##CommandsRead, 1); -]; - -#Endif; ! TARGET_; - -[ NotifyOnSub; notify_mode = true; L__M(##NotifyOn); ]; -[ NotifyOffSub; notify_mode = false; L__M(##NotifyOff); ]; - -[ Places1Sub i j k; - L__M(##Places, 1); - objectloop (i has visited) j++; - objectloop (i has visited) { - print (name) i; k++; - if (k == j) return L__M(##Places, 2); - if (k == j-1) print (SerialComma) j, (string) AND__TX; - else print (string) COMMA__TX; - } -]; - -[ Objects1Sub i j f; - L__M(##Objects, 1); - objectloop (i has moved) { - f = 1; print (the) i; j = parent(i); - if (j) { - if (j == player) { - if (i has worn) L__M(##Objects, 3, j, i); - else L__M(##Objects, 4, j, i); - jump Obj__Ptd; - } - if (j has animate) { L__M(##Objects, 5, j, i); jump Obj__Ptd; } - if (j has visited) { L__M(##Objects, 6, j, i); jump Obj__Ptd; } - if (j has container) { L__M(##Objects, 8, j, i); jump Obj__Ptd; } - if (j has supporter) { L__M(##Objects, 9, j, i); jump Obj__Ptd; } - if (j has enterable) { L__M(##Objects, 7, j, i); jump Obj__Ptd; } - } - L__M(##Objects, 10, j, i); - - .Obj__Ptd; - - new_line; - } - if (f == 0) L__M(##Objects, 2); -]; - -! ---------------------------------------------------------------------------- -! The scoring system -! ---------------------------------------------------------------------------- - -[ ScoreSub; - #Ifdef NO_SCORE; - if (deadflag == 0) L__M(##Score, 2); - #Ifnot; - if (deadflag) new_line; - L__M(##Score, 1); - if(PrintRank() == false) LibraryExtensions.RunAll(ext_printrank); - #Endif; ! NO_SCORE -]; - -#Ifndef TaskScore; -[ TaskScore i; - return task_scores->i; -]; -#Endif; - -[ Achieved num; - if (task_done->num == 0) { - task_done->num = 1; - score = score + TaskScore(num); - } -]; - -[ PANum m n; - print " "; - n = m; - if (n < 0) { n = -m; n = n*10; } - if (n < 10) { print " "; jump Panuml; } - if (n < 100) { print " "; jump Panuml; } - if (n < 1000) { print " "; } - - .Panuml; - - print m, " "; -]; - -[ FullScoreSub i; - ScoreSub(); - if (score == 0 || TASKS_PROVIDED == 1) rfalse; - new_line; - L__M(##FullScore, 1); - for (i=0 : ii == 1) { - PANum(TaskScore(i)); - if(PrintTaskName(i) == false) - LibraryExtensions.RunAll(ext_printtaskname,i); - } - if (things_score) { - PANum(things_score); - L__M(##FullScore, 2); - } - if (places_score) { - PANum(places_score); - L__M(##FullScore, 3); - } - new_line; PANum(score); L__M(##FullScore, 4); -]; - -! ---------------------------------------------------------------------------- -! Real verbs start here: Inventory -! ---------------------------------------------------------------------------- - -[ InvWideSub; - if (actor == player) - inventory_style = ENGLISH_BIT+FULLINV_BIT+RECURSE_BIT; - else - inventory_style = ENGLISH_BIT+PARTINV_BIT; - ; - inventory_style = 0; -]; - -[ InvTallSub; - if (actor == player) - inventory_style = NEWLINE_BIT+INDENT_BIT+FULLINV_BIT+RECURSE_BIT; - else - inventory_style = NEWLINE_BIT+INDENT_BIT+PARTINV_BIT; - ; - inventory_style = 0; -]; - -[ InvSub x; - if (child(actor) == 0) return L__M(##Inv, 1); - if (inventory_style == 0) - if (actor == player) return InvTallSub(); - else return InvWideSub(); - L__M(##Inv, 2); - if (inventory_style & NEWLINE_BIT) L__M(##Inv, 3); else print " "; - - WriteListFrom(child(actor), inventory_style, 1); - if (inventory_style & ENGLISH_BIT) L__M(##Inv, 4); - - #Ifndef MANUAL_PRONOUNS; - objectloop (x in player) PronounNotice(x); - #Endif; - x = 0; ! To prevent a "not used" error - AfterRoutines(); -]; - -! ---------------------------------------------------------------------------- -! The object tree and determining the possibility of moves -! ---------------------------------------------------------------------------- - -[ CommonAncestor o1 o2 i j; - ! Find the nearest object indirectly containing o1 and o2, - ! or return 0 if there is no common ancestor. - i = o1; - while (i) { - j = o2; - while (j) { - if (j == i) return i; - j = parent(j); - } - i = parent(i); - } - return 0; -]; - -[ IndirectlyContains o1 o2; - ! Does o1 indirectly contain o2? (Same as testing if their common ancestor is o1.) - while (o2) { - if (o1 == o2) rtrue; - if (o2 ofclass Class) rfalse; - o2 = parent(o2); - } - rfalse; -]; - -[ ObjectScopedBySomething item i j k l m; - i = item; - objectloop (j .& add_to_scope) { - l = j.&add_to_scope; - k = (j.#add_to_scope)/WORDSIZE; - if (l-->0 ofclass Routine) continue; - for (m=0 : mm == i) return j; - } - rfalse; -]; - -[ ObjectIsUntouchable item flag1 flag2 ancestor i; - ! Determine if there's any barrier preventing the actor from moving - ! things to "item". Return false if no barrier; otherwise print a - ! suitable message and return true. - ! If flag1 is set, do not print any message. - ! If flag2 is set, also apply Take/Remove restrictions. - - ! If the item has been added to scope by something, it's first necessary - ! for that something to be touchable. - - ancestor = CommonAncestor(actor, item); - if (ancestor == 0) { - ancestor = item; - while (ancestor && (i = ObjectScopedBySomething(ancestor)) == 0) - ancestor = parent(ancestor); - if (i) { - if (ObjectIsUntouchable(i, flag1, flag2)) return; - ! An item immediately added to scope - } - } - else - - ! First, a barrier between the actor and the ancestor. The actor - ! can only be in a sequence of enterable objects, and only closed - ! containers form a barrier. - - if (actor ~= ancestor) { - i = parent(actor); - while (i ~= ancestor) { - if (i has container && i hasnt open) { - if (flag1) rtrue; - return L__M(##Take, 9, i, noun); - } - i = parent(i); - } - } - - ! Second, a barrier between the item and the ancestor. The item can - ! be carried by someone, part of a piece of machinery, in or on top - ! of something and so on. - - i = parent(item); - if (item ~= ancestor && i ~= player) { - while (i ~= ancestor) { - if (flag2 && i hasnt container && i hasnt supporter) { - if (i has animate) { - if (flag1) rtrue; - return L__M(##Take, 6, i, noun); - } - if (i has transparent) { - if (flag1) rtrue; - return L__M(##Take, 7, i, noun); - } - if (flag1) rtrue; - return L__M(##Take, 8, item, noun); - } - if (i has container && i hasnt open) { - if (flag1) rtrue; - return L__M(##Take, 9, i, noun); - } - i = parent(i); - } - } - rfalse; -]; - -[ AttemptToTakeObject item - ancestor after_recipient i k; - ! Try to transfer the given item to the actor: return false - ! if successful, true if unsuccessful, printing a suitable message - ! in the latter case. - ! People cannot ordinarily be taken. - if (item == actor) return L__M(##Take, 2, noun); - if (item has animate) return L__M(##Take, 3, item); - - ancestor = CommonAncestor(actor, item); - - if (ancestor == 0) { - i = ObjectScopedBySomething(item); - if (i) ancestor = CommonAncestor(actor, i); - } - - ! Is the actor indirectly inside the item? - if (ancestor == item) return L__M(##Take, 4, item); - - ! Does the actor already directly contain the item? - if (item in actor) return L__M(##Take, 5, item); - - ! Can the actor touch the item, or is there (e.g.) a closed container - ! in the way? - if (ObjectIsUntouchable(item, false, true)) rtrue; - - ! The item is now known to be accessible. - - ! Consult the immediate possessor of the item, if it's in a container - ! which the actor is not in. - - i = parent(item); - if (i && i ~= ancestor && (i has container or supporter)) { - after_recipient = i; - k = action; action = ##LetGo; - if (RunRoutines(i, before)) { action = k; rtrue; } - action = k; - } - - if (item has scenery) return L__M(##Take, 10, item); - if (item has static) return L__M(##Take, 11, item); - - ! The item is now known to be available for taking. Is the player - ! carrying too much? If so, possibly juggle items into the rucksack - ! to make room. - - if (ObjectDoesNotFit(item, actor) || - LibraryExtensions.RunWhile(ext_objectdoesnotfit, false, item, actor)) return; - if (AtFullCapacity(item, actor)) return L__M(##Take, 12, item); - - ! Transfer the item. - - move item to actor; give item ~worn; - - ! Send "after" message to the object letting go of the item, if any. - - if (after_recipient) { - k = action; action = ##LetGo; - if (RunRoutines(after_recipient, after)) { action = k; rtrue; } - action = k; - } - rfalse; -]; - -[ AtFullCapacity n s - obj k; - n = n; ! suppress compiler warning - if (s == actor) { - objectloop (obj in s) - if (obj hasnt worn) k++; - } else - k = children(s); - - if (k < RunRoutines(s, capacity) || (s == player && RoomInSack())) rfalse; -]; - -[ RoomInSack - obj ks; - if (SACK_OBJECT && SACK_OBJECT in player) { - ks = keep_silent; keep_silent = 2; - for (obj=youngest(player) : obj : obj=elder(obj)) - if (obj ~= SACK_OBJECT && obj hasnt worn or light) { - ; - if (obj in SACK_OBJECT) { - keep_silent = ks; - return L__M(##Take, 13, obj, SACK_OBJECT); - } - } - keep_silent = ks; - } - rfalse; -]; - -! ---------------------------------------------------------------------------- -! Support for implicit actions -! ---------------------------------------------------------------------------- - -[ CheckImplicitAction act o1 o2 - sav_act sav_noun sav_sec res; - if (o1 provides before_implicit) { - sav_act = action; action = act; - sav_noun = noun; noun = o1; - if (o2) { sav_sec = second; second = o2; } - res = RunRoutines(o1, before_implicit); - action = sav_act; noun = sav_noun; - if (sav_sec) second = sav_sec; - } - else { - if (no_implicit_actions) - res = 2; - else - res = 0; - } - return res; -]; - -[ ImplicitTake obj - res ks supcon; - switch (metaclass(obj)) { Class, String, Routine, nothing: rfalse; } - if (obj in actor) rfalse; - if (action_to_be == ##Drop && ~~IndirectlyContains(actor, obj)) rfalse; - res = CheckImplicitAction(##Take, obj); - ! 0 = Take object, Tell the user (normal default) - ! 1 = Take object, don't Tell - ! 2 = don't Take object continue (default with no_implicit_actions) - ! 3 = don't Take object, don't continue - if (res >= 2) rtrue; - if (parent(obj) && parent(obj) has container or supporter) supcon = parent(obj); - ks = keep_silent; keep_silent = 2; AttemptToTakeObject(obj); keep_silent = ks; - if (obj notin actor) rtrue; - if (res == 0 && ~~keep_silent) - if (supcon) L__M(##Miscellany, 58, obj, supcon); - else L__M(##Miscellany, 26, obj); - rfalse; -]; - -[ ImplicitExit obj - res ks; - if (parent(obj) == nothing) rfalse; - res = CheckImplicitAction(##Exit, obj); - ! 0 = Exit object, Tell the user (normal default) - ! 1 = Exit object, don't Tell - ! 2 = don't Take object continue (default with no_implicit_actions) - ! 3 = don't Take object, don't continue - if (res >= 2) rtrue; - ks = keep_silent; keep_silent = 2; ; keep_silent = ks; - if (parent(actor) == obj) rtrue; - if (res == 0 && ~~keep_silent) L__M(##Exit, 5, obj); - rfalse; -]; - -[ ImplicitClose obj - res ks; - if (obj hasnt open) rfalse; - res = CheckImplicitAction(##Close, obj); - ! 0 = Close object, Tell the user (normal default) - ! 1 = Close object, don't Tell - ! 2 = don't Take object continue (default with no_implicit_actions) - ! 3 = don't Take object, don't continue - if (res >= 2) rtrue; - ks = keep_silent; keep_silent = 2; ; keep_silent = ks; - if (obj has open) rtrue; - if (res == 0 && ~~keep_silent) L__M(##Close, 4, obj); - rfalse; -]; - -[ ImplicitOpen obj - res temp; - if (obj has open) rfalse; - res = CheckImplicitAction(##Open, obj); - ! 0 = Open object, Tell the user (normal default) - ! 1 = Open object, don't Tell - ! 2 = don't Take object continue (default with no_implicit_actions) - ! 3 = don't Take object, don't continue - if (res >= 2) rtrue; - if (obj has locked) rtrue; - temp = keep_silent; keep_silent = 2; ; keep_silent = temp; - if (obj hasnt open) rtrue; - if (res == 0 && ~~keep_silent) L__M(##Open, 6, obj); - temp = action; action = ##Open; AfterRoutines(); action = temp; - rfalse; -]; - -[ ImplicitUnlock obj; - if (obj has locked) rtrue; - rfalse; -]; - -[ ImplicitDisrobe obj - res ks; - if (obj hasnt worn) rfalse; - res = CheckImplicitAction(##Disrobe, obj); - ! 0 = Take off object, Tell the user (normal default) - ! 1 = Take off object, don't Tell - ! 2 = don't Take object continue (default with no_implicit_actions) - ! 3 = don't Take object, don't continue - if (res >= 2) rtrue; - ks = keep_silent; keep_silent = 1; ; keep_silent = ks; - if (obj has worn && obj in actor) rtrue; - if (res == 0 && ~~keep_silent) L__M(##Drop, 3, obj); - rfalse; -]; - - -! ---------------------------------------------------------------------------- -! Object movement verbs -! ---------------------------------------------------------------------------- - -[ TakeSub; - if (onotheld_mode == 0 || noun notin actor) - if (AttemptToTakeObject(noun)) return; - if (AfterRoutines()) return; - notheld_mode = onotheld_mode; - if (notheld_mode == 1 || keep_silent) return; - L__M(##Take, 1, noun); -]; - -[ RemoveSub i; - i = parent(noun); - if (i && i has container && i hasnt open && ImplicitOpen(i)) return L__M(##Remove, 1, i); - if (i ~= second) return L__M(##Remove, 2, noun); - if (i has animate) return L__M(##Take, 6, i, noun); - - if (AttemptToTakeObject(noun)) rtrue; - - action = ##Remove; if (AfterRoutines()) return; - action = ##Take; if (AfterRoutines()) return; - if (keep_silent) return; - L__M(##Remove, 3, noun); -]; - -[ DropSub; - if (noun == actor) return L__M(##PutOn, 4, noun); - if (noun in parent(actor)) return L__M(##Drop, 1, noun); - if (noun notin actor && ~~ImplicitTake(noun)) return L__M(##Drop, 2, noun); - if (noun has worn && ImplicitDisrobe(noun)) return; - move noun to parent(actor); - if (AfterRoutines() || keep_silent) return; - L__M(##Drop, 4, noun); -]; - -[ PutOnSub ancestor; - receive_action = ##PutOn; - if (second == d_obj || actor in second) <>; - if (parent(noun) == second) return L__M(##Drop, 1, noun); - if (noun notin actor && ImplicitTake(noun)) return L__M(##PutOn, 1, noun); - - ancestor = CommonAncestor(noun, second); - if (ancestor == noun) return L__M(##PutOn, 2, noun); - if (ObjectIsUntouchable(second)) return; - - if (second ~= ancestor) { - action = ##Receive; - if (RunRoutines(second, before)) { action = ##PutOn; return; } - action = ##PutOn; - } - if (second hasnt supporter) return L__M(##PutOn, 3, second); - if (ancestor == actor) return L__M(##PutOn, 4, second); - if (noun has worn && ImplicitDisrobe(noun)) return; - - if (ObjectDoesNotFit(noun, second) || - LibraryExtensions.RunWhile(ext_objectdoesnotfit, false, noun, second)) return; - if (AtFullCapacity(noun, second)) return L__M(##PutOn, 6, second); - - move noun to second; - - if (AfterRoutines()) return; - - if (second ~= ancestor) { - action = ##Receive; - if (RunRoutines(second, after)) { action = ##PutOn; return; } - action = ##PutOn; - } - if (keep_silent) return; - if (multiflag) return L__M(##PutOn, 7); - L__M(##PutOn, 8, noun, second); -]; - -[ InsertSub ancestor; - receive_action = ##Insert; - if (second == d_obj || actor in second) <>; - if (parent(noun) == second) return L__M(##Drop, 1, noun); - if (noun notin actor && ImplicitTake(noun)) return L__M(##Insert, 1, noun); - ancestor = CommonAncestor(noun, second); - if (ancestor == noun) return L__M(##Insert, 5, noun); - if (ObjectIsUntouchable(second)) return; - if (second ~= ancestor) { - action = ##Receive; - if (RunRoutines(second,before)) { action = ##Insert; rtrue; } - action = ##Insert; - if (second has container && second hasnt open && ImplicitOpen(second)) - return L__M(##Insert, 3, second); - } - if (second hasnt container) return L__M(##Insert, 2, second); - if (noun has worn && ImplicitDisrobe(noun)) return; - - if (ObjectDoesNotFit(noun, second) || - LibraryExtensions.RunWhile(ext_objectdoesnotfit, false, noun, second)) return; - if (AtFullCapacity(noun, second)) return L__M(##Insert, 7, second); - - move noun to second; - - if (AfterRoutines()) rtrue; - - if (second ~= ancestor) { - action = ##Receive; - if (RunRoutines(second, after)) { action = ##Insert; rtrue; } - action = ##Insert; - } - if (keep_silent) rtrue; - if (multiflag) return L__M(##Insert, 8, noun); - L__M(##Insert, 9, noun, second); -]; - -! ---------------------------------------------------------------------------- -! Empties and transfers are routed through the actions above -! ---------------------------------------------------------------------------- - -[ TransferSub; - if (noun notin actor && AttemptToTakeObject(noun)) return; - if (second has supporter) <>; - if (second == d_obj) <>; - <>; -]; - -[ EmptySub; second = d_obj; EmptyTSub(); ]; - -[ EmptyTSub i j k flag; - if (noun == second) return L__M(##EmptyT, 4, noun); - if (ObjectIsUntouchable(noun)) return; - if (noun hasnt container) return L__M(##EmptyT, 1, noun); - if (noun hasnt open && ImplicitOpen(noun)) return L__M(##EmptyT, 2, noun); - if (second ~= d_obj) { - if (second hasnt supporter) { - if (second hasnt container) return L__M(##EmptyT, 1, second); - if (second hasnt open && ImplicitOpen(second)) - return L__M(##EmptyT, 2, second); - } - } - i = child(noun); k = children(noun); - if (i == 0) return L__M(##EmptyT, 3, noun); - while (i) { - j = sibling(i); - flag = false; - if (ObjectIsUntouchable(noun)) flag = true; - if (noun hasnt container) flag = true; - if (noun hasnt open) flag = true; - if (second ~= d_obj) { - if (second hasnt supporter) { - if (second hasnt container) flag = true; - if (second hasnt open) flag = true; - } - } - if (k-- == 0) flag = 1; - if (flag) break; - if (keep_silent == 0) print (name) i, (string) COLON__TX; - ; - i = j; - } -]; - -! ---------------------------------------------------------------------------- -! Gifts -! ---------------------------------------------------------------------------- - -[ GiveSub; - if (noun notin actor && ImplicitTake(noun)) return L__M(##Give, 1, noun); - if (second == actor) return L__M(##Give, 2, noun); - if (noun has worn && ImplicitDisrobe(noun)) return; - if (second == player) { - move noun to player; - return L__M(##Give, 4, noun); - } - - if (RunLife(second, ##Give)) return; - L__M(##Give, 3, second); -]; - -[ GiveRSub; ; ]; - -[ ShowSub; - if (noun notin actor && ImplicitTake(noun)) return L__M(##Show, 1, noun); - if (second == player) <>; - if (RunLife(second, ##Show)) return; - L__M(##Show, 2, second); -]; - -[ ShowRSub; ; ]; - -! ---------------------------------------------------------------------------- -! Travelling around verbs -! ---------------------------------------------------------------------------- - -[ EnterSub ancestor j ks; - if (noun has door || noun in compass) <>; - if (actor in noun) return L__M(##Enter, 1, noun); - if (noun hasnt enterable) return L__M(##Enter, 2, noun, verb_word); - - if (parent(actor) ~= parent(noun)) { - ancestor = CommonAncestor(actor, noun); - if (ancestor == actor or 0) return L__M(##Enter, 4, noun); - while (actor notin ancestor) { - j = parent(actor); - ks = keep_silent; - if (parent(j) ~= ancestor || noun ~= ancestor) { - L__M(##Enter, 6, j); - keep_silent = 1; - } - ; - keep_silent = ks; - if (actor in j) return; - } - if (actor in noun) return; - if (noun notin ancestor) { - j = parent(noun); - while (parent(j) ~= ancestor) j = parent(j); - L__M(##Enter, 7, j); - ks = keep_silent; keep_silent = 1; - ; - keep_silent = ks; - if (actor notin j) return; - <>; - } - } - - if (noun has container && noun hasnt open && ImplicitOpen(noun)) return L__M(##Enter, 3, noun); - move actor to noun; - - if (AfterRoutines() || keep_silent) return; - L__M(##Enter, 5, noun); - if (actor == player) Locale(noun); -]; - -[ GetOffSub; - if (parent(actor) == noun) <>; - L__M(##GetOff, 1, noun); -]; - -[ ExitSub p; - p = parent(actor); - if (noun ~= nothing && noun ~= p) return L__M(##Exit, 4 ,noun); - if (p == location || (location == thedark && p == real_location)) { - if (actor provides posture && actor.posture) { - actor.posture = 0; - return L__M(##Exit, 6); - } - if ((location.out_to) || (location == thedark && real_location.out_to)) - <>; - return L__M(##Exit, 1); - } - if (p has container && p hasnt open && ImplicitOpen(p)) - return L__M(##Exit, 2, p); - - if (noun == nothing) { - inp1 = p; - if (RunRoutines(p, before)) return; - } - - move actor to parent(p); - if (player provides posture) player.posture = 0; - - if (AfterRoutines() || keep_silent) return; - L__M(##Exit, 3, p); - if (actor == player && p has container) LookSub(1); -]; - -[ VagueGoSub; L__M(##VagueGo); ]; - -[ GoInSub; <>; ]; - -[ GoSub i j k movewith thedir next_loc; - - ! first, check if any PushDir object is touchable - if (second && second notin Compass && ObjectIsUntouchable(second)) return; - - movewith = 0; - i = parent(actor); - if ((location ~= thedark && i ~= location) || (location == thedark && i ~= real_location)) { - j = location; - if (location == thedark) location = real_location; - k = RunRoutines(i, before); if (k ~= 3) location = j; - if (k == 1) { - movewith = i; i = parent(i); - } - else { - if (k) rtrue; - if (ImplicitExit(i)) return L__M(##Go, 1, i); - i = parent(actor); - } - } - - thedir = noun.door_dir; - if (metaclass(thedir) == Routine) thedir = RunRoutines(noun, door_dir); - - next_loc = i.thedir; k = metaclass(next_loc); - if (k == String) { print (string) next_loc; new_line; rfalse; } - if (k == Routine) { - next_loc = RunRoutines(i, thedir); - if (next_loc == 1) rtrue; - } - - if (k == nothing || next_loc == 0) { - if (i.cant_go ~= 0 or CANTGO__TX) PrintOrRun(i, cant_go); - else L__M(##Go, 2); - rfalse; - } - if (next_loc has door) { - if (next_loc has concealed) return L__M(##Go, 2); - if (next_loc hasnt open && ImplicitOpen(next_loc)) { - if (noun == u_obj) return L__M(##Go, 3, next_loc); - if (noun == d_obj) return L__M(##Go, 4, next_loc); - return L__M(##Go, 5, next_loc); - } - k = RunRoutines(next_loc, door_to); - if (k == 0) return L__M(##Go, 6, next_loc); - if (k == 1) rtrue; - next_loc = k; - } - - action = ##Going; - if (RunRoutines(next_loc, before)) { action = ##Go; return; } - action = ##Go; - - if (movewith == 0) move actor to next_loc; else move movewith to next_loc; - if (actor ~= player) return L__M(##Go, 7); - - k = location; location = next_loc; - MoveFloatingObjects(); - if (OffersLight(location)) - lightflag = true; - else { - lightflag = false; - if (k == thedark) { - if(DarkToDark() == false) ! From real_location To location - LibraryExtensions.RunAll(ext_darktodark); - if (deadflag) rtrue; - } - location = thedark; - } - NoteDeparture(); real_location = next_loc; - action = ##Going; - if (RunRoutines(prev_location, after)) { action = ##Go; return; } - action = ##Go; - if (AfterRoutines() || keep_silent) return; - LookSub(1); -]; - -! ---------------------------------------------------------------------------- -! Describing the world. SayWhatsOn(object) does just that (producing -! no text if nothing except possibly "scenery" and "concealed" items are). -! Locale(object) runs through the "tail end" of a Look-style room -! description for the contents of the object, printing up suitable -! descriptions as it goes. -! ---------------------------------------------------------------------------- - -[ SayWhatsOn descon j f; - if (descon == parent(player)) rfalse; - objectloop (j in descon) - if (j hasnt concealed && j hasnt scenery) f = 1; - if (f == 0) rfalse; - L__M(##Look, 4, descon); -]; - -[ NotSupportingThePlayer o i; - i = parent(player); - while (i && i ~= visibility_ceiling) { - if (i == o) rfalse; - i = parent(i); - if (i && i hasnt supporter) rtrue; - } - rtrue; -]; -! modified with the fix for L61122 -[ Locale descin text_without_ALSO text_with_ALSO - o p num_objs must_print_ALSO; - objectloop (o in descin) give o ~workflag; - num_objs = 0; - objectloop (o in descin) - if (o hasnt concealed && NotSupportingThePlayer(o)) { - #Ifndef MANUAL_PRONOUNS; - PronounNotice(o); - #Endif; - if (o has scenery) { - if (o has supporter && child(o)) SayWhatsOn(o); - } - else { - give o workflag; num_objs++; - p = initial; - if ((o has door or container) && o has open && o provides when_open) { - p = when_open; jump Prop_Chosen; - } - if ((o has door or container) && o hasnt open && o provides when_closed) { - p = when_closed; jump Prop_Chosen; - } - if (o has switchable && o has on && o provides when_on) { - p = when_on; jump Prop_Chosen; - } - if (o has switchable && o hasnt on && o provides when_off) { - p = when_off; - } - - .Prop_Chosen; - - if (o.&describe && RunRoutines(o, describe)) { - must_print_ALSO = true; - give o ~workflag; num_objs--; - continue; - } - if (o.p && (o hasnt moved || p ~= initial)) { - new_line; - PrintOrRun(o, p); - must_print_ALSO = true; - give o ~workflag; num_objs--; - if (o has supporter && child(o)) SayWhatsOn(o); - } - } - } - - if (num_objs == 0) return 0; - - if (actor ~= player) give actor concealed; - if (text_without_ALSO) { - new_line; - if (must_print_ALSO) print (string) text_with_ALSO, " "; - else print (string) text_without_ALSO, " "; - WriteListFrom(child(descin), - ENGLISH_BIT+RECURSE_BIT+PARTINV_BIT+TERSE_BIT+CONCEAL_BIT+WORKFLAG_BIT); - } - else { - if (must_print_ALSO) L__M(##Look, 5, descin); - else L__M(##Look, 6, descin); - } - if (actor ~= player) give actor ~concealed; - return num_objs; -]; - -! ---------------------------------------------------------------------------- -! Looking. LookSub(1) is allowed to abbreviate long descriptions, but -! LookSub(0) (which is what happens when the Look action is generated) -! isn't. (Except that these are over-ridden by the player-set lookmode.) -! ---------------------------------------------------------------------------- - -[ LMode1Sub; lookmode=1; print (string) Story; L__M(##LMode1); ]; ! Brief - -[ LMode2Sub; lookmode=2; print (string) Story; L__M(##LMode2); ]; ! Verbose - -[ LMode3Sub; lookmode=3; print (string) Story; L__M(##LMode3); ]; ! Superbrief - -[ LModeNormalSub; ! 'normal' value: the default, or as set in Initialise() - switch (initial_lookmode) { - 1: <>; - 3: <>; - default: <>; - } -]; - -[ NoteArrival descin; - if (location ~= lastdesc) { - if (location.initial) PrintOrRun(location, initial); - if (location == thedark) { lastdesc = thedark; return; } - descin = location; - if(NewRoom() == false) LibraryExtensions.RunAll(ext_newroom); - lastdesc = descin; - } -]; - -[ NoteDeparture; - prev_location = real_location; -]; - -[ ScoreArrival; - if (location hasnt visited) { - give location visited; - if (location has scored) { - score = score + ROOM_SCORE; - places_score = places_score + ROOM_SCORE; - } - } -]; - -[ FindVisibilityLevels visibility_levels; - visibility_levels = 1; - visibility_ceiling = parent(player); - while ((parent(visibility_ceiling)) && - (visibility_ceiling hasnt container || visibility_ceiling has open or transparent)) { - visibility_ceiling = parent(visibility_ceiling); - visibility_levels++; - } - return visibility_levels; -]; - -[ LookSub allow_abbrev visibility_levels i j k nl_flag; - if (parent(player) == 0) return RunTimeError(10); - - .MovedByInitial; - - if (location == thedark) { visibility_ceiling = thedark; NoteArrival(); } - else { - visibility_levels = FindVisibilityLevels(); - if (visibility_ceiling == location) { - NoteArrival(); - if (visibility_ceiling ~= location) jump MovedByInitial; - } - } - ! Printing the top line: e.g. - ! Octagonal Room (on the table) (as Frodo) - new_line; - #Ifdef TARGET_ZCODE; - style bold; - #Ifnot; ! TARGET_GLULX; - glk_set_style(style_Subheader); - #Endif; ! TARGET_ - if (visibility_levels == 0) print (name) thedark; - else { - if (visibility_ceiling ~= location) print (The) visibility_ceiling; - else print (name) visibility_ceiling; - } - #Ifdef TARGET_ZCODE; - style roman; - #Ifnot; ! TARGET_GLULX; - glk_set_style(style_Normal); - #Endif; ! TARGET_ - - for (j=1,i=parent(player) : j0 : j--,i=parent(i)) give i workflag; - - for (j=visibility_levels : j>0 : j--) { - for (i=player,k=0 : k>; - else return L__M(##Search, 5, noun); - if (noun has switchable) { L__M(##Examine, 3, noun); rfalse; } - return L__M(##Examine, 2, noun); - } - i = PrintOrRun(noun, description); - if (i < 2 && noun has switchable) L__M(##Examine, 3, noun); - AfterRoutines(); -]; - -[ LookUnderSub; - if (location == thedark) return L__M(##LookUnder, 1, noun); - L__M(##LookUnder, 2); -]; - -[ VisibleContents o i f; - objectloop (i in o) if (i hasnt concealed or scenery) f++; - return f; -]; - -[ SearchSub f; - if (location == thedark) return L__M(##Search, 1, noun); - if (ObjectIsUntouchable(noun)) return; - f = VisibleContents(noun); - if (noun has supporter) { - if (f == 0) return L__M(##Search, 2, noun); - return L__M(##Search, 3, noun); - } - if (noun hasnt container) return L__M(##Search, 4, noun); - if (noun hasnt transparent or open && ImplicitOpen(noun)) return L__M(##Search, 5, noun); - if (AfterRoutines()) return; - - if (f == 0) return L__M(##Search, 6, noun); - L__M(##Search, 7, noun); -]; - -! ---------------------------------------------------------------------------- -! Verbs which change the state of objects without moving them -! ---------------------------------------------------------------------------- - -[ UnlockSub; - if (ObjectIsUntouchable(noun)) return; - if (noun hasnt lockable) return L__M(##Unlock, 1, noun); - if (noun hasnt locked) return L__M(##Unlock, 2, noun); - if (noun.with_key ~= second) return L__M(##Unlock, 3, second); - - give noun ~locked; - - if (AfterRoutines() || keep_silent) return; - L__M(##Unlock, 4, noun); -]; - -[ LockSub; - if (ObjectIsUntouchable(noun)) return; - if (noun hasnt lockable) return L__M(##Lock, 1, noun); - if (noun has locked) return L__M(##Lock, 2 ,noun); - if (noun has open && ImplicitClose(noun)) return L__M(##Lock, 3, noun); - if (noun.with_key ~= second) return L__M(##Lock, 4, second); - - give noun locked; - if (AfterRoutines() || keep_silent) return; - L__M(##Lock, 5, noun); -]; - -[ SwitchonSub; - if (ObjectIsUntouchable(noun)) return; - if (noun hasnt switchable) return L__M(##SwitchOn, 1, noun); - if (noun has on) return L__M(##SwitchOn, 2, noun); - - give noun on; - if (AfterRoutines() || keep_silent) return; - L__M(##SwitchOn, 3, noun); -]; - -[ SwitchoffSub; - if (ObjectIsUntouchable(noun)) return; - if (noun hasnt switchable) return L__M(##SwitchOff, 1, noun); - if (noun hasnt on) return L__M(##SwitchOff, 2, noun); - - give noun ~on; - if (AfterRoutines() || keep_silent) return; - L__M(##SwitchOff, 3, noun); -]; - -[ OpenSub; - if (ObjectIsUntouchable(noun)) return; - if (noun hasnt openable) return L__M(##Open, 1, noun); - if (noun has locked && ImplicitUnlock(noun)) return L__M(##Open, 2, noun); - if (noun has open) return L__M(##Open, 3, noun); - give noun open; - - if (keep_silent || AfterRoutines()) return; - - if (noun hasnt container) - return L__M(##Open, 5, noun); - - if ((noun has container && location ~= thedark && VisibleContents(noun) - && IndirectlyContains(noun, player)) == 0) { - if (noun hasnt transparent && noun hasnt door) return L__M(##Open, 4, noun); - } - L__M(##Open, 5, noun); -]; - -[ CloseSub; - if (ObjectIsUntouchable(noun)) return; - if (noun hasnt openable) return L__M(##Close, 1, noun); - if (noun hasnt open) return L__M(##Close, 2, noun); - - give noun ~open; - if (AfterRoutines() || keep_silent) return; - L__M(##Close, 3, noun); -]; - -[ DisrobeSub; - if (ObjectIsUntouchable(noun)) return; - if (noun hasnt worn) return L__M(##Disrobe, 1, noun); - - give noun ~worn; - if (AfterRoutines() || keep_silent) return; - L__M(##Disrobe, 2, noun); -]; - -[ WearSub; - if (ObjectIsUntouchable(noun)) return; - if (noun hasnt clothing) return L__M(##Wear, 1, noun); - if (noun notin actor && ImplicitTake(noun)) return L__M(##Wear, 2, noun); - if (noun has worn) return L__M(##Wear, 3, noun); - - give noun worn; - if (AfterRoutines() || keep_silent) return; - L__M(##Wear, 4, noun); -]; - -[ EatSub; - if (ObjectIsUntouchable(noun)) return; - if (noun hasnt edible) return L__M(##Eat, 1, noun); - if (noun has worn && ImplicitDisrobe(noun)) return; - - remove noun; - if (AfterRoutines() || keep_silent) return; - L__M(##Eat, 2, noun); -]; - -! ---------------------------------------------------------------------------- -! Verbs which are really just stubs (anything which happens for these -! actions must happen in before rules) -! ---------------------------------------------------------------------------- - -[ AllowPushDir i; - if (parent(second) ~= compass) return L__M(##PushDir, 2, noun); - if (second == u_obj or d_obj) return L__M(##PushDir, 3, noun); - AfterRoutines(); i = noun; move i to actor; - ; - if (location == thedark) move i to real_location; - else move i to location; -]; - -[ AnswerSub; - if (second && RunLife(second,##Answer)) rfalse; - L__M(##Answer, 1, noun); -]; - -[ AskSub; - if (RunLife(noun,##Ask)) rfalse; - L__M(##Ask, 1, noun); -]; - -[ AskForSub; - if (noun == player) <>; - L__M(##Order, 1, noun); -]; - -[ AskToSub; L__M(##Order, 1, noun); ]; - -[ AttackSub; - if (ObjectIsUntouchable(noun)) return; - if (noun has animate && RunLife(noun, ##Attack)) rfalse; - L__M(##Attack, 1, noun); -]; - -[ BlowSub; L__M(##Blow, 1, noun); ]; - -[ BurnSub; - if (noun has animate) return L__M(##Burn, 2, noun); - L__M(##Burn, 1, noun); -]; - -[ BuySub; L__M(##Buy, 1, noun); ]; - -[ ClimbSub; - if (noun has animate) return L__M(##Climb, 2, noun); - L__M(##Climb, 1, noun); -]; - -[ ConsultSub; L__M(##Consult, 1, noun); ]; - -[ CutSub; - if (noun has animate) return L__M(##Cut, 2, noun); - L__M(##Cut, 1, noun); -]; - -[ DigSub; L__M(##Dig, 1, noun); ]; - -[ DrinkSub; L__M(##Drink, 1, noun); ]; - -[ FillSub; - if (second == nothing) return L__M(##Fill, 1, noun); - L__M(##Fill, 2, noun, second); -]; - -[ JumpSub; L__M(##Jump, 1, noun); ]; - -[ JumpInSub; - if (noun has animate) return L__M(##JumpIn, 2, noun); - if (noun has enterable) <>; - L__M(##JumpOn, 1, noun); -]; - -[ JumpOnSub; - if (noun has animate) return L__M(##JumpOn, 2, noun); - if (noun has enterable && noun has supporter) <>; - L__M(##JumpOn, 1, noun); -]; - -[ JumpOverSub; - if (noun has animate) return L__M(##JumpOver, 2, noun); - L__M(##JumpOver, 1, noun); -]; - -[ KissSub; - if (ObjectIsUntouchable(noun)) return; - if (RunLife(noun, ##Kiss)) return; - if (noun == actor) return L__M(##Touch, 3, noun); - L__M(##Kiss, 1, noun); -]; - -[ ListenSub; L__M(##Listen, 1, noun); ]; - -[ MildSub; L__M(##Mild, 1, noun); ]; - -[ NoSub; L__M(##No); ]; - -[ PraySub; L__M(##Pray, 1, noun); ]; - -[ PullSub; - if (ObjectIsUntouchable(noun)) return; - if (noun == player) return L__M(##Pull, 1, noun); - if (noun == actor) return L__M(##Pull, 6, noun); - if (noun has static) return L__M(##Pull, 2, noun); - if (noun has scenery) return L__M(##Pull, 3, noun); - if (noun has animate) return L__M(##Pull, 5, noun); - L__M(##Pull, 4, noun); -]; - -[ PushSub; - if (ObjectIsUntouchable(noun)) return; - if (noun == player) return L__M(##Push, 1, noun); - if (noun == actor) return L__M(##Push, 5, noun); - if (noun has static) return L__M(##Push, 2, noun); - if (noun has scenery) return L__M(##Push, 3, noun); - if (noun has animate) return L__M(##Push, 5, noun); - L__M(##Push, 4, noun); -]; - -[ PushDirSub; L__M(##PushDir, 1, noun); ]; - -[ RubSub; - if (ObjectIsUntouchable(noun)) return; - if (noun has animate) return L__M(##Rub, 2, noun); - L__M(##Rub, 1, noun); -]; - -[ SetSub; L__M(##Set, 1, noun); ]; - -[ SetToSub; L__M(##SetTo, 1, noun); ]; - -[ SingSub; L__M(##Sing, 1, noun); ]; - -[ SleepSub; L__M(##Sleep, 1, noun); ]; - -[ SmellSub; - if (noun ~= nothing && noun has animate) return L__M(##Smell, 2, noun); - L__M(##Smell, 1, noun); -]; - -[ SorrySub; L__M(##Sorry, 1, noun); ]; - -[ SqueezeSub; - if (ObjectIsUntouchable(noun)) return; - if (noun has animate && noun ~= player) return L__M(##Squeeze, 1, noun); - L__M(##Squeeze, 2, noun); -]; - -[ StrongSub; L__M(##Strong, 1, noun); ]; - -[ SwimSub; L__M(##Swim, 1, noun); ]; - -[ SwingSub; L__M(##Swing, 1, noun); ]; - -[ TasteSub; - if (ObjectIsUntouchable(noun)) return; - if (noun has animate) return L__M(##Taste, 2, noun); - L__M(##Taste, 1, noun); -]; - -[ TellSub; - if (noun == actor) return L__M(##Tell, 1, noun); - if (RunLife(noun, ##Tell)) return; - L__M(##Tell, 2, noun); -]; - -[ ThinkSub; L__M(##Think, 1, noun); ]; - -[ ThrowAtSub; - if (ObjectIsUntouchable(noun)) return; - if (second > 1) { - action = ##ThrownAt; - if (RunRoutines(second, before)) { action = ##ThrowAt; rtrue; } - action = ##ThrowAt; - } - if (noun has worn && ImplicitDisrobe(noun)) return; - if (second hasnt animate) return L__M(##ThrowAt, 1, noun); - if (RunLife(second, ##ThrowAt)) return; - L__M(##ThrowAt, 2, noun); -]; - -[ TieSub; - if (noun has animate) return L__M(##Tie, 2, noun); - L__M(##Tie, 1, noun); -]; - -[ TouchSub; - if (noun == actor) return L__M(##Touch, 3, noun); - if (ObjectIsUntouchable(noun)) return; - if (noun has animate) return L__M(##Touch, 1, noun); - L__M(##Touch, 2,noun); -]; - -[ TurnSub; - if (ObjectIsUntouchable(noun)) return; - if (noun == player) return L__M(##Turn, 1, noun); - if (noun == actor) return L__M(##Turn, 5, noun); - if (noun has static) return L__M(##Turn, 2, noun); - if (noun has scenery) return L__M(##Turn, 3, noun); - if (noun has animate) return L__M(##Turn, 5, noun); - L__M(##Turn, 4, noun); -]; - -[ WaitSub; - if (AfterRoutines()) rtrue; - L__M(##Wait, 1, noun); -]; - -[ WakeSub; L__M(##Wake, 1, noun); ]; - -[ WakeOtherSub; - if (ObjectIsUntouchable(noun)) return; - if (RunLife(noun, ##WakeOther)) return; - L__M(##WakeOther, 1, noun); -]; - -[ WaveSub; - if (noun == player) return L__M(##Wave, 2 ,noun, second); - if (noun == actor) return L__M(##Wave, 3, noun, second); - if (noun notin actor && ImplicitTake(noun)) return L__M(##Wave, 1, noun); - L__M(##Wave, 2, noun, second); -]; - -[ WaveHandsSub; - if (noun) return L__M(##WaveHands, 2, noun); - L__M(##WaveHands, 1, noun); ]; - -[ YesSub; L__M(##Yes); ]; - -! ---------------------------------------------------------------------------- -! Debugging verbs -! ---------------------------------------------------------------------------- - -#Ifdef DEBUG; - -[ TraceOnSub; parser_trace = 1; "[Trace on.]"; ]; - -[ TraceLevelSub; - parser_trace = noun; - print "[Parser tracing set to level ", parser_trace, ".]^"; -]; - -[ TraceOffSub; parser_trace = 0; "Trace off."; ]; - -[ RoutinesOnSub; - debug_flag = debug_flag | DEBUG_MESSAGES; - "[Message listing on.]"; -]; - -[ RoutinesOffSub; - debug_flag = debug_flag & ~DEBUG_MESSAGES; - "[Message listing off.]"; -]; - -[ RoutinesVerboseSub; - debug_flag = debug_flag | (DEBUG_VERBOSE|DEBUG_MESSAGES); - "[Verbose message listing on.]"; -]; - -[ ActionsOnSub; - debug_flag = debug_flag | DEBUG_ACTIONS; - "[Action listing on.]"; -]; - -[ ActionsOffSub; - debug_flag = debug_flag & ~DEBUG_ACTIONS; - "[Action listing off.]"; -]; - -[ TimersOnSub; - debug_flag = debug_flag | DEBUG_TIMERS; - "[Timers listing on.]"; -]; - -[ TimersOffSub; - debug_flag = debug_flag & ~DEBUG_TIMERS; - "[Timers listing off.]"; -]; - -#Ifdef VN_1610; - -[ ChangesOnSub; debug_flag = debug_flag | DEBUG_CHANGES; "[Changes listing on.]"; ]; -[ ChangesOffSub; debug_flag = debug_flag & ~DEBUG_CHANGES; "[Changes listing off.]"; ]; - -#Ifnot; - -[ ChangesOnSub; "[Changes listing available only from Inform 6.2 onwards.]"; ]; - -[ ChangesOffSub; "[Changes listing available only from Inform 6.2 onwards.]"; ]; - -#Endif; ! VN_1610 - -#Ifdef TARGET_ZCODE; - -[ PredictableSub i; - i = random(-100); - "[Random number generator now predictable.]"; -]; - -#Ifnot; ! TARGET_GLULX; - -[ PredictableSub; - @setrandom 100; - "[Random number generator now predictable.]"; -]; - -#Endif; ! TARGET_; - -[ XTestMove obj dest; - if (~~obj ofclass Object) "[Not an object.]"; - if (~~dest ofclass Object) "[Destination not an object.]"; - if ((obj <= InformLibrary) || (obj == LibraryMessages) || (obj in 1)) - "[Can't move ", (name) obj, ": it's a system object.]"; - while (dest) { - if (dest == obj) "[Can't move ", (name) obj, ": it would contain itself.]"; - dest = parent(dest); - } - rfalse; -]; - -[ XPurloinSub; - if (XTestMove(noun, player)) return; - move noun to player; give noun moved ~concealed; - "[Purloined.]"; -]; - -[ XAbstractSub; - if (XTestMove(noun, second)) return; - move noun to second; - "[Abstracted.]"; -]; - -[ XObj obj f; - if (parent(obj) == 0) print (name) obj; else print (a) obj; - print " (", obj, ") "; - if (f && parent(obj)) - print "in ~", (name) parent(obj), "~ (", parent(obj), ")"; - new_line; - if (child(obj) == 0) rtrue; - if (obj == Class) ! ??? - WriteListFrom(child(obj), NEWLINE_BIT+INDENT_BIT+ALWAYS_BIT+ID_BIT+NOARTICLE_BIT, 1); - else - WriteListFrom(child(obj), NEWLINE_BIT+INDENT_BIT+ALWAYS_BIT+ID_BIT+FULLINV_BIT, 1); -]; - -[ XTreeSub i; - if (noun && ~~noun ofclass Object) "[Not an object.]"; - if (noun == 0) { - objectloop (i) - if (i ofclass Object && parent(i) == 0) XObj(i); - } - else XObj(noun, true); -]; - -[ GotoSub; - if ((~~noun ofclass Object) || parent(noun)) "[Not a safe place.]"; - PlayerTo(noun); -]; - -[ GoNearSub x; - if (~~noun ofclass Object) "[Not a safe place.]"; - x = noun; - while (parent(x)) x = parent(x); - PlayerTo(x); -]; - -[ Print_ScL obj; print_ret ++x_scope_count, ": ", (a) obj, " (", obj, ")"; ]; - -[ ScopeSub; - if (noun && ~~noun ofclass Object) "[Not an object.]"; - x_scope_count = 0; - LoopOverScope(Print_ScL, noun); - if (x_scope_count == 0) "Nothing is in scope."; -]; - -#Ifdef TARGET_GLULX; - -[ GlkListSub id val; - id = glk_window_iterate(0, gg_arguments); - while (id) { - print "Window ", id, " (", gg_arguments-->0, "): "; - val = glk_window_get_type(id); - switch (val) { - 1: print "pair"; - 2: print "blank"; - 3: print "textbuffer"; - 4: print "textgrid"; - 5: print "graphics"; - default: print "unknown"; - } - val = glk_window_get_parent(id); - if (val) print ", parent is window ", val; - else print ", no parent (root)"; - val = glk_window_get_stream(id); - print ", stream ", val; - val = glk_window_get_echo_stream(id); - if (val) print ", echo stream ", val; - print "^"; - id = glk_window_iterate(id, gg_arguments); - } - id = glk_stream_iterate(0, gg_arguments); - while (id) { - print "Stream ", id, " (", gg_arguments-->0, ")^"; - id = glk_stream_iterate(id, gg_arguments); - } - id = glk_fileref_iterate(0, gg_arguments); - while (id) { - print "Fileref ", id, " (", gg_arguments-->0, ")^"; - id = glk_fileref_iterate(id, gg_arguments); - } - val = glk_gestalt(gestalt_Sound, 0); - if (val) { - id = glk_schannel_iterate(0, gg_arguments); - while (id) { - print "Soundchannel ", id, " (", gg_arguments-->0, ")^"; - id = glk_schannel_iterate(id, gg_arguments); - } - } -]; - -#Endif; ! TARGET_; - -#Endif; ! DEBUG - -! ---------------------------------------------------------------------------- -! Finally: the mechanism for library text (the text is in the language defn) -! ---------------------------------------------------------------------------- - -[ L__M act n x1 x2 s; - if (keep_silent == 2) return; - s = sw__var; - sw__var = act; - if (n == 0) n = 1; - L___M(n, x1, x2); - sw__var = s; -]; - -[ L___M n x1 x2 s; - s = action; - lm_n = n; - lm_o = x1; - lm_s = x2; - action = sw__var; - if (RunRoutines(LibraryMessages, before)) { action = s; rfalse; } - if (LibraryExtensions.RunWhile(ext_messages, false )) { action = s; rfalse; } - action = s; - LanguageLM(n, x1, x2); -]; - -! ==============================================================================