home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol133 / modifyf.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  3.4 KB  |  149 lines
  1. EXTERNAL EDITFILE::MODIFY(2);
  2.  
  3. Function INRE : integer;
  4. {This is the original INREC function; it is used by MODIFY and
  5. has been renamed INRE because a heavily altered INREC is used by
  6. BUILD}
  7. {
  8. GLOBAL
  9.     valid_build : boolean }
  10. LABEL    10;
  11. VAR    Alfa : STRING 20;
  12.     j :integer;
  13.     valid : boolean;
  14. begin
  15.   Write(' Enter TAG .......... ');
  16.   REPEAT
  17.     READLN(j);
  18.     valid := false;
  19.     IF j>99 then
  20.       begin
  21.     j := 200;
  22.     {exit} goto 10
  23.       end;
  24.     If  (j=0) or (j=1) or (j=2) or
  25.     (j=4) or (j=6) or (j=99) then
  26.       begin{If valid}
  27.         valid := true;
  28.     NBUFFER.tag := j ;
  29.     WITH NBUFFER DO
  30.       CASE TAG OF
  31.       0:    begin
  32.         SETLENGTH(NAME,0);
  33.         write(' Program Name........ ');
  34.         READLN(ALFA);
  35.         If Length(ALFA)>20 then SETLENGTH(ALFA,20);
  36.         APPEND(NAME,ALFA);
  37.         write(' No. ROWS............ ');
  38.         READLN(N1);
  39.         write(' No. Columns......... ');
  40.         READLN(N2)
  41.         end;
  42.       1:    begin
  43.         write(' Header.............. ');
  44.         READLN(header)
  45.         end;
  46.       2:    begin
  47.         write(' ROW Name............ ');
  48.         READLN(RNAME);
  49.         write(' ROW No. ............ ');
  50.         READLN(RINDEX);
  51.         write(' RHS ................ ');
  52.         READLN(RHS)
  53.         end;
  54.       4:    begin
  55.         write(' Column Name ........ ');
  56.         READLN(CNAME);
  57.         write(' Column No. ......... ');
  58.         READLN(CINDEX);
  59.         write(' OBJ ................ ');
  60.         READLN(OBJ)
  61.         end;
  62.       6:    begin
  63.         write(' ROW NO. ............ ');
  64.         READLN(R);
  65.         write(' Column No. ......... ');
  66.         READLN(S);
  67.         write(' ABAR[R,S] .......... ');
  68.         READLN(T)
  69.         end;
  70.       99:   valid_build := true
  71.       End{With/CASE}
  72.       end{If valid}
  73.     Else
  74.       Write('INVALID TAG, Reenter ---> ')
  75.   UNTIL valid{TAG};
  76. 10: INRE := j
  77. End{of INRE};
  78.  
  79. Procedure MODIFY;
  80. LABEL    3 {File not found};
  81. VAR    OLDF,        (*---File descriptors <FCB>---*)
  82.     NEWF    : LINEAR;
  83.     REC, j : integer;
  84.     ans : char;
  85. begin
  86.   GETID(OFIL,' Modify what File? ');
  87.   RESET(OFIL, OLDF);     (*---RESET( <FID> , <FCB> )---*)
  88.   If EOF(OLDF) then
  89.     begin
  90.     writeln(bell,'File ',OFIL,'not found');
  91.     {exit}goto 3
  92.     end;
  93.   GETID(NFIL,' Name of New File? ');
  94.   {--------------------------------------------------------
  95.     WITH PASCAL/Z, THE ACT OF OPENING A NEW FILE
  96.     USING THE SAME <FCB> CLOSES THE PREVIOUS FILE
  97.     BEFORE OPENING THE NEW FILE.
  98.    --------------------------------------------------------}
  99.   REWRITE(NFIL,NEWF);     (*---REWRITE( <FID> , <FCB> )---*)
  100.   Write(' Starting at which Record? ');
  101.   READLN(J);
  102.   If J>0 then begin
  103.     {Copy previous records from the old file
  104.      starting at the first record up to but not
  105.      including the requested record.}
  106.       REC := 0;
  107.       REPEAT
  108.     READ(OLDF:REC+BIAS,OBUFFER); XEOF := (OBUFFER.TAG=99);
  109.     WRITE(NEWF, OBUFFER);
  110.     REC := REC + 1;
  111.       UNTIL XEOF OR (REC = J);
  112.     END;
  113.   REC := J;
  114.   READ(OLDF:REC+BIAS,OBUFFER);
  115.   XEOF := (OBUFFER.TAG=99);
  116.   While not XEOF do
  117.     begin
  118.     PRINT(OBUFFER,REC);
  119.     writeln(' Process this Record?');
  120.     REPEAT
  121.       valid := true;
  122.       write(' K(eep, C(hange, I(nsert, D(elete   >');
  123.       KEYIN(ANS);WRITELN(ANS);
  124.       CASE ans of
  125.     'K','k': begin
  126.          write(NEWF,OBUFFER);
  127.          REC := REC + 1
  128.          end;
  129.     'C','c': begin
  130.          If INRE < 100 then write(NEWF, NBUFFER);
  131.          REC := REC + 1
  132.          end;
  133.     'D','d': REC := REC + 1;
  134.     'I','i': If INRE < 100 then write(NEWF,NBUFFER);
  135.     ELSE:    begin
  136.          write(BELL);
  137.          valid := false
  138.          end
  139.       End{case};
  140.     UNTIL VALID{ANSWER};
  141.     READ(OLDF:REC+BIAS,OBUFFER);
  142.     XEOF := (OBUFFER.TAG=99);
  143.     End{while not XEOF};
  144. {---Write the End_Of_File record to the New file---}
  145.   Write(NEWF,OBUFFER);
  146. 3:    {file not found}
  147. End{of MODIFY};
  148.  .
  149.