Oakland CPM Archive/oakcpm.iso/sigm/vol133/editfeed.pas

Pascal/Delphi Source File | 1984-04-29 | 4.7 KB | 197 lines

(*********************************************************
*
*        Donated by Ray Penley, June 1980
*
********************************************************)


{*  PROGRAM TITLE:    EDIT A LINEAR FILE
**
**  WRITTEN BY:         W.M. Yarnall
**  DATE WRITTEN:       May 1980
**
**  WRITTEN FOR:    S100 Microsystems
**            May/June 1980
**
**  SUMMARY:
**        See the article in S100....
**
**  MODIFICATION RECORD:
**    25 May 1980    -Modified for Pascal/Z by Raymond E. Penley
**            -All files made local to Procedures.
**             This insures that each file will be closed.
**
**    1 FEB 1983    -CHANGED STRING LENGTH FROM 6 TO 20 IN RINDEX
**            AND CINDEX
**    4 FEB 83    -BREAK INTO MODULES AND REWORK FOR SPECIAL
**            PURPOSE FEEDLOT PROGRAM.  buddenberg
**
**        ---NOTE---
**
** The first logical record in Pascal/Z is No. 1, NOT record
** No. 0 as in PASCAL/M or UCSD PASCAL. This can be rectified
** very eaisly by adding a 'bias' to every record number.
**        PASCAL/Z    bias = 1
**        PASCAL/M    bias = 0
**
*}
PROGRAM EDLINEAR(0);
CONST
  default = 80;       (* Default length for strings *)
  FID_LENGTH = 14; (* MAXIMUM ALLOWED LENGTH FOR A FILE NAME *)
  bias   =  1;       (* see comments above *)

TYPE
  FREC = RECORD
       CASE tag:integer of
        0:  (NAME :STRING 20; N1, N2 :integer);
        1:  (HEADER :STRING 64);
        2:  (RNAME :STRING 20; RINDEX :integer; RHS :real);
        4:  (CNAME :STRING 20; CINDEX :integer; OBJ :real);
        6:  (R,S :integer; T :real);
       99:  () {--end of file--}
     END;

  FID        = STRING FID_LENGTH;
  LINEAR    = FILE OF FREC;
  STR0        = STRING 0;
  STRING80  = STRING default;
  STR255    = STRING 255;

VAR
  OFIL,        (*---File Identifiers <FID>---*)
  NFIL    : FID;
  OBUFFER,       {buffer for OLD file}
  NBUFFER       {buffer for NEW file}
    : FREC;
  editing,       {The state of editing the file}
  valid,       {An answer must be valid to be accepted}
  valid_build,       {All aspects of a "build" have been completed}
  XEOF           {End_Of_File flag for a NON TEXT file}
    : boolean;
  bell,           {console bell}
  Command       {Command answer}
    : char;

PROCEDURE KEYIN(VAR X: char); EXTERNAL;
(* Direct keyboard entry of a single char *)

    (*----Required for Pascal/Z functions----*)
FUNCTION  LENGTH( X :STR255) :INTEGER; EXTERNAL;
PROCEDURE SETLENGTH(VAR X :STR0; Y :INTEGER); EXTERNAL;

Function INREC (j:INTEGER): integer; EXTERNAL;

Function INRE: integer; external;

Procedure PRINT( This_one: FREC; Rcd: INTEGER);
begin
  writeln;
  writeln(' REC', Rcd:4, ' TAG:', This_one.tag:5);
  With This_one do
    CASE TAG of
    0:    begin
        writeln(' NAME: ', name);
        writeln(' No ROWS: ', N1);
        writeln(' No COLS: ', N2)
          end;
    1:    begin
        writeln(' HEADING:');
        writeln(header)
          end;
    2:    begin
        writeln(' ROW: ', RNAME);
        writeln(' INDEX: ', RINDEX);
        writeln(' RHS: ', RHS)
          end;
    4:    begin
        writeln(' COL: ', CNAME);
        writeln(' INDEX: ', CINDEX);
        Writeln(' OBJ: ', OBJ)
          end;
    6:    Writeln(' ABAR[', R:3, ',', S:3, ']: ', T);
    99:    Writeln(' --- End of File ---')
    End{of With/CASE};
  writeln
End{of PRINT};

PROCEDURE GETID( VAR ID: FID; Message: STRING80 );
{-Pascal/Z does not like file names that are
  not space filled to user specified length-}
CONST    SPACE = ' ';
begin
  SETLENGTH(ID,0);
  writeln;
  write(message);
  READLN(ID);
  While Length(ID) < FID_length Do APPEND(ID,SPACE)
end;

Procedure BUILD; EXTERNAL;

Procedure LIST;
LABEL    2 {File not found};
VAR    REC : integer;
    fa  : LINEAR; (*---File descriptor <FCB>---*)
begin
  GETID(OFIL,' List what File? ');
  WRITELN;
  RESET(OFIL, fa);     (*---RESET( <FID> , <FCB> )---*)
  If EOF(fa) then
    begin
    writeln(bell,'File ',OFIL,'not found');
    {exit}goto 2
    end;
  WRITELN;
  WRITE(' Starting at what record? ');
  READLN(REC);
  writeln;
  READ(fa:REC+BIAS, OBUFFER);
  XEOF := (OBUFFER.TAG=99);
  WHILE NOT XEOF do
    begin
      write( REC:5, ': ' );
      With OBUFFER do begin
    Write(TAG:3,' ');
    CASE TAG of
      0:    Writeln(Name:8, N1:7, N2:7);
      1:    Writeln(HEADER);
      2:    Writeln(RNAME:22, RINDEX:7, RHS:14:8);
      4:    Writeln(CNAME:22, CINDEX:7, OBJ:14:8);
      6:    Writeln('ROW', R:3, ' COL', S:3, T:14:8)
      End{of Case}
    End{With};
      REC := REC + 1;
      READ(fa:REC+BIAS,OBUFFER);
      XEOF := (OBUFFER.TAG=99);
    end{while};
2:    {file not found}
End{of LIST};{ CLOSE(fa) }

Procedure MODIFY; external;

BEGIN (*---Main Program---*)
  BELL := CHR(7);
  editing := true;

  WHILE editing do
    begin{ EDIT session }
      REPEAT
    valid := true;
    writeln;
    write(' EDIT: L(ist, B(uild, M(odify, Q(uit ');
    KEYIN(Command);WRITELN(Command);
        CASE Command of
      'L','l':    LIST;
      'B','b':    BUILD;
      'M','m':    MODIFY;
      'Q','q':    editing := false
      ELSE:        begin
             write(BELL);
             valid := false
             end
        End{case}
    UNTIL valid{command}
    end{ EDIT session }
End{---of Edit Linear---}.