Mastermind Game

[YuckFoo]

   1: My endless quest for diversions caused me to write this
   2: Mastermind game knockoff. Maybe should be Monkmind?... <p>
   3: 
   4: Search revealed only one implementation, [68803|here], so I thought
   5: I'd offer this alternative. <p>
   6: 
   7: YuckFoo <p>
   8: 
   9: <code>
  10: #!/usr/bin/perl
  11: 
  12:    use strict;
  13: 
  14:    my $DIGITS = 6;
  15: 
  16:    print "\nFind the $DIGITS digit number:\n\n";
  17:    print "* = Right digit, right position.\n";
  18:    print "+ = Right digit, wrong position.\n";
  19: 
  20:    my $code = sprintf("%*.*d", $DIGITS, $DIGITS, int(rand(10**$DIGITS)));
  21: 
  22:    my (@trys, $try, $inp, $i);
  23: 
  24:    while ($try->{guess} ne $code) {
  25: 
  26:       print "\nGuess: ";
  27: 
  28:       chomp($inp = <>);
  29: 
  30:       $try = {};
  31:       push (@trys, $try);
  32:       $try->{guess} = $inp;
  33:       $try->{score} = score($inp, $code);
  34: 
  35:       print "\n";
  36:       for ($i = 0; $i < @trys; $i++) {
  37:          $try = $trys[$i];
  38:          printf (STDOUT "%3d %-*.*s %s\n",
  39:             $i+1, $DIGITS, $DIGITS, $try->{guess}, $try->{score});
  40:       }
  41:    }
  42: 
  43: #-----------------------------------------------------------
  44: sub score {
  45: 
  46:    my ($gues, $code) = @_;
  47: 
  48:    my @codes = split('', $code);
  49:    my @guess = split('', $gues);
  50:    my ($str, $i, %codes, @retry);
  51: 
  52:    # check for number in right position
  53:    for ($i = 0; $i < @codes; $i++) {
  54:       if ($codes[$i] eq $guess[$i]) {
  55:          $str .= '*';
  56:       }
  57:       else {
  58:          $codes{$codes[$i]}++;
  59:          push (@retry, $guess[$i]);
  60:       }
  61:    }
  62: 
  63:    # check for number in wrong position
  64:    for $i (@retry) {
  65:       if ($codes{$i}-- > 0) { $str .= '+'; }
  66:    }
  67: 
  68:    return $str;
  69: }
  70: 
  71: </code>

[webfiend]

Nice, clean, and fun. How about a "quit" command?

# ...
  print "\nGuess (Q to quit): ";

  chomp($inp = <>);
  last if $inp =~ /^[qQ]/;
# ...

Just a thought ...

---

"All you need is ignorance and confidence; then success is sure."-- Mark Twain