(****************************************************************)
(*                     DATABASE TOOLBOX 4.0                     *)
(*     Copyright (c) 1984, 87 by Borland International, Inc.    *)
(*                                                              *)
(*           Turbo Sort Demonstration Program #1                *)
(*                                                              *)
(*   Purpose: Sorts a file of customer records using Turbo      *)
(*            Sort.  The records are sorted by the number       *)
(*            field and then displayed on the screen.           *)
(*                                                              *)
(****************************************************************)
program SortEx1;
uses CRT, Sort;

type
  NameString = string[25];
  CustRec = record
  { record type that will be sorted }
              Number: integer;
              Name:   NameString;
              Addr:   string[20];
              City:   string[12];
              State:  string[3];
              Zip:    string[5];
            end;
  CustFileType = file of CustRec;

var
  CustFile : CustFileType;
  Customer : CustRec;
  Results  : integer;

procedure Beep;
begin
  Sound(220);
  Delay(200);
  NoSound;
end; { Beep }

procedure OpenFile(var f : CustFileType; Name : NameString);
{ Display welcome screen, open data file }
begin
  ClrScr;
  Writeln('TURBO-SORT DEMONSTRATION PROGRAM');
  Writeln;
  Writeln('Opening data file');
  Assign(f, Name);
  {$I-}
  Reset(f);
  {$I+}
  if IOresult <> 0 then
  begin
    Beep;
    Writeln('  ÄÄ Cannot find ', Name);
    Halt;                                { abort program }
  end;
end; { OpenFile }

{$F+} { Force far calls.  Necessary for Turbo Sort to call the 3 }
      { user routines. }

procedure ReadCustRecs;
{ This procedure sends a stream of customer record in to be
  sorted.  Note: This input routine called by Turbo Sort 
  must be a "far" procedure with no parameters.
}
var
  rec : integer;   { # of records read from data file }
begin
  rec := 0;
  Writeln;
  Writeln('Input routine ÄÄ sending ', FileSize(CustFile),
          ' records to sort:');
  repeat
    rec := rec + 1;
    Write(#13, rec:6);
    Read(CustFile,Customer);
    SortRelease(Customer);
  until EOF(CustFIle);
  Writeln;
  Writeln;
  Writeln('Done with input ÄÄ sorting ',
           FileSize(CustFile), ' records . . .');
  Beep;
end; { ReadCustRecs }

function LowerCustomer(var FirstCust, SecondCust : CustRec) : boolean;
{ This function specifies sort priority.  FirstCust is sorted "lower"
  than SecondCust based on the comparison of the fields specified below.
  Note: this routine is called by Turbo Sort and is a "far" boolean function 
  that has 2 VAR parameters of the sort record type. Because this function
  is called many times, the number  of  statements in it should be kept 
  to a minimum.
}
begin
  LowerCustomer := FirstCust.Number < SecondCust.Number;  { define sort order }
end; { LowerCustomer }

procedure DisplayCustRecs;
{ This procedure receives a stream of sorted customer records back from
  Turbo Sort and displays them on the screen.  Note: This output routine 
  called by Turbo Sort must be a "far" procedure with no parameters.
}
var
  i : integer;
begin
  Beep;
  repeat
    if KeyPressed then Halt;            { Key touched?  Stop program }
    SortReturn(Customer);
    with Customer do
    begin
      Write(Number, ' ', Name,' ');
      for i := Length(Name) to 25 do Write(' ');
      Write(Addr);
      for i := Length(Addr) to 20 do Write(' ');
      Write(City);
      for i := Length(City) to 12 do Write(' ');
      Writeln(State,' ', Zip);
      Delay(100);  { Slow down output to screen }
    end; { with }
  until SortEOS;
end; { DisplayCustRecs }

{$F-} { Use near calls }

procedure DisplayResults(results : integer);
begin
  Writeln;
  Writeln;
  case Results of                         { display sort results     }
     0 : Writeln('Done with sort and display.');
     3 : Writeln('Error:  not enough memory to sort');
     8 : Writeln('Error:  illegal item length.');
     9 : Writeln('Error:  can only sort 64K intems.  Use LSort');
    10 : Writeln('Error:  disk full or disk write error.');
    11 : Writeln('Error:  disk error during read.');
    12 : Writeln('Error:  directory full or invalid path name');
  end;
end; { DisplayResults }

begin { program body }
  OpenFile(CustFile, 'CUSTOMER.DTA');     { open data file to sort   }
  Results := TurboSort(SizeOf(CustRec), @ReadCustRecs,
                       @LowerCustomer, @DisplayCustRecs);
  DisplayResults(Results);                { display sort results     }
end.
