
平台论坛博客文库

› 论坛 › 程序设计 › Perl › [GAME]: 2048

[GAME]: 2048 [复制链接]

rubyish

大富大贵

论坛徽章:: 7

电梯直达

1楼 [收藏(0)] [报告]

发表于 2014-05-17 01:22 |只看该作者 |倒序浏览

本帖最后由 rubyish 于 2014-05-17 03:21 编辑

1: use Gtk2: s/Gtk2/Gtk3/g => is OK
2: font: monosapce font: DejaVu Sans Mono

.

.

#!/usr/bin/perl
use Gtk2 '-init';
## VAR
my ( $TRUE, $FALSE ) = ( 1, 0 );
my $SP = $" x 6 . $/;
my @color = qw/Silver YellowGreen DarkKhaki MediumPurple Peru MediumVioletRed
SteelBlue DarkTurquoise CornflowerBlue Sienna OliveDrab SeaGreen yellow/;
my @value = qw/0 2 4 8 16 32 64 128 256 512 1024 2048 4096/;
my $MKF = q[<span font_desc="DejaVu Sans Mono 18" foreground=]; # font
my $MKF2 = q[<span font_desc="DejaVu Sans Mono 11"]; # font
my $MKB = q[ background=];
my $MKT = q[ size="large">];
my $MKT2 = q[ size="large">];
my $MKE = q[];
my $MKE2 = q[];
my @index = (
[ [ 0, 1, 2, 3 ], [ 4, 5, 6, 7 ], [ 8, 9, 10, 11 ], [ 12, 13, 14, 15 ] ],
[ [ 0, 4, 8, 12 ], [ 1, 5, 9, 13 ], [ 2, 6, 10, 14 ], [ 3, 7, 11, 15 ] ],
[ [ 3, 2, 1, 0 ], [ 7, 6, 5, 4 ], [ 11, 10, 9, 8 ], [ 15, 14, 13, 12 ] ],
[ [ 12, 8, 4, 0 ], [ 13, 9, 5, 1 ], [ 14, 10, 6, 2 ], [ 15, 11, 7, 3 ] ]
);
my ( $I, $I0, $STOP, $SCORE, $GAMEOVER, @ONE, %FACE, @A, @B );
@FACE{@value} = @color;
my %this = map {
my $len = length;
my $l1 = int( ( 6 - $len ) / 2 );
my $l2 = 6 - $l1 - $len;
my $lab =
$SP . ( $" x $l2 ) . ( $_ || $" ) . ( $" x $l1 ) . $/ . $SP;
my $m = $MKF . q['white'] . $MKB . qq["$FACE{$_}"] . $MKT . $lab . $MKE;
$_, $m;
} @value;
## SCORE
my $ini = "$ENV{HOME}/.best_2048_score";
my $BEST = 0;
if ( -e $ini ) {
@ARGV = $ini;
$BEST = <>;
}
END {
open my $FH, '>', $ini or die "$ini:\t$!";
print $FH $BEST;
close $FH;
}
## UI
my $game = Gtk2::Window->new('toplevel');
my $score = Gtk2::Label->new();
my $quit = Gtk2::Button->new('Quit');
my $color = Gtk2::Button->new('Color');
my $play = Gtk2::Button->new('Play');
my $vbox = Gtk2::VBox->new( $FALSE, 0 );
my $hbox = Gtk2::HBox->new( $FALSE, 0 );
my $tabl = Gtk2::Table->new( 4, 4, $TRUE );
$game->set_border_width(10);
$game->set_position('center_always');
$hbox->pack_start( $quit, $TRUE, $TRUE, 15 );
$hbox->pack_start( $color, $TRUE, $TRUE, 15 );
$hbox->pack_start( $play, $TRUE, $TRUE, 15 );
$tabl->set_row_spacings(0);
$tabl->set_col_spacings(11);
my ( $gi, @grid ) = 0;
for my $i ( 0 .. 3 ) {
for my $j ( 0 .. 3 ) {
$grid[$gi] = Gtk2::Label->new();
$tabl->attach_defaults( $grid[ $gi++ ], $j, $j + 1, $i, $i + 1 );
}
}
$vbox->pack_start( $score, $FALSE, $FALSE, 4 );
$vbox->pack_start( Gtk2::HSeparator->new(), $FALSE, $FALSE, 4 );
$vbox->pack_start( $tabl, $FALSE, $FALSE, 4 );
$vbox->pack_end( $hbox, $FALSE, $FALSE, 12 );
$vbox->pack_end( Gtk2::HSeparator->new(), $FALSE, $FALSE, 0 );
$game->add($vbox);
## SIGNAL
$game->signal_connect( delete_event => sub { Gtk2->main_quit; } );
$game->signal_connect( key_press_event => \&press );
$quit->signal_connect( clicked => sub { Gtk2->main_quit; } );
$play->signal_connect( clicked => \&init );
$color->signal_connect( clicked => \&color );
## INIT
init();
$game->show_all;
Gtk2->main;
## SUB
sub init {
( $SCORE, $GAMEOVER, $I0 ) = ( 0, 0, 7 );
@A = (0) x 16;
@B = (1) x 16;
my $index = 16;
for ( 1 .. 2 ) {
my $i = int rand 16;
redo if $i == $index;
( $index, $A[$i] ) = ( $i, 2 );
}
paint();
}
sub color {
@B = (1) x 16;
my @rgb = (
[ 0, 0, 1 ],
[ 0, 0, 2 ],
[ 0, 1, 0 ],
[ 0, 1, 1 ],
[ 0, 1, 2 ],
[ 0, 2, 0 ],
[ 0, 2, 1 ],
[ 0, 2, 2 ],
[ 1, 0, 0 ],
[ 1, 0, 1 ],
[ 1, 0, 2 ],
[ 1, 1, 0 ],
[ 1, 1, 1 ],
[ 1, 1, 2 ],
[ 1, 2, 0 ],
[ 1, 2, 1 ],
[ 1, 2, 2 ],
[ 2, 0, 0 ],
[ 2, 0, 1 ],
[ 2, 0, 2 ],
[ 2, 1, 0 ],
[ 2, 1, 1 ],
[ 2, 1, 2 ],
[ 2, 2, 0 ],
[ 2, 2, 1 ],
);
my ( @c, %uniq, @new ) = ( 3, 7, 9 );
for ( 0 .. 11 ) {
my $i = int rand @rgb;
redo if exists $uniq{$i};
$uniq{$i}++;
my @i = ( $c[ $rgb[$i][0] ], $c[ $rgb[$i][1] ], $c[ $rgb[$i][2] ], );
my $key = '#' . join '', @i;
push @new, $key;
}
undef %uniq;
@uniq{@value[1.. $#value]} = @new;
for ( @value[ 1 .. $#value ] ) {
$this{$_} =~ s/background="#?\w+"/background="$uniq{$_}"/;
}
@A = ( @value[ 1 .. $#value ], (0) x ( @A - @value + 1 ) );
paint();
}
sub play {
( $STOP, @ONE ) = 1;
for my $i ( @{ $index[$I] } ) {
my @i = @$i;
my ( $last, @new ) = 1;
for my $now ( @A[@i] ) {
next unless $now;
$now == $last
? do { $SCORE += ( $new[-1] *= 2 ); $last = 1 }
: push @new, ( $last = $now );
}
push @new, (0) x ( 4 - @new );
if ($STOP) {
my $i;
for ( @A[@i] ) {
$STOP-- and last if $_ != $new[ $i++ ];
}
}
@A[@i] = @new;
push @ONE, grep !$A[$_], @i;
}
check_alive() if !@ONE;
}
sub check_alive {
for my $i ( @{ $index[ $I - 1 ] } ) {
my $n = 1;
$n == $_ ? return : ( $n = $_ ) for @A[@$i];
}
$GAMEOVER = $TRUE;
my $lose = "$SCORE | GAME OVER";
$score->set_markup(
$MKF2 . $MKT2 . qq[best: $BEST | score: $lose] . $MKE2 );
}
sub paint {
for ( 0 .. 15 ) {
$grid[$_]->set_markup( $this{ $A[$_] } ) if $A[$_] != $B[$_];
}
$BEST = $SCORE if $SCORE > $BEST;
$score->set_markup( $MKF2 . $MKT2 . qq[[ $BEST ] | score: $SCORE] . $MKE2 );
@B = @A;
}
sub press {
return if $GAMEOVER;
my ( undef, $key ) = @_;
my $kv = $key->keyval;
return if $kv > 65364 or $kv < 65361;
$I = $kv - 65361;
$STOP && ( $I == $I0 ) ? return : ( $I0 = $I );
play();
return if $STOP or !@ONE;
my $i = $ONE[ rand @ONE ];
$A[$i] = ( 2, 2, 2, 2, 4 )[ rand 5 ];
paint();
}
__DATA__
# up: 65362
# dn: 65364
# ri: 65363
# lf: 65361

复制代码

文库|博客

laputa73

巨富豪门

论坛徽章:: 42

2楼 [报告]

发表于 2014-05-17 21:18 |只看该作者

牛。学习了

实战分享：从技术角度谈机器学习入门| 【大话IT】RadonDB低门槛向MySQL集群下战书 | ChinaUnix打赏功能已上线！ | 新一代分布式关系型数据库RadonDB知多少？

xiumu2280

家境小康

论坛徽章:: 8

3楼 [报告]

发表于 2014-05-19 09:45 |只看该作者

{:2_166:}

wand65

稍有积蓄

论坛徽章:: 0

4楼 [报告]

发表于 2014-05-21 10:20 |只看该作者

牛人啊 {:2_167:}

wand65

稍有积蓄

论坛徽章:: 0

5楼 [报告]

发表于 2014-05-21 10:20 |只看该作者

牛人啊 {:2_167:}

ttcn_cu

富足长乐

论坛徽章:: 1

6楼 [报告]

发表于 2014-05-23 00:20 |只看该作者

赞一个

返回列表

Chinaunix › 论坛 › 程序设计 › Perl › [GAME]: 2048