ドロー・ポーカーの Perl プログラム

ドロー・ポーカーの Perl プログラム

以下は、Perl によるドロー・ポーカーのプログラムの一例です。


#!/usr/bin/env perl

use strict;
use warnings;
use diagnostics;

#定数
use constant IMAX  => 52;#1 組 52 枚のカード
use constant NDECK => 1; #実際のカジノでは、6 デックを 1 スタックとすることが多い
                         #(ブラックジャックの場合)
use constant M     => 5; #手札の枚数
use constant N     => 5; #交換可能な枚数

#グローバル変数
our (@suits);#カードの印

BEGIN {
}

CHECK {
}

INIT {
}

END {
}

{
  my (@stack); #カードの山
  my (@player);#プレーヤーの手札
  my (@hands); #役の種類

  @suits = (
    'S',#spade
    'H',#heart
    'D',#diamond
    'C' #club
  );

  @hands = (
    'No Pair',
    'One Pair',
    'Two Pair',
    'Three of a Kind',
    'Straight',
    'Flush',
    'Full House',
    'Four of a Kind',
    'Straight Flush',
    'Royal Straight Flush'
  );

  #カードを混ぜる
  &shuffle(\@stack);

  #カードを配る
  for (0 .. M - 1) {
    push(@player, shift(@stack));
  }

  #カードを画面に表示する
  &display(@player);

  #カードを交換する
  &change(\@player, \@stack);

  #カードを画面に表示する
  &display(@player);

  #役を確認する
  printf "%s\n", $hands[&check(@player)];

  exit(0);#正常終了
}

#カードを混ぜる
sub shuffle(\@) {
  my ($stack) = @_;

  if ($] >= 5.008) {#特殊変数 $] は、Perl のバージョンを識別する文字列
    use List::Util;

    @$stack = List::Util::shuffle(0 .. IMAX * NDECK - 1);
  } else {
    my (@flag);#フラグ(0:未使用 1: 使用済)

    #配列を初期化する
    for (0 .. IMAX * NDECK - 1) {
      $flag[$_] = 0;
    }

    #擬似乱数を初期化する
    srand:

    #カードを混ぜる
    for (0 .. IMAX * NDECK - 1) {
      my ($index);#カード番号

      #未使用カードを探す
      while (1) {
        #rand の引数に数値 X を指定→0 以上 X 未満の小数を返す
        #rand の引数を省略         →0 以上 1 未満の小数を返す
        $index = int(rand(IMAX * NDECK));
        last if (!$flag[$index]);
      }

      #カードを設定する
      $$stack[$_] = $index;

      #フラグを使用済にする
      $flag[$index] = 1;
    }
  }
}

#番号をカードに換算する
sub calc($) {
  my ($index) = @_;

  return(int(($index % IMAX) / 13), ($index % IMAX) % 13);
}

#カードを画面に表示する
sub display(@) {
  my (@player) = @_;

  for (0 .. $#player) {
    my ($s, $n);#カードの印と数字

    #番号をカードに換算する
    ($s, $n) = &calc($player[$_]);

    #カードを画面に表示する
    printf "%s%02d", $suits[$s], $n + 1;
    print  " " if ($_ != $#player);
  }
  print "\n";
}

#カードを交換する
sub change(\@\@) {
  my ($player, $stack) = @_;
  my ($nflag);#真の flag の数
  my (@flag); #カードの交換フラグ

  #配列を初期化する
  $nflag = 0;
  for (0 .. $#$player) {
    $flag[$_] = 0;
  }

  #交換するカードを決定する
  while (1) {
    my ($i);#入力文字列

    print "Please select the card(s) you want to change (1 - 5). ";
    print "To finish, input 0.\n";
    chomp($i = <STDIN>);

    if      ($i =~ /^[1-M]$/) {
      if ($flag[$i - 1]) {
        next;
      } else {
        $flag[$i - 1] = 1;
      }

      last if (++$nflag == N);
#    } elsif ($i =~ /^0$/) {
    } elsif ($i eq '0') {#正規表現より処理が早い
      last;
    } else {
      print "Input Error!\n";
    }
  }

  #カードを交換する
  for (0 .. $#$player) {
    $$player[$_] = shift(@$stack) if ($flag[$_]);
  }
}

#役を確認する
sub check(@) {
  my (@player) = @_;
  my ($npair);#ペアの数
  my (@s);    #印毎の枚数
  my (@n);    #数字毎の枚数
  my (%flag); #確認フラグ

  #配列を初期化する
  for (0 .. $#suits) {
    $s[$_] = 0;
  }
  for (0 .. 12) {
    $n[$_] = 0;
  }

  foreach (@player) {
    my ($s0, $n0);#カードの印と数字

    #番号をカードに換算する
    ($s0, $n0) = &calc($_);

    #換算したカードの印と数字の枚数を追加する
    $s[$s0]++;
    $n[$n0]++;
  }

  #フラッシュ系
  $flag{'flush'} = 0;#フラッシュの確認フラグ
  foreach (@s) {
    if ($_ == $#player + 1) {
      $flag{'flush'} = 1;
      last;
    }
  }

  #ストレート系
  for (my $i = 0; $i < 10; $i++) {#ストレートの低位の数字は 1 から 10 まで
    $flag{'straight'} = 1;#ストレートの確認フラグ

    for (my $j = 0; $j <= $#player; $j++) {
      if ($n[($i + $j) % 13] != 1) {#13 は 1 と連なる
        $flag{'straight'} = 0;
        last;
      }
    }

    if ($flag{'straight'}) {
      if ($flag{'flush'}) {
        if ($i == 9) {
          return(9);#ロイヤル・ストレート・フラッシュ
        } else {
          return(8);#ストレート・フラッシュ
        }
      } else {
        return(4);#ストレート
      }
      last;
    }
  }
  return(5) if ($flag{'flush'});#フラッシュ

  #ペア系
  $flag{'three'} = 0;#スリーカードの確認フラグ
  $npair         = 0;
  foreach (@n) {
    if      ($_ == 4) {
      return(7);#フォーカード
    } elsif ($_ == 3) {
      $flag{'three'} = 1;
    } elsif ($_ == 2) {
      $npair++;
    }
  }
  if ($flag{'three'}) {
    if ($npair == 1) {
      return(6);#フルハウス
    } else {
      return(3);#スリーカード
    }
  } else {
    if      ($npair == 2) {
      return(2);#ツーペア
    } elsif ($npair == 1) {
      return(1);#ワンペア
    }
  }
  return(0);#ノーペア
}

__END__

各ルーチンについて、以下に説明します。