{COPYRIGHT 1982 (C) BY CRAIG RUDLIN, M.D. ALL RIGHTS RESERVED.}
{***************************** procedure transverse_ tree ****************}
{ This procedure is the main routine for transversing the tree and }
{printing the nodes. Here is where the actual work is done. The procedure}
{reads the master file, sees how many records there are so it knows when to}
{stop, and goes as far down the left side of the tree as possible. It then}
{starts a while loop, that checks for exit conditions. The program includes}
{the node in the I/O buffer array and increments the buffer counter if the}
{node meets the printing conditions. The procedure then increments the number}
{records looked at. If there is no right branch from this node, then it calls}
{procedure flag and returns to the top of the while loop. If there is a right}
{branch, then it sets print flag, and moves to the first node of right branch}
{before going as far left as possible on this branch. The procedure then}
{once again, returns to the top of the while loop. Once the exit conditions}
{are satisfied or the I/O buffer is full, the procedure prints the contents}
{of the I/O buffer. Upon exiting, the while loop the procedure notes how }
{many files were printed and returns to the menu. }
procedure print_terms (hardcopy:boolean);
{main routine for transversing the tree and printing nodes}
{$C-}
{$R-}
{$F-}
{$M-}
{$U-}
type
buffer = array[1..100] of xterms;
dir = (xright,xleft,xparent);
var
output:text;
lines,dummy,counter:byte;
total_printed,page,total_number_recs,recno,num_recs_looked_at:integer;
temp:buffer;
continue:char;
{ This procedure starts at the current node and goes }
{down the left branch of that node as far as it can go. It will not crash}
{if the node does not have a left branch. }
{ This procedure moves through the file in the desired direction.}
{If you're moving to the node's parent then it de-asserts the print_flag,}
{writes the node out to the disk in its new form, and reads in the parent.}
{If you're moving to the right branch then it asserts the print_flag, }
{writes the old node out to the disk, and reads in the right branch.}
begin
with terms do
begin
{set flag indicating that record has been printed}
if direction = xparent then print_flag:=false else print_flag:=true;
write(fterms:recno,terms);{re-write record with newly updated flag}
if direction = xparent then recno:=parent else recno:=right;
read(fterms:recno,terms); {move on....}
end;
end;
{ This procedure is an I/O buffer to reduce the number of disk read-}
{writes. It is,in effect a first in,first out stack. It also prevents }
{the master disk from being printed, and filters out the unwanted records }
{in the case of a special listing. }
{************************** note:*************************************}
{could this be modified by removing the array and having the procedure}
{merely output the record as it is recieved? As there are no disk read-}
{writes involved in printing.}
{this procedure puts record's information into the temporary array, and }
{when the temporary array is filled, ie 100 records, prints the array}
label 1;
begin{of procedure put_in_array}
with terms do
begin
if recno <> 1 then
{don't print the first record since it is just stats}
begin
counter:=counter + 1;
total_printed:=total_printed + 1;
temp[counter]:=terms;
end;
if (counter = 100 ) or (counter = total_number_recs - 1) or
(num_recs_looked_at = total_number_recs) then
begin
lines:=1;
for dummy:= 1 to counter do
begin
write(output,temp[dummy].term);
if needs_units then
writeln(output,trunc(temp[dummy].code):10) ELSE
writeln(output,temp[dummy].code:10:3);
if (hardcopy) and (lines > 56) then
begin
writeln(output,chr(12));{formfeed}
writeln(output,'LISTING OF TERMS','PAGE':35,page:7);
writeln(output);
page:=page + 1;
lines:=2;
end;
if (hardcopy = false) and (lines > 16) then
begin
�prompt(1,24,0,'TYPE ANY LETTER TO CON''T,OR <ESC> TO RETURN TO MENU.',FALSE);
keyin(continue);
if ord(continue)=27 then
begin
clear_screen;
num_recs_looked_at:=total_number_recs+1;
goto 1;
end;
clear_screen;
writeln(output,'LISTING OF TERMS','PAGE':35,page:7);
writeln(output);
page:=page + 1;
lines:=2;
end;
counter:=0;
end;
end;
num_recs_looked_at:=num_recs_looked_at + 1;
end;
1:
end; {of procedure}
procedure flag;
{moves up the tree until it finds a record that has not been printed...}
{$C-}
{$R-}
{$F-}
{$M-}
{$U-}
begin
move(xparent);
if terms.print_flag then flag;
end;
{The following is just "set up" : checking to see if a hardcopy is desired}
{and if so, if the printer is ready, and also checking to see if there are}
{indeed any termss (nodes) in the file.}
begin
page:=1;
clear_screen;
if hardcopy then
begin
prompt(1,12,0,'PREPARE PRINTER AND THEN ENTER ANY CHARACTER.',false);
keyin(continue);
rewrite('lst:',output);
end
ELSE rewrite('con:',output);
clear_screen;
�
writeln(output,'LISTING OF TERMS ','PAGE':35,page:7);
writeln(output);
with terms do
begin
read(fterms:1,terms);
total_number_recs:=trunc(terms.code) - 1;
left_as_possible;
while num_recs_looked_at <= total_number_recs do
begin
put_in_array;
if right = 0 then flag ELSE
begin
move(xright);
left_as_possible;
end;
end;
writeln(output);
writeln(output,'TOTAL NUMBER OF TERMS: ',total_printed:6);
prompt(1,24,0,'TYPE ANY LETTER TO RETURN TO MENU',false);
keyin(continue)
end;
1:
end; {of procedure transverse_tree}
