home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sampler / 02 / parser / textrd3.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-09-06  |  1.9 KB  |  80 lines

  1. {TEXTRD3.PAS}
  2. {
  3. Description:  Blockread routines for reading input file into a character
  4.               array for parsing.
  5.  
  6. Author:       Karl Gerhard
  7. Date:         7/19/87
  8. Application:  IBM PC and compatibles
  9. }
  10.  
  11.  
  12. { Note that this entire file is one procedure }
  13.  
  14. {--------------------------------------}
  15. Procedure  textblockread(var input_array:input_array_Type; var F:file);
  16. { read text file, return length }
  17. Var Recs:integer; n,fptr,ptr1,ptr2:integer;
  18.  
  19. Procedure showinput;
  20. Begin
  21. writeln(' Input Array length:',input_length, '::'); writeln;
  22. for n := 1 to input_length do write(input_array[n] );
  23. writeln;
  24. for n := 1 to input_length do write( n mod 10);
  25. writeln;
  26. End;
  27.  
  28.  
  29. {--------------------------------------}
  30. Function find(cy:char):boolean;
  31. { find the cy, set fptr, return found/not_found }
  32. Begin
  33. fptr := 0;
  34. repeat     fptr := fptr + 1;
  35. until (input_array[fptr] = cy) or (fptr > input_length);
  36. find := fptr <= input_length;
  37. {writeln('Find fptr= ',fptr); {}
  38. End;
  39.  
  40. {--------------------------------------}
  41. Procedure delete_input(p1,p2:integer);
  42. { move upper part of input down }
  43. Var n:integer;
  44. Begin
  45. if (p2 - p1) <= 0 then error('delete_input',' bad lengths');
  46. move(input_array[p2], input_array[p1], input_length - p2 + 1);
  47. input_length := input_length - (p2 - p1);
  48. input_array[p1] := ' ';
  49. End;
  50. {***}
  51.  
  52. { Block for textread }
  53. Begin
  54. reset(F);
  55. Recs := filesize(F);
  56. blockread(F,input_array,Recs);
  57. close(F);
  58. input_length := 0;
  59. repeat input_length := input_length + 1; until input_array[input_length] = #26;
  60. input_length := input_length - 1;
  61.  
  62.  
  63. { ** replace #13#10 with blanks }
  64. for n := 1 to input_length do
  65.   if input_array[n] in [#13,#10] then input_array[n] := ' ';
  66.  
  67. { delte commentary }
  68. while find('{') do begin
  69.   ptr1 := fptr;
  70.   if find('}') then begin
  71.     ptr2 := fptr;
  72.     delete_input(ptr1,ptr2);
  73.   end
  74.   else begin
  75.     showinput;error('delete commentary','Missing closing }');end;
  76. end;
  77.  
  78. End;
  79. 
  80.