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