our
$VERSION
=
'0.1203'
;
__PACKAGE__->mk_acc_ref([
qw(
_flipped
data
id
rank
suit
_game
)
]);
sub
_card_num_normalize
{
my
$arg
=
shift
;
if
(
ref
(
$arg
) eq
""
)
{
return
+{
map
{
$_
=>
$arg
} (
qw(t non_t)
) };
}
else
{
return
$arg
}
}
my
@card_nums
= (
map
{ _card_num_normalize(
$_
) }
(
"A"
, (2 .. 9),
{
't'
=>
"T"
,
'non_t'
=>
"10"
,
},
,
"J"
,
"Q"
,
"K"
));
my
%ranks_map
= (
map
{
$card_nums
[
$_
]->{t} => (
$_
+1) } (0 ..
$#card_nums
));
my
@suits_map_proto
=
(
[
"H"
=> {
name
=>
"hearts"
,
color
=>
"red"
, },],
[
"C"
=> {
name
=>
"clubs"
,
color
=>
"black"
, },],
[
"D"
=> {
name
=>
"diamonds"
,
color
=>
"red"
, },],
[
"S"
=> {
name
=>
"spades"
,
color
=>
"black"
, },],
);
my
%suits_map
= (
map
{
@$_
}
@suits_map_proto
);
sub
get_suits_seq
{
my
$class
=
shift
;
return
[
map
{
$_
->[0] }
@suits_map_proto
];
}
sub
calc_rank
{
my
(
$self
,
$s
) =
@_
;
return
$ranks_map
{
$s
};
}
sub
calc_rank_with_0
{
my
(
$self
,
$str
) =
@_
;
if
(
$str
eq
"0"
)
{
return
0;
}
else
{
return
$self
->calc_rank(
$str
);
}
}
sub
_from_string
{
my
(
$self
,
$str
) =
@_
;
my
$is_flipped
= 0;
if
(
$str
=~ s{\A<(.*)>\z}{$1}ms)
{
$is_flipped
= 1;
}
if
(
length
(
$str
) != 2)
{
Games::Solitaire::Verify::Exception::Parse::Card->throw(
error
=>
"string length is too long"
,
);
}
my
(
$rank
,
$suit
) =
split
(//,
$str
);
if
(!
defined
(
$self
->rank(
$self
->calc_rank(
$rank
))))
{
Games::Solitaire::Verify::Exception::Parse::Card::UnknownRank->throw(
error
=>
"unknown rank"
,
);
}
if
(
exists
(
$suits_map
{
$suit
}))
{
$self
->suit(
$suit
);
}
else
{
Games::Solitaire::Verify::Exception::Parse::Card::UnknownSuit->throw(
error
=>
"unknown suit"
,
);
}
$self
->set_flipped(
$is_flipped
);
return
;
}
sub
_init
{
my
(
$self
,
$args
) =
@_
;
if
(
exists
(
$args
->{string}))
{
$self
->_from_string(
$args
->{string});
}
if
(
exists
(
$args
->{id}))
{
$self
->id(
$args
->{id});
}
if
(
exists
(
$args
->{data}))
{
$self
->data(
$args
->{data});
}
return
;
}
sub
color
{
my
(
$self
) =
@_
;
return
$self
->color_for_suit(
$self
->suit());
}
sub
color_for_suit
{
my
(
$self
,
$suit
) =
@_
;
return
$suits_map
{
$suit
}->{
'color'
};
}
sub
clone
{
my
$self
=
shift
;
my
$new_card
= Games::Solitaire::Verify::Card->new();
$new_card
->data(
$self
->data());
$new_card
->id(
$self
->id());
$new_card
->suit(
$self
->suit());
$new_card
->rank(
$self
->rank());
return
$new_card
;
}
sub
_to_string_without_flipped
{
my
$self
=
shift
;
return
$self
->rank_to_string(
$self
->rank()) .
$self
->suit();
}
sub
to_string
{
my
$self
=
shift
;
my
$s
=
$self
->_to_string_without_flipped();
return
(
$self
->is_flipped ?
"<$s>"
:
$s
);
}
sub
rank_to_string
{
my
(
$class
,
$rank
) =
@_
;
if
(
$rank
== 0)
{
return
'0'
;
}
else
{
return
$card_nums
[
$rank
-1]->{t};
}
}
sub
is_flipped
{
return
shift
->_flipped();
}
sub
set_flipped
{
my
(
$self
,
$v
) =
@_
;
$self
->_flipped(
$v
);
return
;
}
1;