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
|
PACKET date handling DEFINES date, time, (* Autor: H. Indenbirken *)
time of day, (* Stand: 02.06.1986 (wk)*)
month, day , year ,
hour ,
minute,
second :
LET middle yearlength = 31557380.0,
weeklength = 604800.0,
daylength = 86400.0,
hours = 3600.0,
minutes = 60.0,
seconds = 1.0;
(* Tage bis zum Jahr 01.01.1900: 693970.25 5.995903e10 Sekunden *)
(* Dieser Tag ist ein Montag *)
REAL VAR begin of today := 0.0 , end of today := 0.0 ;
TEXT VAR today , result ;
ROW 12 REAL CONST previous days :: ROW 12 REAL : (0.0, 2678400.0, 5097600.0,
7776000.0, 10368000.0, 13046400.0,
15638400.0, 18316800.0, 20995200.0,
23587200.0, 26265600.0, 28857600.0);
REAL PROC day: day length END PROC day;
REAL PROC hour: hours END PROC hour;
REAL PROC minute: minutes END PROC minute;
REAL PROC second: seconds END PROC second;
TEXT PROC date :
IF clock (1) < begin of today OR end of today <= clock (1)
THEN begin of today := clock (1) ;
end of today := floor (begin of today/daylength)*daylength+daylength;
today := date (begin of today)
FI ;
today
ENDPROC date ;
TEXT PROC date (REAL CONST datum):
INT VAR year :: int (datum/middle yearlength),
day :: int (((datum - datum MOD daylength) MOD middle yearlength) / daylength) + 1;
correct kalendary day;
calculate month and correct day;
result := daytext;
result CAT monthtext;
result CAT yeartext;
change all (result, " ", "0") ;
result .
correct kalendary day:
IF day >= 60 AND NOT leapyear
THEN day INCR 1 FI .
leapyear:
IF year MOD 100 = 0
THEN year MOD 400 = 0
ELSE year MOD 4 = 0
FI.
calculate month and correct day:
INT VAR month;
IF day > 182
THEN IF day > 274
THEN IF day > 305
THEN IF day > 335
THEN month := 12;
day DECR 335
ELSE month := 11;
day DECR 305
FI
ELSE month := 10;
day DECR 274
FI
ELSE IF day > 213
THEN IF day > 244
THEN month := 9;
day DECR 244
ELSE month := 8;
day DECR 213
FI
ELSE month := 7;
day DECR 182
FI
FI
ELSE IF day > 91
THEN IF day > 121
THEN IF day > 152
THEN month := 6;
day DECR 152
ELSE month := 5;
day DECR 121
FI
ELSE month := 4;
day DECR 91
FI
ELSE IF day > 31
THEN IF day > 60
THEN month := 3;
day DECR 60
ELSE month := 2;
day DECR 31
FI
ELSE month := 1 FI
FI
FI .
daytext :
text (day, 2) + "." .
monthtext :
text (month,2) + "." .
yeartext:
IF 1900 <= year AND year < 2000
THEN text (year - 1900, 2)
ELSE text (year, 4)
FI .
END PROC date;
TEXT PROC day (REAL CONST datum):
SELECT int ((datum MOD weeklength)/daylength) OF
CASE 1: "Donnerstag"
CASE 2: "Freitag"
CASE 3: "Samstag"
CASE 4: "Sonntag"
CASE 5: "Montag"
CASE 6: "Dienstag"
OTHERWISE "Mittwoch" ENDSELECT .
END PROC day;
TEXT PROC month (REAL CONST datum):
SELECT int (subtext (date (datum), 4, 5)) OF
CASE 1: "Januar"
CASE 2: "Februar"
CASE 3: "März"
CASE 4: "April"
CASE 5: "Mai"
CASE 6: "Juni"
CASE 7: "Juli"
CASE 8: "August"
CASE 9: "September"
CASE 10: "Oktober"
CASE 11: "November"
OTHERWISE "Dezember" ENDSELECT .
END PROC month;
TEXT PROC year (REAL CONST datum) :
TEXT VAR buffer := subtext (date (datum), 7) ;
IF LENGTH buffer = 2
THEN "19" + buffer
ELSE buffer
FI .
ENDPROC year ;
TEXT PROC time of day :
time of day (clock (1))
ENDPROC time of day ;
TEXT PROC time of day (REAL CONST value) :
subtext (time (value MOD daylength), 1, 5)
ENDPROC time of day ;
TEXT PROC time (REAL CONST value) :
time (value,10)
ENDPROC time ;
TEXT PROC time (REAL CONST value, INT CONST length) :
result := "" ;
IF length > 7
THEN result CAT hour ;
result CAT ":"
FI ;
result CAT minute ;
result CAT ":" ;
result CAT rest ;
change all (result, " ", "0") ;
result .
hour :
text (int (value/hours), length-8) .
minute :
text (int (value/minutes MOD 60.0), 2) .
rest :
text (value MOD minutes, 4, 1) .
END PROC time ;
REAL PROC date (TEXT CONST datum) :
split and check datum;
real (day no)*daylength +
previous days [month no] + calendary day +
floor (real (year no)*middleyearlength / daylength)*daylength .
split and check datum:
INT CONST day no :: first no;
IF NOT last conversion ok
THEN errorstop ("inkorrekte Datumsangabe (Tag) : " + datum) FI;
INT CONST month no :: second no;
IF NOT last conversion ok OR month no < 1 OR month no > 12
THEN errorstop ("inkorrekte Datumsangabe (Monat) : " + datum) FI;
INT CONST year no :: third no + century;
IF NOT last conversion ok
THEN errorstop ("inkorrekte Datumsangabe (Jahr) : " + datum) FI;
IF day no < 1 OR day no > size of month
THEN errorstop ("inkorrekte Datumsangabe (Tag) : " + datum) FI .
century:
IF (length (datum) - second pos) <= 2
THEN 1900
ELSE 0 FI .
size of month:
SELECT month no OF
CASE 1, 3, 5, 7, 8, 10, 12: 31
CASE 4, 6, 9, 11: 30
OTHERWISE february size ENDSELECT .
february size:
IF leapyear
THEN 29
ELSE 28 FI .
calendary day:
IF month no > 2 AND leapyear
THEN daylength
ELSE 0.0 FI .
leapyear:
year no MOD 4 = 0 AND year no MOD 400 <> 0 .
first no:
INT CONST first pos :: pos (datum, ".");
int (subtext (datum, 1, first pos-1)) .
second no:
INT CONST second pos :: pos (datum, ".", first pos+1);
int (subtext (datum, first pos + 1, second pos-1)) .
third no:
int (subtext (datum, second pos + 1)) .
END PROC date;
REAL PROC time (TEXT CONST time) :
split and check time;
hour + min + sec .
split and check time:
REAL CONST hour :: hour no * hours;
IF NOT last conversion ok
THEN errorstop ("inkorrekte Datumsangabe (Stunde) : " + time) FI;
REAL CONST min :: min no * minutes;
IF NOT last conversion ok
THEN errorstop ("inkorrekte Datumsangabe (Minute) : " + time) FI;
REAL CONST sec :: sec no;
IF NOT last conversion ok
THEN errorstop ("inkorrekte Datumsangabe (Sekunde) : " + time) FI;
set conversion (hour ok AND min ok AND sec ok) .
hour no:
INT CONST hour pos :: pos (time, ":");
real (subtext (time, 1, hour pos-1)) .
min no:
INT VAR min pos :: pos (time, ":", hour pos+1);
IF min pos = 0
THEN real (subtext (time, hour pos + 1, LENGTH time))
ELSE real (subtext (time, hour pos + 1, min pos-1))
FI .
sec no:
IF min pos = 0
THEN 0.0
ELSE real (subtext (time, min pos + 1))
FI .
hour ok: 0.0 <= hour AND hour < daylength .
min ok: 0.0 <= min AND min < hours .
sec ok: 0.0 <= sec AND sec < minutes .
END PROC time;
END PACKET datehandling
|
