{ Combine.pas }
{ copyright (c) 1995 by Tom Proudfoot }

{ This program combines two NetHack record files into one file,
{ stripping out duplicate scores, and making a new, improved top 100. }
program Combine;

uses Crt, Dos;

var score_array : array[1..201] of string[255];

procedure combine_files;
var
   file_1 : text;
   file_2 : text;
   file_all : text;
   read_line : string[255];
begin
   assign(file_1, 'record.1');
   assign(file_2, 'record.2');
   assign(file_all, 'record');
   reset(file_1);
   reset(file_2);
   rewrite(file_all);
   repeat
         readln(file_1, read_line);
         if read_line <> '' then writeln(file_all, read_line);
   until read_line = '';
   repeat
         readln(file_2, read_line);
         if read_line <> '' then writeln(file_all, read_line);
   until read_line = '';
   close(file_1);
   close(file_2);
   close(file_all);
end;

function exist(f:string):boolean;
var
  fil : file;
begin
  if f=''
    then
      begin
        exist := false;
        exit;
      end;
  assign(fil,f);
 {$i- }
  reset(fil);
  close(fil);
 {$i+ }
  exist := (ioresult=0);
end;

procedure check_for_files;
begin
   if ((exist('record.1')) and (exist('record.2'))) then exit;
   writeln;
   if exist('record.1') <> true then writeln('You are missing a RECORD.1 file!');
   if exist('record.2') <> true then writeln('You are missing a RECORD.2 file!');
   writeln;
   writeln('You must have the two files to be merged in the current directory,');
   writeln('one named RECORD.1 and one named RECORD.2. A new RECORD file will');
   writeln('be created from the two.');
   halt(1);
end;

procedure load_scores;
var
   score_file : text;
   read_line : string[255];
   line_count : integer;
begin
     assign(score_file, 'record');
     reset(score_file);
     line_count := 0;
     repeat
         readln(score_file, read_line);
         inc(line_count);
         score_array[line_count] := read_line;
     until read_line = '';
     close(score_file);
end;

function score(of_line : integer) : longint;
var space_count : byte;
    line_string : string[255];
    line_char : char;
    scan_spot : byte;
    score_string : string[20];
    score_integer : longint;
    junk : integer;
begin
    line_string := score_array[of_line];
    space_count := 0;
    scan_spot := 0;
    while (space_count < 7) do
    begin
         inc(scan_spot);
         if line_string[scan_spot] = ' ' then inc(space_count);
    end;
    score_string := '';
    while (space_count = 7) do
    begin
         inc(scan_spot);
         if line_string[scan_spot] <> ' ' then score_string := score_string + line_string[scan_spot];
         if line_string[scan_spot] = ' ' then inc(space_count);
    end;
    val(score_string, score_integer, junk);
{    write('"',score_string,'" ');
    if junk <> 0 then write('-- ERROR -- ');
    writeln(score_integer);}
    score := score_integer;
end;

procedure sort_scores;
var last_position : integer;
    last_score    : longint;
    score_scan    : integer;
    compare_scan  : integer;
    this_score    : longint;
    compare_score : longint;
    score_buffer  : string[255];
    bottom, top, middle  : integer;
begin
    load_scores;
    for score_scan := 2 to 200 do
    begin
       this_score := score(score_scan);
       score_buffer := score_array[score_scan];
       bottom := 1; top := score_scan - 1;
       while bottom <= top do
       begin
            middle := (bottom + top) div 2;
            if this_score > score(middle) then top := middle - 1
            else bottom := middle + 1;
       end;
       for compare_scan := score_scan - 1 downto bottom do
           score_array[compare_scan + 1] := score_array[compare_scan];
       score_array[bottom] := score_buffer;
    end;
end;

procedure write_scores;
var write_loop : integer;
    score_file : text;
    cutoff_count : integer;
begin
    assign(score_file, 'record');
    rewrite(score_file);
    cutoff_count := 0;
    for write_loop := 1 to 200 do
    begin
         if (score_array[write_loop] <> '')
            and (cutoff_count < 100) then
            begin
                 writeln(score_file, score_array[write_loop]);
                 inc(cutoff_count);
            end;
    end;
    close(score_file);
end;

procedure delete_dups;
var check_loop : integer;
begin
     for check_loop := 1 to 199 do
     begin
          if score_array[check_loop] = score_array[check_loop + 1] then
          score_array[check_loop + 1] := '';
     end;
end;

begin
   writeln('Checking for RECORD files...');
   check_for_files;
   writeln('Combining the scores...');
   combine_files;
   writeln('Sorting the scores...');
   sort_scores;
   writeln('Deleting duplicates...');
   delete_dups;
   writeln('Writing new RECORD file...');
   write_scores;
end.