src/ADPAR.PAS

   1 {//-------------------------------------------------------------------------}\r
   2 {/*                                                                         }\r
   3 {Copyright (C) 1990, 2009 - Apogee Software, Ltd.                           }\r
   4 {                                                                           }\r
   5 {This file is part of Supernova.  Supernova is free software; you can       }\r
   6 {redistribute it and/or modify it under the terms of the GNU General Public }\r
   7 {License as published by the Free Software Foundation; either version 3     }\r
   8 {of the License, or (at your option) any later version.                     }\r
   9 {                                                                           }\r
  10 {This program is distributed in the hope that it will be useful,            }\r
  11 {but WITHOUT ANY WARRANTY; without even the implied warranty of             }\r
  12 {MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                       }\r
  13 {                                                                           }\r
  14 {See the GNU General Public License for more details.                       }\r
  15 {                                                                           }\r
  16 {You should have received a copy of the GNU General Public License          }\r
  17 {along with this program; if not, see https://gnu.org/licenses or write to: }\r
  18 {  Free Software Foundation, Inc.                                           }\r
  19 {  51 Franklin Street, Fifth Floor                                          }\r
  20 {  Boston, MA 02110-1301                                                    }\r
  21 {  USA                                                                      }\r
  22 {                                                                           }\r
  23 {Original Source: 1990 Scott Miller                                         }\r
  24 {Prepared for public release: 03/19/09 - Joe Siegler, Apogee Software, Ltd. }\r
  25 {*/                                                                         }\r
  26 {//-------------------------------------------------------------------------}\r
  27 (*****************************************************************************)\r
  28 (*                                  ADPAR                                    *)\r
  29 (*    >> Contains the Parser, Initialization, Time and Misc. Routines <<     *)\r
  30 (*                         Programmer: Scott Miller                          *)\r
  31 (*                       << Began February 2, 1985 >>                        *)\r
  32 (*                       Copyright 1985 Scott Miller                         *)\r
  33 (*****************************************************************************)\r
  34 \r
  35 procedure RL(Pointer:integer);forward;\r
  36 procedure RS(Pointer:integer);forward;\r
  37 procedure RR(Pointer:integer);forward;\r
  38 procedure RB(Pointer,Colour:byte);forward;\r
  39 procedure RB2(Pointer,Colour:byte);forward;\r
  40 procedure MC(WhichChar,WatchRoom,ToRoom:byte;MessageNum:Integer);forward;\r
  41 procedure Move(New:byte);forward;\r
  42 procedure DEAD;forward;\r
  43 procedure Call13;forward;\r
  44 procedure Van(o:byte);forward;\r
  45 function  FN(VNP:byte):Str29;forward;\r
  46 function  Here(Obj:byte):Boolean;forward;\r
  47 function  Up(Word:Str130):Str1;forward;\r
  48 \r
  49 procedure SF; begin SFlag:=True end;\r
  50 \r
  51 procedure Cur(Num:byte);\r
  52  begin\r
  53   with Result do\r
  54    if Color then\r
  55     begin AX:=$100;\r
  56      case Num of\r
  57       1:CX:=$707; { Underline   }\r
  58       2:CX:=$8;   { Solid block }\r
  59       3:CX:=$800; { Invisible   }\r
  60      end;\r
  61      intr($10,Result);\r
  62     end;\r
  63  end;\r
  64 \r
  65 procedure Col(Num1,Num2:byte);\r
  66  begin if Color then textcolor(Num1) else textcolor(Num2) end;\r
  67 \r
  68 procedure Bak(Num1,Num2:byte);\r
  69  begin if Color then textbackground(Num1) else textbackground(Num2) end;\r
  70 \r
  71 procedure Bor(Num1,Num2:byte);\r
  72  begin\r
  73   with Result do\r
  74    begin AX:=$B00;if Color then BX:=Num1 else BX:=Num2 end;intr($10,Result)\r
  75  end;\r
  76 \r
  77 function  En(Num:byte):boolean;\r
  78  begin if Num in Events then En:=true else En:=false end;\r
  79 \r
  80 procedure Add(Num:byte);\r
  81  begin Events:=Events+[Num] end;\r
  82 \r
  83 procedure Min(Num:byte);\r
  84  begin Events:=Events-[Num] end;\r
  85 \r
  86 procedure Score(Num,pointer:integer);\r
  87  begin if not en(pointer)then begin Sc:=Sc+Num;Add(Pointer)end end;\r
  88 \r
  89 procedure Cn(s:str78);\r
  90  begin gotoxy(40-(length(s)div 2),wherey);writeln(s)end;\r
  91 \r
  92 procedure Pause;\r
  93  begin col(15,15);write('Press any key to continue...');\r
  94   read(kbd,CFlag);col(11,7);writeln;\r
  95  end;\r
  96 \r
  97 procedure Tune(Octave,Note,Duration:integer);\r
  98   var Frequency:real;\r
  99       i:integer;\r
 100  begin\r
 101   Frequency:=32.625;\r
 102   for i:=1 to Octave do\r
 103    Frequency:=Frequency*2;\r
 104   for i:=1 to Note-1 do\r
 105    Frequency:=Frequency*1.059463094;\r
 106   if Duration <> 0 then\r
 107    begin\r
 108     sound(round(Frequency));\r
 109     delay(Duration);\r
 110     nosound\r
 111    end\r
 112   else sound(round(Frequency));\r
 113  end;\r
 114 \r
 115 procedure Play(Start,Stop,Speed:integer);\r
 116   var x:integer;\r
 117  begin\r
 118   if Start<=Stop then\r
 119    for x:=Start to Stop do begin sound(x);delay(Speed)end\r
 120   else\r
 121    for x:= Start downto Stop do begin sound(x);delay(Speed)end;\r
 122   nosound;if Region=4 then sound(20);if Region=5 then sound(60);\r
 123  end;\r
 124 \r
 125 procedure Explode(Duration:byte);\r
 126   var x:integer;\r
 127  begin for x:=Duration*999 downto 20 do sound(random(x));nosound end;\r
 128 \r
 129 procedure Walls(Duration:byte);\r
 130   var x:integer;\r
 131  begin for x:=1 to Duration*999 do sound(random(35)+20);nosound end;\r
 132 \r
 133 procedure Static;\r
 134   var x,y:integer;\r
 135  begin\r
 136   for x:=1 to 50 do\r
 137    case random(2) of\r
 138     0:for y:=1 to random(70)+10 do sound(random(4000)+3000);\r
 139     1:begin nosound;delay(random(29))end\r
 140    end;nosound;if Region=5 then sound(60)\r
 141  end;\r
 142 \r
 143 procedure Blast;\r
 144   var x:byte;\r
 145  begin\r
 146   for x:=1 to 40 do\r
 147    begin play(550-x*6,600+x*6,0);play(600+x*6,550-x*6,0)end;explode(2)\r
 148  end;\r
 149 \r
 150 procedure Dopen(Num:byte);\r
 151  begin writeln('The door slides open...');\r
 152   if Num<>0 then play(50,125-Num,Num)\r
 153   else begin for i:=3500 to 5000 do sound(random(4500)+i);nosound;end;\r
 154   if Region=5 then sound(60)\r
 155  end;\r
 156 \r
 157 procedure Dclose(Num:byte);\r
 158  begin writeln('The sliding door closes.');\r
 159   if Num<>0 then play(125-Num,50,Num)\r
 160   else begin for i:=5000 downto 3500 do sound(random(4500)+i);nosound;end;\r
 161   if Region=5 then sound(60)\r
 162  end;\r
 163 \r
 164 procedure Door(New,Num:byte);\r
 165  begin\r
 166   if en(7)then RL(22)else\r
 167   if en(8)then RL(23)else begin DOpen(Num);Move(New);DClose(Num)end\r
 168  end;\r
 169 \r
 170 procedure Time1;\r
 171  begin Tic:=Tic+1; Min(128); { <--Negates DEAD } col(13,15);\r
 172   for x:=1 to TMax do T[x]:=T[x]-1;\r
 173   if T[2]=1 then begin PStat:=PStat-[5];RL(1)end;\r
 174   case T[3] of { Hunger }\r
 175    25:begin PStat:=PStat+[2];RL(2)end;\r
 176    12:RL(3);\r
 177    4:begin Bor(4,7);RL(4)end;\r
 178    1:begin RL(124);DEAD;end\r
 179   end;\r
 180   case T[4] of { Thirst }\r
 181    22:begin PStat:=PStat+[6];RL(5)end;\r
 182    11:RL(6);\r
 183    4:begin Bor(4,7);RL(7)end;\r
 184    1:begin RL(125);DEAD;end\r
 185   end;\r
 186   case T[5] of { Sleep }\r
 187    32:begin PStat:=PStat+[5];RL(8)end;\r
 188    14:RL(9);\r
 189    5:begin Bor(4,7);RL(10)end;\r
 190    1:begin RL(126);DEAD;end;\r
 191    2..13:begin x:=random(29)+1;\r
 192           if(x in Inv)and not(x in Wear)then\r
 193            begin Van(x);R[x]:=Prm;\r
 194             writeln('A bout of weariness causes you to loose your grip on',\r
 195                     ' the ',FN(x),'!')\r
 196            end\r
 197          end\r
 198   end;\r
 199   case T[29] of { Laser Injury }\r
 200    9:RS(214);\r
 201    4:begin RL(507);Bor(4,7)end;\r
 202    2..11:begin repeat x:=random(27)+1 until x in[1..12,16..20,22..26,28];\r
 203      if(x in Inv)and not(x in Wear)then\r
 204       begin Van(x);R[x]:=Prm;\r
 205        if random(2)=0 then\r
 206         writeln('A sudden stab of pain shoots up your side, you drop the ',\r
 207                  FN(x),'.') else begin\r
 208         writeln('The ',FN(x),' falls from your grip as you almost collapse ',\r
 209                 'from the');writeln('extreme pain.')end\r
 210       end\r
 211      end;\r
 212    1:begin RS(215);DEAD;end\r
 213   end;\r
 214   case T[12] of  { Sickness }\r
 215    120,99,83,55:RL(207);\r
 216    65:begin PStat:=PStat+[3];RL(208)end;\r
 217    47:RL(209); 30:RS(73); 15:RS(74); 4:begin Bor(4,7);RS(75)end;\r
 218    1:begin RS(76);DEAD end;\r
 219    2..29:if(random(25)=0)and(Inv<>[])and not(en(125))then\r
 220           begin RS(232);\r
 221            for x:=1 to 29 do if(x in Inv)and not(x in Wear)then\r
 222             begin Van(x);R[x]:=Prm end\r
 223           end\r
 224   end;\r
 225   Col(10,7);\r
 226   if(Prm in[81..88])and(T[30]<1)and(random(4)=0)then\r
 227    if 28 in Wear then\r
 228     begin T[30]:=9;RS(153+Prm);\r
 229      for i:=999 to 2300 do sound(random(i*3)+i);\r
 230      for i:=3000 downto 20 do sound(random(i*4)+i*2);nosound\r
 231     end\r
 232    else\r
 233     begin\r
 234      write('A small droid appears from the ');\r
 235      case Prm of\r
 236       81:write('south'); 82:write('southwest'); 83:write('west');\r
 237       84:write('northwest'); 85:write('north'); 86:write('northeast');\r
 238       87:write('east'); 88:write('southeast')\r
 239      end; writeln(' section of the corridor and flies');\r
 240      RS(242);RS(243);for i:=20 to 3000 do sound(random(i*3)+i);nosound;\r
 241      delay(1500);DEAD\r
 242     end;\r
 243  end; { Time1 }\r
 244 \r
 245 overlay procedure Time2A;\r
 246  begin col(10,7);  { Pre-Jungle Planet }\r
 247   case T[1] of\r
 248    19:MC(1,13,13,0);\r
 249    18:begin MC(1,8,8,1);MC(1,13,8,2)end;\r
 250    17:if en(19) then begin RS(9);T[1]:=11;end;\r
 251    11..17:if not(en(19))and(Prm=8)and(random(2)=1)then RL(0);\r
 252    10:MC(1,8,9,3);\r
 253    9:begin MC(1,9,0,4);T[1]:=Null;end;\r
 254    5..7:if(en(2))and(en(3))then begin RB2(5-(T[1]-3),10);col(10,7)end;\r
 255    4:if Prm=8 then begin T[1]:=11;RS(5)end;\r
 256   end;\r
 257   if(T[7]=1)then begin RS(35);DEAD;end;\r
 258   if(T[6]=2)and(en(7))then RL(140);\r
 259   if(T[6]=1)and(en(7))then begin RS(20);DEAD;end;\r
 260   case T[8] of { Lift-off countdown }\r
 261    5:RL(181); 4:RL(182); 3:RL(191); 2:RL(192);\r
 262    1:if en(10)then\r
 263       begin Min(10);Min(26);Min(27);Explode(32);\r
 264        sound(20);Bor(0,0);Score(10,122);\r
 265        n[84]:='reactor regulat\';\r
 266        RB(7,10);delay(9999);Pause;col(10,7);RS(43);PStat:=PStat-[2,5,6];\r
 267        Region:=4;T[3]:=150;T[4]:=125;T[5]:=230;T[8]:=0;T[9]:=1;T[10]:=5;end\r
 268      else begin RS(44);Explode(32);DEAD;end;\r
 269   end;\r
 270   if T[9]<1 then T[9]:=15;\r
 271   if(Region=4)and(Prm=1)and(T[9]=12)then RS(62);\r
 272   if T[10] in[1..4]then RL(194);\r
 273   if(Tic>3)and(Prm=8)and not(en(9))and not(en(7))then\r
 274    begin RS(6);Add(9)end else\r
 275   if(Tic>5)and(Prm=8)and(en(9))and not(en(16))and not(en(7))then\r
 276    begin RS(7);Add(16)end;\r
 277   case Prm of\r
 278     1:if(random(2)=0)and(T[9]>12)and(T[9]<15)and(Region=4)and not en(129)then\r
 279        begin RL(593);RL(594);Add(129)end\r
 280       else if(random(20)=0)and(Region=4)then RL(592);\r
 281     7:if random(5)=0 then RL(595);\r
 282     8:if random(3)=1 then RL(24)else if random(3)=1 then RL(178);\r
 283    15,17,19:case random(60) of\r
 284      1:RL(596);\r
 285      2:RL(597);\r
 286      3,4:if RC>40 then begin if T[4]>10 then T[4]:=10;RL(598)end;\r
 287      end; {case}\r
 288    20:if random(4)=1 then RL(25);\r
 289   end; {case}\r
 290   if Prm=SinkRm then begin RL(85);L[Prm]:=L[Prm]+[79];end;\r
 291 end; { Time2A }\r
 292 \r
 293 overlay procedure Time2B;\r
 294  begin col(10,7);  { Jungle Planet }\r
 295   Maze:=not(Maze);\r
 296   if Prm in[42..49]then\r
 297    begin writeln('Some of the walls shift positions.');Walls(4);end;\r
 298   case Prm of\r
 299    7:if random(5)=0 then RL(595);\r
 300    26..29,32..34,59,60:case random(40) of\r
 301       0,1:RL(210); 2,3:RL(211); 4:RS(77); 5,6:RS(78); 7,8:RL(212);\r
 302       9:RL(213); 10:RL(214); 11:begin RL(215);play(6000,6001,20)end\r
 303      end;\r
 304    42..50:if random(7)=0 then RL(280);\r
 305   end; {case}\r
 306   if(Prm=28)and(random(2)=0)then RL(233);\r
 307   if Prm=SinkRm then begin RL(85);L[Prm]:=L[Prm]+[79];end;\r
 308   if T[11]=2 then RL(205);\r
 309   if T[11]=1 then begin RS(70);DEAD;end;\r
 310   if T[13]=1 then begin RB(11,10);for x:=1 to 3 do begin tune(4,2,200);\r
 311    delay(99);tune(4,5,200);delay(99)end;Pause end;\r
 312   if(T[14]=2)and(Prm in[40,41])then RL(251);\r
 313   if T[14]=1 then\r
 314    case Prm of 40:begin RL(249);Walls(8);end;41:begin RL(250);Walls(8);end end;\r
 315   if(T[15]=1)and(Prm=39)then begin RS(94);DEAD;end;\r
 316   if T[17]=4 then begin RS(109);DEAD;end;\r
 317   if T[17]=1 then begin Add(36);if Prm=56 then begin RS(110);Walls(8);end end;\r
 318   if T[18]=2 then begin RS(123);Walls(12)end;\r
 319   if(T[18]=1)and(Prm=53)then begin RS(124);Walls(12);DEAD;end;\r
 320   if T[19]=1 then begin RS(128);Walls(12);DEAD;end;\r
 321  end; { Time2B }\r
 322 \r
 323 overlay procedure Time2C;\r
 324  begin col(11,7);  { Inner Planet }\r
 325   if T[20]=1 then\r
 326    case Prm of 73:DClose(20);66:begin RL(337);play(105,50,20)end end;\r
 327   col(10,7);\r
 328   if(Prm=74)and not(en(47))then\r
 329    writeln('There is something flashing on the computer''s screen.');\r
 330   if(Prm=73)and(CodeSet<>4)then begin\r
 331    writeln('There''s an alarm sound coming over the radio.');\r
 332    for x:=1 to 23 do\r
 333     begin\r
 334      for i:=450 to 999 do sound(i);\r
 335      for i:=999 downto 450 do sound(i);\r
 336     end;nosound\r
 337    end;\r
 338   case random(50) of\r
 339    1..3:if here(38)then RL(588);\r
 340    4,5:begin RL(589);Explode(3)end;\r
 341    6:begin RS(244);for x:=1 to 7 do Static;end\r
 342    else if(Prm in[64,73])and(random(9)=0)then begin RL(590);RL(591)end\r
 343   end;\r
 344  end; { Time2C }\r
 345 \r
 346 overlay procedure Time2D;  { Planetship }\r
 347   function Warn(Message,IfTime,Said:integer):boolean;\r
 348    begin Warn:=false;\r
 349     if not en(Said)and(IfTime>=T[26])then\r
 350      begin if Said<>59 then begin Static;RS(Message);Static end\r
 351            else if Prm>99 then begin Static;RS(Message);Static end;\r
 352       if(Said=59)and(Prm<100)then begin end\r
 353       else begin Warn:=True;Add(Said)end\r
 354      end\r
 355    end; {Warn}\r
 356  begin col(11,7);\r
 357  for x:=0 to 2 do if T[23+x]>2 then Score(20,118+x); { 60 total points }\r
 358  if en(64)then Score(10,121);\r
 359   if T[21]=1 then\r
 360    case Prm of 91:DClose(20);86:begin RL(337);play(110,50,15)end end;\r
 361   col(10,7);\r
 362   if(Prm=95)and not(en(48))then begin\r
 363    writeln('A loud siren is sounding off...');\r
 364    play(300,530,6);delay(200);play(300,530,6)end;\r
 365   if(Prm=91)and not en(53)then begin writeln('An alarm is ringing...');\r
 366     for x:=1 to 23 do begin sound(400);delay(99);sound(940);delay(60);nosound;\r
 367    end end;\r
 368   if T[22]=1 then\r
 369    begin write('The door slides open...');play(50,60,65);\r
 370     writeln('then closes.');play(60,50,60);\r
 371     if en(50)then RS(153)else\r
 372     if Inv=[] then begin RS(247);RS(248)end\r
 373     else begin RS(154);RS(155);Inv:=[];end;\r
 374     delay(2500);write('The door slides open...');play(50,60,65);\r
 375     writeln('then closes.');play(60,50,65);\r
 376    end;\r
 377   case T[23] of\r
 378    13:begin if Prm=91 then RL(438);MC(2,91,91,161);Add(53)end;\r
 379    12:MC(2,91,91,162);\r
 380    11:begin if Prm in[86,91]then DOpen(15);MC(2,91,86,163);MC(2,86,86,164);\r
 381        if Prm in[86,91]then DClose(15)end;\r
 382    10:begin MC(2,86,87,165);MC(2,87,87,166)end;\r
 383    9:begin if Prm in[87,89]then DOpen(65);MC(2,87,89,167);MC(2,89,89,168);\r
 384       if Prm in[87,89]then DClose(65)end;\r
 385    7,8:if Prm=89 then begin ScrnSet:=4;RL(417)end;\r
 386    6:begin if Prm in[87,89]then DOpen(65);MC(2,89,87,169);MC(2,87,87,170);\r
 387       if Prm in[87,89]then DClose(65)end;\r
 388    5:begin MC(2,87,86,171);MC(2,86,86,172)end;\r
 389    4:if T[21]<2 then begin MC(2,86,91,173);if Prm in[86,91]then DOpen(15);\r
 390       if Prm=86 then RL(418);MC(2,91,91,174);if Prm in[86,91]then DClose(15)end\r
 391       else if Prm=86 then begin RL(418);MC(2,0,91,0)end;\r
 392    1:if Prm=91 then begin RL(419);Van(123);DClose(55)end else Van(123)\r
 393   end; {T[23]}\r
 394   if(T[23]>1)and(T[23]<4)and(Prm=91)then begin T[24]:=7;T[23]:=NULL;end;\r
 395   case T[24] of\r
 396    7:if Prm=91 then RS(175);\r
 397    6:if Prm=91 then begin RS(176);RS(177)end;\r
 398    5:if Prm=91 then begin RS(178);RS(179)end;\r
 399    4:begin if Prm=91 then RL(420);if not(1 in Inv)then T[24]:=2;end;\r
 400    2,3:if(Prm=91)and(1 in Inv)then RL(419+T[24]);\r
 401    1:begin Van(123);if Prm=91 then begin RS(180);DOpen(55);RL(418);\r
 402       DClose(55)end;\r
 403      end;\r
 404   end; {T[24]}\r
 405   case T[25] of\r
 406    2..5:if Prm=91 then RS(188-T[25]);\r
 407    1:begin if Prm=91 then RS(187);T[24]:=2;T[26]:=40;Add(64)end;\r
 408   end; {T[25]}\r
 409   if en(64)then\r
 410   if not Warn(198,38,54)then\r
 411   if not Warn(199,33,55)then\r
 412   if not Warn(203,30,59)then\r
 413   if not Warn(200,25,57)then\r
 414   if not Warn(201,20,58)then\r
 415   if not Warn(202,15,56)then\r
 416   if not Warn(204,10,60)then\r
 417   if not Warn(205,6,61)then\r
 418   if not Warn(206,3,62)then\r
 419   if not Warn(207,2,63)then begin end;\r
 420   if T[26]=1 then begin RS(197);DEAD;end;\r
 421   if(T[27]=1998)and(Prm=99)then  begin RS(213);Blast;DEAD;end;\r
 422   if(T[28]=1998)and(Prm=101)then begin RS(213);Blast;DEAD;end;\r
 423  end; { Time2D }\r
 424 \r
 425 overlay procedure Directory;\r
 426 type\r
 427   Char12arr = array [ 1..12 ] of Char;\r
 428   String20  = string[ 20 ];\r
 429 var\r
 430   Regs      : Entr;\r
 431   DTA       : array [ 1..43 ] of Byte;\r
 432   Mask      : Char12arr;\r
 433   NamR      : String20;\r
 434   Error, I  : Integer;\r
 435   SM1Found  : boolean;\r
 436 begin\r
 437   ChDir(Drive+':');\r
 438   SM1Found:=false;\r
 439   FillChar(DTA,SizeOf(DTA),0);\r
 440   FillChar(Mask,SizeOf(Mask),0);\r
 441   FillChar(NamR,SizeOf(NamR),0);\r
 442   writeln;\r
 443   Regs.AX := $1A00;\r
 444   Regs.DS := Seg(DTA);\r
 445   Regs.DX := Ofs(DTA);\r
 446   MSDos(Regs);\r
 447   Error := 0;\r
 448   Mask := '????????.???';\r
 449   Regs.AX := $4E00;\r
 450   Regs.DS := Seg(Mask);\r
 451   Regs.DX := Ofs(Mask);\r
 452   Regs.CX := 22;\r
 453   MSDos(Regs);\r
 454   Error := Regs.AX and $FF;\r
 455   I := 1;\r
 456   if Error=0 then\r
 457     repeat\r
 458       NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);\r
 459       I := I + 1;\r
 460     until not (NamR[I-1] in [' '..'~']) or (I>20);\r
 461   NamR[0] := Chr(I-1);\r
 462   while Error=0 do begin\r
 463     Error := 0;\r
 464     Regs.AX := $4F00;\r
 465     Regs.CX := 22;\r
 466     MSDos( Regs );\r
 467     Error := Regs.AX and $FF;\r
 468     I := 1;\r
 469     repeat\r
 470       NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);\r
 471       I := I + 1;\r
 472     until not (NamR[I-1] in [' '..'~'] ) or (I > 20);\r
 473     NamR[0] := Chr(I-1);\r
 474     delete(NamR,length(NamR),2);\r
 475     if (Error = 0) then\r
 476      if length(NamR)>4 then\r
 477       if copy(NamR,length(NamR)-2,3)='SM1' then\r
 478        begin\r
 479         if not SM1Found then\r
 480          writeln('Here is a list of the SAVE/RESTORE files on the ',\r
 481                  'disk in drive ',up(Drive),':');\r
 482         SM1Found:=true;\r
 483         writeln('    * ',copy(NamR,1,length(NamR)-4));\r
 484        end;\r
 485   end; writeln;\r
 486  if not SM1Found then\r
 487   begin\r
 488    writeln('There are not any SAVE/RESTORE files on the disk in drive ',\r
 489             up(Drive),':');writeln;\r
 490   end;\r
 491  Pause;ChDir(Log+':');\r
 492 end; {Directory}\r
 493 \r
 494 function Up;{Word:Str130):Str1}\r
 495  begin word:=word+' ';\r
 496   if(Word[1]='l')and(Word[2]=' ')then insert('ook',Word,2);\r
 497   if(Word[1]='e')and(Word[2]='x')and(Word[3]=' ')then insert('amine',Word,3);\r
 498   delete(Word,length(word),2);Up:='';\r
 499   for x:=1 to length(Word) do Word[x]:=upcase(Word[x]);\r
 500   col(12,15); write(Word); col(11,7)\r
 501  end;\r
 502 \r
 503 procedure Spaces(var I:Str130);\r
 504  begin I:=concat(' ',I,' ')end;\r
 505 \r
 506 procedure QFormat(var I:Str130);\r
 507  begin\r
 508   if(I[1]='.')or(I[1]=' ')then delete(I,1,1);\r
 509   if(I[length(I)]='.')or(I[length(I)]=' ')then delete(I,length(I),1);\r
 510  end;\r
 511 \r
 512 procedure PreFormat(var I:Str130);\r
 513  procedure D(A:Str29;B:byte);\r
 514   begin while pos(A,I)<>0 do delete(I,pos(A,I),B)end;\r
 515  begin D('  ',1);QFormat(I);\r
 516   FFlag:=0; if(length(I)>0)then FFlag:=1;\r
 517   Spaces(I);\r
 518   Crawl:=false;if pos(' crawl ',I)>0 then Crawl:=true;D(' crawl ',6);\r
 519   D(' walk ',5);D(' run ',4);D(' go ',3);D(' travel ',7);\r
 520   QFormat(I); if(length(I)=0)and(FFlag=1)then FFlag:=2; Spaces(I);\r
 521   D(' of ',3);D(' the ',4);D(' very ',5);D(' more ',5);D(' and ',4);\r
 522   D(' large ',6);D(' big ',4);D(' huge ',5);D(' please ',7);\r
 523   D(' small ',6);D(' little ',7);D(' tiny ',5);\r
 524   D('''',1);D('#',1);D('!',1);D('?',1);D(' number ',7);\r
 525   QFormat(I); if(length(I)=0)and(FFlag=1)then FFlag:=3; Spaces(I);\r
 526   while pos('examine ',I)>0  do delete(I,pos('examine ',I)+2,5);\r
 527   while pos(' into ',I)>0    do delete(I,pos(' into ',I)+3,2);\r
 528   while pos(' onto ',I)>0    do delete(I,pos(' onto ',I)+3,2);\r
 529   while pos(' inside ',I)>0  do delete(I,pos(' inside ',I)+3,4);\r
 530   while pos(' within ',I)>0  do delete(I,pos(' within ',I)+1,4);\r
 531   while pos('look ',I)>0     do delete(I,pos('look ',I)+1,3);\r
 532   while pos('. ',I)>0        do delete(I,pos('. ',I)+1,1);\r
 533   while pos(',',I)>0         do\r
 534    begin insert(' ',I,pos(',',I));delete(I,pos(',',I),1)end;\r
 535   D('..',1);D(' .',1);D('  ',1);\r
 536   QFormat(I);\r
 537   if(length(I)=0)then\r
 538    begin EFlag:=Null;\r
 539     case FFlag of\r
 540      2:RL(193);\r
 541      3:RL(186)\r
 542      else writeln('Pardon me?')\r
 543     end;\r
 544    end\r
 545  end; { PreFormat }\r
 546 \r
 547 procedure LowerCase(var I:Str130);\r
 548  begin\r
 549   if(length(I)>0)then\r
 550    for x:=1 to length(I) do\r
 551     if(I[x] in['A'..'Z'])then\r
 552      I[x]:=chr(ord(I[x])+32);\r
 553  end; { LowerCase }\r
 554 \r
 555 procedure ChopSeven(var I:Str130);\r
 556   var Word:Str130;\r
 557  begin\r
 558   if(length(I)>0)then\r
 559    begin\r
 560     I:=I+' '; x:=1;\r
 561      repeat\r
 562       Word:='';\r
 563       while(I[x]<>' ')and(I[x]<>'.')and(I[x]<>',')do\r
 564        begin Word:=Word+I[x]; x:=x+1 end;\r
 565       if(length(Word)>7)then\r
 566        begin\r
 567         y:=pos(Word,I); x:=x+(7-length(Word));\r
 568         delete(I,y,length(Word)); delete(Word,8,130);\r
 569         insert(Word,I,y)\r
 570        end;\r
 571       x:=x+1;\r
 572      until(x-1)=length(I);\r
 573     delete(I,length(I),1)\r
 574    end\r
 575   end; { ChopSeven }\r
 576 \r
 577 procedure FindMood(var input:Str130;var Word:Str29;var Md:byte);\r
 578   var Temp1:Str53;\r
 579       Temp2:Str29;\r
 580       Counter:char;\r
 581  begin\r
 582   Spaces(input);x:=0;\r
 583   while x < AMax do\r
 584    begin x:=x+1;\r
 585     Counter:='1';\r
 586     Temp1:=A[x];\r
 587     while pos(Counter,Temp1)>0 do\r
 588      begin\r
 589       Temp2:=copy(Temp1,1,pos(Counter,Temp1)-1);\r
 590       if(pos(' '+Temp2+' ',input)>0)then\r
 591        begin\r
 592         Word:=Temp2;\r
 593         Md:=x;if Md=2 then Md:=1;\r
 594         x:=AMax;Counter:='8';\r
 595         delete(input,pos(Temp2,input),length(Temp2)+1);\r
 596        end;\r
 597       delete(Temp1,1,pos(Counter,Temp1));\r
 598       Counter:=succ(Counter);\r
 599      end;\r
 600    end;\r
 601   QFormat(input);\r
 602  end; { FindMood }\r
 603 \r
 604 function FN;{(VNP:byte) : Str29;  ( Finds first Noun ) }\r
 605   var Temp:Str29;\r
 606  begin SF;\r
 607   Temp:=n[VNP];\r
 608   FN:=copy(Temp,1,pos('\',Temp)-1);\r
 609  end; { FW }\r
 610 \r
 611 function Here;{Obj:byte) : Boolean;}\r
 612  begin Here:=false;\r
 613   if Obj in L[Prm] then Here:=true;\r
 614   if(Obj=79)and(MugCon=79)and(29 in Inv)then Here:=true;\r
 615   if Obj<=MMax then if(R[Obj]=Prm)or(Obj in Inv)then Here:=true;\r
 616   if(Obj=58)and((3 in Inv)or(4 in Inv)or(R[4]=Prm)or(R[3]=Prm))then Here:=true;\r
 617  end;\r
 618 \r
 619 function Present : Boolean;\r
 620   label JUMP;\r
 621  begin Present:=false; x:=0;\r
 622   if not(Vb in [17,18,37,39]) then\r
 623    if N1<>Null then\r
 624     if Here(N1) then\r
 625      if N2<>Null then\r
 626       if Here(N2) then Present:=true\r
 627       else writeln('You can''t see any ',FN(N2),' here.')\r
 628      else Present:=true\r
 629     else writeln('You can''t see any ',FN(N1),' here.')\r
 630    else Present:=true\r
 631   else\r
 632    begin JUMP: x:=x+1;\r
 633     if x<=NMax then\r
 634      if x in NounSet then\r
 635       if Here(x) then goto JUMP\r
 636       else begin writeln('You can''t see any ',FN(x),' here.');end\r
 637      else goto JUMP\r
 638     else Present:=true\r
 639    end\r
 640  end; { Present }\r
 641 \r
 642 procedure Convert(var n:byte;Max:byte);\r
 643  begin\r
 644   case Max of\r
 645    1:case n of                     { Verbs }\r
 646       12:n:=11; 14:n:=13; 23:n:=22; 27:n:=26;\r
 647       29:n:=28; 34:n:=33; 36:n:=35; 38:n:=37; 40:n:=39; 43:n:=42; 45:n:=44;\r
 648       52:n:=51; 55:n:=54; 57,58:n:=56; 60,61:n:=59; 63:n:=62;\r
 649      end;\r
 650    2:case n of                     { Nouns }\r
 651       13..15:n:=12; 21:n:=20; 33:n:=32; 36:n:=35; 39:n:=38; 45:n:=44;\r
 652       50:n:=49; 53:n:=52; 65:n:=64; 67:n:=66; 70:n:=69; 76,77:n:=75;\r
 653       97:n:=96; 101,102:n:=100; 114:n:=113; 117:n:=116; 63:n:=62;\r
 654       27:n:=26; 57:n:=56; 61:n:=60; 91:n:=90; 105..108:n:=109; 31:n:=28;\r
 655       133:n:=46; 84:if Prm>21 then n:=128; 115:if Prm=28 then n:=112;\r
 656       58:if Prm=52 then n:=64;\r
 657      end;\r
 658    3:case n of                  { Prepositions }\r
 659        2:n:=1; 4:n:=3; 8:n:=7 ;\r
 660      end;\r
 661   end;\r
 662  end; { Convert }\r
 663 \r
 664 procedure FindWord( var I    : Str130;   { input string }\r
 665                     var VNP  : byte;     { flags which # word found }\r
 666                     var Word : Str29;    { stores last word found }\r
 667                         Max  : byte);    { check which list? }\r
 668   const Slash = '\';\r
 669   var j,ps:byte;\r
 670       Temp1,Temp2:Str29;\r
 671  begin\r
 672   QFormat(I); Spaces(I); J:=0;\r
 673   while (j<m[Max]) do\r
 674    begin\r
 675     j:=j+1;\r
 676     case Max of 1:Temp1:=v[j]; 2:Temp1:=n[j]; 3:Temp1:=p[j] end;\r
 677     ps:=pos(Slash,Temp1);\r
 678     while ps>0 do\r
 679      begin\r
 680       Temp2:=copy(Temp1,1,ps-1);\r
 681       if(copy(I,1,length(Temp2)+2)=' '+Temp2+' ')then\r
 682        begin { Match Found }\r
 683         VNP:=j;\r
 684         Convert(VNP,Max);\r
 685         Word:=Temp2;\r
 686         delete(I,1,length(Temp2)+1);\r
 687         case Max of 1:VStr:=Word; 2:NStr:=Word end;\r
 688         j:=m[Max];\r
 689         Temp1:='X';\r
 690        end;\r
 691       delete(Temp1,1,ps);\r
 692       ps:=pos(Slash,Temp1);\r
 693      end;\r
 694    end; { main loop }\r
 695   QFormat(I);\r
 696  end; { FindWord }\r
 697 \r
 698 procedure Dictionary(IfFound,SkipList:byte);\r
 699   var StopLoopFlag:byte;\r
 700  begin VNP:=Null; list:=1; StopLoopFlag:=1;\r
 701   while(list<4)and(StopLoopFlag=1)do\r
 702    begin\r
 703     if list=SkipList then list:=list+1\r
 704      else\r
 705       begin\r
 706        FindWord(input,VNP,Word,list);\r
 707        if(VNP<>Null)then\r
 708         begin EFlag:=IfFound;list:=list-1;StopLoopFlag:=0;end;\r
 709        list:=list+1;\r
 710       end\r
 711    end;\r
 712   if(EFlag<>IfFound)then\r
 713   begin\r
 714    EFlag:=5;input:=input+' ';\r
 715    Word:=copy(input,1,pos(' ',input)-1);\r
 716    if(pos(' '+Word+' ',' top directi next some from is under underne '+\r
 717                         'leaning but speak pay ')>0)then\r
 718     EFlag:=IfFound\r
 719    else If Word[1] in['0','1','2','3','4','5','6','7','8','9'] then EFlag:=17;\r
 720    if IfFound=14 then EFlag:=14;\r
 721    QFormat(input);\r
 722   end;\r
 723  end; { Dictionary }\r
 724 \r
 725 procedure RL;\r
 726  begin SF;\r
 727   if(pointer<>StoreL)then\r
 728    begin StoreL:=pointer;\r
 729     seek(L1,pointer);\r
 730     read(L1,Text3)\r
 731    end;\r
 732   writeln(Text3);\r
 733  end; { Read Line }\r
 734 \r
 735 procedure RS;\r
 736  begin SF;\r
 737   if(pointer<>StoreS)then\r
 738    begin StoreS:=pointer;\r
 739     seek(S1,pointer);\r
 740     read(S1,Text4)\r
 741    end;\r
 742   writeln(Text4);\r
 743  end; { Read Special }\r
 744 \r
 745 procedure RR;\r
 746  begin SF;\r
 747   if(pointer<>StoreR)then\r
 748    begin StoreR:=pointer;\r
 749     seek(R1,pointer);\r
 750     seek(R2,pointer);\r
 751     read(R1,Text1);\r
 752     read(R2,Text2);\r
 753    end;\r
 754   writeln(Text1,Text2);\r
 755  end; { Read Room }\r
 756 \r
 757 procedure RB;\r
 758   var Block:Str255;\r
 759       Tstart,TStop:Str19;\r
 760  begin SF; Col(Colour,7);\r
 761   str(Pointer-1,TStart);\r
 762   str(Pointer,TStop);\r
 763   TStart:='('+TStart+')';\r
 764   TStop:='('+TStop+')';\r
 765   if old>=Pointer then reset(T1);\r
 766   old:=Pointer+1;\r
 767   repeat readln(T1,Block) until Block=TStart;\r
 768   repeat\r
 769    readln(T1,Block);\r
 770    if(Block<>TStop)then writeln(Block)\r
 771   until Block=TStop; col(11,7);\r
 772  end;\r
 773 \r
 774 procedure RB2;\r
 775   var Block:Str255;\r
 776       Tstart,TStop:Str19;\r
 777  begin SF; Col(Colour,7);\r
 778   str(Pointer-1,TStart);\r
 779   str(Pointer,TStop);\r
 780   TStart:='('+TStart+')';\r
 781   TStop:='('+TStop+')';\r
 782   if old2>=Pointer then reset(T2);\r
 783   old2:=Pointer+1;\r
 784   repeat readln(T2,Block) until Block=TStart;\r
 785   repeat\r
 786    readln(T2,Block);\r
 787    if(Block<>TStop)then writeln(Block)\r
 788   until Block=TStop; col(11,7);\r
 789  end;\r
 790 \r
 791 overlay procedure Won;\r
 792   const W=800;H=400;Q=200;T=131;\r
 793   label JUMP;\r
 794  begin writeln;\r
 795   gotoxy(1,20);for x:=1 to 5 do\r
 796    begin writeln;delay(99);sound(x*50);Bor(x,7)end;\r
 797   gotoxy(1,15);col(4,15);bak(1,7);\r
 798   writeln('#######################################',\r
 799           '#######################################');\r
 800   delay(99);sound(300);Bor(6,0);\r
 801   gotoxy(1,16);for x:=1 to 3 do begin\r
 802   write('#                                      ',\r
 803         '                                      #');\r
 804         delay(99);sound(300+(x*50));Bor(x+8,15)end;gotoxy(1,19);\r
 805   write('#######################################',\r
 806         '#######################################');\r
 807   delay(99);sound(500);Bor(14,0);\r
 808   gotoxy(26,17);col(31,31);\r
 809   write('Y O U   H A V E   W O N ! !');delay(99);sound(550);\r
 810   gotoxy(1,20);bak(0,0);Bor(2,7);writeln;delay(99);nosound;\r
 811   for x:=1 to 12 do begin writeln;delay(80)end;\r
 812   gotoxy(1,9);Col(9,9);\r
 813   writeln('                              S U P E R N O V A');writeln;Col(11,7);\r
 814   writeln('     Programmed by . . . . . . . . . . . . . . . . . . . . . Scott Miller');\r
 815   writeln('     Story by  . . . . . . . . . . . . . . . . . . . . . . . Scott Miller');\r
 816   writeln('     Additional story development. . . . . . . . . . . . . . . Terry Nagy');\r
 817   writeln;writeln;\r
 818   Vb:=78;Call13;writeln;writeln;Col(3,7);\r
 819   write('Press any hey to quit...');\r
 820   tune(2,8,q);tune(2,8,q);tune(3,1,w);\r
 821   repeat\r
 822    tune(2,8,q);tune(2,8,q);\r
 823    tune(3,1,h);tune(2,12,h);tune(2,10,h);tune(2,8,q);tune(2,8,q);\r
 824    tune(3,1,w);tune(2,8,t);tune(2,8,t);tune(2,8,t);\r
 825    if keypressed then goto JUMP;\r
 826    tune(3,1,h);tune(2,12,h);tune(2,10,h);tune(2,8,t);tune(2,8,t);tune(2,8,t);\r
 827    tune(3,3,w);\r
 828    if keypressed then goto JUMP;\r
 829    tune(2,10,q);tune(2,10,q);\r
 830    tune(3,3,h);tune(3,1,h);tune(2,12,h);tune(2,10,q);tune(2,10,q);\r
 831    if keypressed then goto JUMP;\r
 832    tune(3,3,w);tune(2,10,t);tune(2,10,t);tune(2,10,t);\r
 833    tune(3,3,h);tune(3,1,h);tune(2,12,h);tune(2,10,t);tune(2,10,t);tune(2,10,t);\r
 834    tune(3,1,w);\r
 835   until keypressed;\r
 836   JUMP: read(kbd,CFlag);\r
 837   window(1,1,80,25);clrscr;gotoxy(2,2);Col(31,31);Bor(0,0);Cur(1);Bak(2,0);\r
 838   writeln('Congratulations!');\r
 839   HALT;\r
 840  end; { Won }\r
 841 \r
 842 overlay procedure PlayerInput(var LINE:Str130);\r
 843   label JUMP;\r
 844   procedure Key(k:Str19); begin Line:=Line+k;QFlag:=true;write(k)end;\r
 845  begin\r
 846  with Result do begin\r
 847   WRITELN; { Main Space In Game }\r
 848   if(length(Line)=0)then\r
 849    begin\r
 850     bak(4,7);col(14,0);\r
 851     window(1,1,80,22);\r
 852     gotoxy(8,2);write(Tic,'   ');\r
 853     gotoxy(35-(length(RN[Prm])div 2),2);\r
 854       write('      ',RN[Prm],'      ');\r
 855     gotoxy(75,2);write('    ');gotoxy(75,2);write(Sc,' ');\r
 856     bak(7,7);\r
 857     col(1,0);gotoxy(22,3);\r
 858     if PStat=[] then write('Healthy') else write('  *    ');\r
 859     col(15,0);gotoxy(33,3);\r
 860     if 2 in PStat then begin col(31,16);write('Hungry')end\r
 861     else write(' *    ');\r
 862     col(4,0);gotoxy(43,3);\r
 863     if 3 in PStat then begin col(20,16);write('Sick')end\r
 864     else write(' *  ');\r
 865     col(0,0);gotoxy(51,3);\r
 866     if 4 in PStat then begin col(16,16);write('Injured')end\r
 867     else write('   *   ');\r
 868     col(6,0);gotoxy(62,3);\r
 869     if 5 in PStat then begin col(22,16);write('Tired')end\r
 870     else write('  *  ');\r
 871     col(5,0);gotoxy(71,3);\r
 872     if 6 in PStat then begin col(21,16);write('Thirsty')end\r
 873     else write('   *   ');\r
 874     bak(0,0);window(2,5,79,24);\r
 875     if en(66)then begin gotoxy(1,20);goto JUMP;end;\r
 876     gotoxy(1,20);col(28,31);writeln(chr(175));\r
 877     Cur(1);\r
 878     col(14,7);gotoxy(3,19);\r
 879     QFlag:=false;\r
 880     repeat\r
 881      ax:=0;\r
 882      intr($16,result);\r
 883      sound(99);nosound;case Region of 4:sound(20);5:sound(60)end;\r
 884      case chr(Lo(ax)) of\r
 885      ^h:begin\r
 886          if(wherex=1)and(wherey=20)then\r
 887           begin window(1,1,80,25);gotoxy(80,23)end;\r
 888          if length(Line)>0 then write(^h,' ',^h);\r
 889          delete(Line,length(Line),2);\r
 890          window(2,5,79,24);\r
 891         end;\r
 892      ^m:QFlag:=true\r
 893      else\r
 894       begin\r
 895        if(Lo(ax)>0)and(length(Line)<110)then\r
 896         begin write(chr(Lo(ax)));Line:=Line+chr(Lo(ax));end\r
 897        else { read scan }\r
 898         begin\r
 899          case hi(ax) of\r
 900           59:key('Save');      71:key('Northwest');\r
 901           60:key('Restore');   73:key('Northeast');\r
 902           61:key('R D');       79:key('Southwest');\r
 903           62:key('Look');      81:key('Southeast');\r
 904           63:key('Get all');   82:key('Down');\r
 905           64:key('Drop all');  83:key('Up');\r
 906           65:key('Score');     104:begin QFlag:=true;RR(0)end;\r
 907           66:key('Inventory');\r
 908           67:key('Wait');\r
 909           68:begin Line:='';key('Repeat')end;\r
 910           94,30:key('by Scott Miller');\r
 911           95,47:key('Version A Dec 9, 85');\r
 912          end;\r
 913         if Prm in[1..7] then\r
 914          case hi(ax) of\r
 915           72:key('Fore'); 75:key('Port'); 77:key('Starboard'); 80:key('Aft')\r
 916          end\r
 917         else\r
 918          case hi(ax) of\r
 919           72:key('North'); 75:key('West'); 77:key('East'); 80:key('South')\r
 920          end\r
 921        end\r
 922       end\r
 923      end; {case}\r
 924      until QFlag=true;\r
 925     Cur(3);\r
 926     gotoxy(1,19);col(5,7);write(chr(175));col(11,7);gotoxy(1,20);\r
 927     if length(Line)>76 then writeln;\r
 928     LowerCase(Line);Spaces(Line);\r
 929     if(pos(' r ',Line)>0)or(pos(' repeat ',Line)>0)then PreFormat(Line);\r
 930     if(Line='r')or(Line='repeat')then Line:=Again else Again:=Line;\r
 931     Spaces(Line);\r
 932     while pos(' then ',Line)>0 do\r
 933      begin\r
 934       x:=pos(' then ',Line);delete(Line,x,5);insert('.',Line,x)\r
 935      end;\r
 936     ChopSeven(Line);\r
 937     PreFormat(Line);\r
 938    end;\r
 939    if(pos('.',Line)>0)then\r
 940     begin    { SEPERATES LINE INTO SINGLE INPUTS }\r
 941      input:=copy(Line,1,pos('.',Line));\r
 942      delete(Line,1,pos('.',Line));\r
 943      delete(input,pos('.',input),1);\r
 944      PreFormat(input);\r
 945     end\r
 946    else\r
 947     begin\r
 948      input:=Line; Line:='';\r
 949     end; { END OF LINE SEPERATION }\r
 950    Spaces(input);\r
 951    while pos(' it ',input)>0 do\r
 952     begin x:=pos(' it ',input)+1;delete(input,x,2);insert(LastNoun,input,x);\r
 953      PreFormat(input);ChopSeven(input);\r
 954     end;\r
 955    while pos(' them ',input)>0 do\r
 956     begin x:=pos(' them ',input)+1;delete(input,x,4);insert(LastNoun,input,x);\r
 957      PreFormat(input);ChopSeven(input);\r
 958     end;\r
 959    QFormat(input);\r
 960    col(11,7);\r
 961    JUMP:\r
 962  end; { of with statement }\r
 963  end; { PlayerInput }\r
 964 \r
 965 overlay procedure Title;\r
 966  begin\r
 967   clrscr;textcolor(7);Color:=true;\r
 968   if ParamCount=0 then begin\r
 969    write('Do you want ');textcolor(15);write('C');textcolor(7);\r
 970    write('olor or ');textcolor(15);write('B');textcolor(7);\r
 971    write('lack and white? ');textcolor(15);read(kbd,CFlag);\r
 972    if(upcase(CFlag)='B')or(upcase(CFlag)='M')then\r
 973     begin Color:=false;write('Monochrome')end\r
 974    else write('Color');delay(300);\r
 975   end\r
 976   else\r
 977    begin input:=ParamStr(1);CFlag:=input[1];\r
 978     if(CFlag='/')and(length(input)>1)then CFlag:=input[2];\r
 979     if(upcase(CFlag)='B')or(upcase(CFlag)='M')then\r
 980      begin Color:=false;writeln('Monochrome screen option...')end\r
 981     else writeln('Color screen option...');delay(999)\r
 982    end;\r
 983   clrscr;textmode(BW80);\r
 984   Cur(3);\r
 985 \r
 986                  {**** Public Domain title screen ****}\r
 987   Col(9,9);gotoxy(1,1);\r
 988   cn('S U P E R N O V A');\r
 989   Col(9,7);gotoxy(1,3);\r
 990   cn('Published by');\r
 991   gotoxy(1,5);\r
 992   cn('APOGEE SOFTWARE PRODUCTIONS');\r
 993   writeln;\r
 994   Col(11,7);\r
 995   cn('This game is placed in the public domain for your enjoyment.   Please do');\r
 996   cn('not abuse this product or the author''s rights.');\r
 997   writeln;\r
 998   cn('If you enjoy this game the author asks that you contribute $10 (by check).');\r
 999   cn('This payment  will encourage the author  to create similar games  and will');\r
1000   cn('help compensate him  for the several years work that went into  Supernova.');\r
1001   cn('This fee will also register the payer for telephone support and clues.');\r
1002   writeln;\r
1003   Col(14,15);\r
1004   writeln('Please make checks payable to:  Scott Miller');\r
1005   writeln;\r
1006   writeln('Scott Miller      (214) 240-0614');\r
1007   writeln('4206 Mayflower Drive');\r
1008   writeln('Garland, TX 75043');\r
1009   writeln;\r
1010   writeln('Also call for help:  Terry Nagy  (214) 271-3065');\r
1011   writeln;\r
1012   Col(11,7);delay(7000);\r
1013   cn('Thanks, enjoy the game...');\r
1014 \r
1015   Col(7,7);gotoxy(27,25);delay(999);\r
1016   write('Press any key to continue.');repeat;begin;end;until keypressed;\r
1017   read(kbd,CFlag);bak(1,0);clrscr;\r
1018                  {**** Main SUPERNOVA title screen ****}\r
1019 \r
1020   Bor(1,0);Col(15,15);Bak(4,0);\r
1021   for x:=1 to 80 do\r
1022    begin gotoxy(x,1);write(chr(205));gotoxy(x,24);write(chr(205))end;\r
1023   for y:=1 to 24 do\r
1024    begin gotoxy(1,y);write(chr(186));gotoxy(80,y);write(chr(186))end;\r
1025   gotoxy(1,1);write(chr(201)); gotoxy(80,1);write(chr(187));\r
1026   gotoxy(1,24);write(chr(200)); gotoxy(80,24);write(chr(188));\r
1027   Bak(1,0);\r
1028   Col(2,7);gotoxy(1,10);cn('Copyright 1987 Scott Miller');\r
1029   Col(14,7);gotoxy(1,12);cn('Version B');\r
1030   Col(7,7);gotoxy(1,15);\r
1031   cn('Programmed by Scott Miller');\r
1032   cn('Story by Scott Miller and Terry Nagy');\r
1033   gotoxy(1,23);Col(3,7);\r
1034   cn('Press any key to continue.');\r
1035   repeat\r
1036    gotoxy(32,8);\r
1037    if Color then textcolor(random(16))\r
1038    else case random(3) of  0:textcolor(0); 1:textcolor(7); 2:textcolor(15)end;\r
1039    write('S U P E R N O V A');\r
1040   until keypressed;\r
1041   read(kbd,CFlag);\r
1042   if Color then textmode(C80)else textmode(BW80);\r
1043  end; { Title }\r
1044 \r
1045 overlay procedure Init1;\r
1046   label Abort;\r
1047  begin ABORT:\r
1048   Bor(0,0);bak(0,0);clrscr;nosound;\r
1049   Cur(3);randomize;\r
1050   GetDir(0,Word);Log:=Word[1];\r
1051   for x:=1 to 20 do begin sound(x*9);delay(x*2)end;nosound;\r
1052   gotoxy(1,9);y:=0;col(14,7);Identity:='';\r
1053   Cn('Please enter your identity code name:');col(12,15);\r
1054   repeat i:=random(maxint) until keypressed;\r
1055   repeat read(kbd,CFlag);\r
1056    if(CFlag<>chr(13))then\r
1057     if(CFlag<>^h)then Identity:=Identity+upcase(CFlag)\r
1058     else delete(Identity,length(Identity),2);\r
1059    gotoxy(1,11);Cn(' '+Identity+' ');sound(50);delay(50);nosound;\r
1060   until CFlag=chr(13);\r
1061   col(10,7);gotoxy(1,7);\r
1062   if identity<>'' then\r
1063    Cn(' IDENTITY CODE ACCEPTED--YOU MAY PROCEED '+Identity)\r
1064   else begin\r
1065    col(25,31);Bor(4,7);Cn('IDENTITY CODE REJECTED--ABORTING SEQUENCE')end;\r
1066   LowerCase(Identity);ChopSeven(Identity);\r
1067   delay(1500);\r
1068   if Identity='' then goto ABORT;\r
1069   assign(L1,'L1');\r
1070   assign(C1,'C1');\r
1071   assign(S1,'S1');\r
1072   assign(R1,'R1');assign(R2,'R2');\r
1073   assign(T1,'SM');assign(T2,'B1');\r
1074   reset(R1);reset(R2);\r
1075   reset(S1);reset(L1);reset(C1);\r
1076  end; { Init1 }\r
1077 \r
1078 overlay procedure Init2;\r
1079  begin\r
1080   col(7,15);bak(1,7);\r
1081   for x:=1 to 80 do\r
1082    begin gotoxy(x,1);write(chr(205));gotoxy(x,24);write(chr(205))end;\r
1083   gotoxy(80,24);write(chr(190));gotoxy(1,24);write(chr(212));\r
1084   gotoxy(1,4);InsLine;\r
1085   for x:=2 to 24 do\r
1086    begin gotoxy(1,x);write(chr(179));gotoxy(80,x);write(chr(179))end;\r
1087   gotoxy(1,4);write(chr(198));for x:=2 to 79 do\r
1088    begin gotoxy(x,4);write(chr(205))end;write(chr(181));\r
1089   gotoxy(1,1);write(chr(213));gotoxy(80,1);write(chr(184));\r
1090   bak(4,7);col(14,0);gotoxy(2,2);\r
1091   for x:=1 to 78 do write(' ');\r
1092    gotoxy(2,2);write('Move');\r
1093   gotoxy(68,2);write('Score');\r
1094   bak(7,7);gotoxy(2,3);\r
1095   for x:=1 to 78 do write(' ');\r
1096   bak(5,7);col(15,0);\r
1097   gotoxy(2,3);write('Player Condition:');\r
1098   bak(0,0);\r
1099   gotoxy(1,14);col(14,7);\r
1100   cn('Working 14 hours a day in the core of some dusty, smelly mine');\r
1101   cn('is not your idea of the perfect lifestyle.');\r
1102   cn('Barre-An is a dust ball in space, its only salvation being that it is');\r
1103   cn('rich in precious barre-an metal.  Or used to be.  Nowadays the mines');\r
1104   cn('don''t seem so generous, which is why you''re looking for a more');\r
1105   cn('profitable venture.');\r
1106   cn('A break, that''s all you ask for, maybe today you figure...');\r
1107   writeln;\r
1108  end; { Init2 }\r
1109 \r
1110 overlay procedure Init3;\r
1111  begin\r
1112   Line    :='';\r
1113   Again   :='z';\r
1114   LastNoun:='mug';\r
1115   Vb      :=Null;\r
1116   Prm     :=8;\r
1117   Sc      :=0;\r
1118   Tic     :=0;\r
1119   PStat   :=[6];\r
1120   Events  :=[];\r
1121   for o   :=1 to MMax do r[o]:=Null;\r
1122   Inv     :=[3,8];\r
1123   Mov     :=[1..29];\r
1124   AlienRm :=Null;\r
1125   FriendRm:=91;\r
1126   Brief   :=[];\r
1127   Wear    :=[];\r
1128   MugCon  :=99;\r
1129   FoodCon :=4;\r
1130   SatchCon:=6;\r
1131   HolstCon:=Null;\r
1132   NicheCon:=Null;\r
1133   SinkRm  :=Null;\r
1134   PyraCon :=Null;\r
1135   Serum   :=Null;\r
1136   HingeCon:=9;\r
1137   PodumCon:=18;\r
1138   RobotCon:=12;\r
1139   Socket  :=[22..25];\r
1140   CodeSet :=7;\r
1141   ScrnSet :=1;\r
1142   Floor   :=1;\r
1143   Region  :=1;\r
1144   TFlag   :=1;\r
1145   Old     :=250;\r
1146   Old2    :=Old;\r
1147   Maze    :=true;\r
1148   Drive   :='A';\r
1149   StoreR:=-1;StoreS:=-1;StoreL:=-1;StoreC:=-1;{ Stores Last Read File Number }\r
1150   Dir[1]:='NORTH';Dir[2]:='SOUTH';Dir[3]:='EAST';Dir[4]:='WEST';\r
1151   Dir[5]:='NORTHEAST';Dir[6]:='NORTHWEST';\r
1152   Dir[7]:='SOUTHEAST';Dir[8]:='SOUTHWEST';\r
1153   m[1]:=VMax;m[2]:=NMax;m[3]:=PMax;\r
1154   for x   :=1 to TMax do T[x]:=Null;\r
1155   T[2]    :=0;\r
1156   T[3]    :=70;  { Hunger }\r
1157   T[4]    :=26;  { Thirst }\r
1158   T[5]    :=85; { Sleep (No relation to the T[2] sleep timer!) }\r
1159   NoNounOnly  :=[1..8,15,16,30,77..79,82,85..87,95];\r
1160   OneNounMaybe:=[9..14,25,32,46,59..60,66..71,80,81,90,91];\r
1161   ToNounOnly  :=[33,49,64,88,93];\r
1162   ToNounMaybe :=[19,41..44,48,50,53,54,74..76,89,90,92,94];\r
1163   { NOTE:  All other verbs would be OneNounOnly! }\r
1164   window(2,5,79,24);gotoxy(1,19);\r
1165  end; { Init3 }\r
1166 \r
1167 overlay procedure Save;\r
1168   label JUMPABORT,JUMPBACK;\r
1169   var   DiskTest:file;\r
1170  begin SF; JUMPBACK: nosound; for x:=1 to 20 do writeln;\r
1171   Bor(2,7);CFlag:=Drive;Cur(2);\r
1172   gotoxy(1,2);\r
1173   write('Which disk drive (default ',Up(Drive),':)? ');\r
1174   col(14,15);buflen:=1;readln(Drive);col(11,7);\r
1175   Drive:=upcase(Drive);if not(Drive in['A','B'])then Drive:=CFlag;\r
1176   gotoxy(1,5);\r
1177   writeln('Make sure your SAVE/RESTORE disk is in disk drive ',up(Drive),':');\r
1178   writeln;writeln;\r
1179   write('SAVE under what file name (''',up('/'),''' aborts SAVE)? ');\r
1180   buflen:=8;col(14,15);readln(input);col(11,7);\r
1181   Cur(3);\r
1182   while pos(' ',input)>0 do delete(input,pos(' ',input),1);\r
1183   while pos('.',input)>0 do delete(input,pos('.',input),1);\r
1184   while pos(':',input)>0 do delete(input,pos(':',input),1);\r
1185   if pos('/',input)>0 then\r
1186    begin writeln;writeln(up('SAVE ABORTED'));goto JUMPABORT;end;\r
1187   LowerCase(input);\r
1188   if(pos('list',input)>0)or(pos('dir',input)>0)or(pos('file',input)>0)then\r
1189    begin Directory;goto JUMPBACK;end;\r
1190   if length(input)=0 then input:='LASTSAVE';writeln;writeln;\r
1191   writeln('The game file ',Up(Input),' is now being saved on disk drive ',\r
1192            up(Drive),':...');\r
1193   input:=Drive+':'+input;\r
1194   assign(Objects,input+'.sm1');\r
1195   rewrite(Objects);\r
1196   for x:=0 to RMax do write(Objects,L[x]);\r
1197   close(Objects);\r
1198   assign(Things,input+'.sm2');\r
1199   rewrite(Things);\r
1200   write(Things,Prm,Region,MugCon,FoodCon,SatchCon,NicheCon,PyraCon,\r
1201                HingeCon,PodumCon,AlienRm,FriendRm,SinkRm,Serum,TFlag,\r
1202                RobotCon,CodeSet,ScrnSet,HolstCon);\r
1203   for x:=1 to MMax do write(Things,R[x]);\r
1204   close(Things);\r
1205   assign(Timers,input+'.sm3');\r
1206   rewrite(Timers);\r
1207   write(Timers,Tic,Sc,RC,Floor);\r
1208   for x:=1 to TMax do write(Timers,T[x]);\r
1209   close(Timers);\r
1210   with SetSave do\r
1211    begin aInv:=Inv;aPStat:=PStat;aEvents:=Events;\r
1212     aSocket:=Socket;aWear:=Wear;end;\r
1213   assign(Sets,input+'.sm4');\r
1214   rewrite(Sets);\r
1215   write(Sets,SetSave);\r
1216   close(Sets);\r
1217   writeln;writeln;delete(input,1,2);\r
1218   writeln('Your present game location is now SAVED under the name ',\r
1219            up(input),'.');\r
1220   writeln; JUMPABORT: writeln;\r
1221   writeln('Please make sure the SUPERNOVA disk is in drive ',up(Log),':');\r
1222   writeln;writeln;Pause;\r
1223   assign(DiskTest,'Nova.com');\r
1224   {$I-}\r
1225   reset(DiskTest);\r
1226   {$I+}\r
1227   if IOResult<>0 then\r
1228    begin Col(15,15);close(DiskTest);write(^g);goto JUMPABORT;end;\r
1229   close(DiskTest);Col(11,7);\r
1230   Bor(0,0);Line:='l';\r
1231   case Region of 4:sound(20);5:sound(60)end\r
1232  end; { SAVE }\r
1233 \r
1234 overlay procedure Restore;\r
1235   label JUMP,JUMPBACK;\r
1236   var   DiskTest:file;\r
1237  begin SF; JUMPBACK: nosound; for x:=1 to 25 do writeln;\r
1238   Bor(6,7);CFlag:=Drive;Cur(2);\r
1239   gotoxy(1,2);\r
1240   write('Which disk drive (default ',Up(Drive),':)? ');\r
1241   col(14,15);buflen:=1;readln(Drive);col(11,7);\r
1242   Drive:=upcase(Drive);if not(Drive in['A','B'])then Drive:=CFlag;\r
1243   gotoxy(1,5);\r
1244   writeln('Make sure your SAVE/RESTORE disk is in disk drive ',up(Drive),':');\r
1245   writeln;writeln;\r
1246   write('RESTORE from what file name (''',up('/'),''' aborts RESTORE)? ');\r
1247   buflen:=8;col(14,15);readln(input);col(11,7);\r
1248   Cur(3);\r
1249   while pos(' ',input)>0 do delete(input,pos(' ',input),1);\r
1250   while pos('.',input)>0 do delete(input,pos('.',input),1);\r
1251   while pos(':',input)>0 do delete(input,pos(':',input),1);\r
1252   if pos('/',input)>0 then\r
1253    begin writeln;writeln(up('RESTORE ABORTED'));goto JUMP;end;\r
1254   LowerCase(input);\r
1255   if(pos('list',input)>0)or(pos('dir',input)>0)or(pos('file',input)>0)then\r
1256    begin Directory;goto JUMPBACK;end;\r
1257   if length(input)=0 then input:='LASTSAVE';writeln;writeln;\r
1258   writeln('The game file ',Up(Input),' is now being restored from drive ',\r
1259            up(Drive),':...');\r
1260   input:=Drive+':'+input;\r
1261   assign(Objects,input+'.sm1');\r
1262   {$I-}\r
1263   reset(Objects);\r
1264   {$I+}\r
1265   if IOResult<>0 then\r
1266    begin close(Objects);col(12,15);writeln;writeln;delete(input,1,2);\r
1267     for x:=1 to length(input) do input[x]:=upcase(input[x]);\r
1268     Cn('The file '+input+' does not exist on your SAVE/RESTORE disk!');\r
1269     writeln(^g);delay(2000);col(11,7);goto JUMPBACK;\r
1270    end;\r
1271   reset(Objects);\r
1272   for x:=0 to RMax do read(Objects,L[x]);\r
1273   close(Objects);\r
1274   assign(Things,input+'.sm2');\r
1275   reset(Things);\r
1276   read(Things,Prm,Region,MugCon,FoodCon,SatchCon,NicheCon,PyraCon,\r
1277               HingeCon,PodumCon,AlienRm,FriendRm,SinkRm,Serum,TFlag,\r
1278               RobotCon,CodeSet,ScrnSet,HolstCon);\r
1279   for x:=1 to MMax do read(Things,R[x]);\r
1280   close(Things);\r
1281   assign(Timers,input+'.sm3');\r
1282   reset(Timers);\r
1283   read(Timers,Tic,Sc,RC,Floor);\r
1284   for x:=1 to TMax do read(Timers,T[x]);\r
1285   close(Timers);\r
1286   assign(Sets,input+'.sm4');\r
1287   reset(Sets);\r
1288   read(Sets,SetSave);\r
1289   close(Sets);\r
1290   with SetSave do\r
1291    begin Inv:=aInv;PStat:=aPStat;Events:=aEvents;\r
1292     Socket:=aSocket;Wear:=aWear;end;\r
1293   Add(126);\r
1294   writeln;writeln;delete(input,1,2);\r
1295   writeln('Your present game location is now RESTORED from the name ',\r
1296            up(input),'.');\r
1297   writeln; JUMP: writeln;\r
1298   writeln('Please make sure the SUPERNOVA disk is in drive ',up(Log),':');\r
1299   writeln;writeln;Pause;\r
1300   assign(DiskTest,'Nova.com');\r
1301   {$I-}\r
1302   reset(DiskTest);\r
1303   {$I+}\r
1304   if IOResult<>0 then\r
1305    begin Col(15,15);close(DiskTest);write(^g);goto JUMP;end;\r
1306   close(DiskTest);Col(11,7);\r
1307   Bor(0,0);\r
1308   case Region of 4:sound(20);5:sound(60)end;\r
1309   if Region>1 then\r
1310    begin\r
1311     n[84]:='reactor regulat\';\r
1312     n[126]:='hinged mouth\mouth\hinge\';\r
1313    end\r
1314    else\r
1315     begin\r
1316      n[84]:='middle table\middle\';\r
1317      n[126]:='bar\';\r
1318     end;\r
1319   if en(34)then n[18]:='glass ball\ball\glass\'\r
1320    else n[18]:='dusty ball\ball\dusty\';\r
1321   if Prm>79 then\r
1322    begin\r
1323     n[40]:='sockets\socket\';\r
1324     n[82]:='laser beam\beam\laser\';\r
1325     n[110]:='speaker\';\r
1326    end else\r
1327    begin\r
1328     n[40]:='cyan button\cyan\';\r
1329     n[82]:='solar map\map\solar\drawing\';\r
1330     n[110]:='keyhole\';\r
1331    end;\r
1332    Min(128);Line:='l';\r
1333  end; { RESTORE }\r
1334 \r
1335 procedure MoreThanOne;\r
1336  begin\r
1337   if((N1=58)or(58 in NounSet)or(N2=58))and Here(3) and Here(4) then\r
1338    begin Cur(2);\r
1339     repeat write('Which one, the R)usty or S)hiney key? ');\r
1340      read(kbd,CFlag);writeln(CFlag);writeln until upcase(CFlag) in ['R','S'];\r
1341     case upcase(CFlag) of 'R':x:=3; 'S':x:=4 end;\r
1342     if N1=58 then N1:=x;\r
1343     if N2=58 then N2:=x;\r
1344     if 58 in NounSet then begin NounSet:=NounSet-[58];NounSet:=NounSet+[x] end;\r
1345    end;\r
1346   if((N1=86)or(86 in NounSet)or(N2=86))and(Prm=8)then\r
1347    begin Cur(2);\r
1348     repeat write('Which one, the W)estern, M)iddle or E)astern table? ');\r
1349      read(kbd,CFlag);writeln(CFlag);\r
1350      writeln until upcase(CFlag) in ['W','M','E'];\r
1351     case upcase(CFlag) of 'W':x:=83; 'M':x:=84; 'E':x:=85 end;\r
1352     if N1=86 then N1:=x;\r
1353     if N2=86 then N2:=x;\r
1354     if 86 in NounSet then begin NounSet:=NounSet-[86];NounSet:=NounSet+[x] end;\r
1355    end;\r
1356   if((N1=44)or(44 in NounSet)or(N2=44))and(Prm in[1,70])and(Vb<>28)then\r
1357    begin Cur(2);\r
1358     repeat write('Which one, the T)an, P)urple or C)yan button? ');\r
1359      read(kbd,CFlag);writeln(CFlag);\r
1360      writeln until upcase(CFlag) in ['T','P','C'];\r
1361     case upcase(CFlag) of 'T':x:=41; 'P':x:=43; 'C':x:=40 end;\r
1362     if N1=44 then N1:=x;\r
1363     if N2=44 then N2:=x;\r
1364     if 44 in NounSet then begin NounSet:=NounSet-[44];NounSet:=NounSet+[x] end;\r
1365    end;\r
1366   if(N1=58)and Here(3)and not(Here(4))then N1:=3;\r
1367   if(N2=58)and Here(3)and not(Here(4))then N2:=3;\r
1368   if(58 in NounSet)and Here(3)and not(Here(4))then\r
1369     begin NounSet:=NounSet-[58];NounSet:=NounSet+[3] end;\r
1370   if(N1=58)and Here(4)and not(Here(3))then N1:=4;\r
1371   if(N2=58)and Here(4)and not(Here(3))then N2:=4;\r
1372   if(58 in NounSet)and Here(4)and not(Here(3))then\r
1373     begin NounSet:=NounSet-[58];NounSet:=NounSet+[4] end;\r
1374 end; { MoreThanOne }\r
1375 \r
1376 \r
1377 function Print(Word:Str29):Str1;\r
1378  begin Print:='';writeln('--you can''t use the word ',Up(Word),' here.')end;\r
1379 \r
1380 procedure Parser_Syntax(var Input:Str130);\r
1381    label JUMP1, JUMP2;\r
1382 begin\r
1383  Word:=''; Md:=Null; Num:=Null; Code:=Null;\r
1384  Vb:=Null; N1:=Null; N2:=Null; NounSet:=[];\r
1385 JUMP1:  { Used if the player forgets the first noun. }\r
1386  FFlag:=Null; Pr:=Null;\r
1387 JUMP2:  { Used if the player forgets the second noun or preposition. }\r
1388  EFlag:=Null;\r
1389  FindMood(input,Word,Md);\r
1390  if(length(input)>0)then\r
1391   begin\r
1392    FindMood(input,Word,Num);\r
1393    if(Num=Null)then\r
1394     begin\r
1395      FindWord(input,Vb,Word,1);\r
1396      if(Vb<>Null)then\r
1397       if(length(input)=0)then\r
1398        begin\r
1399         if(Vb in NoNounOnly)or(Vb in OneNounMaybe)then EFlag:=Legal;\r
1400         if EFlag<>Legal then\r
1401          begin\r
1402           if(Vb=35)and here(35)then begin EFlag:=Legal;N1:=35;NStr:='seat';end;\r
1403           if(Vb=47)and here(6)then begin EFlag:=Legal;N1:=6;end;\r
1404           if(Vb=62)and here(80)then begin EFlag:=Legal;N1:=80;end;\r
1405           if(Vb=65)and here(124)then begin EFlag:=Legal;N1:=124;end;\r
1406           if EFlag<>Legal then EFlag:=4\r
1407          end\r
1408        end\r
1409       else\r
1410        if(Vb in NoNounOnly)then Dictionary(3,9)\r
1411        else\r
1412         if not(Vb in[17,18,37,39])then       { get,drop and but branch-off }\r
1413          if not(Vb in[25,32,56,66..69,71,80,81])then { characters and type }\r
1414           begin\r
1415            if(Vb<>FFlag)then FindWord(input,N1,Word,2);\r
1416            if(N1<>Null)then LastNoun:=FN(N1);\r
1417            if(N1<>Null)then\r
1418             if(Word<>'all')then\r
1419              if(length(input)=0)then\r
1420               if(Vb in ToNounOnly)then\r
1421                if(VStr='fill')and(Prm=SinkRm)and(N1=29)then\r
1422                   begin N2:=79;Pr:=6;EFlag:=Legal;end else\r
1423                if(Vb=64)and(Prm=8)and(N1 in[29,99])and(not en(21))and\r
1424                   here(8)then begin Pr:=6;N2:=8;EFlag:=Legal;end else\r
1425                if(Vb=88)and(Prm in[9..11])and(N1=56)and here(3)then\r
1426                   begin Pr:=6;N2:=3;EFlag:=Legal;end\r
1427                else EFlag:=15\r
1428               else EFlag:=Legal\r
1429              else\r
1430               if(Vb in ToNounMaybe)or(Vb in ToNounOnly)then\r
1431                begin\r
1432                 FindWord(input,Pr,Word,3);\r
1433                 if(Pr<>Null)then\r
1434                  if(length(input)=0)then\r
1435                    if(Vb=50)and(Pr in[1,9])then EFlag:=Legal\r
1436                    else EFlag:=6\r
1437                  else\r
1438                   if(Vb<>50)then  { branch for turning dials }\r
1439                    begin\r
1440                     FindWord(input,N2,Word,2);\r
1441                     if(N2<>Null)then\r
1442                      if(Word<>'all')then\r
1443                       if(length(input)=0)then EFlag:=Legal\r
1444                       else Dictionary(12,9)\r
1445                      else EFlag:=16\r
1446                     else Dictionary(11,2)\r
1447                    end\r
1448                   else\r
1449                    begin\r
1450                     val(input,Code,testc);\r
1451                     if(testc=0)then EFlag:=Legal\r
1452                     else begin delete(input,1,testc-1);Dictionary(14,9);end;\r
1453                    end\r
1454                 else Dictionary(9,3)\r
1455                end\r
1456               else\r
1457                begin Dictionary(3,9);if(List=2)then EFlag:=8;end\r
1458              else EFlag:=16\r
1459            else Dictionary(10,2)\r
1460           end\r
1461          else { Special case for TYPE, characters, etc. }\r
1462           begin\r
1463            QFormat(input);\r
1464            EFlag:=Legal\r
1465           end { of Special case for SAY, TYPE, etc. }\r
1466         else  { Special case for GET and DROP }\r
1467          while EFlag=Null do\r
1468           begin N1:=Null;\r
1469            FindWord(input,N1,Word,2);\r
1470            if(N1<>Null)then LastNoun:=FN(N1);\r
1471            if(N1<>Null)then\r
1472             if not(N1 in NounSet)then\r
1473              begin\r
1474               NounSet:=NounSet+[N1];\r
1475               if(length(input)=0)then EFlag:=Legal\r
1476              end\r
1477             else EFlag:=13\r
1478            else Dictionary(10,2)\r
1479           end { of Special case for GET and DROP }\r
1480      else Dictionary(7,1)\r
1481     end\r
1482    else EFlag:=2\r
1483   end\r
1484  else EFlag:=1;\r
1485  if EFlag<>Legal then\r
1486   begin Line:='';play(199,199,55);delay(70);play(60,60,55)end;\r
1487  case EFlag of\r
1488  1:RL(186);\r
1489  2:writeln('The word ',up(Word),' is too many adverbs.');\r
1490  3:write('Illegal input',Print(Word));\r
1491  4:if(Vb=56)then RL(187)\r
1492    else\r
1493     begin\r
1494      write('Noun missing--');\r
1495      case Vb of\r
1496       35,62:writeln('what do you want to ',up(Word),' on?');\r
1497       65:writeln('what do you want to ',up(Word),' to?')\r
1498       else writeln('what do you want to ',up(Word),'?');\r
1499      end;\r
1500      PlayerInput(line);\r
1501      if(length(input)>0)then goto JUMP1;\r
1502     end;\r
1503  5:if(length(Word)>1)then\r
1504     writeln('The word ',up(Word),' is not used in this adventure.')\r
1505    else\r
1506     writeln('The letter ',up(Word),' is not used as shorthand in this parser.');\r
1507  6:begin\r
1508     writeln('Noun missing--what do you want to ',up(VStr),up(' the '),\r
1509             up(NStr),' ',up(PStr),'?');\r
1510     PlayerInput(line); FFlag:=Vb;\r
1511     if(length(input)>0)then goto JUMP2;\r
1512    end;\r
1513  7:write('Verb missing',Print(Word));\r
1514  8:RL(188);\r
1515  9:write('Preposition expected',Print(Word));\r
1516  10:write('Noun expected',Print(Word));\r
1517  11:write('Indirect noun expected',Print(Word));\r
1518  12:write('No more input expected',Print(Word));\r
1519  13:writeln('Illegal noun used--',up(Word),' referenced more than once.');\r
1520  14:write('Number expected',Print(Word));\r
1521  15:begin\r
1522      write('Preposition and noun missing--');\r
1523      if(Vb in[33,48])then\r
1524       writeln('where do you want to ',up(VStr),' the ',up(NStr),'?') else\r
1525      if Vb=49 then\r
1526       begin Pr:=1;\r
1527        writeln('who do you want to ',up(VStr),' the ',up(NStr),' to?')end\r
1528      else begin Pr:=6;\r
1529        writeln('what do you want to ',up(VStr),' the ',up(NStr),' with?')end;\r
1530      PlayerInput(line); FFlag:=Vb;\r
1531      if(length(input)>0)then goto JUMP2;\r
1532     end;\r
1533  16:RL(189);\r
1534  17:RL(576)\r
1535  end;\r
1536 end; { Parser Syntax }\r
1537 \r
1538 procedure MC;{WhichChar,WatchRoom,ToRoom:byte;MessageNum:Integer}\r
1539     { WhichChar refers to the character(s) being moved.               }\r
1540     { WatchRoom is the room the player must be in to see the responce.}\r
1541     { ToRoom is the room the character(s) move to.                    }\r
1542     { MessageNum is the message that is written if the player sees.   }\r
1543  begin\r
1544   if(Prm=WatchRoom)then RS(MessageNum);\r
1545   case WhichChar of     { 1 = Aliens,  2 = Scientist }\r
1546    1:begin\r
1547       L[AlienRm]:=L[AlienRm]-[124];AlienRm:=ToRoom;\r
1548       L[AlienRm]:=L[AlienRm]+[124]\r
1549      end;\r
1550    2:begin\r
1551       L[FriendRm]:=L[FriendRm]-[123];FriendRm:=ToRoom;\r
1552       L[FriendRm]:=L[FriendRm]+[123]\r
1553      end\r
1554   end;\r
1555   SFlag:=false;\r
1556  end;\r
1557 \r
1558 procedure Van;\r
1559  begin\r
1560   Inv:=Inv-[o];\r
1561   r[o]:=Null;\r
1562   L[Prm]:=L[Prm]-[o];\r
1563   if o in Wear then Wear:=Wear-[o];\r
1564   if o=SatchCon then SatchCon:=Null;\r
1565   if o=MugCon then MugCon:=Null;\r
1566   if o=16 then Min(6);\r
1567   if o=NicheCon then NicheCon:=Null;\r
1568   if o=PyraCon then PyraCon:=Null;\r
1569   if o=HingeCon then HingeCon:=Null;\r
1570   if o=PodumCon then PodumCon:=Null;\r
1571   if o=16 then begin Min(37);Min(6)end;\r
1572   if o=RobotCon then RobotCon:=Null;\r
1573   if o in Socket then Socket:=Socket-[o];\r
1574   if o=HolstCon then HolstCon:=Null\r
1575  end;\r
1576 \r
1577 procedure Crazy;\r
1578  begin SF; RL(random(7)+127)end;\r
1579 \r
1580 procedure NoSense;\r
1581  begin RL(190) end;\r
1582 \r
1583 procedure Say(What1,What2:Str29);\r
1584  begin SF; writeln('The ',What1,' is already ',What2,'.') end;\r
1585 \r
1586 {******************* END OF PARSER AND MISC. PROCEDURES *********************}\r
1587 \1a\r