home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol094 / tprint.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-02-10  |  6.8 KB  |  278 lines
  1. external terms::print(8);
  2.  
  3.  
  4.  
  5. {COPYRIGHT 1982 (C) BY CRAIG RUDLIN, M.D.  ALL RIGHTS RESERVED.}
  6.  
  7.  
  8.  
  9. {***************************** procedure transverse_ tree ****************}
  10.  
  11.  
  12. {    This procedure is the main routine for transversing the tree and  }
  13. {printing the nodes.  Here is where the actual work is done.  The procedure}
  14. {reads the master file, sees how many records there are so it knows when to}
  15. {stop, and goes as far down the left side of the tree as possible.  It then}
  16. {starts a while loop, that checks for exit conditions.  The program includes}
  17. {the node in the I/O buffer array and increments the buffer counter  if the}
  18. {node meets the printing conditions.  The procedure then increments the number}
  19. {records looked at.  If there is no right branch from this node, then it calls}
  20. {procedure flag and returns to the top of the while loop.  If there is a right}
  21. {branch, then it sets print flag, and moves to the first node of right branch}
  22. {before going as far left as possible on this branch.  The procedure then}
  23. {once again, returns to the top of the while loop.  Once the exit conditions}
  24. {are satisfied or the I/O buffer is full, the procedure prints the contents}
  25. {of the I/O buffer.  Upon exiting, the while loop the procedure notes how }
  26. {many files were printed and returns to the menu.                         }
  27.  
  28.  
  29.  
  30.  
  31.  
  32. procedure print_terms (hardcopy:boolean);
  33.  {main routine for transversing the tree and printing nodes}
  34. {$C-}
  35. {$R-}
  36. {$F-}
  37. {$M-}
  38. {$U-}
  39.  
  40.  
  41. type
  42. buffer = array[1..100] of xterms;
  43. dir = (xright,xleft,xparent);
  44.  
  45.  
  46. var
  47. output:text;
  48. lines,dummy,counter:byte;
  49. total_printed,page,total_number_recs,recno,num_recs_looked_at:integer;
  50. temp:buffer;
  51. continue:char;
  52.  
  53.  
  54.  
  55. {************************* procedure left_as_possible *****************} 
  56.  
  57.  
  58.  
  59. {    This procedure starts at the current node and goes }
  60. {down the left branch of that node as far as it can go. It will not crash}
  61. {if the node does not  have a left branch.  }
  62.  
  63.  
  64.  
  65. procedure left_as_possible;
  66. {$C-}
  67. {$R-}
  68. {$F-}
  69. {$M-}
  70. {$U-}
  71.  
  72. {this procedure moves as far left in the binary tree as possible to find the}
  73. {next record to read...}
  74.  
  75. begin
  76.  
  77.  
  78.   with terms do
  79.   begin
  80.     while left <> 0 do  {left = 0 for the last record to the left}
  81.       begin
  82.       recno:=left;
  83.       read(fterms:recno,terms);
  84.       
  85.       end;
  86.   end;
  87. end; 
  88.  
  89. {******************************** move **********************************}
  90.  
  91. {    This procedure moves through the file in the desired direction.}
  92. {If you're moving to the node's parent then it de-asserts the print_flag,}
  93. {writes the node out to the disk in its new form, and reads in the parent.}
  94. {If you're moving to the right branch then it asserts the print_flag, } 
  95. {writes the old node out to the disk, and reads in the right branch.}
  96.  
  97.  
  98. procedure move(direction:dir);
  99. {$C-}è{$R-}
  100. {$F-}
  101. {$M-}
  102. {$U-}
  103.  
  104.  
  105. begin
  106.   with terms do
  107.   begin
  108.     {set flag indicating that record has been printed}
  109.     if direction = xparent then print_flag:=false else print_flag:=true;
  110.     write(fterms:recno,terms);{re-write record with newly updated flag}
  111.     if direction = xparent then recno:=parent else recno:=right;
  112.     read(fterms:recno,terms);  {move on....}
  113.   end;
  114. end;
  115.  
  116.  
  117. {************************** procedure put_in_array *********************}
  118.  
  119.  
  120. {    This procedure is an I/O buffer to reduce the number of disk read-}
  121. {writes.  It is,in effect a first in,first out stack.  It also prevents }
  122. {the master disk from being printed, and filters out the unwanted records }
  123. {in the case of a special listing.                                        }
  124.  
  125.  
  126.  
  127. {************************** note:*************************************}
  128. {could this be modified by removing the array and having the procedure}
  129. {merely output the record as it is recieved? As there are no disk read-}
  130. {writes involved in printing.}
  131.  
  132. procedure put_in_array;
  133. {$C-}
  134. {$R-}
  135. {$F-}
  136. {$M-}
  137. {$U-}
  138.  
  139. {this procedure puts record's information into the temporary array, and }
  140. {when the temporary array is filled, ie 100 records, prints the array}
  141.  
  142. label 1;
  143.  
  144.  
  145.  
  146.  
  147.  
  148. begin{of procedure put_in_array}
  149. with terms do
  150. begin
  151.  
  152. if recno <> 1 then
  153.   {don't print the first record since it is just stats}
  154.     begin
  155.     counter:=counter + 1;
  156.     total_printed:=total_printed + 1;
  157.     temp[counter]:=terms;
  158.     end;        
  159.         if (counter = 100 ) or (counter = total_number_recs - 1) or 
  160.        (num_recs_looked_at = total_number_recs) then
  161.  
  162.         begin
  163.         lines:=1;
  164.          for dummy:= 1 to counter do
  165.             begin
  166.              
  167.             write(output,temp[dummy].term);
  168.             if needs_units then
  169.             writeln(output,trunc(temp[dummy].code):10) ELSE
  170.             writeln(output,temp[dummy].code:10:3);
  171.  
  172.  
  173.             if (hardcopy) and (lines > 56) then
  174.                     begin
  175.                     writeln(output,chr(12));{formfeed}
  176.     writeln(output,'LISTING OF TERMS','PAGE':35,page:7);
  177.     writeln(output);
  178.                     page:=page + 1;
  179.                     lines:=2;
  180.                     end;
  181.  
  182.             if (hardcopy = false) and (lines > 16) then
  183.                 beginèprompt(1,24,0,'TYPE ANY LETTER TO CON''T,OR <ESC> TO RETURN TO MENU.',FALSE);
  184.                 keyin(continue);
  185.             if ord(continue)=27 then 
  186.             begin
  187.             clear_screen;
  188.             num_recs_looked_at:=total_number_recs+1;
  189.             goto 1;
  190.             end;
  191.                 clear_screen;
  192.     writeln(output,'LISTING OF TERMS','PAGE':35,page:7);
  193.     writeln(output);
  194.                     page:=page + 1;
  195.                     lines:=2;
  196.                 end;
  197.             counter:=0;
  198.             end;
  199.         end;
  200.     num_recs_looked_at:=num_recs_looked_at + 1;
  201. end;
  202. 1:
  203. end; {of procedure}
  204.  
  205.  
  206. procedure flag;
  207. {moves up the tree until it finds a record that has not been printed...}
  208. {$C-}
  209. {$R-}
  210. {$F-}
  211. {$M-}
  212. {$U-}
  213.  
  214. begin
  215. move(xparent);
  216. if terms.print_flag then flag;
  217. end;
  218.  
  219.  
  220.  
  221. {*************************** procedure transverse_tree ****************}
  222.  
  223. {The following is just "set up" : checking to see if a hardcopy is desired}
  224. {and if so, if the printer is ready, and also checking to see if there are}
  225. {indeed any termss (nodes) in the file.}
  226.  
  227.  
  228.  
  229. begin
  230.  
  231. page:=1;
  232. clear_screen;
  233.  
  234.  
  235. if hardcopy then
  236.     begin
  237.     prompt(1,12,0,'PREPARE PRINTER AND THEN ENTER ANY CHARACTER.',false);
  238.     keyin(continue);
  239.      rewrite('lst:',output);
  240.     end
  241.    ELSE rewrite('con:',output);
  242. clear_screen;è
  243. writeln(output,'LISTING OF TERMS ','PAGE':35,page:7);
  244. writeln(output);
  245.  
  246. page:=2;
  247.  
  248. counter:=0;
  249. num_recs_looked_at:=1;
  250. total_printed:=0;
  251.  
  252. with terms do
  253. begin
  254.     read(fterms:1,terms);
  255.     total_number_recs:=trunc(terms.code) - 1;
  256.     left_as_possible;
  257.  
  258.     while num_recs_looked_at <= total_number_recs do
  259.        begin
  260.        put_in_array;
  261.        if right = 0 then flag  ELSE
  262.             begin
  263.             move(xright);
  264.             left_as_possible;
  265.             end;
  266.  
  267.        end;
  268.  
  269. writeln(output);
  270. writeln(output,'TOTAL NUMBER OF TERMS: ',total_printed:6);
  271. prompt(1,24,0,'TYPE ANY LETTER TO RETURN TO MENU',false);
  272. keyin(continue)
  273. end;
  274. 1:
  275. end; {of procedure transverse_tree}
  276.  
  277.  
  278. . {of separate compilation}