home *** CD-ROM | disk | FTP | other *** search
/ Game Killer / Game_Killer.bin / 254.GENERAL.INC < prev    next >
Text File  |  1991-07-08  |  3KB  |  136 lines
  1. { General utility routines for corporate records }
  2.  
  3. procedure menu;
  4. begin
  5.   writeln('Choices:');
  6.   writeln('R');
  7.   writeln('N');
  8.   writeln('Q');
  9.   writeln('I');
  10. end;
  11.  
  12. function GetCommand : char;
  13. var
  14.   ch : char;
  15. begin
  16.   readln( ch );
  17.   if ch in ['a'..'z'] then
  18.     GetCommand := chr( ord(ch) - ord('a') + ord('A') )
  19.   else
  20.     GetCommand :=  ch;
  21. end;
  22.  
  23. function prompt( s : string ) : boolean;
  24. var
  25.   ch : char;
  26. begin
  27.   write( s, '?' );
  28.   read( ch );
  29.   prompt := ch in ['y','Y'];
  30. end;
  31.  
  32. function GetNewFileName( promptstring : string; default : string ) : string;
  33. { Get a valid filename.  Warn if clobbering existing file. }
  34. var
  35.   filename : string;
  36.   g        : text;
  37.   errorcode: integer;
  38.  begin
  39.   repeat
  40.     write( promptstring, '[', default, ']  ' );
  41.     readln( filename );
  42.     if filename = '' then
  43.       if default = abort then
  44.         halt
  45.       else
  46.         filename := default;
  47.     if filename = abort then
  48.       halt;
  49.     {$I-}
  50.     reset( g, filename );
  51.     {$I+}
  52.     errorCode := ioResult;
  53.     close( g );
  54.     if errorCode = 0 then 
  55.       begin
  56.         write('File already exists! ');
  57.         if prompt('Overwrite? ') then
  58.           errorcode := FileNotFound;
  59.       end; {if}
  60.   until errorcode = FileNotFound;
  61.   GetNewFilename := filename;
  62. end; {GetNewFilename}
  63.  
  64. function GetOldFileName( promptstring : string; default : string ) : string;
  65. var
  66.   filename : string;
  67.   f        : text;
  68.   errorcode: integer;
  69. begin
  70.   repeat
  71.     write( promptstring, '[', default, ']  ' );
  72.     readln( filename );
  73.     if filename = '' then
  74.       filename := default;
  75.     if filename = abort then
  76.       halt;
  77.     {$I-}
  78.     reset( f, filename );
  79.     {$I+}
  80.     errorCode := ioResult;
  81.     close( f );
  82.     if errorCode <> 0 then writeln('Error ', errorCode, ' opening file!');
  83.   until errorCode = 0;
  84.   GetOldFileName := filename;
  85. end; {GetOldFileName}
  86.  
  87. procedure skip( var f : text; n : integer);
  88. var
  89.   ch : char;
  90. begin
  91.   for n := 1 to n do
  92.     read( f, ch );
  93. end; {skip}
  94.  
  95. function ReadNumber( var f : text) : integer;
  96. { Read the next number from text file f.  If there is no next number,
  97. return 0.  Ignore commas.}
  98. var
  99.   number : integer;
  100.   ch : char;
  101.   i  : integer;
  102. begin
  103.   number := 0;
  104.   if not eof( f ) then
  105.     begin
  106.       read( f, ch );
  107.       while (ch <= ' ') and (not eof(f)) do read( f, ch );
  108.       repeat
  109.         if ch = ',' then
  110.           read( f, ch );
  111.         if ch in ['0'..'9'] then
  112.           number := number * 10 + ord( ch ) - ord( '0' );
  113.         if not eof( f ) then
  114.           read( f, ch )
  115.         else
  116.           ch := #26;
  117.       until (not (ch in ['0'..'9']));
  118.       if ch = '[' then     {hit [PAUSE]^h^h^h^h^h^h^h}
  119.         skip( f, 32 );
  120.     end;
  121.   ReadNumber := number;
  122. end;
  123.  
  124. procedure enqueue( var c : corp; p : planet );
  125. var
  126.   temp : planetptr;
  127. begin
  128.   c.NumPlanets := c.NumPlanets + 1;
  129.   new( temp );
  130.   temp^ := p;
  131.   if c.numplanets=0 then 
  132.     c.territory.front := temp
  133.   else
  134.     c.territory.rear^.next := temp;
  135.   c.territory.rear := temp;
  136. end;