{//-------------------------------------------------------------------------}\r
{/* }\r
+{Copyright (C) 2014 Jason Self <j@jxself.org> }\r
+{ }\r
+{This file is free software: you may copy, redistribute and/or modify it }\r
+{under the terms of the GNU Affero General Public License as published by }\r
+{the Free Software Foundation, either version 3 of the License, or (at your }\r
+{option) any later version. }\r
+{ }\r
+{This file is distributed in the hope that it will be useful, but WITHOUT }\r
+{ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or }\r
+{FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License}\r
+{for more details. }\r
+{ }\r
+{You should have received a copy of the GNU Affero General Public License }\r
+{along with this program; if not, see https://gnu.org/licenses or write to: }\r
+{ Free Software Foundation, Inc. }\r
+{ 51 Franklin Street, Fifth Floor }\r
+{ Boston, MA 02110-1301 }\r
+{ USA }\r
+{ }\r
+{This file incorporates work covered by the following copyright and }\r
+{permission notice: }\r
+{ }\r
{Copyright (C) 1990, 2009 - Apogee Software, Ltd. }\r
{ }\r
{This file is part of Supernova. Supernova is free software; you can }\r
end {main case}\r
end; { Default0 }\r
{----------}\r
-overlay procedure Default1;\r
+procedure Default1;\r
begin\r
case Vb of\r
\r
end; {main case}\r
end; { Default1 }\r
{----------}\r
-overlay procedure Default2;\r
- label JUMP;\r
+procedure Default2;\r
+{ label JUMP;}\r
begin\r
case Vb of\r
\r
'should first use the');writeln('SAVE command.');\r
write('Are you still sure you want to QUIT? ');\r
Cur(2);\r
- read(kbd,CFlag);\r
+ CFlag:=Readkey;\r
if upcase(CFlag)='Y' then\r
begin\r
RL(12);delay(2200);\r
- close(R1);close(R2);close(S1);close(L1);close(C1);close(T1);close(T2);\r
+ close(R1);close(R2);close(S1);close(L1);close(C1);\r
+ {$I-}\r
+ close(T1);if IOResult<>0 then begin end;\r
+ close(T2);if IOResult<>0 then begin end;\r
+ {$I+}\r
+ DoneScrKbd;\r
window(1,1,80,25);nosound;clrscr;Cur(1);Bor(0,0);gotoxy(2,2);\r
Col(31,16);Bak(4,7);writeln('Good-bye!');halt;\r
end\r
end; {main case}\r
end; { Default2 }\r
{----------}\r
-overlay procedure Default3;\r
+procedure Default3;\r
begin SFlag:=false;\r
case Vb of\r
\r
end {main case}\r
end; { Default3 }\r
{----------}\r
-overlay procedure Default4;\r
+procedure Default4;\r
begin\r
case VB of\r
\r
end; {main case}\r
end; { Default4 }\r
{----------}\r
-overlay procedure Default5;\r
+procedure Default5;\r
label JUMP,JUMP1;\r
begin\r
case Vb of\r
end; {main case}\r
end; { Default5 }\r
{----------}\r
-overlay procedure Default6;\r
+procedure Default6;\r
function Word(W:Str29):boolean;\r
begin if pos(' '+W+' ',input)>0 then Word:=true else Word:=false end;\r
begin\r
end; {main case}\r
end; { Default6 }\r
{----------}\r
-overlay procedure Default7;\r
+procedure Default7;\r
begin\r
case Vb of\r
\r
93:if Pr=6 then\r
if(N2 in Mov)or(N2=60)then\r
case N1 of\r
- 60:begin Cur(2);write('Are you sure? ');read(kbd,CFlag);Cur(3);writeln;\r
+ 60:begin Cur(2);write('Are you sure? ');CFlag:=Readkey;Cur(3);writeln;\r
if upcase(CFlag)='Y' then begin RL(488);Add(128);end\r
else writeln('Whew!')end;\r
123:RL(465);\r
end; {main case}\r
end; { Default7 }\r
{----------}\r
-overlay procedure Default8;\r
+procedure Default8;\r
label JUMP;\r
begin\r
case Vb of\r
end; {main case}\r
end; { Default8 }\r
{----------}\r
-overlay procedure Default9;\r
+procedure Default9;\r
label JUMP;\r
begin\r
case Vb of\r
29:if MugCon<>Null then writeln('The mug contains ',FN(MugCon),'.')\r
else RL(111);\r
35:if NStr='toilet' then RL(114)else RL(113);\r
- 7,10,26,28,32,62,64,69,98,113:writeln('The ',NStr,' is empty.');\r
+ 10,26,28,32,62,64,69,98,113:writeln('The ',NStr,' is empty.');\r
119:RL(112);\r
103..109,115,118:if Prm=63 then RL(113)else RL(115)\r
else RL(113)\r
if not en(15) then\r
begin Add(15);RS(30);\r
Cur(2);\r
- write('Do you still wish to see the clue? ');read(kbd,CFlag);writeln;\r
+ write('Do you still wish to see the clue? ');CFlag:=Readkey;writeln;\r
if upcase(CFlag)='N' then\r
begin writeln('OK, no clue will be shown.');goto JUMP;end\r
end;\r
end; {main case}\r
end; { Default9 }\r
{----------}\r
-overlay procedure Default10;\r
+procedure Default10;\r
begin\r
case Vb of\r
\r
end; {main case}\r
end; { Default10 }\r
{----------}\r
-overlay procedure Default11;\r
+procedure Default11;\r
begin\r
case Vb of\r
\r
{ RESTART }\r
86:begin Bor(1,0);Cur(2);\r
write('Are you sure you want to restart your game? ');\r
- read(kbd,CFlag);\r
+ CFlag:=Readkey;\r
if upcase(CFlag)<>'Y' then RL(169)\r
else\r
begin RL(170);delay(2000);window(1,1,80,25);clrscr;Bor(0,0);nosound;\r
- close(R1);close(R2);close(S1);close(L1);close(C1);close(T1);close(T2);\r
- assign(R1,'nova.com');execute(R1)\r
+ close(R1);close(R2);close(S1);close(L1);close(C1);\r
+ {$I-}\r
+ close(T1);if IOResult<>0 then begin end;\r
+ close(T2);if IOResult<>0 then begin end;\r
+ {$I+}\r
+ DoneScrKbd;\r
+ Halt(ExecuteProcess(ParamStr(0),''));\r
end;Bor(0,0);\r
end;\r
\r
end; {main case}\r
end; { Default11 }\r
{----------}\r
-overlay procedure Default12;\r
+procedure Default12;\r
begin\r
case Vb of\r
\r
end; {main case}\r
end; { Default12 }\r
{----------}\r
-overlay procedure Default13;\r
+procedure Default13;\r
begin\r
case Vb of\r
\r
end; {main case}\r
end; { Default13 }\r
{----------}\r
-overlay procedure Default14;\r
+procedure Default14;\r
begin\r
case Vb of\r
\r
end; {main case}\r
end; { Default14 }\r
{----------}\r
-overlay procedure DeadMain;\r
+procedure DeadMain;\r
label JUMP;\r
begin writeln;\r
gotoxy(1,20);for x:=5 downto 1 do\r
write('Would you like to ');Col(14,15);write('S');Col(11,7);\r
write('tart a new game, ');Col(14,15);write('R');Col(11,7);\r
write('estore or ');Col(14,15);write('Q');Col(11,7);write('uit? ');\r
- read(kbd,CFlag);CFlag:=upcase(CFlag);Col(9,15);writeln(CFlag);\r
+ CFlag:=Readkey;CFlag:=upcase(CFlag);Col(9,15);writeln(CFlag);\r
play(500,500,40);Col(11,7);\r
until CFlag in['S','R','Q'];Bor(0,0);Cur(3);\r
case CFlag of\r
'S':begin RL(170);delay(1500);window(1,1,80,25);clrscr;\r
- close(R1);close(R2);close(S1);close(L1);close(C1);close(T1);close(T2);\r
- assign(R1,'nova.com');execute(R1)\r
+ close(R1);close(R2);close(S1);close(L1);close(C1);\r
+ {$I-}\r
+ close(T1);if IOResult<>0 then begin end;\r
+ close(T2);if IOResult<>0 then begin end;\r
+ {$I+}\r
+ DoneScrKbd;\r
+ Halt(ExecuteProcess(ParamStr(0),''));\r
end;\r
'R':begin Min(126);Restore;if not en(126)then goto JUMP end;\r
'Q':begin window(1,1,80,25);clrscr;Col(3,7);\r
- close(R1);close(R2);close(S1);close(L1);close(C1);close(T1);close(T2);\r
+ close(R1);close(R2);close(S1);close(L1);close(C1);\r
+ {$I-}\r
+ close(T1);if IOResult<>0 then begin end;\r
+ close(T2);if IOResult<>0 then begin end;\r
+ {$I+}\r
writeln('In ',Tic,' moves you scored ',Sc,\r
' out of a possible 1000 points.');writeln;\r
Col(31,16);Bak(1,7);writeln('Good-bye!');writeln;Cur(1);\r
projects / supernova.git / blobdiff