MODULE Lab;
       (* Mittagspausenf�ller - Vergleichstest in M2 zu Nobbys
          BASIC-Programm  h�h h�h 
          (c) 1992 Juergen Galupki - http://galupki.de
          Lizenz http://galupki.de/kontakt/readme-kontakt-lizenz.html
        *)

FROM Random           IMPORT randomIn;
FROM Intervall        IMPORT Wait;
FROM Display          IMPORT Goto,ClrEOS,SetCursorType;
FROM Keyboard         IMPORT KeyPressed,GetKeyCh;
FROM InOut            IMPORT WriteLine,WriteString,WriteLn;



VAR    FELD    : ARRAY [0..100],[0..100] OF INTEGER;
       ZEILE   : ARRAY [1..256] OF CHAR;
       Ymove,
       Xmove   : ARRAY [1..4] OF INTEGER;
       I,J,
       spalten,
       zeilen,
       x,warten: CARDINAL;
       X,Y,R,Z,
       Ralt,K,
       AR,UR   : INTEGER;
       geloest,
       keinZiel,
       latschen,
       exist   : BOOLEAN;
       ch      : CHAR;

(* $S-, $A-, $T-, $R-, $L- *)
(* ohne Runtime-Checks     *)


PROCEDURE MakeLab; (* eigenes Labyrinth erzeugen falls Datei nicht
                      existiert oder kein Ziel hat *)
 BEGIN
   Goto(0,0); ClrEOS;
   zeilen:= 21; spalten:= 38;
   FOR I:= 2 TO zeilen-1 DO
       IF I MOD 2 = 0
          THEN X:= 1; Z:= X + INTEGER(randomIn(1,5));
               WHILE Z < 37 DO
               FOR J:= CARDINAL(X) TO CARDINAL(Z) DO
                   FELD[I,J]:= 9
               END;
               FELD[I,Z+1]:= 0;
               INC(Z,2); X:= Z;
               Z:= X + INTEGER(randomIn(1,5));
               END
          ELSE FOR J:= 2 TO 37 DO
                   IF randomIn(1,10) < 2
                      THEN FELD[I,J]:= 9
                      ELSE FELD[I,J]:= 0
                   END;
               END;
       END;
   END;
   FELD[2,3]:= 0;
   FELD[3,3]:= 0;
   FELD[3,2]:= 0;
   FELD[ randomIn(2,20), randomIn(2,37) ]:= 5;
   keinZiel:= FALSE;
END MakeLab;

PROCEDURE ReadNewLab;
 VAR  ok     : BOOLEAN;
 BEGIN
   zeilen:= 0; spalten:= 0;
   FOR J:= 1 TO 40 DO
       FOR I:= 1 TO 40 DO
           FELD[I,J]:= 9
       END;
   END;

   MakeLab;

   FOR I:= 1 TO zeilen DO
       Goto(I,1);
       FOR J:= 1 TO spalten DO
           CASE FELD[I,J] OF
                0: WriteString("  "); |
                9: WriteString("��"); |
                5: WriteString("�?")
             ELSE
           END;
       END;
   END;
   Ymove[1]:= -1;  Xmove[1]:=  0;
   Ymove[2]:=  0;  Xmove[2]:=  1;
   Ymove[3]:=  1;  Xmove[3]:=  0;
   Ymove[4]:=  0;  Xmove[4]:= -1;
END ReadNewLab;

PROCEDURE position;
 BEGIN
   Goto(Y,2*X-1);
   IF K = 1
      THEN WriteString("::")
      ELSE WriteString("  ")
   END;
   Y:= Y + Ymove[R];
   X:= X + Xmove[R];
   Goto(Y,2*X-1);
   WriteString("[]");
END position;

PROCEDURE merken;
 BEGIN
   FELD[Y,X]:= R;
   position;
END merken;

PROCEDURE zurueck;
 BEGIN
   FELD[Y,X]:= 8;
   K:= 1; position; K:= 0;
END zurueck;

PROCEDURE Weg;
 VAR test : INTEGER;
 BEGIN
   test:= Ralt * 10 + R;
   CASE test OF
        1,3,11,13,31,33:  WriteString("� ");  |
        2,4,22,24,42,44:  WriteString("��");  |
        32,41:            WriteString("��");  |
        21,34:            WriteString("� ");  |
        14,23:            WriteString("� ");  |
        12,43:            WriteString("��")
        ELSE              WriteString("[]")
   END;
END Weg;

PROCEDURE loesung;
 BEGIN
 Ralt:= 0;
 X := 2; Y := 2; R := FELD[Y,X];
 Goto(Y,2*X-1);
 Weg;
 WHILE (R < 5) AND (R > 0) DO
       Y := Y + Ymove[R];
       X := X + Xmove[R];
       Ralt := R;
       IF (X > 0) AND (Y > 0)
          THEN R := FELD[Y,X];
               Goto(Y,2*X-1);
               Weg
          ELSE R := 5
       END;
 END;
END loesung;

PROCEDURE ausschau;
 BEGIN
   R:= 1;
   WHILE (R < 5) AND (NOT geloest) DO
         IF FELD[Y+Ymove[R],X+Xmove[R]] = 5
            THEN merken;
                 geloest:= TRUE
            ELSE R:= R + 1
         END;
   END;
END ausschau;

PROCEDURE marsch;
 BEGIN
   R:= 1; latschen:= FALSE;
   WHILE (R < 5) AND (NOT latschen) DO
         IF FELD[Y+Ymove[R],X+Xmove[R]] = 0
            THEN merken;
                 latschen:= TRUE
            ELSE R:= R + 1
         END;
   END;
END marsch;

PROCEDURE back;
 BEGIN
   R:= 1;
   WHILE (R < 5) AND (NOT latschen)  DO
         AR:= FELD[Y+Ymove[R],X+Xmove[R]];
         IF AR < 5
            THEN UR:= AR + 2;
                 IF UR > 4
                    THEN UR:= UR - 4
                 END;
                 IF R = UR
                    THEN zurueck;
                         latschen:= TRUE
                    ELSE R:= R + 1
                 END;
            ELSE R:= R + 1
         END;
   END;
   IF NOT latschen
      THEN Goto(0,1);
           WriteString("Es gibt keinen Weg zum Ziel");
           geloest:= TRUE;
           keinZiel:= TRUE;
           Goto(1,1)
   END;
   latschen:= FALSE;
END back;



BEGIN

 SetCursorType(31,31);
 exist:= FALSE;

 LOOP;
 Goto(1,1);
 ReadNewLab;
 Goto(1,1);
 Y:= 2;  X:= 2;
 geloest:= FALSE;
 keinZiel:= FALSE;
 warten:= 5000;
 WHILE NOT geloest DO
       ausschau;
       marsch;
       IF NOT latschen
          THEN back;
       END;
       IF KeyPressed()
          THEN GetKeyCh(ch);
               CASE ch OF
                    "+": IF warten < 60001
                            THEN INC(warten,5000)
                         END |
                    "-": IF warten >= 5000
                            THEN DEC(warten,5000)
                         END |
                    "h","H": EXIT
                    ELSE
               END;
       END;
       FOR x:= 0 TO warten DO
           ;
       END;
 END;
 IF NOT keinZiel
    THEN loesung
 END;

 IF KeyPressed() THEN GetKeyCh(ch); EXIT END;
 Wait(3);

 END;
 Goto(23,0);
 SetCursorType(7,8);

END Lab.