💾 Archived View for blitter.com › OLGA › MUSIC › RESOURCES › MISC › OLGA_BROWSER › OLGA_EXTRACT › SR… captured on 2022-06-12 at 08:28:01.

View Raw

More Information

-=-=-=-=-=-=-

  { compile this program for PROTECTED MODE ! }

uses crt;

type str128 = string[128];

const maxent=16020;

var ptrs        : array [0..maxent] of pointer;
    f           : text;
    i,e,j       : integer;
    s           : string;
    cur,hp,hp2  : ^str128;
    ins,lomem   : boolean;
    st          : string[3];

procedure insrt (vorel:integer);
var k:integer;
begin
  if vorel=0 then ptrs[e+1]:=cur
  else
  begin
    for k:=e downto vorel do ptrs [k+1]:=ptrs [k];
    ptrs [vorel]:=cur;
  end;
  inc (e);
  ins:=true;
end;

begin
  if paramcount=0 then
  begin
    writeln ('Sort! Text file sorter  (C) 1995 Sven Winnecke (swi@mb2.tu-chemnitz.de)');
    writeln ('Syntax: SORT! in_dat [out_dat]. If no out_dat is specified the lines will be');
    writeln ('written to screen.'); writeln;
    writeln ('Sort! is capable of sorting files with more than 1600 lines, the maximal');
    writeln ('length of a line is 128 characters. That means the program can handle text');
    writeln ('files of up to 2 MBytes. It uses a modified quicksort algorithm and the');
    writeln ('protected processor mode to work efficiently.');
    halt (0);
  end;
  if paramcount >2 then st:='�  ' else st:='';
  lomem:=false;
  assign (f,paramstr(1)); reset (f);
  readln (f,s); new (cur); cur^:=s; ptrs[1]:=cur; { 1. Element immer #1 }
  readln (f,s);
  new (cur);
  cur^:=s;               { 2. Element }
  hp:=ptrs[1];
  if s>hp^ then ptrs[2]:=cur else                 { 2. El. > 1. El ? }
  begin
    ptrs[2]:=ptrs[1]; ptrs[1]:=cur;
  end;
  e:=2;                                            { Tab. enth. jetzt 2 El. }
  while (not eof (f)) and (e<maxent+1) do
  begin
    gotoxy (1,wherey);
    write (st+'Processing line number ',e+1,'...');
    readln (f,s);
    if memavail<130 then
    begin
      writeln ('st+ERROR :  Insufficient memory! Aborting...');
      halt (1);
    end;
    new (cur); cur^:=s;
    if e=24 then
    begin
      write;
    end;
    i:=e div 2; j:=e div 4; if j=0 then inc (j);
    ins:=false;
    while not ins do
    begin
      hp:=ptrs[i]; hp2:=ptrs[i+1];
      if s<hp^ then
      begin
        if (i=1) or (i=0) then insrt (i)
        else
        begin
          i:=i-j; j:=j div 2;
          if j=0 then inc (j);
        end;
      end else
      if s>hp2^ then
      begin
        if (i+1=e) or (i=e) then insrt (0)
        else
        begin
          i:=i+j; j:=j div 2;
          if j=0 then inc (j);
        end;
      end else insrt (i+1);
    end;
  end;
  close (f); writeln;
  if e>maxent then
  begin
    writeln ('st+ERROR :  Too many lines (max. ',maxent,') - process aborted !!');
    halt (2);
  end;
  if st='' then writeln ('Writing output file...');
  if paramcount>1 then begin assign (f,paramstr(2)); rewrite (f); end;
  for i:=1 to e do
  begin
    cur:=ptrs[i];
    if paramcount>1 then writeln (f,cur^) else writeln (cur^);
  end;
  if paramcount>1 then close (f);
  if st='' then writeln ('Done.');
end.