home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol085 / tree5.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  6.1 KB  |  248 lines
  1. {       Pascal/Z compiler options               }
  2. {$C- <<<control-c keypress checking OFF>>>}
  3. {$M- <<<int mult & divd error checking OFF>>>}
  4. {$F- <<<floating point error checking OFF>>>}
  5.  
  6. PROGRAM BTREE(0);
  7. {for notes, see .doc file}
  8. { associated separately compiled modules:
  9. DELETE     (1)     CONTAINS DELETE-FROM-TREE PROCEDURES
  10. DISC       (2)     CONTAINS STORE AND FETCH TO/FM DISC PROCEDURES
  11. ORDER      (3)     CONTAINS INORDER, PREORDER, POSTORDER PROCEDURES
  12. MENU       (4)     CONTAINS MENU AND SEVERAL UTILITY/MISC PROCEDURES
  13. }
  14. CONST
  15.   default = 80;
  16.   vers    =  5; { PROGRAM VERSION NUMBER }
  17.  
  18. TYPE
  19.   alpha    = packed array [1..10] of char;
  20.   int      = integer;
  21.   str0     = string 0;
  22.   shorty   = string 40;
  23.   dstring  = string default;
  24.   str255   = string 255;
  25.  
  26.   PersonDetails = RECORD
  27.             Name,        { KEY FIELD }
  28.             Company,
  29.             address,
  30.             city,
  31.             state,
  32.             zip,
  33.             salary : shorty;
  34.                  END;
  35.  
  36.   apointer  = ^PERSON;
  37.  
  38.   PERSON = RECORD
  39.             details : PersonDetails;
  40.         Left,
  41.         Right  : apointer
  42.          END;
  43.  
  44.   filestring = string 14;
  45.  
  46. VAR
  47.   bell        : char;
  48.   Command    : CHAR;
  49.   disc,
  50.   con_wanted,
  51.   tty_wanted    : boolean;
  52.   answer        : shorty;    { Console inputs here }
  53.  
  54.   KEY,                { Name field is the "KEY" field }
  55.   New_Salary,
  56.   New_Company,
  57.   New_address,
  58.   New_City,
  59.   New_State,
  60.   New_Zip        : shorty;
  61.  
  62.   fout,
  63.   fin,
  64.   STDOUT        : FILE OF PersonDetails;
  65.  
  66.   Employee    : apointer;
  67.  
  68.  
  69.  
  70. function length( x: str255 ): int; external;
  71.  
  72. function index( x,y: str255 ): int; external;
  73.  
  74. procedure setlength( var x:str0; y: int ); external;
  75.  
  76. function rename( oldfile, newfile: filestring): boolean; external;
  77.  
  78. PROCEDURE InitTree( VAR Employee : apointer );
  79. {  initialize the tree to empty  }
  80. BEGIN
  81.   Employee := NIL
  82. END{of InitTree};
  83.  
  84.  
  85. PROCEDURE INSERT( VAR Employee : apointer;
  86.               key : shorty );
  87. { insert key into the tree. If it }
  88. { is there already then do nothing }
  89. BEGIN
  90.   IF Employee = NIL THEN BEGIN
  91.     NEW(Employee);
  92.     WITH Employee^, details DO BEGIN
  93.     Name    := key;
  94.     Salary  := New_Salary;
  95.     Company := New_Company;
  96.     address := New_address;
  97.     City    := New_City;
  98.     State   := New_State;
  99.     zip     := New_Zip;
  100.     left    := NIL;
  101.     right   := NIL
  102.     END{WITH}
  103.   END
  104.   ELSE IF key = Employee^.details.Name THEN
  105.     WRITELN( bell, key,' already in data file' )
  106.   ELSE IF key < Employee^.details.Name THEN
  107.     Insert( Employee^.left, key )
  108.   ELSE IF key > Employee^.details.Name THEN
  109.     Insert( Employee^.right, key )
  110. END{of INSERT};
  111.  
  112.  
  113. PROCEDURE DeleteLeftMost( VAR Employee : apointer;
  114.               VAR DeleteName : shorty );
  115.      external;
  116. { delete the leftmost node in the tree and }
  117. {  returns its value in DeleteName       }
  118.  
  119. PROCEDURE DeleteRoot( VAR Employee : apointer );
  120.      external;
  121. { deletes the root of the nonempty tree by replacing it  }
  122. { by its successor (or child) if it has only one, or     }
  123. { replacing its value by that of the leftmost descendant }
  124. { of the rightmost subtree.                 }
  125.  
  126. PROCEDURE Delete( VAR Employee : apointer;
  127.               key : shorty );
  128.      external;
  129. { delete key from the tree--if it is not }
  130. { in the tree, do nothing          }
  131.  
  132. PROCEDURE DISPLAY( Employee: apointer );
  133. BEGIN
  134.  IF NOT disc THEN BEGIN
  135.   WITH Employee^.details do begin
  136.     writeln( Name );
  137.     if length( Company ) > 0 then writeln( Company );
  138.     if length( address ) > 0 then writeln( address );
  139.     writeln( City, ', ', State, ' ', Zip );
  140.     writeln
  141.   end    {with}
  142.  end    {if}
  143.  else write (fout, employee^.details);
  144. END{of DISPLAY};
  145.  
  146.  
  147. PROCEDURE Store; external;
  148. {  stores the tree onto disc  }
  149.  
  150. PROCEDURE Fetch; external;
  151. {  gets tree from disc  }
  152.  
  153. PROCEDURE Help; external;
  154. {  calls an explanation  }
  155.  
  156. PROCEDURE Preorder( Employee : apointer );
  157.      external;
  158. {  prints data from left side of tree to right  } 
  159.  
  160. PROCEDURE Inorder( Employee : apointer );
  161.      external;
  162. {  prints data outer to inner of tree  }
  163.  
  164. PROCEDURE Postorder( Employee : apointer );
  165.     external;
  166. {  prints data from leaves first then branchs  }
  167.  
  168. {****************************}
  169. {***   UTILITY ROUTINES   ***}
  170. {****************************}
  171.  
  172.  
  173. PROCEDURE SIGNON;
  174.     external;
  175.  
  176. PROCEDURE MENU;
  177.     external;
  178.  
  179. FUNCTION toupper( ch: CHAR ): CHAR;
  180.     external;
  181.  
  182. PROCEDURE INPUT( txt: dstring; VAR answer: shorty );
  183.     external;
  184.  
  185. PROCEDURE LIST;
  186.     external;
  187.  
  188. BEGIN{ MAIN PROGRAM BLOCK }
  189.   InitTree( Employee );
  190.   bell := chr(7);
  191.   Command := ' ';
  192.   SIGNON;
  193.   MENU;
  194.   INPUT( 'COMMAND: ', answer );
  195.   Command := toupper( answer[1] );
  196.   WHILE Command <> '9' DO BEGIN
  197.     IF Command IN ['1','2','3','4','5','8'] THEN BEGIN
  198.       WRITELN;
  199.       CASE Command  OF
  200.         '1': begin { INSERT MODE }
  201.          REPEAT
  202.         writeln( 'ENTER:' );
  203.         INPUT('1 - NAME <Key field>               !', key );
  204.         INPUT('2 - Salary amount <12000>          !', New_Salary );
  205.         input('3 - Company Name <address line 1>  !', New_Company );
  206.         input('4 - Address line 2                 !', New_address );
  207.         input('5 - City                           !', New_City );
  208.         input('6 - State <e.g. MD>                !', New_State );
  209.         input('7 - Zip Code                       !', New_Zip );
  210.         writeln;
  211.         write( 'DATA OK? ' );
  212.         readln( answer );
  213.           UNTIL toupper(answer[1])<>'N';
  214.           INSERT( Employee,key );
  215.          end;
  216.  
  217.         '2': begin { DELETE MODE }
  218.          REPEAT
  219.            INPUT( 'Enter NAME <Key field>      --> ',key );
  220.            writeln;
  221.            writeln( 'Deleting > ', key );
  222.            write( 'OK? ' );
  223.            readln( answer );
  224.          UNTIL toupper(answer[1])<>'N';
  225.          Delete( Employee,key );
  226.          end;
  227.  
  228.     '3': begin { LIST MODE }
  229.                disc := false;
  230.            LIST;
  231.          end;
  232.         '4': begin {store data to disc}
  233.                 STORE;
  234.                 end;
  235.         '5': begin {get data from disc}
  236.                 FETCH;
  237.                 end;
  238.         '8': begin {call explanation}
  239.                 HELP;
  240.                 end
  241.       END{CASE}
  242.     END{IF};
  243.     MENU;
  244.     INPUT( 'COMMAND: ', answer );
  245.     Command := toupper( answer[1] );
  246.   END{WHILE Command <> '9'}
  247. END{of PROGRAM BTREE}.
  248.