sw/src/pascal/KNIGHT.PS

   1 PROGRAM KNIGHTSTOUR(OUTPUT);
   2
   3 CONST N = 5; NSQ = 25;
   4
   5 VAR   I,J: INTEGER;
   6       Q: BOOLEAN;
   7       A,B: ARRAY[1..8] OF INTEGER;
   8       H: ARRAY[1..N,1..N] OF INTEGER;
   9
  10 PROCEDURE TRY(I: INTEGER; X,Y: INTEGER; VAR Q: BOOLEAN);
  11    VAR K,U,V: INTEGER; Q1: BOOLEAN;
  12 BEGIN K := 0;
  13    REPEAT K:= K+1; Q1 := FALSE;
  14       U := X + A[K]; V := Y + B[K];
  15       IF (1<=U) AND (U<=N) AND (1<=V) AND (V<=N) THEN
  16         IF H[U,V] = 0 THEN
  17         BEGIN H[U,V] := I;
  18            IF I < NSQ THEN
  19               BEGIN TRY(I+1,U,V,Q1);
  20                 IF NOT Q1 THEN H[U,V] := 0
  21               END ELSE Q1 := TRUE
  22         END
  23    UNTIL Q1 OR (K=8);
  24    Q := Q1
  25 END (* TRY *);
  26
  27 BEGIN
  28    A[1] :=  2; B[1] :=  1;
  29    A[2] :=  1; B[2] :=  2;
  30    A[3] := -1; B[3] :=  2;
  31    A[4] := -2; B[4] :=  1;
  32    A[5] := -2; B[5] := -1;
  33    A[6] := -1; B[6] := -2;
  34    A[7] :=  1; B[7] := -2;
  35    A[8] :=  1; B[8] := -1;
  36
  37    FOR I := 1 TO N DO
  38       FOR J := 1 TO N DO H[I,J] := 0;
  39    H[1,1] := 1; TRY(2,1,1,Q);
  40    IF Q THEN
  41       FOR I := 1 TO N DO
  42       BEGIN FOR J := 1 TO N DO WRITE( H[I,J] :5);
  43          WRITELN
  44       END
  45    ELSE WRITELN("KEINE LOESUNG!")
  46 END.