IMPLEMENTATION MODULE MYINOUT; (*************************************************************************** Environnement : Solaris 2.3 Modula-2. ------------- Programmeurs : Pierre L'Ecuyer, Luc De Bellefeuille, Benoit Martin. ------------ ***************************************************************************) IMPORT FileIO, ETextIO, Terminal; FROM SYSTEM IMPORT UNSIGNED_16, UNSIGNED_32, SIGNED_16, SIGNED_32; FROM ConNum IMPORT StrToSigned_16, StrToSigned_32, StrToUnsigned_16, StrToUnsigned_32, SignedToStr, UnsignedToStr; FROM ConReal IMPORT StrToReal, RealToStr; FROM ConLReal IMPORT StrToLReal, LRealToStr; FROM Strings IMPORT Compare, Concat, Length; FROM FileIO IMPORT FILE, FileMode, OpenMode, FOpen, FClose, FEOF, UngetWord, StdIn, StdOut, StdErr; FROM BasicIO IMPORT EOL1st, Ok, SystemError, UseError, BSChar; FROM ErrorSystem IMPORT Result, SetResult; FROM ETextIO IMPORT FReadCh, FReadLn, FWriteCh, FNL; FROM NUM IMPORT LONGCARD; VAR Input, Output : FILE; X16 : SIGNED_16; X32: SIGNED_32; Xu16 : UNSIGNED_16; Xu32: UNSIGNED_32; EOLine : BOOLEAN; CONST INT = 0; LINT = 1; CARD = 2; LCARD = 3; PROCEDURE CleanString (VAR s : ARRAY OF CHAR); (**********************************************************************) (* Procedure non disponible a l'usager. Purge la chaine s de tout *) (* caractere dont le code ASCII est inferieur a 33 (donc tous les *) (* blancs et tous les caracteres de controle) sauf pour un 'NULL' *) (* final. Ignore tout ce qui suit le premier blanc ou caractere de *) (* controle apres le premier "mot" valide contenu dans s. *) (**********************************************************************) VAR max, first, i,j : CARDINAL; BEGIN max := HIGH(s); first := 0; i := 0; WHILE ( first <= max ) AND ( ( ORD ( s[first] ) ) < 33 ) DO INC (first) END; IF first <= max THEN WHILE ( first <= max ) AND ( ( ORD ( s[first]) ) > 32 ) DO s[i] := s[first]; INC (i); INC (first) END; IF i <= max THEN FOR j:= i TO max DO s[j] := CHR(0) END END ELSE FOR j:= 0 TO max DO s[j] := CHR(0) END END END CleanString; PROCEDURE TestOK (S : ARRAY OF CHAR); (**********************************************************************) (* Procedure non-disponible a l'usager. Sert a afficher les messages *) (* d'erreur appropries selon les circonstances. *) (**********************************************************************) BEGIN IF NOT OK THEN Terminal.WriteLn; Terminal.WriteString (S); Terminal.WriteLn END END TestOK; PROCEDURE ReadNum (Type : CARDINAL); (**********************************************************************) (* Procedure non-disponible a l'usager. Sert a gerer le transfert *) (* des chaines de caracteres en Integer ou Cardinal. Comme le default*) (* est presentement "mapint -> long", on n'utilise que les 32 bits. *) (**********************************************************************) VAR S : ARRAY [0..9] OF CHAR; s16 : SIGNED_16; uns16 : UNSIGNED_16; s32 : SIGNED_32; uns32 : UNSIGNED_32; BEGIN ReadString (S); IF OK THEN IF Type = INT THEN StrToSigned_16 (S, 10, s16, OK); X16 := s16; ELSIF Type = LINT THEN StrToSigned_32 (S, 10, s32, OK); X32 := s32; ELSIF Type = CARD THEN StrToUnsigned_16 (S, 10, uns16, OK); Xu16 := uns16; ELSIF Type = LCARD THEN StrToUnsigned_32 (S, 10, uns32, OK); Xu32 := uns32; ELSE OK := FALSE; TestOK ("*** ERROR : MYINOUT.ReadNum -> Bad Type ! ***"); END; END; END ReadNum; PROCEDURE WriteFormatted (S : ARRAY OF CHAR; n : INTEGER); (**********************************************************************) (* Procedure non-disponible a l'usager. Sert a ecrire en sortie, un *) (* nombre dans un format specifique. *) (**********************************************************************) VAR i : CARDINAL; z : INTEGER; BEGIN z := Length(S); IF z >= n THEN z:= 0; ELSE z := n-z END; FOR i:= 1 TO z DO FWriteCh (Output, ' ') END; WriteString (S); END WriteFormatted; PROCEDURE TReadString(VAR s:ARRAY OF CHAR); (**********************************************************************) (* Procedure non-disponible a l'usager. Fonction similaire a *) (* ReadString, sauf que la lecture se fait directement au terminal. *) (**********************************************************************) VAR i:CARDINAL; Ch:CHAR; BEGIN REPEAT Terminal.Read(Ch) UNTIL (Ch>' ') AND (Ch#177C); i:=0; LOOP IF Ch=BSChar THEN IF i>0 THEN DEC(i); END; ELSIF (i>HIGH(s)) OR (Ch<=" ") OR (Ch=177C) THEN EXIT; ELSE s[i]:=Ch; INC(i); END; Terminal.Read(Ch); END; IF i<=HIGH(s) THEN s[i]:=0C; END; OK := TRUE; END TReadString; (**************************************************************************) PROCEDURE OpenInput (Ext : ARRAY OF CHAR); VAR base : ARRAY [0..31] OF CHAR; full : ARRAY [0..64] OF CHAR; BEGIN Terminal.WriteLn; Terminal.WriteString ("Name of input file (without extension) ? "); TReadString (base); CleanString (base); Concat (base, Ext, full); OpenAsInput ( full ); TestOK ("*** ERROR : MYINOUT.OpenInput failed ! ***") END OpenInput; PROCEDURE OpenOutput (Ext : ARRAY OF CHAR); VAR base : ARRAY [0..31] OF CHAR; full : ARRAY [0..64] OF CHAR; succ : BOOLEAN; BEGIN Terminal.WriteLn; Terminal.WriteString ("Name for output file (without extension) ? "); TReadString (base); CleanString (base); Concat (base, Ext, full); OpenAsOutput ( full ); TestOK ("*** ERROR : MYINOUT.OpenOutput failed ! ***") END OpenOutput; PROCEDURE OpenAsInput (S : ARRAY OF CHAR); BEGIN OK := FALSE; Input := FOpen (S, OpenMode{R}, 2); CASE Result() OF Ok : OK := TRUE; | SystemError : Terminal.WriteLn; Terminal.WriteString ('*** File "'); Terminal.WriteString (S); Terminal.WriteString ('" does not exist! ***'); Terminal.WriteLn; | UseError : Terminal.WriteLn; Terminal.WriteString ('*** Unable to open file "'); Terminal.WriteString (S); Terminal.WriteString ('" ***'); Terminal.WriteLn END; IF NOT OK THEN Terminal.WriteString ("*** ERROR : MYINOUT.OpenAsInput failed ! ***"); Terminal.WriteLn ELSE SetInput (Input) END END OpenAsInput; PROCEDURE OpenAsOutput (S : ARRAY OF CHAR); BEGIN Output := FOpen (S, OpenMode {Create,RW}, 2); OK := (Result() = Ok); IF OK THEN SetOutput (Output) ELSE Terminal.WriteLn; Terminal.WriteString ('*** Unable to open file "'); Terminal.WriteString (S); Terminal.WriteString ('" ***'); Terminal.WriteLn; Terminal.WriteString ("*** ERROR : MYINOUT.OpenAsOutput failed ! ***"); Terminal.WriteLn END END OpenAsOutput; PROCEDURE CloseInput; BEGIN FClose (Input); END CloseInput; PROCEDURE CloseOutput; BEGIN FClose (Output); END CloseOutput; PROCEDURE SetInput (f : FILE); BEGIN Input := f; OK := TRUE END SetInput; PROCEDURE SetOutput (f : FILE); BEGIN Output := f; OK := TRUE END SetOutput; PROCEDURE GetInput (VAR f : FILE); BEGIN f:= Input; OK := TRUE END GetInput; PROCEDURE GetOutput (VAR f : FILE); BEGIN f:= Output; OK := TRUE END GetOutput; PROCEDURE EOL () : BOOLEAN; BEGIN RETURN EOLine END EOL; PROCEDURE EOF () : BOOLEAN; BEGIN RETURN FEOF (Input); END EOF; PROCEDURE Read (VAR C : CHAR); BEGIN EOLine := FALSE; FReadCh (Input, C); IF C=EOL1st THEN UngetWord (Input, EOL1st); EOLine := TRUE; END; END Read; PROCEDURE ReadLn; VAR Ch : CHAR; BEGIN FReadCh (Input,Ch); IF Result() # 0 THEN OK:= FALSE; TestOK ("*** ERROR : MYINOUT.ReadLn failed! ***"); RETURN END; IF (Ch # EOL1st) AND (NOT EOF() ) THEN REPEAT FReadCh (Input,Ch); UNTIL (Ch = EOL1st) OR EOF(); END; OK := TRUE END ReadLn; PROCEDURE ReadLine (VAR S : ARRAY OF CHAR); VAR k : CARDINAL; ch:CHAR; BEGIN EOLine := FALSE; k := 0; FReadCh(Input,ch); IF Result()#0 THEN RETURN; END; WHILE (ch#EOL1st) AND (NOT EOF() ) AND (k<=HIGH(S)) DO IF ch=BSChar THEN IF k>0 THEN DEC(k); END; ELSIF (ch>=" ") OR (ch=11c) THEN S[k]:=ch; INC(k); END; FReadCh(Input,ch); END; IF k <= HIGH(S) THEN S[k]:=0C;END; IF (ch#EOL1st) AND (NOT EOF() ) THEN REPEAT FReadCh(Input,ch); UNTIL (ch=EOL1st) OR EOF(); OK := FALSE; TestOK("*** MYINOUT.ReadLine Out of Range! ***"); END; IF NOT EOF() THEN UngetWord (Input, EOL1st); EOLine := TRUE; END; OK := TRUE END ReadLine; PROCEDURE ReadString (VAR S : ARRAY OF CHAR); VAR i,max, k : CARDINAL; Ch : CHAR; BEGIN OK := FALSE; Read (Ch); WHILE (NOT EOF() ) & ((Ch = 40C) OR (Ch = 11C)) & (NOT EOL() ) DO Read (Ch); END; max := HIGH (S); k:= 0; WHILE (NOT EOF() ) & (Ch#40C) & (Ch # 11C) & (k<=max) & (NOT EOL() ) DO S[k] := Ch; INC (k); Read (Ch); END; IF k <= max THEN S[k] := 0C; IF k > 0 THEN OK := TRUE END; ELSIF (NOT EOF() ) & (Ch # 40C) & (Ch # 11C) & (NOT EOL() ) THEN REPEAT Read (Ch); UNTIL (EOF () ) OR (Ch = 40C) OR (Ch = 11C) OR (EOL() ); SetResult(1); ELSE OK := TRUE END; TestOK ("*** ERROR MYINOUT.ReadString failed! ***"); END ReadString; PROCEDURE ReadBool (VAR B : BOOLEAN); VAR S : ARRAY [0..5] OF CHAR; BEGIN ReadString (S); OK := FALSE; B := FALSE; IF (Compare (S, "TRUE") = 0) OR (Compare (S, "true") = 0) THEN B := TRUE; OK := TRUE END; IF (Compare (S, "FALSE") = 0) OR (Compare (S, "false") = 0) THEN B := FALSE; OK := TRUE END; TestOK ("*** ERROR : MYINOUT.ReadBool failed ! ***") END ReadBool; PROCEDURE ReadInt (VAR x : INTEGER); BEGIN ReadNum (LINT); (* Default : LONGINT *) x := X32; TestOK ("*** ERROR : MYINOUT.ReadInt failed! ***"); END ReadInt; PROCEDURE ReadCard (VAR x : CARDINAL); BEGIN ReadNum (LCARD); (* Default : LONGCARD *) x:= Xu32; TestOK ("*** ERROR : MYINOUT.ReadCard failed ! ***") END ReadCard; PROCEDURE ReadLongInt (VAR x : LONGINT); BEGIN ReadNum (LINT); x:= X32; TestOK ("*** ERROR : MYINOUT.ReadLongInt failed ! ***") END ReadLongInt; PROCEDURE ReadLongCard (VAR x : LONGCARD); BEGIN ReadNum (LCARD); x:= Xu32; TestOK ("*** ERROR : MYINOUT.ReadLongCard failed ! ***") END ReadLongCard; PROCEDURE ReadReal (VAR x : REAL); VAR S : ARRAY [0..20] OF CHAR; BEGIN ReadString (S); IF OK THEN StrToReal (S, x, OK); END; TestOK ("*** ERROR : MYINOUT.ReadReal failed ! ***") END ReadReal; PROCEDURE ReadLongReal (VAR x : LONGREAL); VAR S : ARRAY [0..20] OF CHAR; BEGIN ReadString (S); IF OK THEN StrToLReal (S, x); ?? ^210 END; TestOK ("*** ERROR : MYINOUT.ReadLongReal failed ! ***") END ReadLongReal; PROCEDURE Write (C : CHAR); BEGIN FWriteCh (Output, C); OK := TRUE END Write; PROCEDURE WriteLn; BEGIN FNL (Output); OK := TRUE END WriteLn; PROCEDURE WriteString (S : ARRAY OF CHAR); VAR i : CARDINAL; BEGIN i := 0; WHILE (i <= HIGH (S)) & (S[i] # 0C) DO FWriteCh (Output, S[i]); INC (i); END; OK := TRUE END WriteString; PROCEDURE WriteBool (B : BOOLEAN); BEGIN IF B THEN WriteString (" TRUE ") ELSE WriteString (" FALSE ") END; OK := TRUE END WriteBool; PROCEDURE WriteInt (x : INTEGER; n : CARDINAL); VAR S : ARRAY [0..9] OF CHAR; BEGIN SignedToStr (x, 10, S); WriteFormatted (S, n); OK := TRUE END WriteInt; PROCEDURE WriteCard (x, n : CARDINAL); VAR S : ARRAY [0..9] OF CHAR; BEGIN UnsignedToStr (x, 10, S); WriteFormatted (S, n); OK := TRUE END WriteCard; PROCEDURE WriteLongInt (x : LONGINT; n : CARDINAL); VAR S : ARRAY [0..9] OF CHAR; BEGIN SignedToStr (x, 10, S); WriteFormatted (S, n); OK := TRUE END WriteLongInt; PROCEDURE WriteLongCard (x : LONGCARD; n : CARDINAL); VAR S : ARRAY [0..9] OF CHAR; BEGIN UnsignedToStr (x, 10, S); WriteFormatted (S, n); OK := TRUE END WriteLongCard; PROCEDURE WriteReal (x : REAL; p : CARDINAL; i : INTEGER); VAR S : ARRAY [0..20] OF CHAR; BEGIN RealToStr (x, i, S); WriteFormatted (S, p); OK := TRUE END WriteReal; PROCEDURE WriteLongReal (x : LONGREAL; p : CARDINAL; i : INTEGER); VAR S : ARRAY [0..20] OF CHAR; BEGIN LRealToStr (x, i, S); IF Length(S) > p THEN (* Force the Scientific Format *) LRealToStr (x, -i, S); END; WriteFormatted (S, p); OK := TRUE END WriteLongReal; BEGIN (* MYINOUT *) Input := StdIn; Output := StdOut; END MYINOUT.