Parent: [c017f0] (diff)

Child: [8d1c2d] (diff)

Download this file

FIO2.def    399 lines (331 with data), 23.0 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
DEFINITION MODULE FIO2; (* FileInOut *)
(*------------------------------------------------------------------------*)
(* Fileorientierte Lese- und Schreibprozeduren. *)
(* *)
(* File oriented read and write procedures. *)
(*------------------------------------------------------------------------*)
(* Implementation : Michael Riedl *)
(* Licence : GNU Lesser General Public License (LGPL) *)
(*------------------------------------------------------------------------*)
(* $Id: FIO2.def,v 1.4 2018/03/21 11:05:30 mriedl Exp mriedl $ *)
FROM SYSTEM IMPORT BYTE;
FROM FileSystem IMPORT File;
IMPORT CommonIO;
VAR EOL : BOOLEAN; (* Zeilenende erreicht ja/nein *)
EOF : BOOLEAN;
DiskFull : BOOLEAN;
warn : BOOLEAN;
CONST EoL = CommonIO.EoL; (* Zeichen f"ur Zeilenende. *)
EoF = CommonIO.EoF; (* Zeichen f"ur Dateiende. *)
VAR ExpAnz : CARDINAL; (* *** Obsolet *** *)
(* legt die Anzahl der Ziffern im Exponenten *)
(* fest, bitte die Prozedur "SetExpAnz" nutzen *)
PROCEDURE SetExpAnz(nExp : CARDINAL);
(*----------------------------------------------------------------*)
(* Setzt die Anzahl der Ziffern im Exponenten von Fliesskomma- *)
(* zahlen in Exponentialschreibweise. Der Wert von nExp sollte *)
(* im Bereich [1..4] liegen, Vorgabe ist 2 was fuer die meisten *)
(* Zwecke ausreichend sein sollte. *)
(* Bitte beachten dass dieser Werte fuer TIO und FIO2 *)
(* nicht unabhaengig gewaehlt werden kann da beide Module auf *)
(* dieselben Schreibroutinen in FIO2.mod zurueckgreifen. *)
(* *)
(* Defines the number of digits in the exponent of floating point *)
(* values in sientific or engineering representation. The value *)
(* of nExp shall be in the interval [1..4], default value is 2 *)
(* which should be sufficient for most cases. *)
(* Please note the for TIO and FIO2 the value cannot be choosen *)
(* independently. *)
(*----------------------------------------------------------------*)
PROCEDURE RdWort( Ein : File;
VAR Wort : ARRAY OF CHAR);
(*----------------------------------------------------------------*)
(* Lie\3t solange Zeichen von der Datei Ein, bis eine Zeichen- *)
(* kette beginnt. Ab da wird bis EOL oder dem ersten Trennzeichen *)
(* (' ',CHAR(9)) gelesen. *)
(* Wird dabei HIGH(Wort)-1 "uberschritten, wird die bis dahin *)
(* gelesene Zeichenkette zur"uckgegeben. *)
(* *)
(* Reads charactes from stream "Datei" until a string begins. *)
(* The reads to string "Wort" until the next delimiter *)
(* (' ',ASCII.lf,ASCII.tab). If the string is too long long *)
(* to be placed in "Wort" it will be truncated *)
(*----------------------------------------------------------------*)
PROCEDURE ReadLine(VAR Ein : File; VAR Line : ARRAY OF CHAR);
(*----------------------------------------------------------------*)
(* Einlesen aller Zeichen der aktuellen Zeile aus der Datei Ein *)
(* bis EOL erreicht ist. *)
(* *)
(* Reads all characters in the actual line from stream "Ein" *)
(* until EOL is reached *)
(*----------------------------------------------------------------*)
PROCEDURE WrLn(Datei : File);
(*----------------------------------------------------------------*)
(* Schreibt End-of-Line Marke auf die Textdatei 'Datei'. *)
(* *)
(* Write a newline to stream "Datei" *)
(*----------------------------------------------------------------*)
PROCEDURE WrLnN(Datei : File;
n : CARDINAL); (* Anzahl der Zeilenumbr"uche. *)
(*----------------------------------------------------------------*)
(* Schreibt n End-of-Line Marken auf die Textdatei 'Datei'. *)
(* *)
(* Write "n" times a newline to stream "Datei" *)
(*----------------------------------------------------------------*)
PROCEDURE RdChar( Datei : File;
VAR chr : CHAR);
(*----------------------------------------------------------------*)
(* Liest den CHAR chr von der Textdatei 'Datei'. *)
(* Wenn ein Zeilenumbruch anliegt wird CommonIO.EoL zurueckge- *)
(* geben, wenn das Dateiende erreicht wurde CommonIO.EoF. *)
(* *)
(* Reads character "chr" from file "Datei". In case end of line *)
(* is reached CommonIO.EoL, in case the end of the file is *)
(* reached CommonIO.EoF will be returned. *)
(*----------------------------------------------------------------*)
PROCEDURE WrChar(Datei : File;
chr : CHAR);
(*----------------------------------------------------------------*)
(* Schreibt den CHAR chr auf die Text-Datei Datei. *)
(* Wenn chr = EoL wird dies in cl,lf "ubersetz, wenn in CommonIO *)
(* die Variable CrLf auf TRUE gesetzt ist. *)
(* *)
(* Writes character "chr" to file "Datei" *)
(*----------------------------------------------------------------*)
PROCEDURE WrCharN(VAR Aus : File;
chr : CHAR;
Anzahl : CARDINAL);
(*----------------------------------------------------------------*)
(* Schreibt das Zeichen chr Anzahl mal aus. *)
(* *)
(* Write character "chr" "Anzahl" times to stream "Aus" *)
(*----------------------------------------------------------------*)
PROCEDURE RdStr( Datei : File;
VAR Wort : ARRAY OF CHAR);
(*----------------------------------------------------------------*)
(* Liest den String Wort von der Textdatei 'Datei'. *)
(* *)
(* Reads String "Wort" from file "Datei" *)
(*----------------------------------------------------------------*)
PROCEDURE WrStr(Datei : File;
Wort : ARRAY OF CHAR);
(*----------------------------------------------------------------*)
(* Schreibt den Zeichenkette Wort auf die Text-Datei Datei. *)
(* *)
(* Writes String "Wort" to file "Datei" *)
(*----------------------------------------------------------------*)
PROCEDURE WrStrForm(VAR Aus : File;
Str : ARRAY OF CHAR;
Breite : INTEGER);
(*----------------------------------------------------------------*)
(* Schreibt Str mit der Gesamtbreite Breite aus. Wenn die L"ange *)
(* der Zeichenkette Str kleiner als Breite ist, wird eine ent- *)
(* sprechende Anzahl Leerzeiche vorangestellt (Breite > 0) oder *)
(* angeh"angt (Breite < 0). Ist die L"ange von Str gr"o3er als *)
(* Breite wird Str unver"andert ausgegeben (d.h. es wird dann *)
(* "uber die angeforderte Breite hinaus geschrieben). *)
(* *)
(* Wrties string "Str" to file "Aus" with a minimal width of *)
(* "Breite" characters. If "Breite" > 0 the field will be left *)
(* padded with blanks, if "Breite" < 0 right padding is done. *)
(* If Breite is not sufficient the field will be expanded ! *)
(*----------------------------------------------------------------*)
PROCEDURE RdCard( Datei : File;
VAR c : CARDINAL);
(*----------------------------------------------------------------*)
(* Liest CARDINAL-Zahl c von der Textdatei 'Datei'. *)
(* Im Fehlerfalle wird MAX(CARDINAL) zur"uckgegeben und *)
(* *)
(* Reads cardinal value "c" form "Datei". In case of an error *)
(* MAX(CARDINAL) is returned. *)
(*----------------------------------------------------------------*)
PROCEDURE WrCard(Datei : File;
c : CARDINAL;
n : CARDINAL); (* Feldbreite *)
(*----------------------------------------------------------------*)
(* Schreibt CARDINAL-Zahl c auf die Textdatei 'Datei'. *)
(* Falls die Feldbreite zu klein zur Darstellung der Zahl c ist, *)
(* wird Feldbreite auf die Mindestanzahl von Zeichen erweitert ! *)
(* *)
(* Write value "c" to file "Datei" with a field width of "n". *)
(* If n is choosen too small it will be expanded to the mininal *)
(* value needed to represent c. *)
(*----------------------------------------------------------------*)
PROCEDURE RdHex( Datei : File;
VAR c : CARDINAL);
(*----------------------------------------------------------------*)
(* Liest CARDINAL-Zahl c von der Textdatei 'Datei' in hexa- *)
(* dezimaler Form. Im Fehlerfalle wird MAX(CARDINAL) zur"uck- *)
(* gegeben. *)
(* *)
(* Reads "c" from "Datei" in hexadecimal representation *)
(* In case of an error MAX(CARDINAL) is returend. *)
(*----------------------------------------------------------------*)
PROCEDURE WrHex(Datei : File;
c : CARDINAL;
n : CARDINAL); (* Feldbreite *)
(*----------------------------------------------------------------*)
(* Schreibt CARDINAL-Zahl c auf die Textdatei 'Datei' in hexa- *)
(* dezimaler Form. *)
(* Falls die Feldbreite zu klein zur Darstellung der Zahl c ist, *)
(* wird Feldbreite auf die Mindestanzahl von Zeichen erweitert ! *)
(* *)
(* Writes "c" to "Datei" in hexadecimal representation *)
(*----------------------------------------------------------------*)
PROCEDURE WrBits(Datei : File;
c : CARDINAL;
nbits : CARDINAL); (* Feldbreite *)
(*----------------------------------------------------------------*)
(* Schreibt die ersten nbits BITS der CARDINAL-Zahl c in die *)
(* Textdate "Datei". Das hoechstwertigste Bit wird dabei zuerst *)
(* ausgegeben. Falls die Feldbreite zu klein zur Darstellung der *)
(* Zahl c ist, wird Feldbreite auf die Mindestanzahl von Zeichen *)
(* erweitert ! *)
(* *)
(* Beispiel: c = 13, nbits = 5 , Ausgabe ist "01101" *)
(* *)
(* Writes the first nbits bit of "c" to "Datei". The bit with *)
(* highst value is printed first. If nbits is choosen too small *)
(* the field will be expanded ! *)
(* *)
(* example : c = 13, nbits = 5 , output is "10110" *)
(*----------------------------------------------------------------*)
PROCEDURE RdOct( Datei : File;
VAR c : CARDINAL);
(*----------------------------------------------------------------*)
(* Liest CARDINAL-Zahl c von der Textdatei 'Datei' in okta- *)
(* dezimaler Form. *)
(* Im Fehlerfalle wird MAX(CARDINAL) zur"uckgegeben. *)
(* *)
(* Reads "c" from "Datei" in octal notation form *)
(*----------------------------------------------------------------*)
PROCEDURE WrOct(Datei : File;
c : CARDINAL;
n : CARDINAL); (* Feldbreite *)
(*----------------------------------------------------------------*)
(* Schreibt CARDINAL-Zahl c auf die Textdatei 'Datei' in octa- *)
(* dezimaler Form. *)
(* Falls die Feldbreite zu klein zur Darstellung der Zahl c ist, *)
(* wird Feldbreite auf die Mindestanzahl von Zeichen erweitert ! *)
(* *)
(* Writed "c" to file "Datei" in octal notation form *)
(*----------------------------------------------------------------*)
PROCEDURE RdLngCard( Datei : File;
VAR C : LONGCARD);
(*----------------------------------------------------------------*)
(* Liest LONGCARD-Zahl C von der Textdatei 'Datei'. *)
(* *)
(* Reads value "C" form "Datei". In case of an error *)
(* MAX(CARDINAL) is returned. *)
(*----------------------------------------------------------------*)
PROCEDURE WrLngCard(Datei : File;
C : LONGCARD;
n : CARDINAL); (* Feldbreite *)
(*----------------------------------------------------------------*)
(* Schreibt LONGCARD-Zahl C auf die Textdatei 'Datei'. *)
(* Falls die Feldbreite zu klein zur Darstellung der Zahl C ist, *)
(* wird Feldbreite auf die Mindestanzahl von Zeichen erweitert ! *)
(* *)
(* Write value "C" to file "Datei" with a field width of "n". *)
(* If n is choosen too small it will be expanded to the mininal *)
(* value needed to represent c. *)
(*----------------------------------------------------------------*)
PROCEDURE RdInt( Datei : File;
VAR i : INTEGER);
(*----------------------------------------------------------------*)
(* Liest Integer-Zahl i von der Textdatei 'Datei'. *)
(* *)
(* Reads value "i" form "Datei". In case of an error MAX(INTEGER) *)
(* is returned and Datei.res is set to "notdone" *)
(*----------------------------------------------------------------*)
PROCEDURE WrInt(Datei : File;
i : INTEGER;
n : CARDINAL); (* Feldbreite *)
(*----------------------------------------------------------------*)
(* Schreibt Integer-Zahl i auf die Textdatei 'Datei'. *)
(* *)
(* Writes the value "i" to "Datei" with a field width of "n" *)
(*----------------------------------------------------------------*)
PROCEDURE WrLngInt(Datei : File;
I : LONGINT;
n : CARDINAL); (* Feldbreite *)
(*----------------------------------------------------------------*)
(* Schreibt Integer-Zahl I auf die Textdatei 'Datei'. *)
(* *)
(* Same as WrInt for LONGINT values *)
(*----------------------------------------------------------------*)
PROCEDURE RdLngReal( Datei : File;
VAR x : LONGREAL);
(*----------------------------------------------------------------*)
(* Liest Real-Zahl x von der Textdatei 'Datei'. *)
(* Syntax : Siehe RealConvert.StingToReal. *)
(* *)
(* Reads real value "x" form "Datei". In case of an error *)
(* MAX(LONGREAL) is returned (should be NAN) *)
(* For the syntax of a value x please refer to *)
(* RealConvert.StringToReal *)
(*----------------------------------------------------------------*)
PROCEDURE WrLngReal(Datei : File;
x : LONGREAL;
Breite : CARDINAL; (* Feldbreite *)
Komma : INTEGER); (* Nachkommastellen *)
(*----------------------------------------------------------------*)
(* Schreibt Real-Zahl x auf die Textdatei 'Datei'. *)
(* Wenn (m < 0) ==> EXP-Darstellung. Es werden "Komma" Nachkomma- *)
(* stellen in einem Feld der Gesamtbreite "Breite". Wenn eine *)
(* Darstellung nicht moeglich ist wird das Feld mit "*" gefuellt *)
(* ("ahnlich Fortran) *)
(* *)
(* Write real value "x" to "Datei" with "Komma" decimal digits *)
(* and a field width of "Breite". If Komma < 0 exponential *)
(* representation is used. In case the value is not representable *)
(* the entire field is filled by "*" (similar to Fortran) *)
(*----------------------------------------------------------------*)
PROCEDURE WrReal(Datei : File;
x : REAL;
Breite : CARDINAL; (* Feldbreite *)
Komma : INTEGER); (* Nachkommastellen *)
(*----------------------------------------------------------------*)
(* Schreibt Real-Zahl x auf die Textdatei 'Datei'. *)
(* Wenn (Komma < 0) ==> EXP-Darstellung *)
(* *)
(* Similar to WrLngReal for "REAL" values. *)
(*----------------------------------------------------------------*)
PROCEDURE WrLngCmplx(Datei : File;
x : LONGCOMPLEX;
Breite : CARDINAL; (* Feldbreite *)
Komma : INTEGER); (* Nachkommastellen *)
(*----------------------------------------------------------------*)
(* Schreibt Complex-Zahl x auf die Textdatei 'Datei'. *)
(* Wenn (Komma < 0) ==> EXP-Darstellung. *)
(* Breite, Komma beziehen sich auf Einzelkomponenten von x. *)
(* *)
(* Write a long complex value to Datei. For "Breite" and "Komma" *)
(* see WrLngReal. *)
(*----------------------------------------------------------------*)
PROCEDURE WrBool(Datei : File;
Bool : BOOLEAN);
(*----------------------------------------------------------------*)
(* Schreibt den BOOLEAN - Ausdruck Bool als String (TRUE/FALSE) *)
(* *)
(* Write "TRUE " or "FALSE" debending on the value of "Bool" *)
(*----------------------------------------------------------------*)
PROCEDURE RdBin( Datei : File;
VAR Objekt : ARRAY OF BYTE);
(*----------------------------------------------------------------*)
(* Lie\3t beliebiges Objekt (Real,Integer,Cardinal,Array,Record *)
(* etc.) bin"ar von der Datei "Datei". *)
(* *)
(* Read an abitrary Objekt (Real,Integer,Cardinal,Array,Record *)
(* etc.) in binary form form file "Datei". *)
(*----------------------------------------------------------------*)
PROCEDURE WrBin( Datei : File;
VAR Objekt : ARRAY OF BYTE);
(*----------------------------------------------------------------*)
(* Schreibt beliebiges Objekt (Real,Integer,Cardinal,Array,Record *)
(* etc.) bin"ar auf die Datei "Datei". *)
(* *)
(* Write an abitrary Objekt (Real,Integer,Cardinal,Array,Record *)
(* etc.) in binary form to file "Datei". *)
(*----------------------------------------------------------------*)
END FIO2.