(****************************************************************)
(*                     DATABASE TOOLBOX 4.0                     *)
(*     Copyright (c) 1984, 87 by Borland International, Inc.    *)
(*                                                              *)
(*           Turbo Sort Demonstration Program #2                *)
(*                                                              *)
(*   Purpose: Allows user at run-time to select what to sort,   *)
(*            customer records or stock records using Turbo     *)
(*            Sort and then displays the sorted records on the  *)
(*            screen.  Note: Stock records are sorted on        *)
(*            multiple keys.                                    *)
(*                                                              *)
(****************************************************************)
program SortMultipleFiles;
uses CRT, Sort;

type
  NameString = string[25];
  { record types to be sorted }
  CustRec = record
              Number: integer;
              Name:   NameString;
              Addr:   string[20];
              City:   string[12];
              State:  string[3];
              Zip:    string[5];
            end;
  ItemRec = record
              Number:  integer;
              Descrip: string[30];
              InStock: integer;
              Price:   real;
            end;

var
  CustFile  : file of CustRec;
  Customer  : CustRec;
  StockFile : file of ItemRec;
  Item      : ItemRec;
  Choice    : char;
  Results   : integer;

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

procedure ClrEOS(Y : integer);
begin
  Window(1, Y, 80, 25);
  ClrScr;
  Window(1, 1, 80, 25);
  GotoXY(1, Y);
end;

procedure SelectFile(var Choice : char);
{ Set up screen, select which file to sort, open data file }

procedure Menu(var Choice : char);
{ Set up screen, select which file to sort. }
begin
  ClrScr;
  Writeln('TURBO-SORT DEMONSTRATION PROGRAM':56);
  Writeln;
  Writeln;
  Writeln;
  Writeln('Turbo-Sort is fast!   This program will ring the');
  Writeln('bell when the sort starts and then ring it again');
  Writeln('when the sort is finished.');
  Writeln;
  Writeln;
  Writeln('Sort');
  Writeln('ÄÄÄÄ');
  Writeln;
  Writeln('Customer file');
  Writeln('Stock File');
  Writeln;
  Write('Enter C or S: ');
  repeat
    Choice := UpCase(ReadKey);
    if Choice in [^C, #27] then Halt;    { abort program }
  until Choice in ['C','S'];
  ClrEOS(3);

  case Choice of                         { draw header   }
    'C' : begin
            Writeln('     No.  Company Name               Address',
                    '              City      State Zip');
            Writeln('ÄÄÄ  ÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ  ',
                    'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄÄÄ ÄÄ ÄÄÄÄÄ');
            Writeln;
          end; { C }
    'S' : begin
            Writeln(' ':10,
                    '     No.  Description                     ',
                    '  Qty   Price');
            Writeln(' ':10,
                    'ÄÄÄ  ÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ  ',
                    'ÄÄÄÄÄ ÄÄÄÄÄÄÄ');
            Writeln;
          end; { C }
  end; { case }
end; { Menu }

begin { SelectFile }
  Menu(Choice);
  Writeln;
  Writeln('Opening data file');
  case Choice of
    'C': begin
           {$I-}
           Assign(CustFile, 'CUSTOMER.DTA');
           Reset(CustFile);
         end;
    'S': begin
           {$I-}
           Assign(StockFile, 'STOCK.DTA');
           Reset(StockFile);
         end;
  end; {case}
  {$I+}
  if IOresult <> 0 then
  begin
    Writeln('  ÄÄ Cannot find data file.');
    Halt;                                      { abort program }
  end;
end; { SelectFile }

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

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

function LowerCustomer(var Cust1, Cust2 : 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 := Cust1.Number < Cust2.Number;
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
  CurCustomer : integer;
begin
  Beep;         { ring bell -- finished w/ sort!        }
  Window(1, 5, 80, 24);
  ClrScr;
  GotoXY(1, 1);
  CurCustomer := 1;
  repeat
    if KeyPressed then Halt;  { Key touched?  Stop program }
    SortReturn(Customer);
    with Customer do
    begin
      Write(CurCustomer:3, Number:6, ' ', Name,' ':27 - Length(Name));
      Write(Addr,' ':21 - Length(Addr));
      Write(City,' ':13 - Length(City));
      Writeln(State,' ', Zip);
      Delay(100); { Slow down output to screen }
      CurCustomer := succ(CurCustomer);
    end; { with }
  until SortEOS;
  Window(1, 1, 80, 25);
end; { DisplayCustRecs }
{$F-}

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

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

function LowerItem(var Stock1, Stock2 : ItemRec) : boolean;
{ This function specifies sort priority and demonstrates how 
  to sort on multiple keys. It sorts primarily on the quantity 
  in stock and secondarily on price. 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
  LowerItem := (Stock1.InStock < Stock2.InStock)  or
                ((Stock1.InStock = Stock2.InStock) and
                 (Stock1.Price < Stock2.Price));
end; { LowerItem }

procedure DisplayStock;
{ This procedure receives a stream of sorted inventory 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
  CurItem : integer;
begin
  Beep;           { ring bell -- finished w/ sort!        }
  Window(1, 5, 80, 24);
  ClrScr;
  GotoXY(1, 1);
  CurItem := 1;                        { init item counter }
  repeat
    if KeyPressed then Halt;  { Key touched?  Stop program }
    SortReturn(Item);
    with Item do
    begin
      Write(CurItem:13, Number:6, ' ', Descrip,' ':32 - Length(Descrip));
      Writeln(InStock:5, Price:8:2);
      Delay(100); { Slow down output to screen }
    end;
    CurItem := succ(CurItem);
  until SortEOS;
end; { DisplayStock }
{$F-}

procedure DisplayResults(Results : integer);
begin
  GotoXY(1, 25);
  ClrEOL;
  case Results of                         { display sort results     }
     0 : ;
     3 : Write('Error:  not enough memory to sort');
     8 : Write('Error:  illegal item length.');
     9 : Write('Error:  can only sort ', MaxInt, ' records.');
    10 : Write('Error:  disk full or disk write error.');
    11 : Write('Error:  disk error during read.');
    12 : Write('Error:  directory full or invalid path name');
    else;
  end; { case }
end; { DisplayResults }

begin { program body }
  SelectFile(Choice);                     { open data file to sort   }
  case Choice of                          { sort the file of records }
    'C' :  Results := TurboSort(SizeOf(CustRec), @ReadCustRecs,
                               @LowerCustomer, @DisplayCustRecs);
    'S' : Results := TurboSort(SizeOf(ItemRec), @ReadStock,
                               @LowerItem, @DisplayStock);
  end; { case }
  DisplayResults(Results);                { display sort results     }
end.

