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