A large commit.

[pdp8.git] / sw / src / pascal / DATUM.PS

diff --git a/sw/src/pascal/DATUM.PS b/sw/src/pascal/DATUM.PS
new file mode 100644 (file)
index 0000000..76ad643
--- /dev/null
+++ b/sw/src/pascal/DATUM.PS
@@ -0,0 +1,85 @@
+PROGRAM DATUM(INPUT,OUTPUT);
+
+  VAR   JJ,MM,TT,WT: INTEGER;
+
+
+
+  PROCEDURE LIESDATUM;
+           (*********)
+    VAR   STRICH: CHAR;
+  BEGIN
+      READ(JJ, STRICH, MM, STRICH, TT)
+  END (* LIESDATUM *);
+
+
+
+
+  PROCEDURE WOCHENTAG;
+           (*********)
+    VAR   F,G: INTEGER;
+  BEGIN
+      IF MM>2 THEN BEGIN
+                        F := 1900 + JJ;
+                        G := MM + 1
+                   END
+              ELSE BEGIN
+                        F := 1900 + JJ - 1;
+                        G := MM + 13
+                   END;
+      WT := ( TRUNC(365.25*F) + TRUNC(30.6*G) + TT - 621049 ) MOD 7
+  END (* WOCHENTAG *);
+
+
+
+
+  PROCEDURE DATUMSTEXT;
+           (**********)
+
+    PROCEDURE WRITEWOCHENTAG;
+    BEGIN
+        CASE WT OF
+             0: WRITE("SONNTAG");
+             1: WRITE("MONTAG");
+             2: WRITE("DIENSTAG");
+             3: WRITE("MITTWOCH");
+             4: WRITE("DONNERSTAG");
+             5: WRITE("FREITAG");
+             6: WRITE("SAMSTAG")
+        END
+    END (* WRITEWOCHENTAG *);
+
+    PROCEDURE WRITEMONAT;
+    BEGIN
+        CASE MM OF
+              1: WRITE("JAENNER");
+              2: WRITE("FEBRUAR");
+              3: WRITE("MAERZ");
+              4: WRITE("APRIL");
+              5: WRITE("MAI");
+              6: WRITE("JUNI");
+              7: WRITE("JULI");
+              8: WRITE("AUGUST");
+              9: WRITE("SEPTEMBER");
+             10: WRITE("OKTOBER");
+             11: WRITE("NOVEMBER");
+             12: WRITE("DEZEMBER")
+        END
+    END (* WRITEMONAT *);
+
+
+  BEGIN
+      WRITE("HEUTE IST ");
+      WRITEWOCHENTAG;
+      WRITE(", DER", TT:3, ". ");
+      WRITEMONAT;
+      WRITELN(1900+JJ:5)
+  END (* DATUMSTEXT *);
+
+
+
+
+BEGIN
+    LIESDATUM;
+    WOCHENTAG;
+    DATUMSTEXT
+END.