X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;ds=sidebyside;f=sw%2Fsrc%2Fpascal%2FKREUZ.PS;fp=sw%2Fsrc%2Fpascal%2FKREUZ.PS;h=191199022615d03e423c0679857c1e59c6a2cdad;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git

diff --git a/sw/src/pascal/KREUZ.PS b/sw/src/pascal/KREUZ.PS
new file mode 100644
index 0000000..1911990
--- /dev/null
+++ b/sw/src/pascal/KREUZ.PS
@@ -0,0 +1,54 @@
+PROGRAM PLOTKREUZKURVE(INPUT,OUTPUT);
+
+  CONST H0=640;
+
+  VAR   N,H,I,R: INTEGER;
+
+  PROCEDURE ANFANG;
+    BEGIN
+        WRITELN("H", H DIV 2 + 100 :1, "@", H + H DIV 2 + 100 :1, "AKI")
+    END (* ANFANG *);
+
+  PROCEDURE STRECKE(R: INTEGER);
+    BEGIN
+        CASE R MOD 4 OF
+          0: WRITELN(H:1,"A@J");
+          1: WRITELN(H:1,"@AJ");
+          2: WRITELN(H:1,"Q@J");
+          3: WRITELN(H:1,"PAJ")
+        END
+    END (* STRECKE *);
+
+  PROCEDURE SCHLUSS;
+    VAR I: INTEGER;
+    BEGIN
+        WRITELN("H3000@100AK");
+        FOR I := 1 TO 384 DO WRITE(" "); WRITELN
+    END (* SCHLUSS *);
+
+
+  PROCEDURE KREUZ(I,R: INTEGER);
+    BEGIN
+        IF I>0 THEN
+            BEGIN
+                KREUZ(I-1,R);
+                  STRECKE(R+1); STRECKE(R);
+                KREUZ(I-1,R+1);
+                  STRECKE(R);
+                KREUZ(I-1,R-1);
+                  STRECKE(R); STRECKE(R-1);
+                KREUZ(I-1,R)
+            END ELSE STRECKE(R)
+    END (* KREUZ *);
+
+
+BEGIN
+    WHILE NOT EOF DO
+    BEGIN READ(N);
+        H := H0; FOR I := 1 TO N DO H := H DIV 2;
+        ANFANG;
+        FOR R := 0 TO 3 DO
+            BEGIN KREUZ(N,R); STRECKE(R+1); STRECKE(R) END;
+        SCHLUSS
+    END
+END.