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 Perl en sa version console.


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

  1. #!/usr/bin/perl
  2.  
  3. use Term::ANSIScreen qw/:color :cursor :screen :keyboard/;
  4. use Term::ReadKey;
  5.  
  6. my @C = ('','=','=','=','=','=','=','=');
  7. my @XD = (0, 9, 25, 41);
  8. my (@A);
  9. my ($I);
  10. my ($T,$F,$N);
  11. my ($K);
  12.  
  13. sub Update() {
  14.  my ($J, $X, $Y, $Z);
  15.  $I = 0;
  16.  for($Y = 15;$Y >= 8; $Y--) {
  17.    $I++;
  18.    for($X = 1; $X <= 3; $X++) {
  19.     $Z = $A[$X][$I];
  20.     if($Z == 0) {
  21.      locate $Y, $XD[$X] - 7;
  22.      print ' ' x 6,'¦',' ' x 6;
  23.     } else {
  24.      for($J = $XD[$X] - $Z; $J < $XD[$X] + $Z; $J++) {
  25.       locate $Y, $J;
  26.       print $C[$Z];
  27.      }
  28.     }
  29.    }
  30.  }
  31. }
  32.  
  33. sub ChkOk($) {
  34.  my($R) = @_;
  35.   $I = $K;
  36.   if($I =~ m/(1|2|3)/) {
  37.    if($R == 1) {
  38.     $F = $I;
  39.    } else {
  40.     $T = $I;
  41.    }
  42.    print $K;
  43.    locate 20, 10;
  44.    print ' ' x 30;
  45.   } else {
  46.    locate 20, 10;
  47.    print 'Répondre 1, 2 ou 3 S.V.P.';
  48.    return 0;
  49.   }
  50.  return 1;
  51. }
  52.  
  53. for(my $J = 0; $J <= 3; $J++) {
  54.    for(my $I = 0; $I <= 8; $I++) {
  55.       $A[$J][$I] = 0;
  56.    }
  57. }
  58. $N = 1;
  59. $A[2][0] = 7;
  60. for($I = 1; $I <= 7; $I++) {
  61.  $A[2][$I] = 8 - $I;
  62. }
  63.  
  64. cls;
  65. locate 1, 13;
  66. print 'Tours d\'Hanois';
  67. locate 16, 1;
  68. color('BLACK ON_GREEN');
  69. print ' 'x 8,'1',' ' x 14,'2',' ' x 14,'3',' ' x 8;
  70. color('WHITE ON_BLACK');
  71.  
  72. do {
  73.   Update();
  74.   locate 18, 1;
  75.   print 'Coup:',$N;
  76.   clline;
  77.   locate 18, 12;
  78.   print 'Votre Jeu - De:';
  79.   do {
  80.    locate 18, 27;
  81.    ReadMode 4;
  82.    $K = &ReadKey();
  83.    ReadMode 0;
  84.    if($K eq 'q') {
  85.      exit();
  86.    }
  87.   } until (ChkOk(1));
  88.   locate 18, 30;
  89.   print ' à:';
  90.   do {
  91.    locate 18, 33;
  92.    ReadMode 4;
  93.    $K = &ReadKey();
  94.    ReadMode 0;
  95.    if($K eq 'q') {
  96.      exit();
  97.    }
  98.   } until (ChkOk(2));
  99.   locate 20, 10;
  100.   my $Ok = 1;
  101.   if($A[$T][0] != 0) {
  102.    unless (($A[$F][0] > 0) && ($A[$F][$A[$F][0]] < $A[$T][$A[$T][0]])) {
  103.     print 'Coup illégal! Recommencez';
  104.     $Ok = 0;
  105.    }
  106.   } else {
  107.    print ' ' x 30;
  108.   }
  109.   if($Ok) {
  110.    $A[$T][0]++;
  111.    $A[$T][$A[$T][0]] = $A[$F][$A[$F][0]];
  112.    $A[$F][$A[$F][0]] = 0; $A[$F][0]--; $N++;
  113.    if(($A[1][0] == 7) || ($A[3][0] == 7)) {
  114.     Update();
  115.     locate 19, 1;
  116.     print 'Félicitations - Il t\'a fallu ',$N-1,' coups';
  117.     exit();
  118.    }
  119.   }
  120. } until 0 != 0;

Dernière mise à jour : Jeudi, le 17 janvier 2019