Accueil de Gladir.com Notes légales de Gladir.com Flux RSS des nouvelles du site Gladir.com - Langage de programmation - Perl - Tours d'Hanois Section du logiciel DOS «MonsterBook» Inventaire de la bibliothèque de Gladir.com Entrée administrateur

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: Mardi, le 3 janvier 2012