Section courante

A propos

Section administrative du site

Parmi les jeux de logique les plus intéressant, figure bien sûre le fabuleux Tours d'Hanois. Ce jeux consiste a déplacer les pneus sur trois bâtons sans jamais les déplacé sur un pneu plus petit. Voici la version pour Free Pascal et son unité «Crt».

A l'aide du code source Pascal suivant pour le Free Pascal, vous trouvez la réponse que vous souhaitez :

  1. Program Hanois;
  2.  
  3. Uses Crt;
  4.  
  5. Procedure Main;
  6. Const
  7.  C:Array[1..7]of Char='=======';
  8.  XD:Array[1..3]of Byte=(9,25,41);
  9. Var
  10.  A:Array[1..3,0..8]of Byte;
  11.  I:Byte;
  12.  T,F,N:Integer;
  13.  K:Word;
  14.  
  15. Procedure Update;
  16. Var
  17.  J,X,Y,Z:Byte;
  18. Begin
  19.  I:=0;
  20.  For Y:=15downto 8do Begin
  21.   Inc(I);
  22.   For X:=1to 3do Begin
  23.    Z:=A[X,I];
  24.    If Z=0Then Begin
  25.     GotoXY(XD[X]-7,Y); Write(' ':7,'¦',' ':7);
  26.    End
  27.     Else
  28.    For J:=XD[X]-Z to XD[X]+Z do Begin
  29.     GotoXY(J,Y);
  30.     Write(C[Z]);
  31.    End;
  32.   End;
  33.  End;
  34. End;
  35.  
  36. Function ChkOk(R:Byte):Boolean;Begin
  37.  ChkOk:=True; I:=Byte(K)-Byte('0');
  38.  If I in [1..3]Then Begin
  39.   If R=1Then F:=I Else T:=I;
  40.   Write(Char(K));
  41.   GotoXY(10,20);
  42.   Write(' ':30);
  43.  End
  44.   Else
  45.  Begin
  46.   GotoXY(10,20);
  47.   Write('Répondre 1, 2 ou 3 S.V.P.');
  48.   ChkOk:=False;
  49.  End;
  50. End;
  51.  
  52. Begin
  53.  FillChar(A,SizeOf(A),0);
  54.  N:=1; A[2,0]:=7; For I:=1to 7do A[2,I]:=8-I;
  55.  TextMode(CO80);
  56.  TextColor(7);
  57.  TextBackground(0);
  58.  ClrScr;
  59.  GotoXY(13,1);
  60.  Write('Tours d''Hanois');
  61.  TextColor(0);
  62.  TextBackground(2);
  63.  GotoXY(1,16);
  64.  WriteLn(' ':8,'1',' ':15,'2',' ':15,'3',' ':8);
  65.  TextBackground(0);
  66.  TextColor(7);
  67.  Repeat
  68.   Update;
  69.   GotoXY(1,18);
  70.   Write('Coup:',N);
  71.   ClrEol;
  72.   GotoXY(12,18);
  73.   Write('Votre Jeu - De:');
  74.   Repeat
  75.    K:=Byte(ReadKey);
  76.    If K=0Then K:=(K shl 8) or Byte(ReadKey);
  77.    If K=27Then Exit;
  78.   Until ChkOk(1);
  79.   GotoXY(30,18);
  80.   Write(' .:');
  81.   Repeat
  82.    K:=Byte(ReadKey);
  83.    If K=0Then K:=(K shl 8) or Byte(ReadKey);
  84.    If K=27Then Exit;
  85.   Until ChkOk(2);
  86.   GotoXY(10,20);
  87.   If A[T,0]<>0Then Begin
  88.    If Not((A[F,0]>0)and(A[F,A[F,0]]<A[T,A[T,0]]))Then Begin
  89.     Write('Coup illégal! Recommencez');
  90.     Continue;
  91.    End;
  92.   End
  93.    Else
  94.   Write(' ':30);
  95.   Inc(A[T,0]); A[T,A[T,0]]:=A[F,A[F,0]];
  96.   A[F,A[F,0]]:=0; Dec(A[F,0]); Inc(N);
  97.   If(A[1,0]=7)or(A[3,0]=7)Then Begin
  98.    Update;
  99.    GotoXY(1,19);
  100.    Write('Félicitations - Il t''a fallu ',N-1,' coups');
  101.    Exit;
  102.   End;
  103.  Until False;
  104. End;
  105.  
  106. BEGIN
  107.  Main;
  108. END.

Dernière mise à jour : Jeudi, le 29 décembre 2011