File Coverage

blib/lib/Acme/Mahjong/Rule/CC.pm

Criterion	Covered	Total	%
statement	36	54	66.6
branch	3	10	30.0
condition	0	6	0.0
subroutine	7	8	87.5
pod	4	4	100.0
total	50	82	60.9

package Acme::Mahjong::Rule::CC;

use 5.008008;
use strict;
use warnings;
use Carp;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Acme::Mahjong::Rule::CC ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = (
'all' => [ qw(
	mahjong_table
	dealer
	nondealer
	draw
) ],
'tables' =>[qw(
	dealer
	nondealer
	draw
)] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

our $VERSION = '0.22';


sub mahjong_table{
   my $ans = 7;
   while($ans!=0 && $ans!=1 && $ans!=2){
      print("0.Nondealer , 1.Dealer, or 2.Draw : ");
      $ans=;
      }
   my @subs = (\&nondealer, \&dealer, \&draw);
   my @players = (qw/dealer player2 player3 player4/);
   $players[0]='winner' if ($ans != 2);
   $players[1]='dealer' if ($ans == 0);
   my @points;
   foreach $a(@players){
      print("$a : ");
      my $pts =;
      push @points,$pts;
   }
   print "===========================\n";
   foreach (&{$subs[$ans]}(@points)){
      my $p = shift @players;
      print "$p : $_\n";
   }
}
sub nondealer{
   croak "Wrong number of arguments, needs 4.\n" unless (@_==4);
   my @score;
   my($w, $deal, $l2 , $l3)=@_;
   $score[0]=$w*4;
   $score[1]=4*$deal-(2*$w+2*$l2+2*$l3);
   $score[2]=3*$l2-($w+2*$deal+$l3);
   $score[3]=3*$l3-($w+2*$deal+$l2);
   @score;
}
sub dealer{
   croak "Wrong number of arguments, needs 4.\n" unless (@_==4);
   my @score;
   my($w, $l2 ,$l3 ,$l4)=@_;
   $score[0]=$w*6;
   $score[1]=2*$l2-($w*2+$l3+$l4);
   $score[2]=2*$l3-($w*2+$l2+$l4);
   $score[3]=2*$l4-($w*2+$l3+$l2);
   @score;
}
sub draw{
   croak "Wrong number of arguments, needs 4.\n" unless (@_==4);
   my @score;
   my($l1, $l2 ,$l3 ,$l4)=@_;
   $score[0]=$l1*6-2*($l2+$l3+$l4);
   $score[1]=$l2*4-($l1*2+$l3+$l4);
   $score[2]=$l3*4-($l1*2+$l2+$l4);
   $score[3]=$l4*4-($l1*2+$l3+$l2);
   @score;
}

1;
__END__