verblibm.h

   1 ! ==============================================================================
   2 !   VERBLIBM:  Core of standard verbs library.
   3 !
   4 !   Supplied for use with Inform 6 -- Release 6.12.1 -- Serial number 160605
   5 !
   6 !   Copyright Graham Nelson 1993-2004 and David Griffith 2012-2016
   7 !
   8 !   This file is free software: you can redistribute it and/or modify
   9 !   it under the terms of the GNU Affero General Public License as
  10 !   published by the Free Software Foundation, either version 3 of the
  11 !   License, or (at your option) any later version.
  12 !
  13 !   This file is distributed in the hope that it will be useful, but
  14 !   WITHOUT ANY WARRANTY; without even the implied warranty of
  15 !   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  16 !   Affero General Public License for more details.
  17 !
  18 !   You should have received a copy of the GNU Affero General Public
  19 !   License along with this program. If not, see
  20 !   https://gnu.org/licenses/
  21 !
  22 !   This file is automatically Included in your game file by "verblib".
  23 ! ==============================================================================
  24
  25 System_file;
  26
  27 #Ifdef MODULE_MODE;
  28 Constant DEBUG;
  29 Constant Grammar__Version 2;
  30 Include "linklpa";
  31 Include "linklv";
  32 #Endif; ! MODULE_MODE
  33
  34 ! ------------------------------------------------------------------------------
  35
  36 [ Banner i;
  37     #Ifdef LanguageBanner;
  38     LanguageBanner();
  39     i = 0;  ! suppress warning
  40     #Ifnot;
  41     if (Story) {
  42         #Ifdef TARGET_ZCODE;
  43         #IfV5; style bold; #Endif;
  44         print "^", (string) Story;
  45         #IfV5; style roman; #Endif;
  46         #Ifnot; ! TARGET_GLULX;
  47         glk_set_style(style_Header);
  48         print "^", (string) Story;
  49         glk_set_style(style_Normal);
  50         #Endif; ! TARGET_
  51     }
  52     if (Headline) print (string) Headline;
  53     #Ifdef TARGET_ZCODE;
  54     print "Release ", (HDR_GAMERELEASE-->0) & $03ff, " / Serial number ";
  55     for (i=0 : i<6 : i++) print (char) HDR_GAMESERIAL->i;
  56     #Ifnot; ! TARGET_GLULX;
  57     print "Release ";
  58     @aloads ROM_GAMERELEASE 0 i;
  59     print i;
  60     print " / Serial number ";
  61     for (i=0 : i<6 : i++) print (char) ROM_GAMESERIAL->i;
  62     #Endif; ! TARGET_
  63     #Ifdef INFIX;
  64     print "X";
  65     #Ifnot;
  66     #Ifdef DEBUG;
  67     print "D";
  68     #Endif; ! DEBUG
  69     #Endif; ! INFIX
  70     new_line;
  71     #Endif; ! LanguageBanner
  72 ];
  73
  74 [ VersionSub ix;
  75     #Ifdef LanguageVersionSub;
  76     LanguageVersionSub();
  77     ix = 0;  ! suppress warning
  78     #Ifnot;
  79     Banner();
  80     #Ifdef TARGET_ZCODE;
  81     ix = 0; ! shut up compiler warning
  82     if (standard_interpreter > 0) {
  83         print "Standard interpreter ", standard_interpreter/256, ".", standard_interpreter%256,
  84             " (", HDR_TERPNUMBER->0;
  85         #Iftrue (#version_number == 6);
  86         print (char) '.', HDR_TERPVERSION->0;
  87         #Ifnot;
  88         print (char) HDR_TERPVERSION->0;
  89         #Endif;
  90         print ") / ";
  91         }
  92     else {
  93         print "Interpreter ", HDR_TERPNUMBER->0, " Version ";
  94         #Iftrue (#version_number == 6);
  95         print HDR_TERPVERSION->0;
  96         #Ifnot;
  97         print (char) HDR_TERPVERSION->0;
  98         #Endif;
  99         print " / ";
 100     }
 101
 102     #Ifnot; ! TARGET_GLULX;
 103     @gestalt 1 0 ix;
 104     print "Interpreter version ", ix / $10000, ".", (ix & $FF00) / $100,
 105       ".", ix & $FF, " / ";
 106     @gestalt 0 0 ix;
 107     print "VM ", ix / $10000, ".", (ix & $FF00) / $100, ".", ix & $FF, " / ";
 108     #Endif; ! TARGET_;
 109     print "Library serial number ", (string) LibSerial, "^";
 110     #Ifdef LanguageVersion;
 111     print (string) LanguageVersion, "^";
 112     #Endif; ! LanguageVersion
 113     #Endif; ! LanguageVersionSub
 114 ];
 115
 116 [ RunTimeError n p1 p2;
 117     #Ifdef LanguageError;
 118     LanguageError(n, p1, p2);
 119     #Ifnot;
 120     #Ifdef DEBUG;
 121     print "** Library error ", n, " (", p1, ", ", p2, ") **^** ";
 122     switch (n) {
 123       1:    print "preposition not found (this should not occur)";
 124       2:    print "Property value not routine or string: ~", (property) p2, "~ of ~", (name) p1,
 125                   "~ (", p1, ")";
 126       3:    print "Entry in property list not routine or string: ~", (property) p2, "~ list of ~",
 127                   (name) p1, "~ (", p1, ")";
 128       4:    print "Too many timers/daemons are active simultaneously.
 129                   The limit is the library constant MAX_TIMERS
 130                   (currently ", MAX_TIMERS, ") and should be increased";
 131       5:    print "Object ~", (name) p1, "~ has no ~", (property) p2, "~ property";
 132       7:    print "The object ~", (name) p1, "~ can only be used as a player object if it has
 133                   the ~number~ property";
 134       8:    print "Attempt to take random entry from an empty table array";
 135       9:    print p1, " is not a valid direction property number";
 136       10:   print "The player-object is outside the object tree";
 137       11:   print "The room ~", (name) p1, "~ has no ~", (property) p2, "~ property";
 138       12:   print "Tried to set a non-existent pronoun using SetPronoun";
 139       13:   print "A 'topic' token can only be followed by a preposition";
 140       14:   print "Overflowed buffer limit of ", p1, " using '@@64output_stream 3' ", (string) p2;
 141       15:   print "LoopWithinObject broken because the object ", (name) p1, " was moved while the loop passed through it.";
 142       16:   print "Attempt to use illegal narrative_voice of ", p1, ".";
 143       default:
 144             print "(unexplained)";
 145     }
 146     " **";
 147     #Ifnot;
 148     "** Library error ", n, " (", p1, ", ", p2, ") **";
 149     #Endif; ! DEBUG
 150     #Endif; ! LanguageError
 151 ];
 152
 153 ! ----------------------------------------------------------------------------
 154 !  The WriteListFrom routine, a flexible object-lister taking care of
 155 !  plurals, inventory information, various formats and so on.  This is used
 156 !  by everything in the library which ever wants to list anything.
 157 !
 158 !  If there were no objects to list, it prints nothing and returns false;
 159 !  otherwise it returns true.
 160 !
 161 !  o is the object, and style is a bitmap, whose bits are given by:
 162 ! ----------------------------------------------------------------------------
 163
 164
 165 Constant NEWLINE_BIT   $0001;       ! New-line after each entry
 166 Constant INDENT_BIT    $0002;       ! Indent each entry by depth
 167 Constant FULLINV_BIT   $0004;       ! Full inventory information after entry
 168 Constant ENGLISH_BIT   $0008;       ! English sentence style, with commas and and
 169 Constant RECURSE_BIT   $0010;       ! Recurse downwards with usual rules
 170 Constant ALWAYS_BIT    $0020;       ! Always recurse downwards
 171 Constant TERSE_BIT     $0040;       ! More terse English style
 172 Constant PARTINV_BIT   $0080;       ! Only brief inventory information after entry
 173 Constant DEFART_BIT    $0100;       ! Use the definite article in list
 174 Constant WORKFLAG_BIT  $0200;       ! At top level (only), only list objects
 175                                     ! which have the "workflag" attribute
 176 Constant ISARE_BIT     $0400;       ! Print " is" or " are" before list
 177 Constant CONCEAL_BIT   $0800;       ! Omit objects with "concealed" or "scenery":
 178                                     ! if WORKFLAG_BIT also set, then does _not_
 179                                     ! apply at top level, but does lower down
 180 Constant NOARTICLE_BIT $1000;       ! Print no articles, definite or not
 181 Constant ID_BIT        $2000;       ! Print object id after each entry
 182
 183 [ NextEntry o odepth;
 184     for (::) {
 185         o = sibling(o);
 186         if (o == 0) return 0;
 187         if (lt_value && o.list_together ~= lt_value) continue;
 188         if (c_style & WORKFLAG_BIT && odepth==0 && o hasnt workflag) continue;
 189         if (c_style & CONCEAL_BIT && (o has concealed || o has scenery)) continue;
 190         return o;
 191     }
 192 ];
 193
 194 [ WillRecurs o;
 195     if (c_style & ALWAYS_BIT) rtrue;
 196     if (c_style & RECURSE_BIT == 0) rfalse;
 197     if ((o has transparent or supporter) || (o has container && o has open)) rtrue;
 198     rfalse;
 199 ];
 200
 201 [ ListEqual o1 o2;
 202     if (child(o1) && WillRecurs(o1)) rfalse;
 203     if (child(o2) && WillRecurs(o2)) rfalse;
 204     if (c_style & (FULLINV_BIT + PARTINV_BIT)) {
 205         if ((o1 hasnt worn && o2 has worn) || (o2 hasnt worn && o1 has worn)) rfalse;
 206         if ((o1 hasnt light && o2 has light) || (o2 hasnt light && o1 has light)) rfalse;
 207         if (o1 has container) {
 208             if (o2 hasnt container) rfalse;
 209             if ((o1 has open && o2 hasnt open) || (o2 has open && o1 hasnt open))
 210                 rfalse;
 211         }
 212         else if (o2 has container)
 213             rfalse;
 214     }
 215     return Identical(o1, o2);
 216 ];
 217
 218 [ SortTogether obj value;
 219     ! print "Sorting together possessions of ", (object) obj, " by value ", value, "^";
 220     ! for (x=child(obj) : x : x=sibling(x))
 221     !     print (the) x, " no: ", x, " lt: ", x.list_together, "^";
 222     while (child(obj)) {
 223         if (child(obj).list_together ~= value) move child(obj) to out_obj;
 224         else                                   move child(obj) to in_obj;
 225     }
 226     while (child(in_obj))  move child(in_obj) to obj;
 227     while (child(out_obj)) move child(out_obj) to obj;
 228 ];
 229
 230 [ SortOutList obj i k l;
 231     !  print "^^Sorting out list from ", (name) obj, "^  ";
 232     !  for (i=child(location) : i : i=sibling(i))
 233     !      print (name) i, " --> ";
 234     !  new_line;
 235
 236   .AP_SOL;
 237
 238     for (i=obj : i : i=sibling(i)) {
 239         k = i.list_together;
 240         if (k ~= 0) {
 241             ! print "Scanning ", (name) i, " with lt=", k, "^";
 242             for (i=sibling(i) : i && i.list_together == k :) i = sibling(i);
 243             if (i == 0) rfalse;
 244             ! print "First not in block is ", (name) i, " with lt=", i.list_together, "^";
 245             for (l=sibling(i) : l : l=sibling(l))
 246                 if (l.list_together == k) {
 247                     SortTogether(parent(obj), k);
 248                     ! print "^^After ST:^  ";
 249                     ! for (i=child(location) : i : i=sibling(i))
 250                     !     print (name) i, " --> ";
 251                     ! new_line;
 252                     obj = child(parent(obj));
 253                     jump AP_SOL;
 254                 }
 255         }
 256     }
 257 ];
 258
 259 #Ifdef TARGET_ZCODE;
 260
 261 [ Print__Spaces n;         ! To avoid a bug occurring in Inform 6.01 to 6.10
 262     if (n == 0) return;
 263     spaces n;
 264 ];
 265
 266 #Ifnot; ! TARGET_GLULX;
 267
 268 [ Print__Spaces n;
 269     while (n > 0) {
 270         @streamchar ' ';
 271         n = n - 1;
 272     }
 273 ];
 274
 275 #Endif; ! TARGET_
 276
 277 [ WriteListFrom o style depth
 278     s1 s2 s3 s4 s5 s6;
 279
 280     if (o == nothing) return 0;
 281
 282     s1 = c_style;      s2 = lt_value;   s3 = listing_together;
 283     s4 = listing_size; s5 = wlf_indent; s6 = inventory_stage;
 284
 285     if (o == child(parent(o))) {
 286         SortOutList(o);
 287         o = child(parent(o));
 288     }
 289     c_style = style;
 290     wlf_indent = 0;
 291     if (WriteListR(o, depth) == 0) return 0;
 292
 293     c_style = s1;      lt_value = s2;   listing_together = s3;
 294     listing_size = s4; wlf_indent = s5; inventory_stage = s6;
 295     rtrue;
 296 ];
 297
 298 [ WriteListR o depth stack_pointer  classes_p sizes_p i j k k2 l m n q senc mr;
 299     if (depth > 0 && o == child(parent(o))) {
 300         SortOutList(o);
 301         o = child(parent(o));
 302     }
 303     for (::) {
 304         if (o == 0) rfalse;
 305         if (c_style & WORKFLAG_BIT && depth==0 && o hasnt workflag) {
 306             o = sibling(o);
 307             continue;
 308         }
 309         if (c_style & CONCEAL_BIT && (o has concealed || o has scenery)) {
 310             o = sibling(o);
 311             continue;
 312         }
 313         break;
 314     }
 315     classes_p = match_classes + stack_pointer;
 316     sizes_p   = match_list + stack_pointer;
 317
 318     for (i=o,j=0 : i && (j+stack_pointer)<128 : i=NextEntry(i,depth),j++) {
 319         classes_p->j = 0;
 320         if (i.plural) k++;
 321     }
 322
 323     if (c_style & ISARE_BIT) {
 324         if (j == 1 && o hasnt pluralname) Tense(IS__TX, WAS__TX);
 325         else                              Tense(ARE__TX, WERE__TX);
 326         if (c_style & NEWLINE_BIT)   print ":^";
 327         else                              print (char) ' ';
 328         c_style = c_style - ISARE_BIT;
 329     }
 330
 331     stack_pointer = stack_pointer+j+1;
 332
 333     if (k < 2) jump EconomyVersion;   ! It takes two to plural
 334     n = 1;
 335     for (i=o,k=0 : k<j : i=NextEntry(i,depth),k++)
 336         if (classes_p->k == 0) {
 337             classes_p->k = n; sizes_p->n = 1;
 338             for (l=NextEntry(i,depth),m=k+1 : l && m<j : l=NextEntry(l,depth),m++)
 339                 if (classes_p->m == 0 && i.plural && l.plural ~= 0) {
 340                     if (ListEqual(i, l) == 1) {
 341                         sizes_p->n = sizes_p->n + 1;
 342                         classes_p->m = n;
 343                     }
 344                 }
 345             n++;
 346         }
 347     n--;
 348
 349     for (i=1,j=o,k=0 : i<=n : i++,senc++) {
 350         while (((classes_p->k) ~= i) && ((classes_p->k) ~= -i)) {
 351             k++; j=NextEntry(j, depth);
 352         }
 353         m = sizes_p->i;
 354         if (j == 0) mr = 0;
 355         else {
 356             if (j.list_together ~= 0 or lt_value && metaclass(j.list_together) == Routine or String &&
 357                 j.list_together == mr) senc--;
 358             mr = j.list_together;
 359         }
 360     }
 361     senc--;
 362
 363     for (i=1,j=o,k=0,mr=0 : senc>=0 : i++,senc--) {
 364         while (((classes_p->k) ~= i) && ((classes_p->k) ~= -i)) {
 365             k++; j=NextEntry(j, depth);
 366         }
 367         if (j.list_together ~= 0 or lt_value) {
 368             if (j.list_together == mr) {
 369                 senc++;
 370                 jump Omit_FL2;
 371             }
 372             k2 = NextEntry(j, depth);
 373             if (k2 == 0 || k2.list_together ~= j.list_together) jump Omit_WL2;
 374             k2 = metaclass(j.list_together);
 375             if (k2 == Routine or String) {
 376                 q = j; listing_size = 1; l = k; m = i;
 377                 while (m < n && q.list_together == j.list_together) {
 378                     m++;
 379                     while (((classes_p->l) ~= m) && ((classes_p->l) ~= -m)) {
 380                         l++; q = NextEntry(q, depth);
 381                      }
 382                     if (q.list_together == j.list_together) listing_size++;
 383                 }
 384                 ! print " [", listing_size, "] ";
 385                 if (listing_size == 1) jump Omit_WL2;
 386                 if (c_style & INDENT_BIT) Print__Spaces(2*(depth+wlf_indent));
 387                 if (k2 == String) {
 388                     q = 0;
 389                     for (l=0 : l<listing_size : l++) q = q+sizes_p->(l+i);
 390                     EnglishNumber(q); print " ";
 391                     print (string) j.list_together;
 392                     if (c_style & ENGLISH_BIT) print " (";
 393                     if (c_style & INDENT_BIT)  print ":^";
 394                 }
 395                 q = c_style;
 396                 if (k2 ~= String) {
 397                     inventory_stage = 1;
 398                     parser_one = j; parser_two = depth+wlf_indent;
 399                     if (RunRoutines(j, list_together) == 1) jump Omit__Sublist2;
 400                 }
 401
 402                 #Ifdef TARGET_ZCODE;
 403                 @push lt_value;    @push listing_together;    @push listing_size;
 404                 #Ifnot; ! TARGET_GLULX;
 405                 @copy lt_value sp; @copy listing_together sp; @copy listing_size sp;
 406                 #Endif; ! TARGET_;
 407
 408                 lt_value = j.list_together; listing_together = j; wlf_indent++;
 409                 WriteListR(j, depth, stack_pointer); wlf_indent--;
 410
 411                 #Ifdef TARGET_ZCODE;
 412                 @pull listing_size; @pull listing_together; @pull lt_value;
 413                 #Ifnot; ! TARGET_GLULX;
 414                 @copy sp listing_size;
 415                 @copy sp listing_together;
 416                 @copy sp lt_value;
 417                 #Endif; ! TARGET_;
 418
 419                 if (k2 == String) {
 420                     if (q & ENGLISH_BIT) print ")";
 421                 }
 422                 else {
 423                     inventory_stage = 2;
 424                     parser_one = j; parser_two = depth+wlf_indent;
 425                     RunRoutines(j, list_together);
 426                 }
 427
 428               .Omit__Sublist2;
 429
 430                 if (q & NEWLINE_BIT && c_style & NEWLINE_BIT == 0) new_line;
 431                 c_style = q;
 432                 mr = j.list_together;
 433                 jump Omit_EL2;
 434             }
 435         }
 436
 437       .Omit_WL2;
 438
 439         if (WriteBeforeEntry(j, depth, 0, senc) == 1) jump Omit_FL2;
 440         if (sizes_p->i == 1) {
 441             if (c_style & NOARTICLE_BIT)  print (name) j;
 442             else {
 443                 if (c_style & DEFART_BIT) print (the) j;
 444                 else                      print (a) j;
 445             }
 446             if (c_style & ID_BIT)         print " (", j, ")";
 447         }
 448         else {
 449             if (c_style & DEFART_BIT) PrefaceByArticle(j, 1, sizes_p->i);
 450             print (number) sizes_p->i, " ";
 451             PrintOrRun(j, plural, 1);
 452         }
 453         if (sizes_p->i > 1 && j hasnt pluralname) {
 454             give j pluralname;
 455             WriteAfterEntry(j, depth, stack_pointer);
 456             give j ~pluralname;
 457         }
 458         else {
 459             WriteAfterEntry(j,depth,stack_pointer);
 460         }
 461       .Omit_EL2;
 462
 463         if (c_style & ENGLISH_BIT) {
 464             if (senc == 1) print (SerialComma) i+senc, (string) AND__TX;
 465             if (senc > 1)  print (string) COMMA__TX;
 466         }
 467      .Omit_FL2;
 468     }
 469     rtrue;
 470
 471   .EconomyVersion;
 472
 473     n = j;
 474     for (i=1,j=o : i<=n : j=NextEntry(j,depth),i++,senc++) {
 475         if (j.list_together ~= 0 or lt_value && metaclass(j.list_together) == Routine or String &&
 476             j.list_together==mr) senc--;
 477         mr = j.list_together;
 478     }
 479
 480     for (i=1,j=o,mr=0 : i<=senc : j=NextEntry(j,depth),i++) {
 481         if (j.list_together ~= 0 or lt_value) {
 482             if (j.list_together == mr) {
 483                 i--;
 484                 jump Omit_FL;
 485             }
 486             k = NextEntry(j, depth);
 487             if (k == 0 || k.list_together ~= j.list_together) jump Omit_WL;
 488             k = metaclass(j.list_together);
 489             if (k == Routine or String) {
 490                 if (c_style & INDENT_BIT) Print__Spaces(2*(depth+wlf_indent));
 491                 if (k == String) {
 492                     q = j; l = 0;
 493                     do {
 494                         q = NextEntry(q, depth); l++;
 495                     } until (q == 0 || q.list_together ~= j.list_together);
 496                     EnglishNumber(l); print " ";
 497                     print (string) j.list_together;
 498                     if (c_style & ENGLISH_BIT) print " (";
 499                     if (c_style & INDENT_BIT) print ":^";
 500                 }
 501                 q = c_style;
 502                 if (k ~= String) {
 503                     inventory_stage = 1;
 504                     parser_one = j; parser_two = depth+wlf_indent;
 505                     if (RunRoutines(j, list_together) == 1) jump Omit__Sublist;
 506                 }
 507
 508                 #Ifdef TARGET_ZCODE;
 509                 @push lt_value; @push listing_together; @push listing_size;
 510                 #Ifnot; ! TARGET_GLULX;
 511                 @copy lt_value sp; @copy listing_together sp; @copy listing_size sp;
 512                 #Endif; ! TARGET_;
 513
 514                 lt_value = j.list_together; listing_together = j; wlf_indent++;
 515                 WriteListR(j, depth, stack_pointer); wlf_indent--;
 516
 517                 #Ifdef TARGET_ZCODE;
 518                 @pull listing_size; @pull listing_together; @pull lt_value;
 519                 #Ifnot; ! TARGET_GLULX;
 520                 @copy sp listing_size; @copy sp listing_together; @copy sp lt_value;
 521                 #Endif; ! TARGET_;
 522
 523                 if (k == String) {
 524                     if (q & ENGLISH_BIT) print ")";
 525                 }
 526                 else {
 527                     inventory_stage = 2;
 528                     parser_one = j; parser_two = depth+wlf_indent;
 529                     RunRoutines(j, list_together);
 530                 }
 531
 532               .Omit__Sublist;
 533
 534                 if (q & NEWLINE_BIT && c_style & NEWLINE_BIT == 0) new_line;
 535                 c_style = q;
 536                 mr = j.list_together;
 537                 jump Omit_EL;
 538             }
 539         }
 540
 541       .Omit_WL;
 542
 543         if (WriteBeforeEntry(j, depth, i, senc) == 1) jump Omit_FL;
 544         if (c_style & NOARTICLE_BIT)  print (name) j;
 545         else {
 546             if (c_style & DEFART_BIT) print (the) j;
 547             else                      print (a) j;
 548         }
 549         if (c_style & ID_BIT)         print " (", j, ")";
 550         WriteAfterEntry(j, depth, stack_pointer);
 551
 552       .Omit_EL;
 553
 554         if (c_style & ENGLISH_BIT) {
 555             if (i == senc-1) print (SerialComma) senc, (string) AND__TX;
 556             if (i < senc-1) print (string) COMMA__TX;
 557         }
 558
 559   .Omit_FL;
 560
 561     }
 562 ]; ! end of WriteListR
 563
 564 [ WriteBeforeEntry o depth ipos sentencepos
 565     flag;
 566
 567     inventory_stage = 1;
 568     if (c_style & INDENT_BIT) Print__Spaces(2*(depth+wlf_indent));
 569     if (o.invent && (c_style & (PARTINV_BIT|FULLINV_BIT))) {
 570         flag = PrintOrRun(o, invent, 1);
 571         if (flag) {
 572             if (c_style & ENGLISH_BIT) {
 573                 if (ipos == sentencepos-1)
 574                     print (SerialComma) sentencepos, (string) AND__TX;
 575                 if (ipos < sentencepos-1)
 576                     print (string) COMMA__TX;
 577             }
 578             if (c_style & NEWLINE_BIT) new_line;
 579         }
 580     }
 581     return flag;
 582 ];
 583
 584 [ WriteAfterEntry o depth stack_p
 585     p recurse_flag parenth_flag eldest_child child_count combo i j;
 586
 587     inventory_stage = 2;
 588     if (c_style & PARTINV_BIT) {
 589         if (o.invent && RunRoutines(o, invent))
 590             if (c_style & NEWLINE_BIT) ""; else rtrue;
 591
 592         combo = 0;
 593         if (o has light && location hasnt light) combo=combo+1;
 594         if (o has container && o hasnt open)     combo=combo+2;
 595         if ((o has container && (o has open || o has transparent))) {
 596             objectloop(i in o) {
 597                 if (i hasnt concealed && i hasnt scenery) {
 598                     j = true; break;
 599                 }
 600             }
 601             if (~~j) combo=combo+4;
 602         }
 603         if (combo) L__M(##ListMiscellany, combo, o);
 604     }   ! end of PARTINV_BIT processing
 605
 606     if (c_style & FULLINV_BIT) {
 607         if (o.invent && RunRoutines(o, invent))
 608             if (c_style & NEWLINE_BIT) ""; else rtrue;
 609
 610         if (o has light && o has worn) { L__M(##ListMiscellany, 8, o);  parenth_flag = true; }
 611         else {
 612             if (o has light)           { L__M(##ListMiscellany, 9, o);  parenth_flag = true; }
 613             if (o has worn)            { L__M(##ListMiscellany, 10, o); parenth_flag = true; }
 614         }
 615
 616         if (o has container)
 617             if (o has openable) {
 618                 if (parenth_flag) print (string) AND__TX;
 619                 else              L__M(##ListMiscellany, 11, o);
 620                 if (o has open)
 621                     if (child(o)) L__M(##ListMiscellany, 12, o);
 622                     else          L__M(##ListMiscellany, 13, o);
 623                 else
 624                     if (o has lockable && o has locked) L__M(##ListMiscellany, 15, o);
 625                     else                                L__M(##ListMiscellany, 14, o);
 626                 parenth_flag = true;
 627             }
 628             else
 629                 if (child(o)==0 && o has transparent)
 630                     if (parenth_flag) L__M(##ListMiscellany, 16, o);
 631                     else              L__M(##ListMiscellany, 17, o);
 632
 633         if (parenth_flag) print ")";
 634     }   ! end of FULLINV_BIT processing
 635
 636     if (c_style & CONCEAL_BIT) {
 637         child_count = 0;
 638         objectloop (p in o)
 639             if (p hasnt concealed && p hasnt scenery) { child_count++; eldest_child = p; }
 640     }
 641     else { child_count = children(o); eldest_child = child(o); }
 642
 643     if (child_count && (c_style & ALWAYS_BIT)) {
 644         if (c_style & ENGLISH_BIT) L__M(##ListMiscellany, 18, o);
 645         recurse_flag = true;
 646     }
 647
 648     if (child_count && (c_style & RECURSE_BIT)) {
 649         if (o has supporter) {
 650             if (c_style & ENGLISH_BIT) {
 651                 if (c_style & TERSE_BIT) L__M(##ListMiscellany, 19, o);
 652                 else                     L__M(##ListMiscellany, 20, o);
 653                 if (o has animate)       print (string) WHOM__TX;
 654                 else                     print (string) WHICH__TX;
 655             }
 656             recurse_flag = true;
 657         }
 658         if (o has container && (o has open || o has transparent)) {
 659             if (c_style & ENGLISH_BIT) {
 660                 if (c_style & TERSE_BIT) L__M(##ListMiscellany, 21, o);
 661                 else                     L__M(##ListMiscellany, 22, o);
 662                 if (o has animate)       print (string) WHOM__TX;
 663                 else                     print (string) WHICH__TX;
 664                 }
 665             recurse_flag = true;
 666         }
 667     }
 668
 669     if (recurse_flag && (c_style & ENGLISH_BIT))
 670         if (child_count > 1 || eldest_child has pluralname) Tense(ARE2__TX, WERE2__TX);
 671         else                                                Tense(IS2__TX, WAS2__TX);
 672
 673     if (c_style & NEWLINE_BIT) new_line;
 674
 675     if (recurse_flag) {
 676         o = child(o);
 677         #Ifdef TARGET_ZCODE;
 678         @push lt_value; @push listing_together; @push listing_size;
 679         #Ifnot; ! TARGET_GLULX;
 680         @copy lt_value sp; @copy listing_together sp; @copy listing_size sp;
 681         #Endif;
 682         lt_value = 0;   listing_together = 0;   listing_size = 0;
 683         WriteListR(o, depth+1, stack_p);
 684         #Ifdef TARGET_ZCODE;
 685         @pull listing_size; @pull listing_together; @pull lt_value;
 686         #Ifnot; ! TARGET_GLULX;
 687         @copy sp listing_size; @copy sp listing_together; @copy sp lt_value;
 688         #Endif;
 689         if (c_style & TERSE_BIT) print ")";
 690     }
 691 ];
 692
 693 ! ----------------------------------------------------------------------------
 694 ! LoopWithinObject(rtn,obj,arg)
 695 !
 696 ! rtn is the address of a user-supplied routine.
 697 ! obj is an optional parent object whose dependents are to be processed; the
 698 ! default is the current actor (normally the player).
 699 ! arg is an optional argument passed to the rtn; this can be a single variable
 700 ! or constant, or the address of an array (which enables multiple values to be
 701 ! passed and returned).
 702 !
 703 ! For each object o which is a child, grandchild, great-grandchild, etc, of the
 704 ! original obj, LoopWithinObject() calls rtn(o,arg).
 705 !
 706 ! The rtn should perform any appropriate testing or processing on each object o,
 707 ! using the optional arg value if necessary. If the rtn returns true (or any
 708 ! positive value), the children of o, if any, are also tested; those children
 709 ! are skipped if rtn returns false. To terminate the loop before all objects
 710 ! have been processed, rtn should return a large negative number (eg -99).
 711 !
 712 ! To deal with supporters and open containers, so that objects are processed
 713 ! only if they are accessible to the player, rtn might end with these
 714 ! statements:
 715 !   if ((o has transparent or supporter) || (o has container && o has open)) rtrue;
 716 !   rfalse;
 717 ! or alternatively with:
 718 !   c_style = RECURSE_BIT; return WillRecurs(o);
 719 !
 720 ! LoopWithinObject() returns the number of objects which have been processed.
 721 ! ----------------------------------------------------------------------------
 722
 723 [ LoopWithinObject rtn obj arg
 724     n o x y;
 725     if (obj == 0) obj = actor;
 726     o = child(obj);
 727     while (o) {
 728         y = parent(o); n++;
 729         x = rtn(o, arg);    ! user-supplied routine returning x.
 730                             ! if x < 0: skip up to next parent
 731                             ! if x = 0: jump across to next sibling
 732                             ! if x > 0: continue down to child objects
 733         if (y ~= parent(o)) { RunTimeError(15, o); rfalse; }
 734         if (x > 0 && child(o)) o = child(o);
 735         else
 736             while (o) {
 737                 if (++x > 0 && sibling(o)) { o = sibling(o); break; }
 738                 o = parent(o);
 739                 if (o == obj) return n;
 740             }
 741     }
 742 ];
 743
 744
 745 ! ----------------------------------------------------------------------------
 746 !  Much better menus can be created using one of the optional library
 747 !  extensions.  These are provided for compatibility with previous practice:
 748 ! ----------------------------------------------------------------------------
 749
 750 [ LowKey_Menu menu_choices EntryR ChoiceR lines main_title i j;
 751     menu_nesting++;
 752
 753   .LKRD;
 754
 755     menu_item = 0;
 756     lines = EntryR();
 757     main_title = item_name;
 758
 759     print "--- "; print (string) main_title; print " ---^^";
 760
 761     if (menu_choices ofclass Routine) menu_choices();
 762     else                              print (string) menu_choices;
 763
 764     for (::) {
 765         L__M(##Miscellany, 52, lines);
 766         print "> ";
 767
 768         #Ifdef TARGET_ZCODE;
 769         #IfV3;
 770         read buffer parse;
 771         #Ifnot;
 772         read buffer parse DrawStatusLine;
 773         #Endif; ! V3
 774         j = parse->1; ! number of words
 775         #Ifnot; ! TARGET_GLULX;
 776         KeyboardPrimitive(buffer, parse);
 777         j = parse-->0; ! number of words
 778         #Endif; ! TARGET_
 779
 780         i = parse-->1;
 781         if (j == 0 || (i == QUIT1__WD or QUIT2__WD)) {
 782             menu_nesting--; if (menu_nesting > 0) rfalse;
 783             if (deadflag == 0) <<Look>>;
 784             rfalse;
 785         }
 786         i = TryNumber(1);
 787         if (i == 0) jump LKRD;
 788         if (i < 1 || i > lines) continue;
 789         menu_item = i;
 790         j = ChoiceR();
 791         if (j == 2) jump LKRD;
 792         if (j == 3) rfalse;
 793     }
 794 ];
 795
 796 #Ifdef TARGET_ZCODE;
 797
 798 #IfV3;
 799
 800 [ DoMenu menu_choices EntryR ChoiceR; LowKey_Menu(menu_choices, EntryR, ChoiceR); ];
 801
 802 #Endif; ! V3
 803
 804 #IfV5;
 805
 806 [ DoMenu menu_choices EntryR ChoiceR
 807          lines main_title main_wid cl i j oldcl pkey ch cw y x;
 808     if (pretty_flag == 0) return LowKey_Menu(menu_choices, EntryR, ChoiceR);
 809     menu_nesting++;
 810     menu_item = 0;
 811     lines = EntryR();
 812     main_title = item_name; main_wid = item_width;
 813     cl = 7;
 814
 815   .ReDisplay;
 816
 817     oldcl = 0;
 818     @erase_window $ffff;
 819     #Iftrue (#version_number == 6);
 820     @set_cursor -1;
 821     ch = HDR_FONTWUNITS->0;
 822     #Ifnot;
 823     ch = 1;
 824     #Endif;
 825     i = ch * (lines+7);
 826     @split_window i;
 827     i = HDR_SCREENWCHARS->0;
 828     if (i == 0) i = 80;
 829     @set_window 1;
 830     @set_cursor 1 1;
 831
 832     #Iftrue (#version_number == 6);
 833     @set_font 4 -> cw;
 834     cw = HDR_FONTHUNITS->0;
 835     #Ifnot;
 836     cw = 1;
 837     #Endif;
 838
 839     style reverse;
 840     spaces(i); j=1+(i/2-main_wid)*cw;
 841     @set_cursor 1 j;
 842     print (string) main_title;
 843     y=1+ch; @set_cursor y 1; spaces(i);
 844     x=1+cw; @set_cursor y x; print (string) NKEY__TX;
 845     j=1+(i-13)*cw; @set_cursor y j; print (string) PKEY__TX;
 846     y=y+ch; @set_cursor y 1; spaces(i);
 847     @set_cursor y x; print (string) RKEY__TX;
 848     j=1+(i-18)*cw; @set_cursor y j;
 849
 850     if (menu_nesting == 1) print (string) QKEY1__TX;
 851     else                   print (string) QKEY2__TX;
 852     style roman;
 853     y = y+2*ch;
 854     @set_cursor y x; font off;
 855
 856     if (menu_choices ofclass String) print (string) menu_choices;
 857     else                             menu_choices();
 858
 859     x = 1+3*cw;
 860     for (::) {
 861         if (cl ~= oldcl) {
 862             if (oldcl>0) {
 863                 y=1+(oldcl-1)*ch; @set_cursor y x; print " ";
 864             }
 865             y=1+(cl-1)*ch; @set_cursor y x; print ">";
 866         }
 867
 868         oldcl = cl;
 869         @read_char 1 -> pkey;
 870         if (pkey == NKEY1__KY or NKEY2__KY or 130) {
 871             cl++; if (cl == 7+lines) cl = 7; continue;
 872         }
 873         if (pkey == PKEY1__KY or PKEY2__KY or 129) {
 874             cl--; if (cl == 6) cl = 6+lines; continue;
 875         }
 876         if (pkey == QKEY1__KY or QKEY2__KY or 27 or 131) break;
 877         if (pkey == 10 or 13 or 132) {
 878             @set_window 0; font on;
 879             new_line; new_line; new_line;
 880
 881             menu_item = cl-6;
 882             EntryR();
 883
 884             @erase_window $ffff;
 885             @split_window ch;
 886             i = HDR_SCREENWCHARS->0; if ( i== 0) i = 80;
 887             @set_window 1; @set_cursor 1 1; style reverse; spaces(i);
 888             j=1+(i/2-item_width)*cw;
 889             @set_cursor 1 j;
 890             print (string) item_name;
 891             style roman; @set_window 0; new_line;
 892
 893             i = ChoiceR();
 894             if (i == 2) jump ReDisplay;
 895             if (i == 3) break;
 896
 897             L__M(##Miscellany, 53);
 898             @read_char 1 -> pkey; jump ReDisplay;
 899         }
 900     }
 901
 902     menu_nesting--; if (menu_nesting > 0) rfalse;
 903     font on; @set_cursor 1 1;
 904     @erase_window $ffff; @set_window 0;
 905     #Iftrue (#version_number == 6);
 906     @set_cursor -2;
 907     #Endif;
 908     new_line; new_line; new_line;
 909     if (deadflag == 0) <<Look>>;
 910 ];
 911
 912 #Endif; ! V5
 913
 914 #Ifnot; ! TARGET_GLULX
 915
 916 [ DoMenu menu_choices EntryR ChoiceR
 917     winwid winhgt lines main_title main_wid cl i oldcl pkey;
 918
 919     if (pretty_flag == 0 || gg_statuswin == 0) return LowKey_Menu(menu_choices, EntryR, ChoiceR);
 920
 921     menu_nesting++;
 922     menu_item = 0;
 923     lines = EntryR();
 924     main_title = item_name;
 925     main_wid = item_width;
 926
 927     cl = 0;
 928
 929     ! If we printed "hit arrow keys" here, it would be appropriate to
 930     ! check for the availability of Glk input keys. But we actually
 931     ! print "hit N/P/Q". So it's reasonable to silently accept Glk
 932     ! arrow key codes as secondary options.
 933
 934   .ReDisplay;
 935
 936     glk_window_clear(gg_statuswin);
 937     glk_window_clear(gg_mainwin);
 938     glk_set_window(gg_statuswin);
 939     StatusLineHeight(lines+7);
 940     glk_window_get_size(gg_statuswin, gg_arguments, gg_arguments+4);
 941     winwid = gg_arguments-->0;
 942     winhgt = gg_arguments-->1;
 943     glk_set_style(style_Subheader);
 944     glk_window_move_cursor(gg_statuswin, winwid/2-main_wid, 0);
 945     print (string) main_title;
 946     glk_window_move_cursor(gg_statuswin, 1, 1);
 947     print (string) NKEY__TX;
 948     glk_window_move_cursor(gg_statuswin, winwid-13, 1);
 949     print (string) PKEY__TX;
 950     glk_window_move_cursor(gg_statuswin, 1, 2);
 951     print (string) RKEY__TX;
 952     glk_window_move_cursor(gg_statuswin, winwid-18, 2);
 953     if (menu_nesting == 1) print (string) QKEY1__TX;
 954     else                   print (string) QKEY2__TX;
 955     glk_set_style(style_Normal);
 956     glk_window_move_cursor(gg_statuswin, 1, 4);
 957     if (menu_choices ofclass String) print (string) menu_choices;
 958     else                             menu_choices();
 959
 960     oldcl = -1;
 961
 962     for (::) {
 963         if (cl ~= oldcl) {
 964             if (cl < 0 || cl >= lines) cl = 0;
 965             if (oldcl >= 0) {
 966                 glk_window_move_cursor(gg_statuswin, 3, oldcl+6);
 967                 print (char) ' ';
 968             }
 969             oldcl = cl;
 970             glk_window_move_cursor(gg_statuswin, 3, oldcl+6);
 971             print (char) '>';
 972         }
 973         pkey = KeyCharPrimitive(gg_statuswin, true);
 974         if (pkey == $80000000) jump ReDisplay;
 975         if (pkey == NKEY1__KY or NKEY2__KY or $fffffffb) {
 976             cl++;
 977             if (cl >= lines) cl = 0;
 978             continue;
 979         }
 980         if (pkey == PKEY1__KY or PKEY2__KY or $fffffffc) {
 981             cl--;
 982             if (cl < 0) cl = lines-1;
 983             continue;
 984         }
 985         if (pkey == QKEY1__KY or QKEY2__KY or $fffffff8 or $fffffffe) break;
 986         if (pkey == $fffffffa or $fffffffd) {
 987             glk_set_window(gg_mainwin);
 988             new_line; new_line; new_line;
 989             menu_item = cl+1;
 990             EntryR();
 991             glk_window_clear(gg_statuswin);
 992             glk_window_clear(gg_mainwin);
 993             glk_set_window(gg_statuswin);
 994             StatusLineHeight(1);
 995             glk_window_get_size(gg_statuswin, gg_arguments, gg_arguments+4);
 996             winwid = gg_arguments-->0;
 997             winhgt = gg_arguments-->1;
 998             glk_set_style(style_Subheader);
 999             glk_window_move_cursor(gg_statuswin, winwid/2-item_width, 0);
1000             print (string) item_name;
1001             glk_set_style(style_Normal);
1002             glk_set_window(gg_mainwin);
1003             new_line;
1004             i = ChoiceR();
1005             if (i == 2) jump ReDisplay;
1006             if (i == 3) break;
1007             L__M(##Miscellany, 53);
1008             pkey = KeyCharPrimitive(gg_mainwin, 1);
1009             jump ReDisplay;
1010         }
1011     }
1012
1013     ! done with this menu...
1014     menu_nesting--;
1015     if (menu_nesting > 0) rfalse;
1016     glk_set_window(gg_mainwin);
1017     glk_window_clear(gg_mainwin);
1018     new_line; new_line; new_line;
1019     if (deadflag == 0) <<Look>>;
1020 ];
1021
1022 #Endif; ! TARGET_
1023
1024 ! ----------------------------------------------------------------------------
1025 !   A cunning routine (which could have been a daemon, but isn't, for the
1026 !   sake of efficiency) to move objects which could be in many rooms about
1027 !   so that the player never catches one not in place
1028 ! ----------------------------------------------------------------------------
1029
1030 [ MoveFloatingObjects i k l m address flag;
1031     if (location == player or nothing) return;
1032     objectloop (i) {
1033         address = i.&found_in;
1034         if (address && i hasnt non_floating && ~~IndirectlyContains(player, i)) {
1035             if (metaclass(address-->0) == Routine)
1036                 flag = i.found_in();
1037             else {
1038                 flag = false;
1039                 k = i.#found_in/WORDSIZE;
1040                 for (l=0 : l<k : l++) {
1041                     m = address-->l;
1042                     if ((m in Class && location ofclass m) ||
1043                             m == location || m in location) {
1044                         flag = true;
1045                         break;
1046                     }
1047                 }
1048             }
1049             if (flag) {
1050                 if (i notin location) move i to location;
1051             } else {
1052                 if (parent(i)) remove i;
1053             }
1054         }
1055     }
1056 ];
1057
1058 ! ----------------------------------------------------------------------------
1059 !   Two little routines for moving the player safely.
1060 ! ----------------------------------------------------------------------------
1061
1062 [ PlayerTo newplace flag;
1063     NoteDeparture();
1064     move player to newplace;
1065     while (parent(newplace)) newplace = parent(newplace);
1066     location = real_location = newplace;
1067     MoveFloatingObjects(); AdjustLight(1);
1068     switch (flag) {
1069       0:    <Look>;
1070       1:    NoteArrival(); ScoreArrival();
1071       2:    LookSub(1);
1072     }
1073 ];
1074
1075 [ MovePlayer direc; <Go direc>; <Look>; ];
1076
1077 ! ----------------------------------------------------------------------------
1078 !   The handy YesOrNo routine, and some "meta" verbs
1079 ! ----------------------------------------------------------------------------
1080
1081 [ YesOrNo noStatusRedraw
1082     i j;
1083     for (::) {
1084         #Ifdef TARGET_ZCODE;
1085         if (location == nothing || parent(player) == nothing || noStatusRedraw)
1086             read buffer parse;
1087         else read buffer parse DrawStatusLine;
1088         j = parse->1;
1089         #Ifnot; ! TARGET_GLULX;
1090         noStatusRedraw = 0; ! suppress warning
1091         KeyboardPrimitive(buffer, parse);
1092         j = parse-->0;
1093         #Endif; ! TARGET_
1094         if (j) { ! at least one word entered
1095             i = parse-->1;
1096             if (i == YES1__WD or YES2__WD or YES3__WD) rtrue;
1097             if (i == NO1__WD  or NO2__WD  or NO3__WD) rfalse;
1098         }
1099         L__M(##Quit, 1); print "> ";
1100     }
1101 ];
1102
1103 #Ifdef TARGET_ZCODE;
1104
1105 [ QuitSub;
1106     L__M(##Quit, 2);
1107     if (YesOrNo()) quit;
1108 ];
1109
1110 [ RestartSub;
1111     L__M(##Restart, 1);
1112     if (YesOrNo()) { @restart; L__M(##Restart, 2); }
1113 ];
1114
1115 [ RestoreSub;
1116     restore Rmaybe;
1117     return L__M(##Restore, 1);
1118   .RMaybe;
1119     L__M(##Restore, 2);
1120 ];
1121
1122 [ SaveSub flag;
1123     #IfV5;
1124     @save -> flag;
1125     switch (flag) {
1126       0: L__M(##Save, 1);
1127       1: L__M(##Save, 2);
1128       2:
1129         RestoreColours();
1130         L__M(##Restore, 2);
1131     }
1132     #Ifnot;
1133     save Smaybe;
1134     return L__M(##Save, 1);
1135   .SMaybe;
1136     L__M(##Save, 2);
1137     #Endif; ! V5
1138 ];
1139
1140 [ VerifySub;
1141     @verify ?Vmaybe;
1142     jump Vwrong;
1143   .Vmaybe;
1144     return L__M(##Verify, 1);
1145   .Vwrong;
1146     L__M(##Verify, 2);
1147 ];
1148
1149 [ ScriptOnSub;
1150     transcript_mode = ((HDR_GAMEFLAGS-->0) & 1);
1151     if (transcript_mode) return L__M(##ScriptOn, 1);
1152     @output_stream 2;
1153     if (((HDR_GAMEFLAGS-->0) & 1) == 0) return L__M(##ScriptOn, 3);
1154     L__M(##ScriptOn, 2); VersionSub();
1155     transcript_mode = true;
1156 ];
1157
1158 [ ScriptOffSub;
1159     transcript_mode = ((HDR_GAMEFLAGS-->0) & 1);
1160     if (transcript_mode == false) return L__M(##ScriptOff, 1);
1161     L__M(##ScriptOff, 2);
1162     @output_stream -2;
1163     if ((HDR_GAMEFLAGS-->0) & 1) return L__M(##ScriptOff, 3);
1164     transcript_mode = false;
1165 ];
1166
1167 [ CommandsOnSub;
1168     @output_stream 4;
1169     xcommsdir = 1;
1170     L__M(##CommandsOn, 1);
1171 ];
1172
1173 [ CommandsOffSub;
1174     if (xcommsdir == 1) @output_stream -4;
1175     xcommsdir = 0;
1176     L__M(##CommandsOff, 1);
1177 ];
1178
1179 [ CommandsReadSub;
1180     @input_stream 1;
1181     xcommsdir = 2;
1182     L__M(##CommandsRead, 1);
1183 ];
1184
1185 #Ifnot; ! TARGET_GLULX;
1186
1187 [ QuitSub;
1188     L__M(##Quit, 2);
1189     if (YesOrNo()) quit;
1190 ];
1191
1192 [ RestartSub;
1193     L__M(##Restart,1);
1194     if (YesOrNo()) { @restart; L__M(##Restart, 2); }
1195 ];
1196
1197 [ RestoreSub res fref;
1198     fref = glk_fileref_create_by_prompt($01, $02, 0);
1199     if (fref == 0) jump RFailed;
1200     gg_savestr = glk_stream_open_file(fref, $02, GG_SAVESTR_ROCK);
1201     glk_fileref_destroy(fref);
1202     if (gg_savestr == 0) jump RFailed;
1203     @restore gg_savestr res;
1204     glk_stream_close(gg_savestr, 0);
1205     gg_savestr = 0;
1206   .RFailed;
1207     L__M(##Restore, 1);
1208 ];
1209
1210 [ SaveSub res fref;
1211     fref = glk_fileref_create_by_prompt($01, $01, 0);
1212     if (fref == 0) jump SFailed;
1213     gg_savestr = glk_stream_open_file(fref, $01, GG_SAVESTR_ROCK);
1214     glk_fileref_destroy(fref);
1215     if (gg_savestr == 0) jump SFailed;
1216     @save gg_savestr res;
1217     if (res == -1) {
1218         ! The player actually just typed "restore". We're going to print
1219         !  L__M(##Restore,2); the Z-Code Inform library does this correctly
1220         ! now. But first, we have to recover all the Glk objects; the values
1221         ! in our global variables are all wrong.
1222         GGRecoverObjects();
1223         glk_stream_close(gg_savestr, 0);
1224         gg_savestr = 0;
1225         return L__M(##Restore, 2);
1226     }
1227     glk_stream_close(gg_savestr, 0);
1228     gg_savestr = 0;
1229     if (res == 0) return L__M(##Save, 2);
1230   .SFailed;
1231     L__M(##Save, 1);
1232 ];
1233
1234 [ VerifySub res;
1235     @verify res;
1236     if (res == 0) return L__M(##Verify, 1);
1237     L__M(##Verify, 2);
1238 ];
1239
1240 [ ScriptOnSub;
1241     if (gg_scriptstr) return L__M(##ScriptOn, 1);
1242     if (gg_scriptfref == 0) {
1243         gg_scriptfref = glk_fileref_create_by_prompt($102, $05, GG_SCRIPTFREF_ROCK);
1244         if (gg_scriptfref == 0) jump S1Failed;
1245     }
1246     gg_scriptstr = glk_stream_open_file(gg_scriptfref, $05, GG_SCRIPTSTR_ROCK);
1247     if (gg_scriptstr == 0) jump S1Failed;
1248     glk_window_set_echo_stream(gg_mainwin, gg_scriptstr);
1249     L__M(##ScriptOn, 2);
1250     VersionSub();
1251     return;
1252   .S1Failed;
1253     L__M(##ScriptOn, 3);
1254 ];
1255
1256 [ ScriptOffSub;
1257     if (gg_scriptstr == 0) return L__M(##ScriptOff,1);
1258     L__M(##ScriptOff, 2);
1259     glk_stream_close(gg_scriptstr, 0);
1260     gg_scriptstr = 0;
1261 ];
1262
1263 [ CommandsOnSub fref;
1264     if (gg_commandstr) {
1265         if (gg_command_reading) return L__M(##CommandsOn, 2);
1266         else                    return L__M(##CommandsOn, 3);
1267     }
1268     fref = glk_fileref_create_by_prompt($103, $01, 0);
1269     if (fref == 0) return L__M(##CommandsOn, 4);
1270     gg_command_reading = false;
1271     gg_commandstr = glk_stream_open_file(fref, $01, GG_COMMANDWSTR_ROCK);
1272     glk_fileref_destroy(fref);
1273     if (gg_commandstr == 0) return L__M(##CommandsOn, 4);
1274     L__M(##CommandsOn, 1);
1275 ];
1276
1277 [ CommandsOffSub;
1278     if (gg_commandstr == 0) return L__M(##CommandsOff, 2);
1279     if (gg_command_reading) return L__M(##CommandsRead, 5);
1280     glk_stream_close(gg_commandstr, 0);
1281     gg_commandstr = 0;
1282     gg_command_reading = false;
1283     L__M(##CommandsOff, 1);
1284 ];
1285
1286 [ CommandsReadSub fref;
1287     if (gg_commandstr) {
1288         if (gg_command_reading) return L__M(##CommandsRead, 2);
1289         else                    return L__M(##CommandsRead, 3);
1290     }
1291     fref = glk_fileref_create_by_prompt($103, $02, 0);
1292     if (fref == 0) return L__M(##CommandsRead, 4);
1293     gg_command_reading = true;
1294     gg_commandstr = glk_stream_open_file(fref, $02, GG_COMMANDRSTR_ROCK);
1295     glk_fileref_destroy(fref);
1296     if (gg_commandstr == 0) return L__M(##CommandsRead, 4);
1297     L__M(##CommandsRead, 1);
1298 ];
1299
1300 #Endif; ! TARGET_;
1301
1302 [ NotifyOnSub;  notify_mode = true; L__M(##NotifyOn);  ];
1303 [ NotifyOffSub; notify_mode = false; L__M(##NotifyOff); ];
1304
1305 [ Places1Sub i j k;
1306     L__M(##Places, 1);
1307     objectloop (i has visited) j++;
1308     objectloop (i has visited) {
1309         print (name) i; k++;
1310         if (k == j) return L__M(##Places, 2);
1311         if (k == j-1) print (SerialComma) j, (string) AND__TX;
1312         else          print (string) COMMA__TX;
1313     }
1314 ];
1315
1316 [ Objects1Sub i j f;
1317     L__M(##Objects, 1);
1318     objectloop (i has moved) {
1319        f = 1; print (the) i; j = parent(i);
1320         if (j) {
1321            if (j == player) {
1322                if (i has worn) L__M(##Objects, 3, j, i);
1323                else            L__M(##Objects, 4, j, i);
1324                 jump Obj__Ptd;
1325             }
1326             if (j has animate)   { L__M(##Objects, 5, j, i); jump Obj__Ptd; }
1327             if (j has visited)   { L__M(##Objects, 6, j, i); jump Obj__Ptd; }
1328             if (j has container) { L__M(##Objects, 8, j, i); jump Obj__Ptd; }
1329             if (j has supporter) { L__M(##Objects, 9, j, i); jump Obj__Ptd; }
1330             if (j has enterable) { L__M(##Objects, 7, j, i); jump Obj__Ptd; }
1331         }
1332         L__M(##Objects, 10, j, i);
1333
1334       .Obj__Ptd;
1335
1336         new_line;
1337     }
1338     if (f == 0) L__M(##Objects, 2);
1339 ];
1340
1341 ! ----------------------------------------------------------------------------
1342 !   The scoring system
1343 ! ----------------------------------------------------------------------------
1344
1345 [ ScoreSub;
1346     #Ifdef NO_SCORE;
1347     if (deadflag == 0) L__M(##Score, 2);
1348     #Ifnot;
1349     if (deadflag) new_line;
1350     L__M(##Score, 1);
1351     if(PrintRank() == false) LibraryExtensions.RunAll(ext_printrank);
1352     #Endif; ! NO_SCORE
1353 ];
1354
1355 #Ifndef TaskScore;
1356 [ TaskScore i;
1357     return task_scores->i;
1358 ];
1359 #Endif;
1360
1361 [ Achieved num;
1362     if (task_done->num == 0) {
1363         task_done->num = 1;
1364         score = score + TaskScore(num);
1365     }
1366 ];
1367
1368 [ PANum m n;
1369     print "  ";
1370     n = m;
1371     if (n < 0)    { n = -m; n = n*10; }
1372     if (n < 10)   { print "   "; jump Panuml; }
1373     if (n < 100)  { print "  "; jump Panuml; }
1374     if (n < 1000) { print " "; }
1375
1376   .Panuml;
1377
1378     print m, " ";
1379 ];
1380
1381 [ FullScoreSub i;
1382     ScoreSub();
1383     if (score == 0 || TASKS_PROVIDED == 1) rfalse;
1384     new_line;
1385     L__M(##FullScore, 1);
1386     for (i=0 : i<NUMBER_TASKS : i++)
1387         if (task_done->i == 1) {
1388             PANum(TaskScore(i));
1389             if(PrintTaskName(i) == false)
1390                 LibraryExtensions.RunAll(ext_printtaskname,i);
1391         }
1392     if (things_score) {
1393         PANum(things_score);
1394         L__M(##FullScore, 2);
1395     }
1396     if (places_score) {
1397         PANum(places_score);
1398         L__M(##FullScore, 3);
1399     }
1400     new_line; PANum(score); L__M(##FullScore, 4);
1401 ];
1402
1403 ! ----------------------------------------------------------------------------
1404 !   Real verbs start here: Inventory
1405 ! ----------------------------------------------------------------------------
1406
1407 [ InvWideSub;
1408     if (actor == player)
1409         inventory_style = ENGLISH_BIT+FULLINV_BIT+RECURSE_BIT;
1410     else
1411         inventory_style = ENGLISH_BIT+PARTINV_BIT;
1412     <Inv, actor>;
1413     inventory_style = 0;
1414 ];
1415
1416 [ InvTallSub;
1417     if (actor == player)
1418         inventory_style = NEWLINE_BIT+INDENT_BIT+FULLINV_BIT+RECURSE_BIT;
1419     else
1420         inventory_style = NEWLINE_BIT+INDENT_BIT+PARTINV_BIT;
1421     <Inv, actor>;
1422     inventory_style = 0;
1423 ];
1424
1425 [ InvSub x;
1426     if (child(actor) == 0)   return L__M(##Inv, 1);
1427     if (inventory_style == 0)
1428         if (actor == player) return InvTallSub();
1429         else                 return InvWideSub();
1430     L__M(##Inv, 2);
1431     if (inventory_style & NEWLINE_BIT) L__M(##Inv, 3); else print " ";
1432
1433     WriteListFrom(child(actor), inventory_style, 1);
1434     if (inventory_style & ENGLISH_BIT) L__M(##Inv, 4);
1435
1436     #Ifndef MANUAL_PRONOUNS;
1437     objectloop (x in player) PronounNotice(x);
1438     #Endif;
1439     x = 0; ! To prevent a "not used" error
1440     AfterRoutines();
1441 ];
1442
1443 ! ----------------------------------------------------------------------------
1444 !   The object tree and determining the possibility of moves
1445 ! ----------------------------------------------------------------------------
1446
1447 [ CommonAncestor o1 o2 i j;
1448     ! Find the nearest object indirectly containing o1 and o2,
1449     ! or return 0 if there is no common ancestor.
1450     i = o1;
1451     while (i) {
1452         j = o2;
1453         while (j) {
1454             if (j == i) return i;
1455             j = parent(j);
1456         }
1457         i = parent(i);
1458     }
1459     return 0;
1460 ];
1461
1462 [ IndirectlyContains o1 o2;
1463     ! Does o1 indirectly contain o2?  (Same as testing if their common ancestor is o1.)
1464     while (o2) {
1465         if (o1 == o2) rtrue;
1466         if (o2 ofclass Class) rfalse;
1467         o2 = parent(o2);
1468     }
1469     rfalse;
1470 ];
1471
1472 [ ObjectScopedBySomething item i j k l m;
1473     i = item;
1474     objectloop (j .& add_to_scope) {
1475         l = j.&add_to_scope;
1476         k = (j.#add_to_scope)/WORDSIZE;
1477         if (l-->0 ofclass Routine) continue;
1478         for (m=0 : m<k : m++)
1479             if (l-->m == i) return j;
1480     }
1481     rfalse;
1482 ];
1483
1484 [ ObjectIsUntouchable item flag1 flag2 ancestor i;
1485     ! Determine if there's any barrier preventing the actor from moving
1486     ! things to "item".  Return false if no barrier; otherwise print a
1487     ! suitable message and return true.
1488     ! If flag1 is set, do not print any message.
1489     ! If flag2 is set, also apply Take/Remove restrictions.
1490
1491     ! If the item has been added to scope by something, it's first necessary
1492     ! for that something to be touchable.
1493
1494     ancestor = CommonAncestor(actor, item);
1495     if (ancestor == 0) {
1496         ancestor = item;
1497         while (ancestor && (i = ObjectScopedBySomething(ancestor)) == 0)
1498             ancestor = parent(ancestor);
1499         if (i) {
1500             if (ObjectIsUntouchable(i, flag1, flag2)) return;
1501             ! An item immediately added to scope
1502         }
1503     }
1504     else
1505
1506     ! First, a barrier between the actor and the ancestor.  The actor
1507     ! can only be in a sequence of enterable objects, and only closed
1508     ! containers form a barrier.
1509
1510     if (actor ~= ancestor) {
1511         i = parent(actor);
1512         while (i ~= ancestor) {
1513             if (i has container && i hasnt open) {
1514                 if (flag1) rtrue;
1515                 return L__M(##Take, 9, i, noun);
1516             }
1517             i = parent(i);
1518         }
1519     }
1520
1521     ! Second, a barrier between the item and the ancestor.  The item can
1522     ! be carried by someone, part of a piece of machinery, in or on top
1523     ! of something and so on.
1524
1525     i = parent(item);
1526     if (item ~= ancestor && i ~= player) {
1527         while (i ~= ancestor) {
1528             if (flag2 && i hasnt container && i hasnt supporter) {
1529                 if (i has animate) {
1530                     if (flag1) rtrue;
1531                     return L__M(##Take, 6, i, noun);
1532                 }
1533                 if (i has transparent) {
1534                     if (flag1) rtrue;
1535                     return L__M(##Take, 7, i, noun);
1536                 }
1537                 if (flag1) rtrue;
1538                 return L__M(##Take, 8, item, noun);
1539             }
1540             if (i has container && i hasnt open) {
1541                 if (flag1) rtrue;
1542                 return L__M(##Take, 9, i, noun);
1543             }
1544             i = parent(i);
1545         }
1546     }
1547     rfalse;
1548 ];
1549
1550 [ AttemptToTakeObject item
1551     ancestor after_recipient i k;
1552     ! Try to transfer the given item to the actor: return false
1553     ! if successful, true if unsuccessful, printing a suitable message
1554     ! in the latter case.
1555     ! People cannot ordinarily be taken.
1556     if (item == actor) return L__M(##Take, 2, noun);
1557     if (item has animate) return L__M(##Take, 3, item);
1558
1559     ancestor = CommonAncestor(actor, item);
1560
1561     if (ancestor == 0) {
1562         i = ObjectScopedBySomething(item);
1563         if (i) ancestor = CommonAncestor(actor, i);
1564     }
1565
1566     ! Is the actor indirectly inside the item?
1567     if (ancestor == item) return L__M(##Take, 4, item);
1568
1569     ! Does the actor already directly contain the item?
1570     if (item in actor) return L__M(##Take, 5, item);
1571
1572     ! Can the actor touch the item, or is there (e.g.) a closed container
1573     ! in the way?
1574     if (ObjectIsUntouchable(item, false, true)) rtrue;
1575
1576     ! The item is now known to be accessible.
1577
1578     ! Consult the immediate possessor of the item, if it's in a container
1579     ! which the actor is not in.
1580
1581     i = parent(item);
1582     if (i && i ~= ancestor && (i has container or supporter)) {
1583         after_recipient = i;
1584         k = action; action = ##LetGo;
1585         if (RunRoutines(i, before)) { action = k; rtrue; }
1586         action = k;
1587     }
1588
1589     if (item has scenery) return L__M(##Take, 10, item);
1590     if (item has static)  return L__M(##Take, 11, item);
1591
1592     ! The item is now known to be available for taking.  Is the player
1593     ! carrying too much?  If so, possibly juggle items into the rucksack
1594     ! to make room.
1595
1596     if (ObjectDoesNotFit(item, actor) ||
1597         LibraryExtensions.RunWhile(ext_objectdoesnotfit, false, item, actor)) return;
1598     if (AtFullCapacity(item, actor)) return L__M(##Take, 12, item);
1599
1600     ! Transfer the item.
1601
1602     move item to actor; give item ~worn;
1603
1604     ! Send "after" message to the object letting go of the item, if any.
1605
1606     if (after_recipient) {
1607         k = action; action = ##LetGo;
1608         if (RunRoutines(after_recipient, after)) { action = k; rtrue; }
1609         action = k;
1610     }
1611     rfalse;
1612 ];
1613
1614 [ AtFullCapacity n s
1615     obj k;
1616     n = n; ! suppress compiler warning
1617     if (s == actor) {
1618         objectloop (obj in s)
1619             if (obj hasnt worn) k++;
1620     } else
1621         k = children(s);
1622
1623     if (k < RunRoutines(s, capacity) || (s == player && RoomInSack())) rfalse;
1624 ];
1625
1626 [ RoomInSack
1627     obj ks;
1628     if (SACK_OBJECT && SACK_OBJECT in player) {
1629         ks = keep_silent; keep_silent = 2;
1630         for (obj=youngest(player) : obj : obj=elder(obj))
1631             if (obj ~= SACK_OBJECT && obj hasnt worn or light) {
1632                 <Insert obj SACK_OBJECT>;
1633                 if (obj in SACK_OBJECT) {
1634                     keep_silent = ks;
1635                     return L__M(##Take, 13, obj, SACK_OBJECT);
1636                 }
1637             }
1638         keep_silent = ks;
1639     }
1640     rfalse;
1641 ];
1642
1643 ! ----------------------------------------------------------------------------
1644 !   Support for implicit actions
1645 ! ----------------------------------------------------------------------------
1646
1647 [ CheckImplicitAction act o1 o2
1648     sav_act sav_noun sav_sec res;
1649     if (o1 provides before_implicit) {
1650         sav_act  = action; action = act;
1651         sav_noun = noun;   noun   = o1;
1652         if (o2) { sav_sec  = second; second = o2; }
1653         res = RunRoutines(o1, before_implicit);
1654         action = sav_act; noun = sav_noun;
1655         if (sav_sec) second = sav_sec;
1656     }
1657     else {
1658         if (no_implicit_actions)
1659             res = 2;
1660         else
1661             res = 0;
1662     }
1663     return res;
1664 ];
1665
1666 [ ImplicitTake obj
1667     res ks supcon;
1668     switch (metaclass(obj)) { Class, String, Routine, nothing: rfalse; }
1669     if (obj in actor) rfalse;
1670     if (action_to_be == ##Drop && ~~IndirectlyContains(actor, obj)) rfalse;
1671     res = CheckImplicitAction(##Take, obj);
1672     ! 0 = Take object, Tell the user (normal default)
1673     ! 1 = Take object, don't Tell
1674     ! 2 = don't Take object  continue       (default with no_implicit_actions)
1675     ! 3 = don't Take object, don't continue
1676     if (res >= 2) rtrue;
1677     if (parent(obj) && parent(obj) has container or supporter) supcon = parent(obj);
1678     ks = keep_silent; keep_silent = 2; AttemptToTakeObject(obj); keep_silent = ks;
1679     if (obj notin actor) rtrue;
1680     if (res == 0 && ~~keep_silent)
1681         if (supcon) L__M(##Miscellany, 58, obj, supcon);
1682         else        L__M(##Miscellany, 26, obj);
1683     rfalse;
1684 ];
1685
1686 [ ImplicitExit obj
1687     res ks;
1688     if (parent(obj) == nothing) rfalse;
1689     res = CheckImplicitAction(##Exit, obj);
1690     ! 0 = Exit object, Tell the user (normal default)
1691     ! 1 = Exit object, don't Tell
1692     ! 2 = don't Take object  continue       (default with no_implicit_actions)
1693     ! 3 = don't Take object, don't continue
1694     if (res >= 2) rtrue;
1695     ks = keep_silent; keep_silent = 2; <Exit obj, actor>; keep_silent = ks;
1696     if (parent(actor) == obj) rtrue;
1697     if (res == 0 && ~~keep_silent) L__M(##Exit, 5, obj);
1698     rfalse;
1699 ];
1700
1701 [ ImplicitClose obj
1702     res ks;
1703     if (obj hasnt open) rfalse;
1704     res = CheckImplicitAction(##Close, obj);
1705     ! 0 = Close object, Tell the user (normal default)
1706     ! 1 = Close object, don't Tell
1707     ! 2 = don't Take object  continue       (default with no_implicit_actions)
1708     ! 3 = don't Take object, don't continue
1709     if (res >= 2) rtrue;
1710     ks = keep_silent; keep_silent = 2; <Close obj, actor>; keep_silent = ks;
1711     if (obj has open) rtrue;
1712     if (res == 0 && ~~keep_silent) L__M(##Close, 4, obj);
1713     rfalse;
1714 ];
1715
1716 [ ImplicitOpen obj
1717     res temp;
1718     if (obj has open) rfalse;
1719     res = CheckImplicitAction(##Open, obj);
1720     ! 0 = Open object, Tell the user (normal default)
1721     ! 1 = Open object, don't Tell
1722     ! 2 = don't Take object  continue       (default with no_implicit_actions)
1723     ! 3 = don't Take object, don't continue
1724     if (res >= 2) rtrue;
1725     if (obj has locked) rtrue;
1726     temp = keep_silent; keep_silent = 2; <Open obj, actor>; keep_silent = temp;
1727     if (obj hasnt open) rtrue;
1728     if (res == 0 && ~~keep_silent) L__M(##Open, 6, obj);
1729     temp = action; action = ##Open; AfterRoutines(); action = temp;
1730     rfalse;
1731 ];
1732
1733 [ ImplicitUnlock obj;
1734     if (obj has locked) rtrue;
1735     rfalse;
1736 ];
1737
1738 [ ImplicitDisrobe obj
1739     res ks;
1740     if (obj hasnt worn) rfalse;
1741     res = CheckImplicitAction(##Disrobe, obj);
1742     ! 0 = Take off object, Tell the user (normal default)
1743     ! 1 = Take off object, don't Tell
1744     ! 2 = don't Take object  continue       (default with no_implicit_actions)
1745     ! 3 = don't Take object, don't continue
1746     if (res >= 2) rtrue;
1747     ks = keep_silent; keep_silent = 1; <Disrobe obj, actor>; keep_silent = ks;
1748     if (obj has worn && obj in actor) rtrue;
1749     if (res == 0 && ~~keep_silent) L__M(##Drop, 3, obj);
1750     rfalse;
1751 ];
1752
1753
1754 ! ----------------------------------------------------------------------------
1755 !   Object movement verbs
1756 ! ----------------------------------------------------------------------------
1757
1758 [ TakeSub;
1759     if (onotheld_mode == 0 || noun notin actor)
1760         if (AttemptToTakeObject(noun)) return;
1761     if (AfterRoutines()) return;
1762     notheld_mode = onotheld_mode;
1763     if (notheld_mode == 1 || keep_silent) return;
1764     L__M(##Take, 1, noun);
1765 ];
1766
1767 [ RemoveSub i;
1768     i = parent(noun);
1769     if (i && i has container && i hasnt open && ImplicitOpen(i)) return L__M(##Remove, 1, i);
1770     if (i ~= second)   return L__M(##Remove, 2, noun);
1771     if (i has animate) return L__M(##Take, 6, i, noun);
1772
1773     if (AttemptToTakeObject(noun)) rtrue;
1774
1775     action = ##Remove; if (AfterRoutines()) return;
1776     action = ##Take;   if (AfterRoutines()) return;
1777     if (keep_silent) return;
1778     L__M(##Remove, 3, noun);
1779 ];
1780
1781 [ DropSub;
1782     if (noun == actor)         return L__M(##PutOn, 4, noun);
1783     if (noun in parent(actor)) return L__M(##Drop, 1, noun);
1784     if (noun notin actor && ~~ImplicitTake(noun)) return L__M(##Drop, 2, noun);
1785     if (noun has worn && ImplicitDisrobe(noun)) return;
1786     move noun to parent(actor);
1787     if (AfterRoutines() || keep_silent) return;
1788     L__M(##Drop, 4, noun);
1789 ];
1790
1791 [ PutOnSub ancestor;
1792     receive_action = ##PutOn;
1793     if (second == d_obj || actor in second) <<Drop noun, actor>>;
1794     if (parent(noun) == second) return L__M(##Drop, 1, noun);
1795     if (noun notin actor && ImplicitTake(noun)) return L__M(##PutOn, 1, noun);
1796
1797     ancestor = CommonAncestor(noun, second);
1798     if (ancestor == noun) return L__M(##PutOn, 2, noun);
1799     if (ObjectIsUntouchable(second)) return;
1800
1801     if (second ~= ancestor) {
1802         action = ##Receive;
1803         if (RunRoutines(second, before)) { action = ##PutOn; return; }
1804         action = ##PutOn;
1805     }
1806     if (second hasnt supporter) return L__M(##PutOn, 3, second);
1807     if (ancestor == actor)      return L__M(##PutOn, 4, second);
1808     if (noun has worn && ImplicitDisrobe(noun)) return;
1809
1810     if (ObjectDoesNotFit(noun, second) ||
1811         LibraryExtensions.RunWhile(ext_objectdoesnotfit, false, noun, second)) return;
1812     if (AtFullCapacity(noun, second)) return L__M(##PutOn, 6, second);
1813
1814     move noun to second;
1815
1816     if (AfterRoutines()) return;
1817
1818     if (second ~= ancestor) {
1819         action = ##Receive;
1820         if (RunRoutines(second, after)) { action = ##PutOn; return; }
1821         action = ##PutOn;
1822     }
1823     if (keep_silent) return;
1824     if (multiflag) return L__M(##PutOn, 7);
1825     L__M(##PutOn, 8, noun, second);
1826 ];
1827
1828 [ InsertSub ancestor;
1829     receive_action = ##Insert;
1830     if (second == d_obj || actor in second) <<Drop noun, actor>>;
1831     if (parent(noun) == second) return L__M(##Drop, 1, noun);
1832     if (noun notin actor && ImplicitTake(noun)) return L__M(##Insert, 1, noun);
1833     ancestor = CommonAncestor(noun, second);
1834     if (ancestor == noun) return L__M(##Insert, 5, noun);
1835     if (ObjectIsUntouchable(second)) return;
1836     if (second ~= ancestor) {
1837         action = ##Receive;
1838         if (RunRoutines(second,before)) { action = ##Insert; rtrue; }
1839         action = ##Insert;
1840         if (second has container && second hasnt open && ImplicitOpen(second))
1841             return L__M(##Insert, 3, second);
1842     }
1843     if (second hasnt container) return L__M(##Insert, 2, second);
1844     if (noun has worn && ImplicitDisrobe(noun)) return;
1845
1846     if (ObjectDoesNotFit(noun, second) ||
1847         LibraryExtensions.RunWhile(ext_objectdoesnotfit, false, noun, second)) return;
1848     if (AtFullCapacity(noun, second)) return L__M(##Insert, 7, second);
1849
1850     move noun to second;
1851
1852     if (AfterRoutines()) rtrue;
1853
1854     if (second ~= ancestor) {
1855         action = ##Receive;
1856         if (RunRoutines(second, after)) { action = ##Insert; rtrue; }
1857         action = ##Insert;
1858     }
1859     if (keep_silent) rtrue;
1860     if (multiflag) return L__M(##Insert, 8, noun);
1861     L__M(##Insert, 9, noun, second);
1862 ];
1863
1864 ! ----------------------------------------------------------------------------
1865 !   Empties and transfers are routed through the actions above
1866 ! ----------------------------------------------------------------------------
1867
1868 [ TransferSub;
1869     if (noun notin actor && AttemptToTakeObject(noun)) return;
1870     if (second has supporter) <<PutOn noun second, actor>>;
1871     if (second == d_obj) <<Drop noun, actor>>;
1872     <<Insert noun second, actor>>;
1873 ];
1874
1875 [ EmptySub; second = d_obj; EmptyTSub(); ];
1876
1877 [ EmptyTSub i j k flag;
1878     if (noun == second) return L__M(##EmptyT, 4, noun);
1879     if (ObjectIsUntouchable(noun)) return;
1880     if (noun hasnt container) return L__M(##EmptyT, 1, noun);
1881     if (noun hasnt open && ImplicitOpen(noun)) return L__M(##EmptyT, 2, noun);
1882     if (second ~= d_obj) {
1883         if (second hasnt supporter) {
1884             if (second hasnt container) return L__M(##EmptyT, 1, second);
1885             if (second hasnt open && ImplicitOpen(second))
1886                 return L__M(##EmptyT, 2, second);
1887         }
1888     }
1889     i = child(noun); k = children(noun);
1890     if (i == 0) return L__M(##EmptyT, 3, noun);
1891     while (i) {
1892         j = sibling(i);
1893         flag = false;
1894         if (ObjectIsUntouchable(noun)) flag = true;
1895         if (noun hasnt container) flag = true;
1896         if (noun hasnt open) flag = true;
1897         if (second ~= d_obj) {
1898             if (second hasnt supporter) {
1899                 if (second hasnt container) flag = true;
1900                 if (second hasnt open) flag = true;
1901             }
1902         }
1903         if (k-- == 0) flag = 1;
1904         if (flag) break;
1905         if (keep_silent == 0) print (name) i, (string) COLON__TX;
1906         <Transfer i second, actor>;
1907         i = j;
1908     }
1909 ];
1910
1911 ! ----------------------------------------------------------------------------
1912 !   Gifts
1913 ! ----------------------------------------------------------------------------
1914
1915 [ GiveSub;
1916     if (noun notin actor && ImplicitTake(noun)) return L__M(##Give, 1, noun);
1917     if (second == actor) return L__M(##Give, 2, noun);
1918     if (noun has worn && ImplicitDisrobe(noun)) return;
1919     if (second == player) {
1920         move noun to player;
1921         return L__M(##Give, 4, noun);
1922     }
1923
1924     if (RunLife(second, ##Give)) return;
1925     L__M(##Give, 3, second);
1926 ];
1927
1928 [ GiveRSub; <Give second noun, actor>; ];
1929
1930 [ ShowSub;
1931     if (noun notin actor && ImplicitTake(noun)) return L__M(##Show, 1, noun);
1932     if (second == player) <<Examine noun, actor>>;
1933     if (RunLife(second, ##Show)) return;
1934     L__M(##Show, 2, second);
1935 ];
1936
1937 [ ShowRSub; <Show second noun, actor>; ];
1938
1939 ! ----------------------------------------------------------------------------
1940 !   Travelling around verbs
1941 ! ----------------------------------------------------------------------------
1942
1943 [ EnterSub ancestor j ks;
1944     if (noun has door || noun in compass) <<Go noun, actor>>;
1945     if (actor in noun) return L__M(##Enter, 1, noun);
1946     if (noun hasnt enterable) return L__M(##Enter, 2, noun, verb_word);
1947
1948     if (parent(actor) ~= parent(noun)) {
1949         ancestor = CommonAncestor(actor, noun);
1950         if (ancestor == actor or 0) return L__M(##Enter, 4, noun);
1951         while (actor notin ancestor) {
1952             j = parent(actor);
1953             ks = keep_silent;
1954             if (parent(j) ~= ancestor || noun ~= ancestor) {
1955                 L__M(##Enter, 6, j);
1956                 keep_silent = 1;
1957             }
1958             <Exit, actor>;
1959             keep_silent = ks;
1960             if (actor in j) return;
1961         }
1962         if (actor in noun) return;
1963         if (noun notin ancestor) {
1964             j = parent(noun);
1965             while (parent(j) ~= ancestor) j = parent(j);
1966             L__M(##Enter, 7, j);
1967             ks = keep_silent; keep_silent = 1;
1968             <Enter j, actor>;
1969             keep_silent = ks;
1970             if (actor notin j) return;
1971             <<Enter noun, actor>>;
1972         }
1973     }
1974
1975     if (noun has container && noun hasnt open && ImplicitOpen(noun)) return L__M(##Enter, 3, noun);
1976     move actor to noun;
1977
1978     if (AfterRoutines() || keep_silent) return;
1979     L__M(##Enter, 5, noun);
1980     if (actor == player) Locale(noun);
1981 ];
1982
1983 [ GetOffSub;
1984     if (parent(actor) == noun) <<Exit, actor>>;
1985     L__M(##GetOff, 1, noun);
1986 ];
1987
1988 [ ExitSub p;
1989     p = parent(actor);
1990     if (noun ~= nothing && noun ~= p) return L__M(##Exit, 4 ,noun);
1991     if (p == location || (location == thedark && p == real_location)) {
1992         if (actor provides posture && actor.posture) {
1993             actor.posture = 0;
1994             return L__M(##Exit, 6);
1995         }
1996         if ((location.out_to) || (location == thedark && real_location.out_to))
1997             <<Go out_obj, actor>>;
1998         return L__M(##Exit, 1);
1999     }
2000     if (p has container && p hasnt open && ImplicitOpen(p))
2001         return L__M(##Exit, 2, p);
2002
2003     if (noun == nothing) {
2004         inp1 = p;
2005         if (RunRoutines(p, before)) return;
2006     }
2007
2008     move actor to parent(p);
2009     if (player provides posture) player.posture = 0;
2010
2011     if (AfterRoutines() || keep_silent) return;
2012     L__M(##Exit, 3, p);
2013     if (actor == player && p has container) LookSub(1);
2014 ];
2015
2016 [ VagueGoSub; L__M(##VagueGo); ];
2017
2018 [ GoInSub; <<Go in_obj, actor>>; ];
2019
2020 [ GoSub i j k movewith thedir next_loc;
2021
2022     ! first, check if any PushDir object is touchable
2023     if (second && second notin Compass && ObjectIsUntouchable(second)) return;
2024
2025     movewith = 0;
2026     i = parent(actor);
2027     if ((location ~= thedark && i ~= location) || (location == thedark && i ~= real_location)) {
2028         j = location;
2029         if (location == thedark) location = real_location;
2030         k = RunRoutines(i, before); if (k ~= 3) location = j;
2031         if (k == 1) {
2032            movewith = i; i = parent(i);
2033         }
2034         else {
2035             if (k) rtrue;
2036             if (ImplicitExit(i)) return L__M(##Go, 1, i);
2037             i = parent(actor);
2038         }
2039     }
2040
2041     thedir = noun.door_dir;
2042     if (metaclass(thedir) == Routine) thedir = RunRoutines(noun, door_dir);
2043
2044     next_loc = i.thedir; k = metaclass(next_loc);
2045     if (k == String) { print (string) next_loc; new_line; rfalse; }
2046     if (k == Routine) {
2047         next_loc = RunRoutines(i, thedir);
2048         if (next_loc == 1) rtrue;
2049     }
2050
2051     if (k == nothing || next_loc == 0) {
2052         if (i.cant_go ~= 0 or CANTGO__TX) PrintOrRun(i, cant_go);
2053         else                              L__M(##Go, 2);
2054         rfalse;
2055     }
2056     if (next_loc has door) {
2057         if (next_loc has concealed) return L__M(##Go, 2);
2058         if (next_loc hasnt open && ImplicitOpen(next_loc)) {
2059             if (noun == u_obj) return L__M(##Go, 3, next_loc);
2060             if (noun == d_obj) return L__M(##Go, 4, next_loc);
2061             return L__M(##Go, 5, next_loc);
2062         }
2063         k = RunRoutines(next_loc, door_to);
2064         if (k == 0) return L__M(##Go, 6, next_loc);
2065         if (k == 1) rtrue;
2066         next_loc = k;
2067     }
2068
2069     action = ##Going;
2070     if (RunRoutines(next_loc, before)) { action = ##Go; return; }
2071     action = ##Go;
2072
2073     if (movewith == 0) move actor to next_loc; else move movewith to next_loc;
2074     if (actor ~= player) return L__M(##Go, 7);
2075
2076     k = location; location = next_loc;
2077     MoveFloatingObjects();
2078     if (OffersLight(location))
2079         lightflag = true;
2080     else {
2081         lightflag = false;
2082         if (k == thedark) {
2083             if(DarkToDark() == false) ! From real_location To location
2084                 LibraryExtensions.RunAll(ext_darktodark);
2085             if (deadflag) rtrue;
2086         }
2087         location = thedark;
2088     }
2089     NoteDeparture(); real_location = next_loc;
2090     action = ##Going;
2091     if (RunRoutines(prev_location, after)) { action = ##Go; return; }
2092     action = ##Go;
2093     if (AfterRoutines() || keep_silent) return;
2094     LookSub(1);
2095 ];
2096
2097 ! ----------------------------------------------------------------------------
2098 !   Describing the world.  SayWhatsOn(object) does just that (producing
2099 !   no text if nothing except possibly "scenery" and "concealed" items are).
2100 !   Locale(object) runs through the "tail end" of a Look-style room
2101 !   description for the contents of the object, printing up suitable
2102 !   descriptions as it goes.
2103 ! ----------------------------------------------------------------------------
2104
2105 [ SayWhatsOn descon j f;
2106     if (descon == parent(player)) rfalse;
2107     objectloop (j in descon)
2108         if (j hasnt concealed && j hasnt scenery) f = 1;
2109     if (f == 0) rfalse;
2110     L__M(##Look, 4, descon);
2111 ];
2112
2113 [ NotSupportingThePlayer o i;
2114     i = parent(player);
2115     while (i && i ~= visibility_ceiling) {
2116         if (i == o) rfalse;
2117         i = parent(i);
2118         if (i && i hasnt supporter) rtrue;
2119     }
2120     rtrue;
2121 ];
2122 ! modified with the fix for L61122
2123 [ Locale descin text_without_ALSO text_with_ALSO
2124     o p num_objs must_print_ALSO;
2125     objectloop (o in descin) give o ~workflag;
2126     num_objs = 0;
2127     objectloop (o in descin)
2128         if (o hasnt concealed && NotSupportingThePlayer(o)) {
2129             #Ifndef MANUAL_PRONOUNS;
2130             PronounNotice(o);
2131             #Endif;
2132             if (o has scenery) {
2133                 if (o has supporter && child(o)) SayWhatsOn(o);
2134             }
2135             else {
2136                 give o workflag; num_objs++;
2137                 p = initial;
2138                 if ((o has door or container) && o has open && o provides when_open) {
2139                     p = when_open; jump Prop_Chosen;
2140                 }
2141                 if ((o has door or container) && o hasnt open && o provides when_closed) {
2142                     p = when_closed; jump Prop_Chosen;
2143                 }
2144                 if (o has switchable && o has on && o provides when_on) {
2145                     p = when_on; jump Prop_Chosen;
2146                 }
2147                 if (o has switchable && o hasnt on && o provides when_off) {
2148                     p = when_off;
2149                 }
2150
2151               .Prop_Chosen;
2152
2153                 if (o.&describe && RunRoutines(o, describe)) {
2154                     must_print_ALSO = true;
2155                     give o ~workflag; num_objs--;
2156                     continue;
2157                 }
2158                 if (o.p && (o hasnt moved || p ~= initial)) {
2159                     new_line;
2160                     PrintOrRun(o, p);
2161                     must_print_ALSO = true;
2162                     give o ~workflag; num_objs--;
2163                     if (o has supporter && child(o)) SayWhatsOn(o);
2164                 }
2165             }
2166         }
2167
2168     if (num_objs == 0) return 0;
2169
2170     if (actor ~= player) give actor concealed;
2171     if (text_without_ALSO) {
2172         new_line;
2173         if (must_print_ALSO) print (string) text_with_ALSO, " ";
2174         else print (string) text_without_ALSO, " ";
2175         WriteListFrom(child(descin),
2176           ENGLISH_BIT+RECURSE_BIT+PARTINV_BIT+TERSE_BIT+CONCEAL_BIT+WORKFLAG_BIT);
2177     }
2178     else {
2179         if (must_print_ALSO) L__M(##Look, 5, descin);
2180         else L__M(##Look, 6, descin);
2181     }
2182     if (actor ~= player) give actor ~concealed;
2183     return num_objs;
2184 ];
2185
2186 ! ----------------------------------------------------------------------------
2187 !   Looking.  LookSub(1) is allowed to abbreviate long descriptions, but
2188 !     LookSub(0) (which is what happens when the Look action is generated)
2189 !     isn't.  (Except that these are over-ridden by the player-set lookmode.)
2190 ! ----------------------------------------------------------------------------
2191
2192 [ LMode1Sub; lookmode=1; print (string) Story; L__M(##LMode1); ];  ! Brief
2193
2194 [ LMode2Sub; lookmode=2; print (string) Story; L__M(##LMode2); ];  ! Verbose
2195
2196 [ LMode3Sub; lookmode=3; print (string) Story; L__M(##LMode3); ];  ! Superbrief
2197
2198 [ LModeNormalSub;       ! 'normal' value: the default, or as set in Initialise()
2199     switch (initial_lookmode) {
2200       1:       <<LMode1>>;
2201       3:       <<LMode3>>;
2202       default: <<LMode2>>;
2203     }
2204 ];
2205
2206 [ NoteArrival descin;
2207     if (location ~= lastdesc) {
2208         if (location.initial) PrintOrRun(location, initial);
2209         if (location == thedark) { lastdesc = thedark; return; }
2210         descin = location;
2211         if(NewRoom() == false) LibraryExtensions.RunAll(ext_newroom);
2212         lastdesc = descin;
2213     }
2214 ];
2215
2216 [ NoteDeparture;
2217     prev_location = real_location;
2218 ];
2219
2220 [ ScoreArrival;
2221     if (location hasnt visited) {
2222         give location visited;
2223         if (location has scored) {
2224             score = score + ROOM_SCORE;
2225             places_score = places_score + ROOM_SCORE;
2226         }
2227     }
2228 ];
2229
2230 [ FindVisibilityLevels visibility_levels;
2231     visibility_levels = 1;
2232     visibility_ceiling = parent(player);
2233     while ((parent(visibility_ceiling)) &&
2234                   (visibility_ceiling hasnt container || visibility_ceiling has open or transparent)) {
2235         visibility_ceiling = parent(visibility_ceiling);
2236         visibility_levels++;
2237     }
2238     return visibility_levels;
2239 ];
2240
2241 [ LookSub allow_abbrev  visibility_levels i j k nl_flag;
2242     if (parent(player) == 0) return RunTimeError(10);
2243
2244   .MovedByInitial;
2245
2246     if (location == thedark) { visibility_ceiling = thedark; NoteArrival(); }
2247     else {
2248         visibility_levels = FindVisibilityLevels();
2249         if (visibility_ceiling == location) {
2250             NoteArrival();
2251             if (visibility_ceiling ~= location) jump MovedByInitial;
2252         }
2253     }
2254     ! Printing the top line: e.g.
2255     ! Octagonal Room (on the table) (as Frodo)
2256     new_line;
2257     #Ifdef TARGET_ZCODE;
2258     style bold;
2259     #Ifnot; ! TARGET_GLULX;
2260     glk_set_style(style_Subheader);
2261     #Endif; ! TARGET_
2262     if (visibility_levels == 0) print (name) thedark;
2263     else {
2264         if (visibility_ceiling ~= location) print (The) visibility_ceiling;
2265         else print (name) visibility_ceiling;
2266     }
2267     #Ifdef TARGET_ZCODE;
2268     style roman;
2269     #Ifnot; ! TARGET_GLULX;
2270     glk_set_style(style_Normal);
2271     #Endif; ! TARGET_
2272
2273     for (j=1,i=parent(player) : j<visibility_levels : j++,i=parent(i))
2274         if (i has supporter) L__M(##Look, 1, i);
2275         else                 L__M(##Look, 2, i);
2276
2277     if (print_player_flag == 1) L__M(##Look, 3, player);
2278     new_line;
2279
2280     ! The room description (if visible)
2281
2282     if (lookmode < 3 && visibility_ceiling == location) {
2283         if ((allow_abbrev ~= 1) || (lookmode == 2) || (location hasnt visited)) {
2284             if (location.&describe) RunRoutines(location, describe);
2285             else {
2286                 if (location.description == 0) RunTimeError(11, location, description);
2287                 else PrintOrRun(location, description);
2288             }
2289         }
2290     }
2291
2292     if (visibility_ceiling == location) nl_flag = 1;
2293
2294     if (visibility_levels == 0) Locale(thedark);
2295     else {
2296         for (i=player,j=visibility_levels : j>0 : j--,i=parent(i)) give i workflag;
2297
2298         for (j=visibility_levels : j>0 : j--) {
2299             for (i=player,k=0 : k<j : k++) i=parent(i);
2300             if (i.inside_description) {
2301                 if (nl_flag) new_line; else nl_flag = 1;
2302                     PrintOrRun(i,inside_description);
2303                 }
2304             if (Locale(i)) nl_flag=1;
2305         }
2306     }
2307
2308     if(LookRoutine() == false) LibraryExtensions.RunAll(ext_lookroutine);
2309     ScoreArrival();
2310     action = ##Look;
2311     AfterRoutines();
2312 ];
2313
2314 [ ExamineSub i;
2315     if (location == thedark) return L__M(##Examine, 1, noun);
2316     i = noun.description;
2317     if (i == 0) {
2318         if (noun has container)
2319             if (noun has open or transparent) <<Search noun, actor>>;
2320             else return L__M(##Search, 5, noun);
2321         if (noun has switchable) { L__M(##Examine, 3, noun); rfalse; }
2322         return L__M(##Examine, 2, noun);
2323     }
2324     i = PrintOrRun(noun, description);
2325     if (i < 2 && noun has switchable) L__M(##Examine, 3, noun);
2326     AfterRoutines();
2327 ];
2328
2329 [ LookUnderSub;
2330     if (location == thedark) return L__M(##LookUnder, 1, noun);
2331     L__M(##LookUnder, 2);
2332 ];
2333
2334 [ VisibleContents o  i f;
2335     objectloop (i in o) if (i hasnt concealed or scenery) f++;
2336     return f;
2337 ];
2338
2339 [ SearchSub f;
2340     if (location == thedark) return L__M(##Search, 1, noun);
2341     if (ObjectIsUntouchable(noun)) return;
2342     f = VisibleContents(noun);
2343     if (noun has supporter) {
2344         if (f == 0) return L__M(##Search, 2, noun);
2345         return L__M(##Search, 3, noun);
2346     }
2347     if (noun hasnt container) return L__M(##Search, 4, noun);
2348     if (noun hasnt transparent or open && ImplicitOpen(noun)) return L__M(##Search, 5, noun);
2349     if (AfterRoutines()) return;
2350
2351     if (f == 0) return L__M(##Search, 6, noun);
2352     L__M(##Search, 7, noun);
2353 ];
2354
2355 ! ----------------------------------------------------------------------------
2356 !   Verbs which change the state of objects without moving them
2357 ! ----------------------------------------------------------------------------
2358
2359 [ UnlockSub;
2360     if (ObjectIsUntouchable(noun)) return;
2361     if (noun hasnt lockable)     return L__M(##Unlock, 1, noun);
2362     if (noun hasnt locked)       return L__M(##Unlock, 2, noun);
2363     if (noun.with_key ~= second) return L__M(##Unlock, 3, second);
2364
2365     give noun ~locked;
2366
2367     if (AfterRoutines() || keep_silent) return;
2368     L__M(##Unlock, 4, noun);
2369 ];
2370
2371 [ LockSub;
2372     if (ObjectIsUntouchable(noun)) return;
2373     if (noun hasnt lockable) return L__M(##Lock, 1, noun);
2374     if (noun has locked)     return L__M(##Lock, 2 ,noun);
2375     if (noun has open && ImplicitClose(noun)) return L__M(##Lock, 3, noun);
2376     if (noun.with_key ~= second) return L__M(##Lock, 4, second);
2377
2378     give noun locked;
2379     if (AfterRoutines() || keep_silent) return;
2380     L__M(##Lock, 5, noun);
2381 ];
2382
2383 [ SwitchonSub;
2384     if (ObjectIsUntouchable(noun)) return;
2385     if (noun hasnt switchable) return L__M(##SwitchOn, 1, noun);
2386     if (noun has on)           return L__M(##SwitchOn, 2, noun);
2387
2388     give noun on;
2389     if (AfterRoutines() || keep_silent) return;
2390     L__M(##SwitchOn, 3, noun);
2391 ];
2392
2393 [ SwitchoffSub;
2394     if (ObjectIsUntouchable(noun)) return;
2395     if (noun hasnt switchable) return L__M(##SwitchOff, 1, noun);
2396     if (noun hasnt on)         return L__M(##SwitchOff, 2, noun);
2397
2398     give noun ~on;
2399     if (AfterRoutines() || keep_silent) return;
2400     L__M(##SwitchOff, 3, noun);
2401 ];
2402
2403 [ OpenSub;
2404     if (ObjectIsUntouchable(noun)) return;
2405     if (noun hasnt openable) return L__M(##Open, 1, noun);
2406     if (noun has locked && ImplicitUnlock(noun)) return L__M(##Open, 2, noun);
2407     if (noun has open)       return L__M(##Open, 3, noun);
2408     give noun open;
2409
2410     if (keep_silent || AfterRoutines()) return;
2411
2412     if (noun hasnt container)
2413         return L__M(##Open, 5, noun);
2414
2415     if ((noun has container && location ~= thedark && VisibleContents(noun)
2416          && IndirectlyContains(noun, player)) == 0) {
2417          if (noun hasnt transparent && noun hasnt door) return L__M(##Open, 4, noun);
2418     }
2419     L__M(##Open, 5, noun);
2420 ];
2421
2422 [ CloseSub;
2423     if (ObjectIsUntouchable(noun)) return;
2424     if (noun hasnt openable) return L__M(##Close, 1, noun);
2425     if (noun hasnt open)     return L__M(##Close, 2, noun);
2426
2427     give noun ~open;
2428     if (AfterRoutines() || keep_silent) return;
2429     L__M(##Close, 3, noun);
2430 ];
2431
2432 [ DisrobeSub;
2433     if (ObjectIsUntouchable(noun)) return;
2434     if (noun hasnt worn) return L__M(##Disrobe, 1, noun);
2435
2436     give noun ~worn;
2437     if (AfterRoutines() || keep_silent) return;
2438     L__M(##Disrobe, 2, noun);
2439 ];
2440
2441 [ WearSub;
2442     if (ObjectIsUntouchable(noun)) return;
2443     if (noun hasnt clothing)    return L__M(##Wear, 1, noun);
2444     if (noun notin actor && ImplicitTake(noun)) return L__M(##Wear, 2, noun);
2445     if (noun has worn)          return L__M(##Wear, 3, noun);
2446
2447     give noun worn;
2448     if (AfterRoutines() || keep_silent) return;
2449     L__M(##Wear, 4, noun);
2450 ];
2451
2452 [ EatSub;
2453     if (ObjectIsUntouchable(noun)) return;
2454     if (noun hasnt edible) return L__M(##Eat, 1, noun);
2455     if (noun has worn && ImplicitDisrobe(noun)) return;
2456
2457     remove noun;
2458     if (AfterRoutines() || keep_silent) return;
2459     L__M(##Eat, 2, noun);
2460 ];
2461
2462 ! ----------------------------------------------------------------------------
2463 !   Verbs which are really just stubs (anything which happens for these
2464 !   actions must happen in before rules)
2465 ! ----------------------------------------------------------------------------
2466
2467 [ AllowPushDir i;
2468     if (parent(second) ~= compass) return L__M(##PushDir, 2, noun);
2469     if (second == u_obj or d_obj)  return L__M(##PushDir, 3, noun);
2470     AfterRoutines(); i = noun; move i to actor;
2471     <Go second, actor>;
2472     if (location == thedark) move i to real_location;
2473     else                     move i to location;
2474 ];
2475
2476 [ AnswerSub;
2477     if (second && RunLife(second,##Answer)) rfalse;
2478     L__M(##Answer, 1, noun);
2479 ];
2480
2481 [ AskSub;
2482     if (RunLife(noun,##Ask)) rfalse;
2483     L__M(##Ask, 1, noun);
2484 ];
2485
2486 [ AskForSub;
2487     if (noun == player) <<Inv, actor>>;
2488     L__M(##Order, 1, noun);
2489 ];
2490
2491 [ AskToSub; L__M(##Order, 1, noun); ];
2492
2493 [ AttackSub;
2494     if (ObjectIsUntouchable(noun)) return;
2495     if (noun has animate && RunLife(noun, ##Attack)) rfalse;
2496     L__M(##Attack, 1, noun);
2497 ];
2498
2499 [ BlowSub; L__M(##Blow, 1, noun); ];
2500
2501 [ BurnSub;
2502     if (noun has animate) return L__M(##Burn, 2, noun);
2503     L__M(##Burn, 1, noun);
2504 ];
2505
2506 [ BuySub; L__M(##Buy, 1, noun); ];
2507
2508 [ ClimbSub;
2509     if (noun has animate) return L__M(##Climb, 2, noun);
2510     L__M(##Climb, 1, noun);
2511 ];
2512
2513 [ ConsultSub; L__M(##Consult, 1, noun); ];
2514
2515 [ CutSub;
2516     if (noun has animate) return L__M(##Cut, 2, noun);
2517     L__M(##Cut, 1, noun);
2518 ];
2519
2520 [ DigSub; L__M(##Dig, 1, noun); ];
2521
2522 [ DrinkSub; L__M(##Drink, 1, noun); ];
2523
2524 [ FillSub;
2525     if (second == nothing) return L__M(##Fill, 1, noun);
2526     L__M(##Fill, 2, noun, second);
2527 ];
2528
2529 [ JumpSub; L__M(##Jump, 1, noun); ];
2530
2531 [ JumpInSub;
2532     if (noun has animate) return L__M(##JumpIn, 2, noun);
2533     if (noun has enterable) <<Enter noun>>;
2534     L__M(##JumpOn, 1, noun);
2535 ];
2536
2537 [ JumpOnSub;
2538     if (noun has animate) return L__M(##JumpOn, 2, noun);
2539     if (noun has enterable && noun has supporter) <<Enter noun>>;
2540     L__M(##JumpOn, 1, noun);
2541 ];
2542
2543 [ JumpOverSub;
2544     if (noun has animate) return L__M(##JumpOver, 2, noun);
2545     L__M(##JumpOver, 1, noun);
2546 ];
2547
2548 [ KissSub;
2549     if (ObjectIsUntouchable(noun)) return;
2550     if (RunLife(noun, ##Kiss)) return;
2551     if (noun == actor) return L__M(##Touch, 3, noun);
2552     L__M(##Kiss, 1, noun);
2553 ];
2554
2555 [ ListenSub; L__M(##Listen, 1, noun); ];
2556
2557 [ MildSub; L__M(##Mild, 1, noun); ];
2558
2559 [ NoSub; L__M(##No); ];
2560
2561 [ PraySub; L__M(##Pray, 1, noun); ];
2562
2563 [ PullSub;
2564     if (ObjectIsUntouchable(noun)) return;
2565     if (noun == player)   return L__M(##Pull, 1, noun);
2566     if (noun == actor)    return L__M(##Pull, 6, noun);
2567     if (noun has static)  return L__M(##Pull, 2, noun);
2568     if (noun has scenery) return L__M(##Pull, 3, noun);
2569     if (noun has animate) return L__M(##Pull, 5, noun);
2570     L__M(##Pull, 4, noun);
2571 ];
2572
2573 [ PushSub;
2574     if (ObjectIsUntouchable(noun)) return;
2575     if (noun == player)   return L__M(##Push, 1, noun);
2576     if (noun == actor)    return L__M(##Push, 5, noun);
2577     if (noun has static)  return L__M(##Push, 2, noun);
2578     if (noun has scenery) return L__M(##Push, 3, noun);
2579     if (noun has animate) return L__M(##Push, 5, noun);
2580     L__M(##Push, 4, noun);
2581 ];
2582
2583 [ PushDirSub; L__M(##PushDir, 1, noun); ];
2584
2585 [ RubSub;
2586     if (ObjectIsUntouchable(noun)) return;
2587     if (noun has animate) return L__M(##Rub, 2, noun);
2588     L__M(##Rub, 1, noun);
2589 ];
2590
2591 [ SetSub; L__M(##Set, 1, noun); ];
2592
2593 [ SetToSub; L__M(##SetTo, 1, noun); ];
2594
2595 [ SingSub; L__M(##Sing, 1, noun); ];
2596
2597 [ SleepSub; L__M(##Sleep, 1, noun); ];
2598
2599 [ SmellSub;
2600     if (noun ~= nothing && noun has animate) return L__M(##Smell, 2, noun);
2601     L__M(##Smell, 1, noun);
2602 ];
2603
2604 [ SorrySub; L__M(##Sorry, 1, noun); ];
2605
2606 [ SqueezeSub;
2607     if (ObjectIsUntouchable(noun)) return;
2608     if (noun has animate && noun ~= player) return L__M(##Squeeze, 1, noun);
2609     L__M(##Squeeze, 2, noun);
2610 ];
2611
2612 [ StrongSub; L__M(##Strong, 1, noun); ];
2613
2614 [ SwimSub; L__M(##Swim, 1, noun); ];
2615
2616 [ SwingSub; L__M(##Swing, 1, noun); ];
2617
2618 [ TasteSub;
2619     if (ObjectIsUntouchable(noun)) return;
2620     if (noun has animate) return L__M(##Taste, 2, noun);
2621     L__M(##Taste, 1, noun);
2622 ];
2623
2624 [ TellSub;
2625     if (noun == actor) return L__M(##Tell, 1, noun);
2626     if (RunLife(noun, ##Tell)) return;
2627     L__M(##Tell, 2, noun);
2628 ];
2629
2630 [ ThinkSub; L__M(##Think, 1, noun); ];
2631
2632 [ ThrowAtSub;
2633     if (ObjectIsUntouchable(noun)) return;
2634     if (second > 1) {
2635         action = ##ThrownAt;
2636         if (RunRoutines(second, before)) { action = ##ThrowAt; rtrue; }
2637         action = ##ThrowAt;
2638     }
2639     if (noun has worn && ImplicitDisrobe(noun)) return;
2640     if (second hasnt animate) return L__M(##ThrowAt, 1, noun);
2641     if (RunLife(second, ##ThrowAt)) return;
2642     L__M(##ThrowAt, 2, noun);
2643 ];
2644
2645 [ TieSub;
2646     if (noun has animate) return L__M(##Tie, 2, noun);
2647     L__M(##Tie, 1, noun);
2648 ];
2649
2650 [ TouchSub;
2651     if (noun == actor)   return L__M(##Touch, 3, noun);
2652     if (ObjectIsUntouchable(noun)) return;
2653     if (noun has animate) return L__M(##Touch, 1, noun);
2654     L__M(##Touch, 2,noun);
2655 ];
2656
2657 [ TurnSub;
2658     if (ObjectIsUntouchable(noun)) return;
2659     if (noun == player)    return L__M(##Turn, 1, noun);
2660     if (noun == actor)     return L__M(##Turn, 5, noun);
2661     if (noun has static)   return L__M(##Turn, 2, noun);
2662     if (noun has scenery)  return L__M(##Turn, 3, noun);
2663     if (noun has animate)  return L__M(##Turn, 5, noun);
2664     L__M(##Turn, 4, noun);
2665 ];
2666
2667 [ WaitSub;
2668     if (AfterRoutines()) rtrue;
2669     L__M(##Wait, 1, noun);
2670 ];
2671
2672 [ WakeSub; L__M(##Wake, 1, noun); ];
2673
2674 [ WakeOtherSub;
2675     if (ObjectIsUntouchable(noun)) return;
2676     if (RunLife(noun, ##WakeOther)) return;
2677     L__M(##WakeOther, 1, noun);
2678 ];
2679
2680 [ WaveSub;
2681     if (noun == player) return L__M(##Wave, 2 ,noun, second);
2682     if (noun == actor) return L__M(##Wave, 3, noun, second);
2683     if (noun notin actor && ImplicitTake(noun)) return L__M(##Wave, 1, noun);
2684     L__M(##Wave, 2, noun, second);
2685 ];
2686
2687 [ WaveHandsSub;
2688     if (noun) return L__M(##WaveHands, 2, noun);
2689     L__M(##WaveHands, 1, noun); ];
2690
2691 [ YesSub; L__M(##Yes); ];
2692
2693 ! ----------------------------------------------------------------------------
2694 !   Debugging verbs
2695 ! ----------------------------------------------------------------------------
2696
2697 #Ifdef DEBUG;
2698
2699 [ TraceOnSub; parser_trace = 1; "[Trace on.]"; ];
2700
2701 [ TraceLevelSub;
2702     parser_trace = noun;
2703     print "[Parser tracing set to level ", parser_trace, ".]^";
2704 ];
2705
2706 [ TraceOffSub; parser_trace = 0; "Trace off."; ];
2707
2708 [ RoutinesOnSub;
2709     debug_flag = debug_flag |  DEBUG_MESSAGES;
2710     "[Message listing on.]";
2711 ];
2712
2713 [ RoutinesOffSub;
2714     debug_flag = debug_flag & ~DEBUG_MESSAGES;
2715     "[Message listing off.]";
2716 ];
2717
2718 [ RoutinesVerboseSub;
2719     debug_flag = debug_flag | (DEBUG_VERBOSE|DEBUG_MESSAGES);
2720     "[Verbose message listing on.]";
2721 ];
2722
2723 [ ActionsOnSub;
2724     debug_flag = debug_flag |  DEBUG_ACTIONS;
2725     "[Action listing on.]";
2726 ];
2727
2728 [ ActionsOffSub;
2729     debug_flag = debug_flag & ~DEBUG_ACTIONS;
2730     "[Action listing off.]";
2731 ];
2732
2733 [ TimersOnSub;
2734     debug_flag = debug_flag |  DEBUG_TIMERS;
2735     "[Timers listing on.]";
2736 ];
2737
2738 [ TimersOffSub;
2739     debug_flag = debug_flag & ~DEBUG_TIMERS;
2740     "[Timers listing off.]";
2741 ];
2742
2743 #Ifdef VN_1610;
2744
2745 [ ChangesOnSub;   debug_flag = debug_flag |  DEBUG_CHANGES;  "[Changes listing on.]"; ];
2746 [ ChangesOffSub;  debug_flag = debug_flag & ~DEBUG_CHANGES;  "[Changes listing off.]"; ];
2747
2748 #Ifnot;
2749
2750 [ ChangesOnSub; "[Changes listing available only from Inform 6.2 onwards.]"; ];
2751
2752 [ ChangesOffSub; "[Changes listing available only from Inform 6.2 onwards.]"; ];
2753
2754 #Endif; ! VN_1610
2755
2756 #Ifdef TARGET_ZCODE;
2757
2758 [ PredictableSub i;
2759     i = random(-100);
2760     "[Random number generator now predictable.]";
2761 ];
2762
2763 #Ifnot; ! TARGET_GLULX;
2764
2765 [ PredictableSub;
2766     @setrandom 100;
2767     "[Random number generator now predictable.]";
2768 ];
2769
2770 #Endif; ! TARGET_;
2771
2772 [ XTestMove obj dest;
2773     if (~~obj ofclass Object) "[Not an object.]";
2774     if (~~dest ofclass Object) "[Destination not an object.]";
2775     if ((obj <= InformLibrary) || (obj == LibraryMessages) || (obj in 1))
2776         "[Can't move ", (name) obj, ": it's a system object.]";
2777     while (dest) {
2778         if (dest == obj) "[Can't move ", (name) obj, ": it would contain itself.]";
2779         dest = parent(dest);
2780     }
2781     rfalse;
2782 ];
2783
2784 [ XPurloinSub;
2785     if (XTestMove(noun, player)) return;
2786     move noun to player; give noun moved ~concealed;
2787     "[Purloined.]";
2788 ];
2789
2790 [ XAbstractSub;
2791     if (XTestMove(noun, second)) return;
2792     move noun to second;
2793     "[Abstracted.]";
2794 ];
2795
2796 [ XObj obj f;
2797     if (parent(obj) == 0) print (name) obj; else print (a) obj;
2798     print " (", obj, ") ";
2799     if (f && parent(obj))
2800         print "in ~", (name) parent(obj), "~ (", parent(obj), ")";
2801     new_line;
2802     if (child(obj) == 0) rtrue;
2803     if (obj == Class) ! ???
2804         WriteListFrom(child(obj), NEWLINE_BIT+INDENT_BIT+ALWAYS_BIT+ID_BIT+NOARTICLE_BIT, 1);
2805     else
2806         WriteListFrom(child(obj), NEWLINE_BIT+INDENT_BIT+ALWAYS_BIT+ID_BIT+FULLINV_BIT, 1);
2807 ];
2808
2809 [ XTreeSub i;
2810     if (noun && ~~noun ofclass Object) "[Not an object.]";
2811     if (noun == 0) {
2812         objectloop (i)
2813             if (i ofclass Object && parent(i) == 0) XObj(i);
2814     }
2815     else XObj(noun, true);
2816 ];
2817
2818 [ GotoSub;
2819     if ((~~noun ofclass Object) || parent(noun)) "[Not a safe place.]";
2820     PlayerTo(noun);
2821 ];
2822
2823 [ GoNearSub x;
2824     if (~~noun ofclass Object) "[Not a safe place.]";
2825     x = noun;
2826     while (parent(x)) x = parent(x);
2827     PlayerTo(x);
2828 ];
2829
2830 [ Print_ScL obj; print_ret ++x_scope_count, ": ", (a) obj, " (", obj, ")"; ];
2831
2832 [ ScopeSub;
2833     if (noun && ~~noun ofclass Object) "[Not an object.]";
2834     x_scope_count = 0;
2835     LoopOverScope(Print_ScL, noun);
2836     if (x_scope_count == 0) "Nothing is in scope.";
2837 ];
2838
2839 #Ifdef TARGET_GLULX;
2840
2841 [ GlkListSub id val;
2842     id = glk_window_iterate(0, gg_arguments);
2843     while (id) {
2844         print "Window ", id, " (", gg_arguments-->0, "): ";
2845         val = glk_window_get_type(id);
2846         switch (val) {
2847           1: print "pair";
2848           2: print "blank";
2849           3: print "textbuffer";
2850           4: print "textgrid";
2851           5: print "graphics";
2852           default: print "unknown";
2853         }
2854         val = glk_window_get_parent(id);
2855         if (val) print ", parent is window ", val;
2856         else     print ", no parent (root)";
2857         val = glk_window_get_stream(id);
2858         print ", stream ", val;
2859         val = glk_window_get_echo_stream(id);
2860         if (val) print ", echo stream ", val;
2861         print "^";
2862         id = glk_window_iterate(id, gg_arguments);
2863     }
2864     id = glk_stream_iterate(0, gg_arguments);
2865     while (id) {
2866         print "Stream ", id, " (", gg_arguments-->0, ")^";
2867         id = glk_stream_iterate(id, gg_arguments);
2868     }
2869     id = glk_fileref_iterate(0, gg_arguments);
2870     while (id) {
2871         print "Fileref ", id, " (", gg_arguments-->0, ")^";
2872         id = glk_fileref_iterate(id, gg_arguments);
2873     }
2874     val = glk_gestalt(gestalt_Sound, 0);
2875     if (val) {
2876         id = glk_schannel_iterate(0, gg_arguments);
2877         while (id) {
2878             print "Soundchannel ", id, " (", gg_arguments-->0, ")^";
2879             id = glk_schannel_iterate(id, gg_arguments);
2880         }
2881     }
2882 ];
2883
2884 #Endif; ! TARGET_;
2885
2886 #Endif; ! DEBUG
2887
2888 ! ----------------------------------------------------------------------------
2889 !   Finally: the mechanism for library text (the text is in the language defn)
2890 ! ----------------------------------------------------------------------------
2891
2892 [ L__M act n x1 x2 s;
2893     if (keep_silent == 2) return;
2894     s = sw__var;
2895     sw__var = act;
2896     if (n == 0) n = 1;
2897     L___M(n, x1, x2);
2898     sw__var = s;
2899 ];
2900
2901 [ L___M n x1 x2 s;
2902     s = action;
2903     lm_n = n;
2904     lm_o = x1;
2905     lm_s = x2;
2906     action = sw__var;
2907     if (RunRoutines(LibraryMessages, before))             { action = s; rfalse; }
2908     if (LibraryExtensions.RunWhile(ext_messages, false )) { action = s; rfalse; }
2909     action = s;
2910     LanguageLM(n, x1, x2);
2911 ];
2912
2913 ! ==============================================================================