home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol079 / io.pli < prev    next >
Text File  |  1984-04-29  |  2KB  |  95 lines
  1. io:
  2.     proc;
  3.     %replace
  4.         true  by '1'b,
  5.         false by '0'b;
  6.     %include 'attrib.dcl';
  7.  
  8. hdr_out:
  9.     proc(a) ext;
  10.     /* write name attribute a */
  11.     dcl
  12.         a fixed,
  13.         i fixed,
  14.         f char(max_chr);
  15.  
  16.         do i = 1 to max_chr by 2;
  17.         substr(f,i,2) = '.';
  18.         end;
  19.  
  20.     substr(f,1,length(att_chars(a))+1) = att_chars(a);
  21.     put edit(f) (column(4),a);
  22.     end hdr_out;
  23.  
  24. att_in:
  25.     proc(a,r) returns(bit) ext;
  26.     /* read attribute to r, return true if sucessful */
  27.     dcl
  28.         a  fixed,
  29.         r  char(max_siz),
  30.         t  char(max_siz) var,
  31.         fl fixed;
  32.     get edit(t) (a);
  33.     fl = att_len(a);
  34.     if length(t) > fl then
  35.         return(false);
  36.     if length(t) > 0 then
  37.         substr(r, att_start(a), fl) = t;
  38.     return(true);
  39.     end att_in;
  40.  
  41. att_out:
  42.     proc(a,r) ext;
  43.     /* write attribute value a from record r */
  44.     dcl
  45.         a fixed,
  46.         r char(max_siz);
  47.     put edit(substr(r,att_start(a),att_len(a)))
  48.         (x(1),a(max_chr));
  49.     end att_out;
  50.  
  51. att_len:
  52.     proc(a) returns(fixed) ext;
  53.     dcl
  54.         a fixed;
  55.     return (att_finish(a) - att_start(a) + 1);
  56.     end att_len;
  57.  
  58. accept:
  59.     proc(r) ext;
  60.     /* read record into r */
  61.     dcl
  62.         r char(max_siz),
  63.         i fixed;
  64.  
  65.     r = '';
  66.     i = 1;
  67.         do while(i <= att_cnt);
  68.         call hdr_out(i);
  69.         if att_in(i,r) then
  70.             i = i + 1;
  71.         else
  72.             call att_err();
  73.         end;
  74.     end accept;
  75.  
  76. att_err:
  77.     proc ext;
  78.     put edit('Item Too Long, Retry','')
  79.         (column(4),a,skip,a);
  80.     end att_err;
  81.  
  82. display:
  83.     proc(r) ext;
  84.     /* write record r */
  85.     dcl
  86.         r char(max_siz),
  87.         i fixed;
  88.  
  89.         do i = 1 to att_cnt;
  90.         call hdr_out(i);
  91.         call att_out(i,r);
  92.         end;
  93.     end display;
  94. end io;
  95.