PROGRAM GENERATE;
(*
********************************************************
* An attempt to access files under PASCAL/Z. *
* This program will Generate a File of data, *
* read the data back and display the data. *
* *
* 1.0 30 NOV 79, REP *
* 1.1 3 DEC 79, REP *
* 1.2 4 DEC 79, REP *
* Cleaned up some logic concerning Eof() *
* *
* REP (Ray Penley) wrote this back in version 2.O *
* days but I upgraded it to version 3.O. Its still *
* interesting to those of us who need all the in- *
* structional help we can get.(I only modified it *
* enough to get it running, so it possibly has some *
* outdated syntax.) *
* *
* Donated to Pascal/Z users group, Aug 1980 *
********************************************************
*)
CONST
MaxLength = 80;
EOS = '|'; (* End of String marker *)
TYPE
FILETYPE = TEXT;
CPMFILENAME = PACKED ARRAY[1..14] of CHAR;
ErrorSym = (NULL, ERR0, ERR1, ERR2, ERR3);
MININTEGER = -240..240;
strg = record
length : INTEGER;
image : PACKED ARRAY[1..MaxLength] of CHAR;
end;
VAR
F1NAME, (* File name - File A *)
F2NAME : CPMFILENAME; (* File name - File B *)
TextFile : FILETYPE;
INBUFF : STRG;
CH : CHAR;
ErrorCodes : SET of ErrorSym;
error : ErrorSym;
EndofFile, (* End of File flag *)
EndofText, (* End of Text flag *)
complete : BOOLEAN; (* Action flag *)
(**********************************)
FUNCTION G( II : INTEGER ): CHAR;
(* Function to perform some action upon the CHAR *)
begin
G := CHR(II +32)
end;
Procedure PRINT( VAR X : STRG );
(* Print the string X until End of String *)
VAR
CH : CHAR;
pos : MININTEGER;
begin
pos := 0;
REPEAT
pos := pos +1;
CH := X.image[ pos ];
If CH <> EOS then WRITE(CH)
UNTIL (CH = EOS) OR (pos = MaxLength);
If (pos=MaxLength) then error := ERR3;
Writeln
end;
Procedure PUTDATA;
VAR
I, J : MININTEGER;
begin
(*** CREATE FILE ***)
REWRITE( F1NAME, TextFile );
EndofFile := Eof(TextFile);(*** SET Eof FLAG ***)
J := 0;
complete := FALSE;
Writeln('Now writing data to File ', F1NAME);
REPEAT
J := J +1;
WRITE( J:4 );
FOR I := 1 TO 58 DO
begin
CH := G( I ); (*** PROCESS CHAR ***)
WRITE( TextFile, CH )
end;
WRITE( TextFile, EOS ) (* NOW WRITE OUR End of String *)
UNTIL (J = 25);
Writeln;
complete := TRUE
(*** CLOSE FILE ***)
end(* PUTDATA *);
Procedure GetLine( VAR INBUFF : STRG );
(* GLOBAL
INBUFF, EndofFile, MaxLength *)
VAR
CH : CHAR;
I : MININTEGER;
begin
WITH INBUFF DO
begin
FOR I:=1 TO MaxLength DO (* Initialize INbuffer *)
image[ I ]:= EOS;
length := 0;
EndofText := FALSE;
WHILE NOT Eof(TextFile) AND (CH <> EOS) DO
begin
If length < MaxLength then
begin
READ(TextFile, CH );
length := length +1;
image [length] := CH
end(* If *)
ELSE (*** error ***)
begin
error := ERR2;
EndofText := TRUE
end(* else *)
end(* WHILE *);
EndofFile := Eof(TextFile) (*** !!! SET FLAG !!! ***)
end(* with *)
end(* GetLine *);
Procedure GetData;
VAR
I : MININTEGER;
begin
(*** Open File ***)
RESET( F1NAME, TextFile );
I := 0;
complete := TRUE;
EndofFile := Eof(TextFile);(*** GET Eof FLAG ***)
If EndofFile then
begin
error := ERR1;(* FILE NOT FOUND *)
complete := FALSE
end
ELSE
begin Writeln('Now Reading Data from ', F1NAME );
GetLine(INBUFF); (* Attempt to Read a Line *)
WHILE NOT EndofFile DO
begin
I := I +1;
WRITE( I:2, ' ');
PRINT(INBUFF); (*** PROCESS THE CHAR ***)
GetLine(INBUFF); (* Attempt to Read a Line *)
end(* While *)
end(* else *)
(*** Close File ***)
end(* GET DATA *);
Procedure ShowError;
begin
CASE error of
ERR0: Writeln;
ERR1: Writeln('FILE NOT FOUND');
ERR2: Writeln('Exceeded buffer limits on read');
ERR3: Writeln('Exceeded write buffer limits')
end(* CASE *)
end;
begin(*** GENERATE ***)
INITIALIZE;
PUTDATA;
If NOT(error IN ErrorCodes) then
begin
If complete then Writeln(CHR(7), ' ':12, 'Good Write!');
GetData
end(* If *);
Writeln;
If error IN ErrorCodes then ShowError;
If complete then Writeln(CHR(7), ' ':12, 'Excellent Read Back!');
Writeln;Writeln;
Writeln('That''s All!')
end.
