X-Git-Url: https://jxself.org/git/?p=supernova.git;a=blobdiff_plain;f=src%2FDEFAULT.PAS;fp=src%2FDEFAULT.PAS;h=acf7ce391d993f005f6fd4661fe1c7f65d4edb30;hp=c7107f29f4b7f9f56e995e26593caa15c6abb0f5;hb=c39dca3ccc60c8967191a68325d59ef3fd293bae;hpb=1c5af91cf03243a3bdc9c5ff8d82e3afaf4ee571

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