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 QuickPascal et son unité «Crt».


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

  1. Program Hanois;
  2.  
  3. Uses Crt;
  4.  
  5. Procedure Main;
  6. Label
  7.  Continue;
  8. Const
  9.  C:Array[1..7]of Char='=======';
  10.  XD:Array[1..3]of Byte=(9,25,41);
  11. Var
  12.  A:Array[1..3,0..8]of Byte;
  13.  I:Byte;
  14.  T,F,N:Integer;
  15.  K:Word;
  16.  
  17.  Procedure Update;
  18.  Var
  19.   J,X,Y,Z:Byte;
  20.  Begin
  21.   I:=0; For Y:=15downto 8do Begin
  22.    Inc(I); For X:=1to 3do Begin
  23.     Z:=A[X,I]; If Z=0Then Begin
  24.      GotoXY(XD[X]-7,Y); Write(' ':7,'¦',' ':7);
  25.     End
  26.      Else
  27.     For J:=XD[X]-Z to XD[X]+Z do Begin
  28.      GotoXY(J,Y);
  29.      Write(C[Z]);
  30.     End;
  31.    End;
  32.   End;
  33.  End;
  34.  
  35.  Function ChkOk(R:Byte):Boolean;
  36.  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. Continue:
  69.   Update;
  70.   GotoXY(1,18);
  71.   Write('Coup:',N);
  72.   ClrEol;
  73.   GotoXY(12,18);
  74.   Write('Votre Jeu - De:');
  75.   Repeat
  76.    K:=Byte(ReadKey);
  77.    If K=0Then K:=(K shl 8) or Byte(ReadKey);
  78.    If K=27Then Exit;
  79.   Until ChkOk(1);
  80.   GotoXY(30,18);
  81.   Write(' .:');
  82.   Repeat
  83.    K:=Byte(ReadKey);
  84.    If K=0Then K:=(K shl 8) or Byte(ReadKey);
  85.    If K=27Then Exit;
  86.   Until ChkOk(2);
  87.   GotoXY(10,20);
  88.   If A[T,0]<>0Then Begin
  89.    If Not((A[F,0]>0)and(A[F,A[F,0]]<A[T,A[T,0]]))Then Begin
  90.     Write('Coup illégal! Recommencez');
  91.     Goto Continue;
  92.    End;
  93.   End
  94.    Else
  95.   Write(' ':30);
  96.   Inc(A[T,0]); A[T,A[T,0]]:=A[F,A[F,0]];
  97.   A[F,A[F,0]]:=0; Dec(A[F,0]); Inc(N);
  98.   If(A[1,0]=7)or(A[3,0]=7)Then Begin
  99.    Update;
  100.    GotoXY(1,19);
  101.    Write('Félicitations - Il t''a fallu ',N-1,' coups');
  102.    Exit;
  103.   End;
  104.  Until False;
  105. End;
  106.  
  107. BEGIN
  108.  Main;
  109. END.

Code source

Voici le code source du jeu sur GitHub :

Lien Langage de programmation Projet
https://github.com/gladir/quickpascal_toursdhanois/blob/main/HANOIS.PAS Quick Pascal quickpascal_toursdhanois


Dernière mise à jour : Dimanche, le 4 mai 2014