+{//-------------------------------------------------------------------------}\r
+{/* }\r
+{Copyright (C) 1990, 2009 - Apogee Software, Ltd. }\r
+{ }\r
+{This file is part of Supernova. Supernova is free software; you can }\r
+{redistribute it and/or modify it under the terms of the GNU General Public }\r
+{License as published by the Free Software Foundation; either version 2 }\r
+{of the License, or (at your option) any later version. }\r
+{ }\r
+{This program is distributed in the hope that it will be useful, }\r
+{but WITHOUT ANY WARRANTY; without even the implied warranty of }\r
+{MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. }\r
+{ }\r
+{See the GNU General Public License for more details. }\r
+{ }\r
+{You should have received a copy of the GNU General Public License }\r
+{along with this program; if not, write to the Free Software }\r
+{Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.}\r
+{ }\r
+{Original Source: 1990 Scott Miller }\r
+{Prepared for public release: 03/19/09 - Joe Siegler, Apogee Software, Ltd. }\r
+{*/ }\r
+{//-------------------------------------------------------------------------}\r
+(*****************************************************************************)\r
+(* ADPAR *)\r
+(* >> Contains the Parser, Initialization, Time and Misc. Routines << *)\r
+(* Programmer: Scott Miller *)\r
+(* << Began February 2, 1985 >> *)\r
+(* Copyright 1985 Scott Miller *)\r
+(*****************************************************************************)\r
+\r
+procedure RL(Pointer:integer);forward;\r
+procedure RS(Pointer:integer);forward;\r
+procedure RR(Pointer:integer);forward;\r
+procedure RB(Pointer,Colour:byte);forward;\r
+procedure RB2(Pointer,Colour:byte);forward;\r
+procedure MC(WhichChar,WatchRoom,ToRoom:byte;MessageNum:Integer);forward;\r
+procedure Move(New:byte);forward;\r
+procedure DEAD;forward;\r
+procedure Call13;forward;\r
+procedure Van(o:byte);forward;\r
+function FN(VNP:byte):Str29;forward;\r
+function Here(Obj:byte):Boolean;forward;\r
+function Up(Word:Str130):Str1;forward;\r
+\r
+procedure SF; begin SFlag:=True end;\r
+\r
+procedure Cur(Num:byte);\r
+ begin\r
+ with Result do\r
+ if Color then\r
+ begin AX:=$100;\r
+ case Num of\r
+ 1:CX:=$707; { Underline }\r
+ 2:CX:=$8; { Solid block }\r
+ 3:CX:=$800; { Invisible }\r
+ end;\r
+ intr($10,Result);\r
+ end;\r
+ end;\r
+\r
+procedure Col(Num1,Num2:byte);\r
+ begin if Color then textcolor(Num1) else textcolor(Num2) end;\r
+\r
+procedure Bak(Num1,Num2:byte);\r
+ begin if Color then textbackground(Num1) else textbackground(Num2) end;\r
+\r
+procedure Bor(Num1,Num2:byte);\r
+ begin\r
+ with Result do\r
+ begin AX:=$B00;if Color then BX:=Num1 else BX:=Num2 end;intr($10,Result)\r
+ end;\r
+\r
+function En(Num:byte):boolean;\r
+ begin if Num in Events then En:=true else En:=false end;\r
+\r
+procedure Add(Num:byte);\r
+ begin Events:=Events+[Num] end;\r
+\r
+procedure Min(Num:byte);\r
+ begin Events:=Events-[Num] end;\r
+\r
+procedure Score(Num,pointer:integer);\r
+ begin if not en(pointer)then begin Sc:=Sc+Num;Add(Pointer)end end;\r
+\r
+procedure Cn(s:str78);\r
+ begin gotoxy(40-(length(s)div 2),wherey);writeln(s)end;\r
+\r
+procedure Pause;\r
+ begin col(15,15);write('Press any key to continue...');\r
+ read(kbd,CFlag);col(11,7);writeln;\r
+ end;\r
+\r
+procedure Tune(Octave,Note,Duration:integer);\r
+ var Frequency:real;\r
+ i:integer;\r
+ begin\r
+ Frequency:=32.625;\r
+ for i:=1 to Octave do\r
+ Frequency:=Frequency*2;\r
+ for i:=1 to Note-1 do\r
+ Frequency:=Frequency*1.059463094;\r
+ if Duration <> 0 then\r
+ begin\r
+ sound(round(Frequency));\r
+ delay(Duration);\r
+ nosound\r
+ end\r
+ else sound(round(Frequency));\r
+ end;\r
+\r
+procedure Play(Start,Stop,Speed:integer);\r
+ var x:integer;\r
+ begin\r
+ if Start<=Stop then\r
+ for x:=Start to Stop do begin sound(x);delay(Speed)end\r
+ else\r
+ for x:= Start downto Stop do begin sound(x);delay(Speed)end;\r
+ nosound;if Region=4 then sound(20);if Region=5 then sound(60);\r
+ end;\r
+\r
+procedure Explode(Duration:byte);\r
+ var x:integer;\r
+ begin for x:=Duration*999 downto 20 do sound(random(x));nosound end;\r
+\r
+procedure Walls(Duration:byte);\r
+ var x:integer;\r
+ begin for x:=1 to Duration*999 do sound(random(35)+20);nosound end;\r
+\r
+procedure Static;\r
+ var x,y:integer;\r
+ begin\r
+ for x:=1 to 50 do\r
+ case random(2) of\r
+ 0:for y:=1 to random(70)+10 do sound(random(4000)+3000);\r
+ 1:begin nosound;delay(random(29))end\r
+ end;nosound;if Region=5 then sound(60)\r
+ end;\r
+\r
+procedure Blast;\r
+ var x:byte;\r
+ begin\r
+ for x:=1 to 40 do\r
+ begin play(550-x*6,600+x*6,0);play(600+x*6,550-x*6,0)end;explode(2)\r
+ end;\r
+\r
+procedure Dopen(Num:byte);\r
+ begin writeln('The door slides open...');\r
+ if Num<>0 then play(50,125-Num,Num)\r
+ else begin for i:=3500 to 5000 do sound(random(4500)+i);nosound;end;\r
+ if Region=5 then sound(60)\r
+ end;\r
+\r
+procedure Dclose(Num:byte);\r
+ begin writeln('The sliding door closes.');\r
+ if Num<>0 then play(125-Num,50,Num)\r
+ else begin for i:=5000 downto 3500 do sound(random(4500)+i);nosound;end;\r
+ if Region=5 then sound(60)\r
+ end;\r
+\r
+procedure Door(New,Num:byte);\r
+ begin\r
+ if en(7)then RL(22)else\r
+ if en(8)then RL(23)else begin DOpen(Num);Move(New);DClose(Num)end\r
+ end;\r
+\r
+procedure Time1;\r
+ begin Tic:=Tic+1; Min(128); { <--Negates DEAD } col(13,15);\r
+ for x:=1 to TMax do T[x]:=T[x]-1;\r
+ if T[2]=1 then begin PStat:=PStat-[5];RL(1)end;\r
+ case T[3] of { Hunger }\r
+ 25:begin PStat:=PStat+[2];RL(2)end;\r
+ 12:RL(3);\r
+ 4:begin Bor(4,7);RL(4)end;\r
+ 1:begin RL(124);DEAD;end\r
+ end;\r
+ case T[4] of { Thirst }\r
+ 22:begin PStat:=PStat+[6];RL(5)end;\r
+ 11:RL(6);\r
+ 4:begin Bor(4,7);RL(7)end;\r
+ 1:begin RL(125);DEAD;end\r
+ end;\r
+ case T[5] of { Sleep }\r
+ 32:begin PStat:=PStat+[5];RL(8)end;\r
+ 14:RL(9);\r
+ 5:begin Bor(4,7);RL(10)end;\r
+ 1:begin RL(126);DEAD;end;\r
+ 2..13:begin x:=random(29)+1;\r
+ if(x in Inv)and not(x in Wear)then\r
+ begin Van(x);R[x]:=Prm;\r
+ writeln('A bout of weariness causes you to loose your grip on',\r
+ ' the ',FN(x),'!')\r
+ end\r
+ end\r
+ end;\r
+ case T[29] of { Laser Injury }\r
+ 9:RS(214);\r
+ 4:begin RL(507);Bor(4,7)end;\r
+ 2..11:begin repeat x:=random(27)+1 until x in[1..12,16..20,22..26,28];\r
+ if(x in Inv)and not(x in Wear)then\r
+ begin Van(x);R[x]:=Prm;\r
+ if random(2)=0 then\r
+ writeln('A sudden stab of pain shoots up your side, you drop the ',\r
+ FN(x),'.') else begin\r
+ writeln('The ',FN(x),' falls from your grip as you almost collapse ',\r
+ 'from the');writeln('extreme pain.')end\r
+ end\r
+ end;\r
+ 1:begin RS(215);DEAD;end\r
+ end;\r
+ case T[12] of { Sickness }\r
+ 120,99,83,55:RL(207);\r
+ 65:begin PStat:=PStat+[3];RL(208)end;\r
+ 47:RL(209); 30:RS(73); 15:RS(74); 4:begin Bor(4,7);RS(75)end;\r
+ 1:begin RS(76);DEAD end;\r
+ 2..29:if(random(25)=0)and(Inv<>[])and not(en(125))then\r
+ begin RS(232);\r
+ for x:=1 to 29 do if(x in Inv)and not(x in Wear)then\r
+ begin Van(x);R[x]:=Prm end\r
+ end\r
+ end;\r
+ Col(10,7);\r
+ if(Prm in[81..88])and(T[30]<1)and(random(4)=0)then\r
+ if 28 in Wear then\r
+ begin T[30]:=9;RS(153+Prm);\r
+ for i:=999 to 2300 do sound(random(i*3)+i);\r
+ for i:=3000 downto 20 do sound(random(i*4)+i*2);nosound\r
+ end\r
+ else\r
+ begin\r
+ write('A small droid appears from the ');\r
+ case Prm of\r
+ 81:write('south'); 82:write('southwest'); 83:write('west');\r
+ 84:write('northwest'); 85:write('north'); 86:write('northeast');\r
+ 87:write('east'); 88:write('southeast')\r
+ end; writeln(' section of the corridor and flies');\r
+ RS(242);RS(243);for i:=20 to 3000 do sound(random(i*3)+i);nosound;\r
+ delay(1500);DEAD\r
+ end;\r
+ end; { Time1 }\r
+\r
+overlay procedure Time2A;\r
+ begin col(10,7); { Pre-Jungle Planet }\r
+ case T[1] of\r
+ 19:MC(1,13,13,0);\r
+ 18:begin MC(1,8,8,1);MC(1,13,8,2)end;\r
+ 17:if en(19) then begin RS(9);T[1]:=11;end;\r
+ 11..17:if not(en(19))and(Prm=8)and(random(2)=1)then RL(0);\r
+ 10:MC(1,8,9,3);\r
+ 9:begin MC(1,9,0,4);T[1]:=Null;end;\r
+ 5..7:if(en(2))and(en(3))then begin RB2(5-(T[1]-3),10);col(10,7)end;\r
+ 4:if Prm=8 then begin T[1]:=11;RS(5)end;\r
+ end;\r
+ if(T[7]=1)then begin RS(35);DEAD;end;\r
+ if(T[6]=2)and(en(7))then RL(140);\r
+ if(T[6]=1)and(en(7))then begin RS(20);DEAD;end;\r
+ case T[8] of { Lift-off countdown }\r
+ 5:RL(181); 4:RL(182); 3:RL(191); 2:RL(192);\r
+ 1:if en(10)then\r
+ begin Min(10);Min(26);Min(27);Explode(32);\r
+ sound(20);Bor(0,0);Score(10,122);\r
+ n[84]:='reactor regulat\';\r
+ RB(7,10);delay(9999);Pause;col(10,7);RS(43);PStat:=PStat-[2,5,6];\r
+ Region:=4;T[3]:=150;T[4]:=125;T[5]:=230;T[8]:=0;T[9]:=1;T[10]:=5;end\r
+ else begin RS(44);Explode(32);DEAD;end;\r
+ end;\r
+ if T[9]<1 then T[9]:=15;\r
+ if(Region=4)and(Prm=1)and(T[9]=12)then RS(62);\r
+ if T[10] in[1..4]then RL(194);\r
+ if(Tic>3)and(Prm=8)and not(en(9))and not(en(7))then\r
+ begin RS(6);Add(9)end else\r
+ if(Tic>5)and(Prm=8)and(en(9))and not(en(16))and not(en(7))then\r
+ begin RS(7);Add(16)end;\r
+ case Prm of\r
+ 1:if(random(2)=0)and(T[9]>12)and(T[9]<15)and(Region=4)and not en(129)then\r
+ begin RL(593);RL(594);Add(129)end\r
+ else if(random(20)=0)and(Region=4)then RL(592);\r
+ 7:if random(5)=0 then RL(595);\r
+ 8:if random(3)=1 then RL(24)else if random(3)=1 then RL(178);\r
+ 15,17,19:case random(60) of\r
+ 1:RL(596);\r
+ 2:RL(597);\r
+ 3,4:if RC>40 then begin if T[4]>10 then T[4]:=10;RL(598)end;\r
+ end; {case}\r
+ 20:if random(4)=1 then RL(25);\r
+ end; {case}\r
+ if Prm=SinkRm then begin RL(85);L[Prm]:=L[Prm]+[79];end;\r
+end; { Time2A }\r
+\r
+overlay procedure Time2B;\r
+ begin col(10,7); { Jungle Planet }\r
+ Maze:=not(Maze);\r
+ if Prm in[42..49]then\r
+ begin writeln('Some of the walls shift positions.');Walls(4);end;\r
+ case Prm of\r
+ 7:if random(5)=0 then RL(595);\r
+ 26..29,32..34,59,60:case random(40) of\r
+ 0,1:RL(210); 2,3:RL(211); 4:RS(77); 5,6:RS(78); 7,8:RL(212);\r
+ 9:RL(213); 10:RL(214); 11:begin RL(215);play(6000,6001,20)end\r
+ end;\r
+ 42..50:if random(7)=0 then RL(280);\r
+ end; {case}\r
+ if(Prm=28)and(random(2)=0)then RL(233);\r
+ if Prm=SinkRm then begin RL(85);L[Prm]:=L[Prm]+[79];end;\r
+ if T[11]=2 then RL(205);\r
+ if T[11]=1 then begin RS(70);DEAD;end;\r
+ if T[13]=1 then begin RB(11,10);for x:=1 to 3 do begin tune(4,2,200);\r
+ delay(99);tune(4,5,200);delay(99)end;Pause end;\r
+ if(T[14]=2)and(Prm in[40,41])then RL(251);\r
+ if T[14]=1 then\r
+ case Prm of 40:begin RL(249);Walls(8);end;41:begin RL(250);Walls(8);end end;\r
+ if(T[15]=1)and(Prm=39)then begin RS(94);DEAD;end;\r
+ if T[17]=4 then begin RS(109);DEAD;end;\r
+ if T[17]=1 then begin Add(36);if Prm=56 then begin RS(110);Walls(8);end end;\r
+ if T[18]=2 then begin RS(123);Walls(12)end;\r
+ if(T[18]=1)and(Prm=53)then begin RS(124);Walls(12);DEAD;end;\r
+ if T[19]=1 then begin RS(128);Walls(12);DEAD;end;\r
+ end; { Time2B }\r
+\r
+overlay procedure Time2C;\r
+ begin col(11,7); { Inner Planet }\r
+ if T[20]=1 then\r
+ case Prm of 73:DClose(20);66:begin RL(337);play(105,50,20)end end;\r
+ col(10,7);\r
+ if(Prm=74)and not(en(47))then\r
+ writeln('There is something flashing on the computer''s screen.');\r
+ if(Prm=73)and(CodeSet<>4)then begin\r
+ writeln('There''s an alarm sound coming over the radio.');\r
+ for x:=1 to 23 do\r
+ begin\r
+ for i:=450 to 999 do sound(i);\r
+ for i:=999 downto 450 do sound(i);\r
+ end;nosound\r
+ end;\r
+ case random(50) of\r
+ 1..3:if here(38)then RL(588);\r
+ 4,5:begin RL(589);Explode(3)end;\r
+ 6:begin RS(244);for x:=1 to 7 do Static;end\r
+ else if(Prm in[64,73])and(random(9)=0)then begin RL(590);RL(591)end\r
+ end;\r
+ end; { Time2C }\r
+\r
+overlay procedure Time2D; { Planetship }\r
+ function Warn(Message,IfTime,Said:integer):boolean;\r
+ begin Warn:=false;\r
+ if not en(Said)and(IfTime>=T[26])then\r
+ begin if Said<>59 then begin Static;RS(Message);Static end\r
+ else if Prm>99 then begin Static;RS(Message);Static end;\r
+ if(Said=59)and(Prm<100)then begin end\r
+ else begin Warn:=True;Add(Said)end\r
+ end\r
+ end; {Warn}\r
+ begin col(11,7);\r
+ for x:=0 to 2 do if T[23+x]>2 then Score(20,118+x); { 60 total points }\r
+ if en(64)then Score(10,121);\r
+ if T[21]=1 then\r
+ case Prm of 91:DClose(20);86:begin RL(337);play(110,50,15)end end;\r
+ col(10,7);\r
+ if(Prm=95)and not(en(48))then begin\r
+ writeln('A loud siren is sounding off...');\r
+ play(300,530,6);delay(200);play(300,530,6)end;\r
+ if(Prm=91)and not en(53)then begin writeln('An alarm is ringing...');\r
+ for x:=1 to 23 do begin sound(400);delay(99);sound(940);delay(60);nosound;\r
+ end end;\r
+ if T[22]=1 then\r
+ begin write('The door slides open...');play(50,60,65);\r
+ writeln('then closes.');play(60,50,60);\r
+ if en(50)then RS(153)else\r
+ if Inv=[] then begin RS(247);RS(248)end\r
+ else begin RS(154);RS(155);Inv:=[];end;\r
+ delay(2500);write('The door slides open...');play(50,60,65);\r
+ writeln('then closes.');play(60,50,65);\r
+ end;\r
+ case T[23] of\r
+ 13:begin if Prm=91 then RL(438);MC(2,91,91,161);Add(53)end;\r
+ 12:MC(2,91,91,162);\r
+ 11:begin if Prm in[86,91]then DOpen(15);MC(2,91,86,163);MC(2,86,86,164);\r
+ if Prm in[86,91]then DClose(15)end;\r
+ 10:begin MC(2,86,87,165);MC(2,87,87,166)end;\r
+ 9:begin if Prm in[87,89]then DOpen(65);MC(2,87,89,167);MC(2,89,89,168);\r
+ if Prm in[87,89]then DClose(65)end;\r
+ 7,8:if Prm=89 then begin ScrnSet:=4;RL(417)end;\r
+ 6:begin if Prm in[87,89]then DOpen(65);MC(2,89,87,169);MC(2,87,87,170);\r
+ if Prm in[87,89]then DClose(65)end;\r
+ 5:begin MC(2,87,86,171);MC(2,86,86,172)end;\r
+ 4:if T[21]<2 then begin MC(2,86,91,173);if Prm in[86,91]then DOpen(15);\r
+ if Prm=86 then RL(418);MC(2,91,91,174);if Prm in[86,91]then DClose(15)end\r
+ else if Prm=86 then begin RL(418);MC(2,0,91,0)end;\r
+ 1:if Prm=91 then begin RL(419);Van(123);DClose(55)end else Van(123)\r
+ end; {T[23]}\r
+ if(T[23]>1)and(T[23]<4)and(Prm=91)then begin T[24]:=7;T[23]:=NULL;end;\r
+ case T[24] of\r
+ 7:if Prm=91 then RS(175);\r
+ 6:if Prm=91 then begin RS(176);RS(177)end;\r
+ 5:if Prm=91 then begin RS(178);RS(179)end;\r
+ 4:begin if Prm=91 then RL(420);if not(1 in Inv)then T[24]:=2;end;\r
+ 2,3:if(Prm=91)and(1 in Inv)then RL(419+T[24]);\r
+ 1:begin Van(123);if Prm=91 then begin RS(180);DOpen(55);RL(418);\r
+ DClose(55)end;\r
+ end;\r
+ end; {T[24]}\r
+ case T[25] of\r
+ 2..5:if Prm=91 then RS(188-T[25]);\r
+ 1:begin if Prm=91 then RS(187);T[24]:=2;T[26]:=40;Add(64)end;\r
+ end; {T[25]}\r
+ if en(64)then\r
+ if not Warn(198,38,54)then\r
+ if not Warn(199,33,55)then\r
+ if not Warn(203,30,59)then\r
+ if not Warn(200,25,57)then\r
+ if not Warn(201,20,58)then\r
+ if not Warn(202,15,56)then\r
+ if not Warn(204,10,60)then\r
+ if not Warn(205,6,61)then\r
+ if not Warn(206,3,62)then\r
+ if not Warn(207,2,63)then begin end;\r
+ if T[26]=1 then begin RS(197);DEAD;end;\r
+ if(T[27]=1998)and(Prm=99)then begin RS(213);Blast;DEAD;end;\r
+ if(T[28]=1998)and(Prm=101)then begin RS(213);Blast;DEAD;end;\r
+ end; { Time2D }\r
+\r
+overlay procedure Directory;\r
+type\r
+ Char12arr = array [ 1..12 ] of Char;\r
+ String20 = string[ 20 ];\r
+var\r
+ Regs : Entr;\r
+ DTA : array [ 1..43 ] of Byte;\r
+ Mask : Char12arr;\r
+ NamR : String20;\r
+ Error, I : Integer;\r
+ SM1Found : boolean;\r
+begin\r
+ ChDir(Drive+':');\r
+ SM1Found:=false;\r
+ FillChar(DTA,SizeOf(DTA),0);\r
+ FillChar(Mask,SizeOf(Mask),0);\r
+ FillChar(NamR,SizeOf(NamR),0);\r
+ writeln;\r
+ Regs.AX := $1A00;\r
+ Regs.DS := Seg(DTA);\r
+ Regs.DX := Ofs(DTA);\r
+ MSDos(Regs);\r
+ Error := 0;\r
+ Mask := '????????.???';\r
+ Regs.AX := $4E00;\r
+ Regs.DS := Seg(Mask);\r
+ Regs.DX := Ofs(Mask);\r
+ Regs.CX := 22;\r
+ MSDos(Regs);\r
+ Error := Regs.AX and $FF;\r
+ I := 1;\r
+ if Error=0 then\r
+ repeat\r
+ NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);\r
+ I := I + 1;\r
+ until not (NamR[I-1] in [' '..'~']) or (I>20);\r
+ NamR[0] := Chr(I-1);\r
+ while Error=0 do begin\r
+ Error := 0;\r
+ Regs.AX := $4F00;\r
+ Regs.CX := 22;\r
+ MSDos( Regs );\r
+ Error := Regs.AX and $FF;\r
+ I := 1;\r
+ repeat\r
+ NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);\r
+ I := I + 1;\r
+ until not (NamR[I-1] in [' '..'~'] ) or (I > 20);\r
+ NamR[0] := Chr(I-1);\r
+ delete(NamR,length(NamR),2);\r
+ if (Error = 0) then\r
+ if length(NamR)>4 then\r
+ if copy(NamR,length(NamR)-2,3)='SM1' then\r
+ begin\r
+ if not SM1Found then\r
+ writeln('Here is a list of the SAVE/RESTORE files on the ',\r
+ 'disk in drive ',up(Drive),':');\r
+ SM1Found:=true;\r
+ writeln(' * ',copy(NamR,1,length(NamR)-4));\r
+ end;\r
+ end; writeln;\r
+ if not SM1Found then\r
+ begin\r
+ writeln('There are not any SAVE/RESTORE files on the disk in drive ',\r
+ up(Drive),':');writeln;\r
+ end;\r
+ Pause;ChDir(Log+':');\r
+end; {Directory}\r
+\r
+function Up;{Word:Str130):Str1}\r
+ begin word:=word+' ';\r
+ if(Word[1]='l')and(Word[2]=' ')then insert('ook',Word,2);\r
+ if(Word[1]='e')and(Word[2]='x')and(Word[3]=' ')then insert('amine',Word,3);\r
+ delete(Word,length(word),2);Up:='';\r
+ for x:=1 to length(Word) do Word[x]:=upcase(Word[x]);\r
+ col(12,15); write(Word); col(11,7)\r
+ end;\r
+\r
+procedure Spaces(var I:Str130);\r
+ begin I:=concat(' ',I,' ')end;\r
+\r
+procedure QFormat(var I:Str130);\r
+ begin\r
+ if(I[1]='.')or(I[1]=' ')then delete(I,1,1);\r
+ if(I[length(I)]='.')or(I[length(I)]=' ')then delete(I,length(I),1);\r
+ end;\r
+\r
+procedure PreFormat(var I:Str130);\r
+ procedure D(A:Str29;B:byte);\r
+ begin while pos(A,I)<>0 do delete(I,pos(A,I),B)end;\r
+ begin D(' ',1);QFormat(I);\r
+ FFlag:=0; if(length(I)>0)then FFlag:=1;\r
+ Spaces(I);\r
+ Crawl:=false;if pos(' crawl ',I)>0 then Crawl:=true;D(' crawl ',6);\r
+ D(' walk ',5);D(' run ',4);D(' go ',3);D(' travel ',7);\r
+ QFormat(I); if(length(I)=0)and(FFlag=1)then FFlag:=2; Spaces(I);\r
+ D(' of ',3);D(' the ',4);D(' very ',5);D(' more ',5);D(' and ',4);\r
+ D(' large ',6);D(' big ',4);D(' huge ',5);D(' please ',7);\r
+ D(' small ',6);D(' little ',7);D(' tiny ',5);\r
+ D('''',1);D('#',1);D('!',1);D('?',1);D(' number ',7);\r
+ QFormat(I); if(length(I)=0)and(FFlag=1)then FFlag:=3; Spaces(I);\r
+ while pos('examine ',I)>0 do delete(I,pos('examine ',I)+2,5);\r
+ while pos(' into ',I)>0 do delete(I,pos(' into ',I)+3,2);\r
+ while pos(' onto ',I)>0 do delete(I,pos(' onto ',I)+3,2);\r
+ while pos(' inside ',I)>0 do delete(I,pos(' inside ',I)+3,4);\r
+ while pos(' within ',I)>0 do delete(I,pos(' within ',I)+1,4);\r
+ while pos('look ',I)>0 do delete(I,pos('look ',I)+1,3);\r
+ while pos('. ',I)>0 do delete(I,pos('. ',I)+1,1);\r
+ while pos(',',I)>0 do\r
+ begin insert(' ',I,pos(',',I));delete(I,pos(',',I),1)end;\r
+ D('..',1);D(' .',1);D(' ',1);\r
+ QFormat(I);\r
+ if(length(I)=0)then\r
+ begin EFlag:=Null;\r
+ case FFlag of\r
+ 2:RL(193);\r
+ 3:RL(186)\r
+ else writeln('Pardon me?')\r
+ end;\r
+ end\r
+ end; { PreFormat }\r
+\r
+procedure LowerCase(var I:Str130);\r
+ begin\r
+ if(length(I)>0)then\r
+ for x:=1 to length(I) do\r
+ if(I[x] in['A'..'Z'])then\r
+ I[x]:=chr(ord(I[x])+32);\r
+ end; { LowerCase }\r
+\r
+procedure ChopSeven(var I:Str130);\r
+ var Word:Str130;\r
+ begin\r
+ if(length(I)>0)then\r
+ begin\r
+ I:=I+' '; x:=1;\r
+ repeat\r
+ Word:='';\r
+ while(I[x]<>' ')and(I[x]<>'.')and(I[x]<>',')do\r
+ begin Word:=Word+I[x]; x:=x+1 end;\r
+ if(length(Word)>7)then\r
+ begin\r
+ y:=pos(Word,I); x:=x+(7-length(Word));\r
+ delete(I,y,length(Word)); delete(Word,8,130);\r
+ insert(Word,I,y)\r
+ end;\r
+ x:=x+1;\r
+ until(x-1)=length(I);\r
+ delete(I,length(I),1)\r
+ end\r
+ end; { ChopSeven }\r
+\r
+procedure FindMood(var input:Str130;var Word:Str29;var Md:byte);\r
+ var Temp1:Str53;\r
+ Temp2:Str29;\r
+ Counter:char;\r
+ begin\r
+ Spaces(input);x:=0;\r
+ while x < AMax do\r
+ begin x:=x+1;\r
+ Counter:='1';\r
+ Temp1:=A[x];\r
+ while pos(Counter,Temp1)>0 do\r
+ begin\r
+ Temp2:=copy(Temp1,1,pos(Counter,Temp1)-1);\r
+ if(pos(' '+Temp2+' ',input)>0)then\r
+ begin\r
+ Word:=Temp2;\r
+ Md:=x;if Md=2 then Md:=1;\r
+ x:=AMax;Counter:='8';\r
+ delete(input,pos(Temp2,input),length(Temp2)+1);\r
+ end;\r
+ delete(Temp1,1,pos(Counter,Temp1));\r
+ Counter:=succ(Counter);\r
+ end;\r
+ end;\r
+ QFormat(input);\r
+ end; { FindMood }\r
+\r
+function FN;{(VNP:byte) : Str29; ( Finds first Noun ) }\r
+ var Temp:Str29;\r
+ begin SF;\r
+ Temp:=n[VNP];\r
+ FN:=copy(Temp,1,pos('\',Temp)-1);\r
+ end; { FW }\r
+\r
+function Here;{Obj:byte) : Boolean;}\r
+ begin Here:=false;\r
+ if Obj in L[Prm] then Here:=true;\r
+ if(Obj=79)and(MugCon=79)and(29 in Inv)then Here:=true;\r
+ if Obj<=MMax then if(R[Obj]=Prm)or(Obj in Inv)then Here:=true;\r
+ if(Obj=58)and((3 in Inv)or(4 in Inv)or(R[4]=Prm)or(R[3]=Prm))then Here:=true;\r
+ end;\r
+\r
+function Present : Boolean;\r
+ label JUMP;\r
+ begin Present:=false; x:=0;\r
+ if not(Vb in [17,18,37,39]) then\r
+ if N1<>Null then\r
+ if Here(N1) then\r
+ if N2<>Null then\r
+ if Here(N2) then Present:=true\r
+ else writeln('You can''t see any ',FN(N2),' here.')\r
+ else Present:=true\r
+ else writeln('You can''t see any ',FN(N1),' here.')\r
+ else Present:=true\r
+ else\r
+ begin JUMP: x:=x+1;\r
+ if x<=NMax then\r
+ if x in NounSet then\r
+ if Here(x) then goto JUMP\r
+ else begin writeln('You can''t see any ',FN(x),' here.');end\r
+ else goto JUMP\r
+ else Present:=true\r
+ end\r
+ end; { Present }\r
+\r
+procedure Convert(var n:byte;Max:byte);\r
+ begin\r
+ case Max of\r
+ 1:case n of { Verbs }\r
+ 12:n:=11; 14:n:=13; 23:n:=22; 27:n:=26;\r
+ 29:n:=28; 34:n:=33; 36:n:=35; 38:n:=37; 40:n:=39; 43:n:=42; 45:n:=44;\r
+ 52:n:=51; 55:n:=54; 57,58:n:=56; 60,61:n:=59; 63:n:=62;\r
+ end;\r
+ 2:case n of { Nouns }\r
+ 13..15:n:=12; 21:n:=20; 33:n:=32; 36:n:=35; 39:n:=38; 45:n:=44;\r
+ 50:n:=49; 53:n:=52; 65:n:=64; 67:n:=66; 70:n:=69; 76,77:n:=75;\r
+ 97:n:=96; 101,102:n:=100; 114:n:=113; 117:n:=116; 63:n:=62;\r
+ 27:n:=26; 57:n:=56; 61:n:=60; 91:n:=90; 105..108:n:=109; 31:n:=28;\r
+ 133:n:=46; 84:if Prm>21 then n:=128; 115:if Prm=28 then n:=112;\r
+ 58:if Prm=52 then n:=64;\r
+ end;\r
+ 3:case n of { Prepositions }\r
+ 2:n:=1; 4:n:=3; 8:n:=7 ;\r
+ end;\r
+ end;\r
+ end; { Convert }\r
+\r
+procedure FindWord( var I : Str130; { input string }\r
+ var VNP : byte; { flags which # word found }\r
+ var Word : Str29; { stores last word found }\r
+ Max : byte); { check which list? }\r
+ const Slash = '\';\r
+ var j,ps:byte;\r
+ Temp1,Temp2:Str29;\r
+ begin\r
+ QFormat(I); Spaces(I); J:=0;\r
+ while (j<m[Max]) do\r
+ begin\r
+ j:=j+1;\r
+ case Max of 1:Temp1:=v[j]; 2:Temp1:=n[j]; 3:Temp1:=p[j] end;\r
+ ps:=pos(Slash,Temp1);\r
+ while ps>0 do\r
+ begin\r
+ Temp2:=copy(Temp1,1,ps-1);\r
+ if(copy(I,1,length(Temp2)+2)=' '+Temp2+' ')then\r
+ begin { Match Found }\r
+ VNP:=j;\r
+ Convert(VNP,Max);\r
+ Word:=Temp2;\r
+ delete(I,1,length(Temp2)+1);\r
+ case Max of 1:VStr:=Word; 2:NStr:=Word end;\r
+ j:=m[Max];\r
+ Temp1:='X';\r
+ end;\r
+ delete(Temp1,1,ps);\r
+ ps:=pos(Slash,Temp1);\r
+ end;\r
+ end; { main loop }\r
+ QFormat(I);\r
+ end; { FindWord }\r
+\r
+procedure Dictionary(IfFound,SkipList:byte);\r
+ var StopLoopFlag:byte;\r
+ begin VNP:=Null; list:=1; StopLoopFlag:=1;\r
+ while(list<4)and(StopLoopFlag=1)do\r
+ begin\r
+ if list=SkipList then list:=list+1\r
+ else\r
+ begin\r
+ FindWord(input,VNP,Word,list);\r
+ if(VNP<>Null)then\r
+ begin EFlag:=IfFound;list:=list-1;StopLoopFlag:=0;end;\r
+ list:=list+1;\r
+ end\r
+ end;\r
+ if(EFlag<>IfFound)then\r
+ begin\r
+ EFlag:=5;input:=input+' ';\r
+ Word:=copy(input,1,pos(' ',input)-1);\r
+ if(pos(' '+Word+' ',' top directi next some from is under underne '+\r
+ 'leaning but speak pay ')>0)then\r
+ EFlag:=IfFound\r
+ else If Word[1] in['0','1','2','3','4','5','6','7','8','9'] then EFlag:=17;\r
+ if IfFound=14 then EFlag:=14;\r
+ QFormat(input);\r
+ end;\r
+ end; { Dictionary }\r
+\r
+procedure RL;\r
+ begin SF;\r
+ if(pointer<>StoreL)then\r
+ begin StoreL:=pointer;\r
+ seek(L1,pointer);\r
+ read(L1,Text3)\r
+ end;\r
+ writeln(Text3);\r
+ end; { Read Line }\r
+\r
+procedure RS;\r
+ begin SF;\r
+ if(pointer<>StoreS)then\r
+ begin StoreS:=pointer;\r
+ seek(S1,pointer);\r
+ read(S1,Text4)\r
+ end;\r
+ writeln(Text4);\r
+ end; { Read Special }\r
+\r
+procedure RR;\r
+ begin SF;\r
+ if(pointer<>StoreR)then\r
+ begin StoreR:=pointer;\r
+ seek(R1,pointer);\r
+ seek(R2,pointer);\r
+ read(R1,Text1);\r
+ read(R2,Text2);\r
+ end;\r
+ writeln(Text1,Text2);\r
+ end; { Read Room }\r
+\r
+procedure RB;\r
+ var Block:Str255;\r
+ Tstart,TStop:Str19;\r
+ begin SF; Col(Colour,7);\r
+ str(Pointer-1,TStart);\r
+ str(Pointer,TStop);\r
+ TStart:='('+TStart+')';\r
+ TStop:='('+TStop+')';\r
+ if old>=Pointer then reset(T1);\r
+ old:=Pointer+1;\r
+ repeat readln(T1,Block) until Block=TStart;\r
+ repeat\r
+ readln(T1,Block);\r
+ if(Block<>TStop)then writeln(Block)\r
+ until Block=TStop; col(11,7);\r
+ end;\r
+\r
+procedure RB2;\r
+ var Block:Str255;\r
+ Tstart,TStop:Str19;\r
+ begin SF; Col(Colour,7);\r
+ str(Pointer-1,TStart);\r
+ str(Pointer,TStop);\r
+ TStart:='('+TStart+')';\r
+ TStop:='('+TStop+')';\r
+ if old2>=Pointer then reset(T2);\r
+ old2:=Pointer+1;\r
+ repeat readln(T2,Block) until Block=TStart;\r
+ repeat\r
+ readln(T2,Block);\r
+ if(Block<>TStop)then writeln(Block)\r
+ until Block=TStop; col(11,7);\r
+ end;\r
+\r
+overlay procedure Won;\r
+ const W=800;H=400;Q=200;T=131;\r
+ label JUMP;\r
+ begin writeln;\r
+ gotoxy(1,20);for x:=1 to 5 do\r
+ begin writeln;delay(99);sound(x*50);Bor(x,7)end;\r
+ gotoxy(1,15);col(4,15);bak(1,7);\r
+ writeln('#######################################',\r
+ '#######################################');\r
+ delay(99);sound(300);Bor(6,0);\r
+ gotoxy(1,16);for x:=1 to 3 do begin\r
+ write('# ',\r
+ ' #');\r
+ delay(99);sound(300+(x*50));Bor(x+8,15)end;gotoxy(1,19);\r
+ write('#######################################',\r
+ '#######################################');\r
+ delay(99);sound(500);Bor(14,0);\r
+ gotoxy(26,17);col(31,31);\r
+ write('Y O U H A V E W O N ! !');delay(99);sound(550);\r
+ gotoxy(1,20);bak(0,0);Bor(2,7);writeln;delay(99);nosound;\r
+ for x:=1 to 12 do begin writeln;delay(80)end;\r
+ gotoxy(1,9);Col(9,9);\r
+ writeln(' S U P E R N O V A');writeln;Col(11,7);\r
+ writeln(' Programmed by . . . . . . . . . . . . . . . . . . . . . Scott Miller');\r
+ writeln(' Story by . . . . . . . . . . . . . . . . . . . . . . . Scott Miller');\r
+ writeln(' Additional story development. . . . . . . . . . . . . . . Terry Nagy');\r
+ writeln;writeln;\r
+ Vb:=78;Call13;writeln;writeln;Col(3,7);\r
+ write('Press any hey to quit...');\r
+ tune(2,8,q);tune(2,8,q);tune(3,1,w);\r
+ repeat\r
+ tune(2,8,q);tune(2,8,q);\r
+ tune(3,1,h);tune(2,12,h);tune(2,10,h);tune(2,8,q);tune(2,8,q);\r
+ tune(3,1,w);tune(2,8,t);tune(2,8,t);tune(2,8,t);\r
+ if keypressed then goto JUMP;\r
+ 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
+ tune(3,3,w);\r
+ if keypressed then goto JUMP;\r
+ tune(2,10,q);tune(2,10,q);\r
+ tune(3,3,h);tune(3,1,h);tune(2,12,h);tune(2,10,q);tune(2,10,q);\r
+ if keypressed then goto JUMP;\r
+ tune(3,3,w);tune(2,10,t);tune(2,10,t);tune(2,10,t);\r
+ 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
+ tune(3,1,w);\r
+ until keypressed;\r
+ JUMP: read(kbd,CFlag);\r
+ window(1,1,80,25);clrscr;gotoxy(2,2);Col(31,31);Bor(0,0);Cur(1);Bak(2,0);\r
+ writeln('Congratulations!');\r
+ HALT;\r
+ end; { Won }\r
+\r
+overlay procedure PlayerInput(var LINE:Str130);\r
+ label JUMP;\r
+ procedure Key(k:Str19); begin Line:=Line+k;QFlag:=true;write(k)end;\r
+ begin\r
+ with Result do begin\r
+ WRITELN; { Main Space In Game }\r
+ if(length(Line)=0)then\r
+ begin\r
+ bak(4,7);col(14,0);\r
+ window(1,1,80,22);\r
+ gotoxy(8,2);write(Tic,' ');\r
+ gotoxy(35-(length(RN[Prm])div 2),2);\r
+ write(' ',RN[Prm],' ');\r
+ gotoxy(75,2);write(' ');gotoxy(75,2);write(Sc,' ');\r
+ bak(7,7);\r
+ col(1,0);gotoxy(22,3);\r
+ if PStat=[] then write('Healthy') else write(' * ');\r
+ col(15,0);gotoxy(33,3);\r
+ if 2 in PStat then begin col(31,16);write('Hungry')end\r
+ else write(' * ');\r
+ col(4,0);gotoxy(43,3);\r
+ if 3 in PStat then begin col(20,16);write('Sick')end\r
+ else write(' * ');\r
+ col(0,0);gotoxy(51,3);\r
+ if 4 in PStat then begin col(16,16);write('Injured')end\r
+ else write(' * ');\r
+ col(6,0);gotoxy(62,3);\r
+ if 5 in PStat then begin col(22,16);write('Tired')end\r
+ else write(' * ');\r
+ col(5,0);gotoxy(71,3);\r
+ if 6 in PStat then begin col(21,16);write('Thirsty')end\r
+ else write(' * ');\r
+ bak(0,0);window(2,5,79,24);\r
+ if en(66)then begin gotoxy(1,20);goto JUMP;end;\r
+ gotoxy(1,20);col(28,31);writeln(chr(175));\r
+ Cur(1);\r
+ col(14,7);gotoxy(3,19);\r
+ QFlag:=false;\r
+ repeat\r
+ ax:=0;\r
+ intr($16,result);\r
+ sound(99);nosound;case Region of 4:sound(20);5:sound(60)end;\r
+ case chr(Lo(ax)) of\r
+ ^h:begin\r
+ if(wherex=1)and(wherey=20)then\r
+ begin window(1,1,80,25);gotoxy(80,23)end;\r
+ if length(Line)>0 then write(^h,' ',^h);\r
+ delete(Line,length(Line),2);\r
+ window(2,5,79,24);\r
+ end;\r
+ ^m:QFlag:=true\r
+ else\r
+ begin\r
+ if(Lo(ax)>0)and(length(Line)<110)then\r
+ begin write(chr(Lo(ax)));Line:=Line+chr(Lo(ax));end\r
+ else { read scan }\r
+ begin\r
+ case hi(ax) of\r
+ 59:key('Save'); 71:key('Northwest');\r
+ 60:key('Restore'); 73:key('Northeast');\r
+ 61:key('R D'); 79:key('Southwest');\r
+ 62:key('Look'); 81:key('Southeast');\r
+ 63:key('Get all'); 82:key('Down');\r
+ 64:key('Drop all'); 83:key('Up');\r
+ 65:key('Score'); 104:begin QFlag:=true;RR(0)end;\r
+ 66:key('Inventory');\r
+ 67:key('Wait');\r
+ 68:begin Line:='';key('Repeat')end;\r
+ 94,30:key('by Scott Miller');\r
+ 95,47:key('Version A Dec 9, 85');\r
+ end;\r
+ if Prm in[1..7] then\r
+ case hi(ax) of\r
+ 72:key('Fore'); 75:key('Port'); 77:key('Starboard'); 80:key('Aft')\r
+ end\r
+ else\r
+ case hi(ax) of\r
+ 72:key('North'); 75:key('West'); 77:key('East'); 80:key('South')\r
+ end\r
+ end\r
+ end\r
+ end; {case}\r
+ until QFlag=true;\r
+ Cur(3);\r
+ gotoxy(1,19);col(5,7);write(chr(175));col(11,7);gotoxy(1,20);\r
+ if length(Line)>76 then writeln;\r
+ LowerCase(Line);Spaces(Line);\r
+ if(pos(' r ',Line)>0)or(pos(' repeat ',Line)>0)then PreFormat(Line);\r
+ if(Line='r')or(Line='repeat')then Line:=Again else Again:=Line;\r
+ Spaces(Line);\r
+ while pos(' then ',Line)>0 do\r
+ begin\r
+ x:=pos(' then ',Line);delete(Line,x,5);insert('.',Line,x)\r
+ end;\r
+ ChopSeven(Line);\r
+ PreFormat(Line);\r
+ end;\r
+ if(pos('.',Line)>0)then\r
+ begin { SEPERATES LINE INTO SINGLE INPUTS }\r
+ input:=copy(Line,1,pos('.',Line));\r
+ delete(Line,1,pos('.',Line));\r
+ delete(input,pos('.',input),1);\r
+ PreFormat(input);\r
+ end\r
+ else\r
+ begin\r
+ input:=Line; Line:='';\r
+ end; { END OF LINE SEPERATION }\r
+ Spaces(input);\r
+ while pos(' it ',input)>0 do\r
+ begin x:=pos(' it ',input)+1;delete(input,x,2);insert(LastNoun,input,x);\r
+ PreFormat(input);ChopSeven(input);\r
+ end;\r
+ while pos(' them ',input)>0 do\r
+ begin x:=pos(' them ',input)+1;delete(input,x,4);insert(LastNoun,input,x);\r
+ PreFormat(input);ChopSeven(input);\r
+ end;\r
+ QFormat(input);\r
+ col(11,7);\r
+ JUMP:\r
+ end; { of with statement }\r
+ end; { PlayerInput }\r
+\r
+overlay procedure Title;\r
+ begin\r
+ clrscr;textcolor(7);Color:=true;\r
+ if ParamCount=0 then begin\r
+ write('Do you want ');textcolor(15);write('C');textcolor(7);\r
+ write('olor or ');textcolor(15);write('B');textcolor(7);\r
+ write('lack and white? ');textcolor(15);read(kbd,CFlag);\r
+ if(upcase(CFlag)='B')or(upcase(CFlag)='M')then\r
+ begin Color:=false;write('Monochrome')end\r
+ else write('Color');delay(300);\r
+ end\r
+ else\r
+ begin input:=ParamStr(1);CFlag:=input[1];\r
+ if(CFlag='/')and(length(input)>1)then CFlag:=input[2];\r
+ if(upcase(CFlag)='B')or(upcase(CFlag)='M')then\r
+ begin Color:=false;writeln('Monochrome screen option...')end\r
+ else writeln('Color screen option...');delay(999)\r
+ end;\r
+ clrscr;textmode(BW80);\r
+ Cur(3);\r
+\r
+ {**** Public Domain title screen ****}\r
+ Col(9,9);gotoxy(1,1);\r
+ cn('S U P E R N O V A');\r
+ Col(9,7);gotoxy(1,3);\r
+ cn('Published by');\r
+ gotoxy(1,5);\r
+ cn('APOGEE SOFTWARE PRODUCTIONS');\r
+ writeln;\r
+ Col(11,7);\r
+ cn('This game is placed in the public domain for your enjoyment. Please do');\r
+ cn('not abuse this product or the author''s rights.');\r
+ writeln;\r
+ cn('If you enjoy this game the author asks that you contribute $10 (by check).');\r
+ cn('This payment will encourage the author to create similar games and will');\r
+ cn('help compensate him for the several years work that went into Supernova.');\r
+ cn('This fee will also register the payer for telephone support and clues.');\r
+ writeln;\r
+ Col(14,15);\r
+ writeln('Please make checks payable to: Scott Miller');\r
+ writeln;\r
+ writeln('Scott Miller (214) 240-0614');\r
+ writeln('4206 Mayflower Drive');\r
+ writeln('Garland, TX 75043');\r
+ writeln;\r
+ writeln('Also call for help: Terry Nagy (214) 271-3065');\r
+ writeln;\r
+ Col(11,7);delay(7000);\r
+ cn('Thanks, enjoy the game...');\r
+\r
+ Col(7,7);gotoxy(27,25);delay(999);\r
+ write('Press any key to continue.');repeat;begin;end;until keypressed;\r
+ read(kbd,CFlag);bak(1,0);clrscr;\r
+ {**** Main SUPERNOVA title screen ****}\r
+\r
+ Bor(1,0);Col(15,15);Bak(4,0);\r
+ for x:=1 to 80 do\r
+ begin gotoxy(x,1);write(chr(205));gotoxy(x,24);write(chr(205))end;\r
+ for y:=1 to 24 do\r
+ begin gotoxy(1,y);write(chr(186));gotoxy(80,y);write(chr(186))end;\r
+ gotoxy(1,1);write(chr(201)); gotoxy(80,1);write(chr(187));\r
+ gotoxy(1,24);write(chr(200)); gotoxy(80,24);write(chr(188));\r
+ Bak(1,0);\r
+ Col(2,7);gotoxy(1,10);cn('Copyright 1987 Scott Miller');\r
+ Col(14,7);gotoxy(1,12);cn('Version B');\r
+ Col(7,7);gotoxy(1,15);\r
+ cn('Programmed by Scott Miller');\r
+ cn('Story by Scott Miller and Terry Nagy');\r
+ gotoxy(1,23);Col(3,7);\r
+ cn('Press any key to continue.');\r
+ repeat\r
+ gotoxy(32,8);\r
+ if Color then textcolor(random(16))\r
+ else case random(3) of 0:textcolor(0); 1:textcolor(7); 2:textcolor(15)end;\r
+ write('S U P E R N O V A');\r
+ until keypressed;\r
+ read(kbd,CFlag);\r
+ if Color then textmode(C80)else textmode(BW80);\r
+ end; { Title }\r
+\r
+overlay procedure Init1;\r
+ label Abort;\r
+ begin ABORT:\r
+ Bor(0,0);bak(0,0);clrscr;nosound;\r
+ Cur(3);randomize;\r
+ GetDir(0,Word);Log:=Word[1];\r
+ for x:=1 to 20 do begin sound(x*9);delay(x*2)end;nosound;\r
+ gotoxy(1,9);y:=0;col(14,7);Identity:='';\r
+ Cn('Please enter your identity code name:');col(12,15);\r
+ repeat i:=random(maxint) until keypressed;\r
+ repeat read(kbd,CFlag);\r
+ if(CFlag<>chr(13))then\r
+ if(CFlag<>^h)then Identity:=Identity+upcase(CFlag)\r
+ else delete(Identity,length(Identity),2);\r
+ gotoxy(1,11);Cn(' '+Identity+' ');sound(50);delay(50);nosound;\r
+ until CFlag=chr(13);\r
+ col(10,7);gotoxy(1,7);\r
+ if identity<>'' then\r
+ Cn(' IDENTITY CODE ACCEPTED--YOU MAY PROCEED '+Identity)\r
+ else begin\r
+ col(25,31);Bor(4,7);Cn('IDENTITY CODE REJECTED--ABORTING SEQUENCE')end;\r
+ LowerCase(Identity);ChopSeven(Identity);\r
+ delay(1500);\r
+ if Identity='' then goto ABORT;\r
+ assign(L1,'L1');\r
+ assign(C1,'C1');\r
+ assign(S1,'S1');\r
+ assign(R1,'R1');assign(R2,'R2');\r
+ assign(T1,'SM');assign(T2,'B1');\r
+ reset(R1);reset(R2);\r
+ reset(S1);reset(L1);reset(C1);\r
+ end; { Init1 }\r
+\r
+overlay procedure Init2;\r
+ begin\r
+ col(7,15);bak(1,7);\r
+ for x:=1 to 80 do\r
+ begin gotoxy(x,1);write(chr(205));gotoxy(x,24);write(chr(205))end;\r
+ gotoxy(80,24);write(chr(190));gotoxy(1,24);write(chr(212));\r
+ gotoxy(1,4);InsLine;\r
+ for x:=2 to 24 do\r
+ begin gotoxy(1,x);write(chr(179));gotoxy(80,x);write(chr(179))end;\r
+ gotoxy(1,4);write(chr(198));for x:=2 to 79 do\r
+ begin gotoxy(x,4);write(chr(205))end;write(chr(181));\r
+ gotoxy(1,1);write(chr(213));gotoxy(80,1);write(chr(184));\r
+ bak(4,7);col(14,0);gotoxy(2,2);\r
+ for x:=1 to 78 do write(' ');\r
+ gotoxy(2,2);write('Move');\r
+ gotoxy(68,2);write('Score');\r
+ bak(7,7);gotoxy(2,3);\r
+ for x:=1 to 78 do write(' ');\r
+ bak(5,7);col(15,0);\r
+ gotoxy(2,3);write('Player Condition:');\r
+ bak(0,0);\r
+ gotoxy(1,14);col(14,7);\r
+ cn('Working 14 hours a day in the core of some dusty, smelly mine');\r
+ cn('is not your idea of the perfect lifestyle.');\r
+ cn('Barre-An is a dust ball in space, its only salvation being that it is');\r
+ cn('rich in precious barre-an metal. Or used to be. Nowadays the mines');\r
+ cn('don''t seem so generous, which is why you''re looking for a more');\r
+ cn('profitable venture.');\r
+ cn('A break, that''s all you ask for, maybe today you figure...');\r
+ writeln;\r
+ end; { Init2 }\r
+\r
+overlay procedure Init3;\r
+ begin\r
+ Line :='';\r
+ Again :='z';\r
+ LastNoun:='mug';\r
+ Vb :=Null;\r
+ Prm :=8;\r
+ Sc :=0;\r
+ Tic :=0;\r
+ PStat :=[6];\r
+ Events :=[];\r
+ for o :=1 to MMax do r[o]:=Null;\r
+ Inv :=[3,8];\r
+ Mov :=[1..29];\r
+ AlienRm :=Null;\r
+ FriendRm:=91;\r
+ Brief :=[];\r
+ Wear :=[];\r
+ MugCon :=99;\r
+ FoodCon :=4;\r
+ SatchCon:=6;\r
+ HolstCon:=Null;\r
+ NicheCon:=Null;\r
+ SinkRm :=Null;\r
+ PyraCon :=Null;\r
+ Serum :=Null;\r
+ HingeCon:=9;\r
+ PodumCon:=18;\r
+ RobotCon:=12;\r
+ Socket :=[22..25];\r
+ CodeSet :=7;\r
+ ScrnSet :=1;\r
+ Floor :=1;\r
+ Region :=1;\r
+ TFlag :=1;\r
+ Old :=250;\r
+ Old2 :=Old;\r
+ Maze :=true;\r
+ Drive :='A';\r
+ StoreR:=-1;StoreS:=-1;StoreL:=-1;StoreC:=-1;{ Stores Last Read File Number }\r
+ Dir[1]:='NORTH';Dir[2]:='SOUTH';Dir[3]:='EAST';Dir[4]:='WEST';\r
+ Dir[5]:='NORTHEAST';Dir[6]:='NORTHWEST';\r
+ Dir[7]:='SOUTHEAST';Dir[8]:='SOUTHWEST';\r
+ m[1]:=VMax;m[2]:=NMax;m[3]:=PMax;\r
+ for x :=1 to TMax do T[x]:=Null;\r
+ T[2] :=0;\r
+ T[3] :=70; { Hunger }\r
+ T[4] :=26; { Thirst }\r
+ T[5] :=85; { Sleep (No relation to the T[2] sleep timer!) }\r
+ NoNounOnly :=[1..8,15,16,30,77..79,82,85..87,95];\r
+ OneNounMaybe:=[9..14,25,32,46,59..60,66..71,80,81,90,91];\r
+ ToNounOnly :=[33,49,64,88,93];\r
+ ToNounMaybe :=[19,41..44,48,50,53,54,74..76,89,90,92,94];\r
+ { NOTE: All other verbs would be OneNounOnly! }\r
+ window(2,5,79,24);gotoxy(1,19);\r
+ end; { Init3 }\r
+\r
+overlay procedure Save;\r
+ label JUMPABORT,JUMPBACK;\r
+ var DiskTest:file;\r
+ begin SF; JUMPBACK: nosound; for x:=1 to 20 do writeln;\r
+ Bor(2,7);CFlag:=Drive;Cur(2);\r
+ gotoxy(1,2);\r
+ write('Which disk drive (default ',Up(Drive),':)? ');\r
+ col(14,15);buflen:=1;readln(Drive);col(11,7);\r
+ Drive:=upcase(Drive);if not(Drive in['A','B'])then Drive:=CFlag;\r
+ gotoxy(1,5);\r
+ writeln('Make sure your SAVE/RESTORE disk is in disk drive ',up(Drive),':');\r
+ writeln;writeln;\r
+ write('SAVE under what file name (''',up('/'),''' aborts SAVE)? ');\r
+ buflen:=8;col(14,15);readln(input);col(11,7);\r
+ Cur(3);\r
+ while pos(' ',input)>0 do delete(input,pos(' ',input),1);\r
+ while pos('.',input)>0 do delete(input,pos('.',input),1);\r
+ while pos(':',input)>0 do delete(input,pos(':',input),1);\r
+ if pos('/',input)>0 then\r
+ begin writeln;writeln(up('SAVE ABORTED'));goto JUMPABORT;end;\r
+ LowerCase(input);\r
+ if(pos('list',input)>0)or(pos('dir',input)>0)or(pos('file',input)>0)then\r
+ begin Directory;goto JUMPBACK;end;\r
+ if length(input)=0 then input:='LASTSAVE';writeln;writeln;\r
+ writeln('The game file ',Up(Input),' is now being saved on disk drive ',\r
+ up(Drive),':...');\r
+ input:=Drive+':'+input;\r
+ assign(Objects,input+'.sm1');\r
+ rewrite(Objects);\r
+ for x:=0 to RMax do write(Objects,L[x]);\r
+ close(Objects);\r
+ assign(Things,input+'.sm2');\r
+ rewrite(Things);\r
+ write(Things,Prm,Region,MugCon,FoodCon,SatchCon,NicheCon,PyraCon,\r
+ HingeCon,PodumCon,AlienRm,FriendRm,SinkRm,Serum,TFlag,\r
+ RobotCon,CodeSet,ScrnSet,HolstCon);\r
+ for x:=1 to MMax do write(Things,R[x]);\r
+ close(Things);\r
+ assign(Timers,input+'.sm3');\r
+ rewrite(Timers);\r
+ write(Timers,Tic,Sc,RC,Floor);\r
+ for x:=1 to TMax do write(Timers,T[x]);\r
+ close(Timers);\r
+ with SetSave do\r
+ begin aInv:=Inv;aPStat:=PStat;aEvents:=Events;\r
+ aSocket:=Socket;aWear:=Wear;end;\r
+ assign(Sets,input+'.sm4');\r
+ rewrite(Sets);\r
+ write(Sets,SetSave);\r
+ close(Sets);\r
+ writeln;writeln;delete(input,1,2);\r
+ writeln('Your present game location is now SAVED under the name ',\r
+ up(input),'.');\r
+ writeln; JUMPABORT: writeln;\r
+ writeln('Please make sure the SUPERNOVA disk is in drive ',up(Log),':');\r
+ writeln;writeln;Pause;\r
+ assign(DiskTest,'Nova.com');\r
+ {$I-}\r
+ reset(DiskTest);\r
+ {$I+}\r
+ if IOResult<>0 then\r
+ begin Col(15,15);close(DiskTest);write(^g);goto JUMPABORT;end;\r
+ close(DiskTest);Col(11,7);\r
+ Bor(0,0);Line:='l';\r
+ case Region of 4:sound(20);5:sound(60)end\r
+ end; { SAVE }\r
+\r
+overlay procedure Restore;\r
+ label JUMP,JUMPBACK;\r
+ var DiskTest:file;\r
+ begin SF; JUMPBACK: nosound; for x:=1 to 25 do writeln;\r
+ Bor(6,7);CFlag:=Drive;Cur(2);\r
+ gotoxy(1,2);\r
+ write('Which disk drive (default ',Up(Drive),':)? ');\r
+ col(14,15);buflen:=1;readln(Drive);col(11,7);\r
+ Drive:=upcase(Drive);if not(Drive in['A','B'])then Drive:=CFlag;\r
+ gotoxy(1,5);\r
+ writeln('Make sure your SAVE/RESTORE disk is in disk drive ',up(Drive),':');\r
+ writeln;writeln;\r
+ write('RESTORE from what file name (''',up('/'),''' aborts RESTORE)? ');\r
+ buflen:=8;col(14,15);readln(input);col(11,7);\r
+ Cur(3);\r
+ while pos(' ',input)>0 do delete(input,pos(' ',input),1);\r
+ while pos('.',input)>0 do delete(input,pos('.',input),1);\r
+ while pos(':',input)>0 do delete(input,pos(':',input),1);\r
+ if pos('/',input)>0 then\r
+ begin writeln;writeln(up('RESTORE ABORTED'));goto JUMP;end;\r
+ LowerCase(input);\r
+ if(pos('list',input)>0)or(pos('dir',input)>0)or(pos('file',input)>0)then\r
+ begin Directory;goto JUMPBACK;end;\r
+ if length(input)=0 then input:='LASTSAVE';writeln;writeln;\r
+ writeln('The game file ',Up(Input),' is now being restored from drive ',\r
+ up(Drive),':...');\r
+ input:=Drive+':'+input;\r
+ assign(Objects,input+'.sm1');\r
+ {$I-}\r
+ reset(Objects);\r
+ {$I+}\r
+ if IOResult<>0 then\r
+ begin close(Objects);col(12,15);writeln;writeln;delete(input,1,2);\r
+ for x:=1 to length(input) do input[x]:=upcase(input[x]);\r
+ Cn('The file '+input+' does not exist on your SAVE/RESTORE disk!');\r
+ writeln(^g);delay(2000);col(11,7);goto JUMPBACK;\r
+ end;\r
+ reset(Objects);\r
+ for x:=0 to RMax do read(Objects,L[x]);\r
+ close(Objects);\r
+ assign(Things,input+'.sm2');\r
+ reset(Things);\r
+ read(Things,Prm,Region,MugCon,FoodCon,SatchCon,NicheCon,PyraCon,\r
+ HingeCon,PodumCon,AlienRm,FriendRm,SinkRm,Serum,TFlag,\r
+ RobotCon,CodeSet,ScrnSet,HolstCon);\r
+ for x:=1 to MMax do read(Things,R[x]);\r
+ close(Things);\r
+ assign(Timers,input+'.sm3');\r
+ reset(Timers);\r
+ read(Timers,Tic,Sc,RC,Floor);\r
+ for x:=1 to TMax do read(Timers,T[x]);\r
+ close(Timers);\r
+ assign(Sets,input+'.sm4');\r
+ reset(Sets);\r
+ read(Sets,SetSave);\r
+ close(Sets);\r
+ with SetSave do\r
+ begin Inv:=aInv;PStat:=aPStat;Events:=aEvents;\r
+ Socket:=aSocket;Wear:=aWear;end;\r
+ Add(126);\r
+ writeln;writeln;delete(input,1,2);\r
+ writeln('Your present game location is now RESTORED from the name ',\r
+ up(input),'.');\r
+ writeln; JUMP: writeln;\r
+ writeln('Please make sure the SUPERNOVA disk is in drive ',up(Log),':');\r
+ writeln;writeln;Pause;\r
+ assign(DiskTest,'Nova.com');\r
+ {$I-}\r
+ reset(DiskTest);\r
+ {$I+}\r
+ if IOResult<>0 then\r
+ begin Col(15,15);close(DiskTest);write(^g);goto JUMP;end;\r
+ close(DiskTest);Col(11,7);\r
+ Bor(0,0);\r
+ case Region of 4:sound(20);5:sound(60)end;\r
+ if Region>1 then\r
+ begin\r
+ n[84]:='reactor regulat\';\r
+ n[126]:='hinged mouth\mouth\hinge\';\r
+ end\r
+ else\r
+ begin\r
+ n[84]:='middle table\middle\';\r
+ n[126]:='bar\';\r
+ end;\r
+ if en(34)then n[18]:='glass ball\ball\glass\'\r
+ else n[18]:='dusty ball\ball\dusty\';\r
+ if Prm>79 then\r
+ begin\r
+ n[40]:='sockets\socket\';\r
+ n[82]:='laser beam\beam\laser\';\r
+ n[110]:='speaker\';\r
+ end else\r
+ begin\r
+ n[40]:='cyan button\cyan\';\r
+ n[82]:='solar map\map\solar\drawing\';\r
+ n[110]:='keyhole\';\r
+ end;\r
+ Min(128);Line:='l';\r
+ end; { RESTORE }\r
+\r
+procedure MoreThanOne;\r
+ begin\r
+ if((N1=58)or(58 in NounSet)or(N2=58))and Here(3) and Here(4) then\r
+ begin Cur(2);\r
+ repeat write('Which one, the R)usty or S)hiney key? ');\r
+ read(kbd,CFlag);writeln(CFlag);writeln until upcase(CFlag) in ['R','S'];\r
+ case upcase(CFlag) of 'R':x:=3; 'S':x:=4 end;\r
+ if N1=58 then N1:=x;\r
+ if N2=58 then N2:=x;\r
+ if 58 in NounSet then begin NounSet:=NounSet-[58];NounSet:=NounSet+[x] end;\r
+ end;\r
+ if((N1=86)or(86 in NounSet)or(N2=86))and(Prm=8)then\r
+ begin Cur(2);\r
+ repeat write('Which one, the W)estern, M)iddle or E)astern table? ');\r
+ read(kbd,CFlag);writeln(CFlag);\r
+ writeln until upcase(CFlag) in ['W','M','E'];\r
+ case upcase(CFlag) of 'W':x:=83; 'M':x:=84; 'E':x:=85 end;\r
+ if N1=86 then N1:=x;\r
+ if N2=86 then N2:=x;\r
+ if 86 in NounSet then begin NounSet:=NounSet-[86];NounSet:=NounSet+[x] end;\r
+ end;\r
+ if((N1=44)or(44 in NounSet)or(N2=44))and(Prm in[1,70])and(Vb<>28)then\r
+ begin Cur(2);\r
+ repeat write('Which one, the T)an, P)urple or C)yan button? ');\r
+ read(kbd,CFlag);writeln(CFlag);\r
+ writeln until upcase(CFlag) in ['T','P','C'];\r
+ case upcase(CFlag) of 'T':x:=41; 'P':x:=43; 'C':x:=40 end;\r
+ if N1=44 then N1:=x;\r
+ if N2=44 then N2:=x;\r
+ if 44 in NounSet then begin NounSet:=NounSet-[44];NounSet:=NounSet+[x] end;\r
+ end;\r
+ if(N1=58)and Here(3)and not(Here(4))then N1:=3;\r
+ if(N2=58)and Here(3)and not(Here(4))then N2:=3;\r
+ if(58 in NounSet)and Here(3)and not(Here(4))then\r
+ begin NounSet:=NounSet-[58];NounSet:=NounSet+[3] end;\r
+ if(N1=58)and Here(4)and not(Here(3))then N1:=4;\r
+ if(N2=58)and Here(4)and not(Here(3))then N2:=4;\r
+ if(58 in NounSet)and Here(4)and not(Here(3))then\r
+ begin NounSet:=NounSet-[58];NounSet:=NounSet+[4] end;\r
+end; { MoreThanOne }\r
+\r
+\r
+function Print(Word:Str29):Str1;\r
+ begin Print:='';writeln('--you can''t use the word ',Up(Word),' here.')end;\r
+\r
+procedure Parser_Syntax(var Input:Str130);\r
+ label JUMP1, JUMP2;\r
+begin\r
+ Word:=''; Md:=Null; Num:=Null; Code:=Null;\r
+ Vb:=Null; N1:=Null; N2:=Null; NounSet:=[];\r
+JUMP1: { Used if the player forgets the first noun. }\r
+ FFlag:=Null; Pr:=Null;\r
+JUMP2: { Used if the player forgets the second noun or preposition. }\r
+ EFlag:=Null;\r
+ FindMood(input,Word,Md);\r
+ if(length(input)>0)then\r
+ begin\r
+ FindMood(input,Word,Num);\r
+ if(Num=Null)then\r
+ begin\r
+ FindWord(input,Vb,Word,1);\r
+ if(Vb<>Null)then\r
+ if(length(input)=0)then\r
+ begin\r
+ if(Vb in NoNounOnly)or(Vb in OneNounMaybe)then EFlag:=Legal;\r
+ if EFlag<>Legal then\r
+ begin\r
+ if(Vb=35)and here(35)then begin EFlag:=Legal;N1:=35;NStr:='seat';end;\r
+ if(Vb=47)and here(6)then begin EFlag:=Legal;N1:=6;end;\r
+ if(Vb=62)and here(80)then begin EFlag:=Legal;N1:=80;end;\r
+ if(Vb=65)and here(124)then begin EFlag:=Legal;N1:=124;end;\r
+ if EFlag<>Legal then EFlag:=4\r
+ end\r
+ end\r
+ else\r
+ if(Vb in NoNounOnly)then Dictionary(3,9)\r
+ else\r
+ if not(Vb in[17,18,37,39])then { get,drop and but branch-off }\r
+ if not(Vb in[25,32,56,66..69,71,80,81])then { characters and type }\r
+ begin\r
+ if(Vb<>FFlag)then FindWord(input,N1,Word,2);\r
+ if(N1<>Null)then LastNoun:=FN(N1);\r
+ if(N1<>Null)then\r
+ if(Word<>'all')then\r
+ if(length(input)=0)then\r
+ if(Vb in ToNounOnly)then\r
+ if(VStr='fill')and(Prm=SinkRm)and(N1=29)then\r
+ begin N2:=79;Pr:=6;EFlag:=Legal;end else\r
+ if(Vb=64)and(Prm=8)and(N1 in[29,99])and(not en(21))and\r
+ here(8)then begin Pr:=6;N2:=8;EFlag:=Legal;end else\r
+ if(Vb=88)and(Prm in[9..11])and(N1=56)and here(3)then\r
+ begin Pr:=6;N2:=3;EFlag:=Legal;end\r
+ else EFlag:=15\r
+ else EFlag:=Legal\r
+ else\r
+ if(Vb in ToNounMaybe)or(Vb in ToNounOnly)then\r
+ begin\r
+ FindWord(input,Pr,Word,3);\r
+ if(Pr<>Null)then\r
+ if(length(input)=0)then\r
+ if(Vb=50)and(Pr in[1,9])then EFlag:=Legal\r
+ else EFlag:=6\r
+ else\r
+ if(Vb<>50)then { branch for turning dials }\r
+ begin\r
+ FindWord(input,N2,Word,2);\r
+ if(N2<>Null)then\r
+ if(Word<>'all')then\r
+ if(length(input)=0)then EFlag:=Legal\r
+ else Dictionary(12,9)\r
+ else EFlag:=16\r
+ else Dictionary(11,2)\r
+ end\r
+ else\r
+ begin\r
+ val(input,Code,testc);\r
+ if(testc=0)then EFlag:=Legal\r
+ else begin delete(input,1,testc-1);Dictionary(14,9);end;\r
+ end\r
+ else Dictionary(9,3)\r
+ end\r
+ else\r
+ begin Dictionary(3,9);if(List=2)then EFlag:=8;end\r
+ else EFlag:=16\r
+ else Dictionary(10,2)\r
+ end\r
+ else { Special case for TYPE, characters, etc. }\r
+ begin\r
+ QFormat(input);\r
+ EFlag:=Legal\r
+ end { of Special case for SAY, TYPE, etc. }\r
+ else { Special case for GET and DROP }\r
+ while EFlag=Null do\r
+ begin N1:=Null;\r
+ FindWord(input,N1,Word,2);\r
+ if(N1<>Null)then LastNoun:=FN(N1);\r
+ if(N1<>Null)then\r
+ if not(N1 in NounSet)then\r
+ begin\r
+ NounSet:=NounSet+[N1];\r
+ if(length(input)=0)then EFlag:=Legal\r
+ end\r
+ else EFlag:=13\r
+ else Dictionary(10,2)\r
+ end { of Special case for GET and DROP }\r
+ else Dictionary(7,1)\r
+ end\r
+ else EFlag:=2\r
+ end\r
+ else EFlag:=1;\r
+ if EFlag<>Legal then\r
+ begin Line:='';play(199,199,55);delay(70);play(60,60,55)end;\r
+ case EFlag of\r
+ 1:RL(186);\r
+ 2:writeln('The word ',up(Word),' is too many adverbs.');\r
+ 3:write('Illegal input',Print(Word));\r
+ 4:if(Vb=56)then RL(187)\r
+ else\r
+ begin\r
+ write('Noun missing--');\r
+ case Vb of\r
+ 35,62:writeln('what do you want to ',up(Word),' on?');\r
+ 65:writeln('what do you want to ',up(Word),' to?')\r
+ else writeln('what do you want to ',up(Word),'?');\r
+ end;\r
+ PlayerInput(line);\r
+ if(length(input)>0)then goto JUMP1;\r
+ end;\r
+ 5:if(length(Word)>1)then\r
+ writeln('The word ',up(Word),' is not used in this adventure.')\r
+ else\r
+ writeln('The letter ',up(Word),' is not used as shorthand in this parser.');\r
+ 6:begin\r
+ writeln('Noun missing--what do you want to ',up(VStr),up(' the '),\r
+ up(NStr),' ',up(PStr),'?');\r
+ PlayerInput(line); FFlag:=Vb;\r
+ if(length(input)>0)then goto JUMP2;\r
+ end;\r
+ 7:write('Verb missing',Print(Word));\r
+ 8:RL(188);\r
+ 9:write('Preposition expected',Print(Word));\r
+ 10:write('Noun expected',Print(Word));\r
+ 11:write('Indirect noun expected',Print(Word));\r
+ 12:write('No more input expected',Print(Word));\r
+ 13:writeln('Illegal noun used--',up(Word),' referenced more than once.');\r
+ 14:write('Number expected',Print(Word));\r
+ 15:begin\r
+ write('Preposition and noun missing--');\r
+ if(Vb in[33,48])then\r
+ writeln('where do you want to ',up(VStr),' the ',up(NStr),'?') else\r
+ if Vb=49 then\r
+ begin Pr:=1;\r
+ writeln('who do you want to ',up(VStr),' the ',up(NStr),' to?')end\r
+ else begin Pr:=6;\r
+ writeln('what do you want to ',up(VStr),' the ',up(NStr),' with?')end;\r
+ PlayerInput(line); FFlag:=Vb;\r
+ if(length(input)>0)then goto JUMP2;\r
+ end;\r
+ 16:RL(189);\r
+ 17:RL(576)\r
+ end;\r
+end; { Parser Syntax }\r
+\r
+procedure MC;{WhichChar,WatchRoom,ToRoom:byte;MessageNum:Integer}\r
+ { WhichChar refers to the character(s) being moved. }\r
+ { WatchRoom is the room the player must be in to see the responce.}\r
+ { ToRoom is the room the character(s) move to. }\r
+ { MessageNum is the message that is written if the player sees. }\r
+ begin\r
+ if(Prm=WatchRoom)then RS(MessageNum);\r
+ case WhichChar of { 1 = Aliens, 2 = Scientist }\r
+ 1:begin\r
+ L[AlienRm]:=L[AlienRm]-[124];AlienRm:=ToRoom;\r
+ L[AlienRm]:=L[AlienRm]+[124]\r
+ end;\r
+ 2:begin\r
+ L[FriendRm]:=L[FriendRm]-[123];FriendRm:=ToRoom;\r
+ L[FriendRm]:=L[FriendRm]+[123]\r
+ end\r
+ end;\r
+ SFlag:=false;\r
+ end;\r
+\r
+procedure Van;\r
+ begin\r
+ Inv:=Inv-[o];\r
+ r[o]:=Null;\r
+ L[Prm]:=L[Prm]-[o];\r
+ if o in Wear then Wear:=Wear-[o];\r
+ if o=SatchCon then SatchCon:=Null;\r
+ if o=MugCon then MugCon:=Null;\r
+ if o=16 then Min(6);\r
+ if o=NicheCon then NicheCon:=Null;\r
+ if o=PyraCon then PyraCon:=Null;\r
+ if o=HingeCon then HingeCon:=Null;\r
+ if o=PodumCon then PodumCon:=Null;\r
+ if o=16 then begin Min(37);Min(6)end;\r
+ if o=RobotCon then RobotCon:=Null;\r
+ if o in Socket then Socket:=Socket-[o];\r
+ if o=HolstCon then HolstCon:=Null\r
+ end;\r
+\r
+procedure Crazy;\r
+ begin SF; RL(random(7)+127)end;\r
+\r
+procedure NoSense;\r
+ begin RL(190) end;\r
+\r
+procedure Say(What1,What2:Str29);\r
+ begin SF; writeln('The ',What1,' is already ',What2,'.') end;\r
+\r
+{******************* END OF PARSER AND MISC. PROCEDURES *********************}\r
+\1a
\ No newline at end of file