home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TOOL_INC.ZIP / READBAS.INC < prev    next >
Encoding:
Text File  |  1988-02-09  |  4.2 KB  |  186 lines
  1.  
  2. (*
  3.  * readbas.inc - Library to read "basic" format data files
  4.  *
  5.  * (C) 1987 Samuel H. Smith, 20-Jun-87 (rev. 20-Dec-87)
  6.  *
  7.  *)
  8.  
  9.  
  10. (* --------------------------------------------------------- *)
  11. procedure openfile(name: anystring);
  12.    (* open a file for "basic" style parsing *)
  13. begin
  14.    if length(name) = 0 then
  15.    begin
  16.       ok := false;
  17.       exit;
  18.    end;
  19.  
  20.    assignText(curfd,name);
  21.    {$i-} reset(curfd); {$i+}
  22.    ok := ioresult = 0;
  23. end;
  24.  
  25.  
  26. (* --------------------------------------------------------- *)
  27. function endfile: boolean;
  28.    (* check for end of file on the current data file *)
  29. begin
  30.    endfile := eof(curfd);
  31. end;
  32.  
  33.  
  34.  
  35. (* --------------------------------------------------------- *)
  36. procedure closefile;
  37.    (* close the data file *)
  38. begin
  39.    close(curfd);
  40. end;
  41.  
  42.  
  43. (* --------------------------------------------------------- *)
  44. procedure getline(var line: longstring;
  45.                   len:      integer{;
  46.                   what:     anystring});
  47.    (* get a full line from the "basic" file *)
  48. var
  49.    buf:  longstring;
  50.  
  51. begin
  52.    repeat
  53.       if endfile then
  54.          buf := 'EOF'
  55.       else
  56.          readln(curfd,buf);
  57.    until line[1] <> '#';
  58.  
  59.    line := copy(buf,1,len);
  60.  
  61. {  if TESTING         then writeln(con,'   ',what,' = ',line);
  62.    if length(buf) > len  then writeln(con,what,' TOO LONG, buf=',buf); }
  63. end;
  64.  
  65.  
  66. (* --------------------------------------------------------- *)
  67. procedure getstr(var str: longstring;
  68.                  len:     integer{;
  69.                  what:    anystring});
  70.    (* get a string of characters from the "basic" file.  a string ends in
  71.       either "," or crlf *)
  72. var
  73.    c:       char;
  74.    buf:     longstring;
  75. label
  76.    comment;
  77.  
  78. begin
  79.    if endfile then
  80.       buf := 'EOF'
  81.    else
  82.  
  83.    begin
  84. comment:
  85.       buf := '';
  86.       if endfile then
  87.          c := #26
  88.       else
  89.          read(curfd,c);
  90.  
  91.       while (c = ' ') do
  92.          read(curfd,c);
  93.  
  94.       if c = '#' then
  95.       begin
  96.          readln(curfd,buf);
  97.          goto comment;
  98.       end;
  99.  
  100.       while (c <> ',') and (c <> #13) and (c <> #26) do
  101.       begin
  102.          inc(buf[0]);
  103.          buf[length(buf)] := c;
  104.          read(curfd,c);
  105.       end;
  106.  
  107.       if c = #13 then
  108.          read(curfd,c);
  109.    end;
  110.  
  111.    str := copy(buf,1,len);
  112.  
  113. {  if TESTING and (what<>'') then writeln(con,'   ',what,' = ',str);
  114.    if length(buf) > len         then writeln(con,what,' TOO LONG, buf=',buf); }
  115. end;
  116.  
  117.  
  118. (* --------------------------------------------------------- *)
  119. procedure getstrd(var str: longstring);
  120.    (* get a directory string from the "basic" file.  check special case
  121.       for no trailing "\" in the root directory *)
  122. begin
  123.    getstr(str,65);
  124.    stoupper(str);
  125.  
  126.    if str[length(str)] = '\' then
  127.       dec(str[0]);       {remove trailing "\" from ramdisks and such}
  128. end;
  129.  
  130.  
  131. (* --------------------------------------------------------- *)
  132. procedure getint(var i: integer{;
  133.                  what:  anystring});
  134.    (* get a string and convert it into an integer *)
  135. var
  136.    buf:  longstring;
  137.  
  138. begin
  139.    getstr(buf,sizeof(buf));
  140.    i := atoi(buf);
  141.  
  142. {  if TESTING then writeln(con,'   ',what,' = ',i);}
  143. end;
  144.  
  145.  
  146. (* --------------------------------------------------------- *)
  147. procedure getflag(var f: boolean{;
  148.                   what:  anystring});
  149.    (* get a string and convert it into a true/false flag *)
  150. var
  151.    buf:  longstring;
  152.  
  153. begin
  154.    getstr(buf,sizeof(buf));
  155.    f := (buf[1] = '-') or (buf[1] = 'Y');
  156.  
  157. {  if TESTING then writeln(con,'   ',what,' = ',f); }
  158. end;
  159.  
  160.  
  161. (* --------------------------------------------------------- *)
  162. procedure vgetstr(var str: varstring);
  163.    (* get a variable allocation string of characters from the "basic"
  164.       file.  a string ends in either "," or crlf *)
  165. var
  166.    temp: longstring;
  167. begin
  168.    getstr(temp,sizeof(temp)-1);
  169.    savestr(str,temp);
  170. end;
  171.  
  172.  
  173. (* --------------------------------------------------------- *)
  174. procedure vgetstrd(var str: varstring);
  175.    (* get a variable allocation string and format as a directory *)
  176. var
  177.    temp: longstring;
  178. begin
  179.    getstr(temp,sizeof(temp));
  180.    if temp[length(temp)] = '\' then
  181.       dec(temp[0]);       {remove trailing "\" from ramdisks and such}
  182.    savestr(str,temp);
  183. end;
  184.  
  185.  
  186.