CP/M/CPM_CDROM.iso/simtel/sigm/vols000/vol085/tree5.pas

Pascal/Delphi Source File | 1984-04-29 | 6KB | 248 lines

{       Pascal/Z compiler options               }
{$C- <<<control-c keypress checking OFF>>>}
{$M- <<<int mult & divd error checking OFF>>>}
{$F- <<<floating point error checking OFF>>>}

PROGRAM BTREE(0);
{for notes, see .doc file}
{ associated separately compiled modules:
DELETE     (1)     CONTAINS DELETE-FROM-TREE PROCEDURES
DISC       (2)     CONTAINS STORE AND FETCH TO/FM DISC PROCEDURES
ORDER      (3)     CONTAINS INORDER, PREORDER, POSTORDER PROCEDURES
MENU       (4)     CONTAINS MENU AND SEVERAL UTILITY/MISC PROCEDURES
}
CONST
  default = 80;
  vers    =  5; { PROGRAM VERSION NUMBER }

TYPE
  alpha    = packed array [1..10] of char;
  int      = integer;
  str0     = string 0;
  shorty   = string 40;
  dstring  = string default;
  str255   = string 255;

  PersonDetails = RECORD
            Name,        { KEY FIELD }
            Company,
            address,
            city,
            state,
            zip,
            salary : shorty;
                 END;

  apointer  = ^PERSON;

  PERSON = RECORD
            details : PersonDetails;
        Left,
        Right  : apointer
         END;

  filestring = string 14;

VAR
  bell        : char;
  Command    : CHAR;
  disc,
  con_wanted,
  tty_wanted    : boolean;
  answer        : shorty;    { Console inputs here }

  KEY,                { Name field is the "KEY" field }
  New_Salary,
  New_Company,
  New_address,
  New_City,
  New_State,
  New_Zip        : shorty;

  fout,
  fin,
  STDOUT        : FILE OF PersonDetails;

  Employee    : apointer;



function length( x: str255 ): int; external;

function index( x,y: str255 ): int; external;

procedure setlength( var x:str0; y: int ); external;

function rename( oldfile, newfile: filestring): boolean; external;

PROCEDURE InitTree( VAR Employee : apointer );
{  initialize the tree to empty  }
BEGIN
  Employee := NIL
END{of InitTree};


PROCEDURE INSERT( VAR Employee : apointer;
              key : shorty );
{ insert key into the tree. If it }
{ is there already then do nothing }
BEGIN
  IF Employee = NIL THEN BEGIN
    NEW(Employee);
    WITH Employee^, details DO BEGIN
    Name    := key;
    Salary  := New_Salary;
    Company := New_Company;
    address := New_address;
    City    := New_City;
    State   := New_State;
    zip     := New_Zip;
    left    := NIL;
    right   := NIL
    END{WITH}
  END
  ELSE IF key = Employee^.details.Name THEN
    WRITELN( bell, key,' already in data file' )
  ELSE IF key < Employee^.details.Name THEN
    Insert( Employee^.left, key )
  ELSE IF key > Employee^.details.Name THEN
    Insert( Employee^.right, key )
END{of INSERT};


PROCEDURE DeleteLeftMost( VAR Employee : apointer;
              VAR DeleteName : shorty );
     external;
{ delete the leftmost node in the tree and }
{  returns its value in DeleteName       }

PROCEDURE DeleteRoot( VAR Employee : apointer );
     external;
{ deletes the root of the nonempty tree by replacing it  }
{ by its successor (or child) if it has only one, or     }
{ replacing its value by that of the leftmost descendant }
{ of the rightmost subtree.                 }

PROCEDURE Delete( VAR Employee : apointer;
              key : shorty );
     external;
{ delete key from the tree--if it is not }
{ in the tree, do nothing          }

PROCEDURE DISPLAY( Employee: apointer );
BEGIN
 IF NOT disc THEN BEGIN
  WITH Employee^.details do begin
    writeln( Name );
    if length( Company ) > 0 then writeln( Company );
    if length( address ) > 0 then writeln( address );
    writeln( City, ', ', State, ' ', Zip );
    writeln
  end    {with}
 end    {if}
 else write (fout, employee^.details);
END{of DISPLAY};


PROCEDURE Store; external;
{  stores the tree onto disc  }

PROCEDURE Fetch; external;
{  gets tree from disc  }

PROCEDURE Help; external;
{  calls an explanation  }

PROCEDURE Preorder( Employee : apointer );
     external;
{  prints data from left side of tree to right  }

PROCEDURE Inorder( Employee : apointer );
     external;
{  prints data outer to inner of tree  }

PROCEDURE Postorder( Employee : apointer );
    external;
{  prints data from leaves first then branchs  }

{****************************}
{***   UTILITY ROUTINES   ***}
{****************************}


PROCEDURE SIGNON;
    external;

PROCEDURE MENU;
    external;

FUNCTION toupper( ch: CHAR ): CHAR;
    external;

PROCEDURE INPUT( txt: dstring; VAR answer: shorty );
    external;

PROCEDURE LIST;
    external;

BEGIN{ MAIN PROGRAM BLOCK }
  InitTree( Employee );
  bell := chr(7);
  Command := ' ';
  SIGNON;
  MENU;
  INPUT( 'COMMAND: ', answer );
  Command := toupper( answer[1] );
  WHILE Command <> '9' DO BEGIN
    IF Command IN ['1','2','3','4','5','8'] THEN BEGIN
      WRITELN;
      CASE Command  OF
        '1': begin { INSERT MODE }
         REPEAT
        writeln( 'ENTER:' );
        INPUT('1 - NAME <Key field>               !', key );
        INPUT('2 - Salary amount <12000>          !', New_Salary );
        input('3 - Company Name <address line 1>  !', New_Company );
        input('4 - Address line 2                 !', New_address );
        input('5 - City                           !', New_City );
        input('6 - State <e.g. MD>                !', New_State );
        input('7 - Zip Code                       !', New_Zip );
        writeln;
        write( 'DATA OK? ' );
        readln( answer );
          UNTIL toupper(answer[1])<>'N';
          INSERT( Employee,key );
         end;

        '2': begin { DELETE MODE }
         REPEAT
           INPUT( 'Enter NAME <Key field>      --> ',key );
           writeln;
           writeln( 'Deleting > ', key );
           write( 'OK? ' );
           readln( answer );
         UNTIL toupper(answer[1])<>'N';
         Delete( Employee,key );
         end;

    '3': begin { LIST MODE }
               disc := false;
           LIST;
         end;
        '4': begin {store data to disc}
                STORE;
                end;
        '5': begin {get data from disc}
                FETCH;
                end;
        '8': begin {call explanation}
                HELP;
                end
      END{CASE}
    END{IF};
    MENU;
    INPUT( 'COMMAND: ', answer );
    Command := toupper( answer[1] );
  END{WHILE Command <> '9'}
END{of PROGRAM BTREE}.