免费注册 查看新帖 |

Chinaunix

  平台 论坛 博客 文库
最近访问板块 发新帖
查看: 4544 | 回复: 5

[GAME]: 2048 [复制链接]

论坛徽章:
7
戌狗
日期:2013-12-15 20:43:38技术图书徽章
日期:2014-03-05 01:33:12技术图书徽章
日期:2014-03-15 20:31:17未羊
日期:2014-03-25 23:48:20丑牛
日期:2014-04-07 22:37:44巳蛇
日期:2014-04-11 21:58:0915-16赛季CBA联赛之青岛
日期:2016-03-17 20:36:13
发表于 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


game.gif


.

.
  1. #!/usr/bin/perl
  2. use Gtk2 '-init';

  3. ## VAR

  4. my ( $TRUE, $FALSE ) = ( 1, 0 );
  5. my $SP    = $" x 6 . $/;
  6. my @color = qw/Silver YellowGreen DarkKhaki MediumPurple Peru MediumVioletRed
  7.   SteelBlue DarkTurquoise CornflowerBlue Sienna OliveDrab SeaGreen yellow/;

  8. my @value = qw/0 2 4 8 16 32 64 128 256 512 1024 2048 4096/;
  9. my $MKF   = q[<span font_desc="DejaVu Sans Mono 18" foreground=];    # font
  10. my $MKF2  = q[<span font_desc="DejaVu Sans Mono 11"];                # font
  11. my $MKB   = q[ background=];
  12. my $MKT   = q[ size="large"><i><b>];
  13. my $MKT2  = q[ size="large"><b>];
  14. my $MKE   = q[</b></i></span>];
  15. my $MKE2  = q[</b></span>];

  16. my @index = (
  17.     [ [ 0, 1, 2, 3 ],  [ 4, 5, 6, 7 ],  [ 8, 9, 10, 11 ], [ 12, 13, 14, 15 ] ],
  18.     [ [ 0, 4, 8, 12 ], [ 1, 5, 9, 13 ], [ 2, 6, 10, 14 ], [ 3,  7,  11, 15 ] ],
  19.     [ [ 3,  2, 1, 0 ], [ 7,  6, 5, 4 ], [ 11, 10, 9, 8 ], [ 15, 14, 13, 12 ] ],
  20.     [ [ 12, 8, 4, 0 ], [ 13, 9, 5, 1 ], [ 14, 10, 6, 2 ], [ 15, 11, 7,  3 ] ]
  21. );

  22. my ( $I, $I0, $STOP, $SCORE, $GAMEOVER, @ONE, %FACE, @A, @B );
  23. @FACE{@value} = @color;

  24. my %this = map {
  25.     my $len = length;
  26.     my $l1  = int( ( 6 - $len ) / 2 );
  27.     my $l2  = 6 - $l1 - $len;
  28.     my $lab =
  29.       $SP . ( $" x $l2 ) . ( $_ || $" ) . ( $" x $l1 ) . $/ . $SP;
  30.     my $m = $MKF . q['white'] . $MKB . qq["$FACE{$_}"] . $MKT . $lab . $MKE;
  31.     $_, $m;
  32. } @value;

  33. ## SCORE

  34. my $ini  = "$ENV{HOME}/.best_2048_score";
  35. my $BEST = 0;
  36. if ( -e $ini ) {
  37.     @ARGV = $ini;
  38.     $BEST = <>;
  39. }

  40. END {
  41.     open my $FH, '>', $ini or die "$ini:\t$!";
  42.     print $FH $BEST;
  43.     close $FH;
  44. }

  45. ## UI

  46. my $game  = Gtk2::Window->new('toplevel');
  47. my $score = Gtk2::Label->new();
  48. my $quit  = Gtk2::Button->new('Quit');
  49. my $color = Gtk2::Button->new('Color');
  50. my $play  = Gtk2::Button->new('Play');
  51. my $vbox  = Gtk2::VBox->new( $FALSE, 0 );
  52. my $hbox  = Gtk2::HBox->new( $FALSE, 0 );
  53. my $tabl  = Gtk2::Table->new( 4, 4, $TRUE );

  54. $game->set_border_width(10);
  55. $game->set_position('center_always');
  56. $hbox->pack_start( $quit,  $TRUE, $TRUE, 15 );
  57. $hbox->pack_start( $color, $TRUE, $TRUE, 15 );
  58. $hbox->pack_start( $play,  $TRUE, $TRUE, 15 );
  59. $tabl->set_row_spacings(0);
  60. $tabl->set_col_spacings(11);

  61. my ( $gi, @grid ) = 0;
  62. for my $i ( 0 .. 3 ) {
  63.     for my $j ( 0 .. 3 ) {
  64.         $grid[$gi] = Gtk2::Label->new();
  65.         $tabl->attach_defaults( $grid[ $gi++ ], $j, $j + 1, $i, $i + 1 );
  66.     }
  67. }

  68. $vbox->pack_start( $score,                  $FALSE, $FALSE, 4 );
  69. $vbox->pack_start( Gtk2::HSeparator->new(), $FALSE, $FALSE, 4 );
  70. $vbox->pack_start( $tabl,                   $FALSE, $FALSE, 4 );
  71. $vbox->pack_end( $hbox,                   $FALSE, $FALSE, 12 );
  72. $vbox->pack_end( Gtk2::HSeparator->new(), $FALSE, $FALSE, 0 );
  73. $game->add($vbox);

  74. ## SIGNAL

  75. $game->signal_connect( delete_event => sub { Gtk2->main_quit; } );
  76. $game->signal_connect( key_press_event => \&press );
  77. $quit->signal_connect( clicked         => sub { Gtk2->main_quit; } );
  78. $play->signal_connect( clicked         => \&init );
  79. $color->signal_connect( clicked => \&color );

  80. ## INIT

  81. init();
  82. $game->show_all;
  83. Gtk2->main;

  84. ## SUB

  85. sub init {
  86.     ( $SCORE, $GAMEOVER, $I0 ) = ( 0, 0, 7 );
  87.     @A = (0) x 16;
  88.     @B = (1) x 16;
  89.     my $index = 16;
  90.     for ( 1 .. 2 ) {
  91.         my $i = int rand 16;
  92.         redo if $i == $index;
  93.         ( $index, $A[$i] ) = ( $i, 2 );
  94.     }
  95.     paint();
  96. }

  97. sub color {
  98.     @B = (1) x 16;
  99.     my @rgb = (
  100.         [ 0, 0, 1 ],
  101.         [ 0, 0, 2 ],
  102.         [ 0, 1, 0 ],
  103.         [ 0, 1, 1 ],
  104.         [ 0, 1, 2 ],
  105.         [ 0, 2, 0 ],
  106.         [ 0, 2, 1 ],
  107.         [ 0, 2, 2 ],
  108.         [ 1, 0, 0 ],
  109.         [ 1, 0, 1 ],
  110.         [ 1, 0, 2 ],
  111.         [ 1, 1, 0 ],
  112.         [ 1, 1, 1 ],
  113.         [ 1, 1, 2 ],
  114.         [ 1, 2, 0 ],
  115.         [ 1, 2, 1 ],
  116.         [ 1, 2, 2 ],
  117.         [ 2, 0, 0 ],
  118.         [ 2, 0, 1 ],
  119.         [ 2, 0, 2 ],
  120.         [ 2, 1, 0 ],
  121.         [ 2, 1, 1 ],
  122.         [ 2, 1, 2 ],
  123.         [ 2, 2, 0 ],
  124.         [ 2, 2, 1 ],
  125.     );
  126.     my ( @c, %uniq, @new ) = ( 3, 7, 9 );
  127.     for ( 0 .. 11 ) {
  128.         my $i = int rand @rgb;
  129.         redo if exists $uniq{$i};
  130.         $uniq{$i}++;
  131.         my @i = ( $c[ $rgb[$i][0] ], $c[ $rgb[$i][1] ], $c[ $rgb[$i][2] ], );
  132.         my $key = '#' . join '', @i;
  133.         push @new, $key;
  134.     }
  135.     undef %uniq;
  136.     @uniq{@value[1.. $#value]} = @new;
  137.     for ( @value[ 1 .. $#value ] ) {
  138.         $this{$_} =~ s/background="#?\w+"/background="$uniq{$_}"/;
  139.     }
  140.     @A = ( @value[ 1 .. $#value ], (0) x ( @A - @value + 1 ) );
  141.     paint();
  142. }

  143. sub play {
  144.     ( $STOP, @ONE ) = 1;
  145.     for my $i ( @{ $index[$I] } ) {
  146.         my @i = @$i;
  147.         my ( $last, @new ) = 1;
  148.         for my $now ( @A[@i] ) {
  149.             next unless $now;
  150.             $now == $last
  151.               ? do { $SCORE += ( $new[-1] *= 2 ); $last = 1 }
  152.               : push @new, ( $last = $now );
  153.         }
  154.         push @new, (0) x ( 4 - @new );
  155.         if ($STOP) {
  156.             my $i;
  157.             for ( @A[@i] ) {
  158.                 $STOP-- and last if $_ != $new[ $i++ ];
  159.             }
  160.         }
  161.         @A[@i] = @new;
  162.         push @ONE, grep !$A[$_], @i;
  163.     }
  164.     check_alive() if !@ONE;
  165. }

  166. sub check_alive {
  167.     for my $i ( @{ $index[ $I - 1 ] } ) {
  168.         my $n = 1;
  169.         $n == $_ ? return : ( $n = $_ ) for @A[@$i];
  170.     }
  171.     $GAMEOVER = $TRUE;
  172.     my $lose = "$SCORE | GAME OVER";
  173.     $score->set_markup(
  174.         $MKF2 . $MKT2 . qq[best: $BEST | score: $lose] . $MKE2 );
  175. }

  176. sub paint {
  177.     for ( 0 .. 15 ) {
  178.         $grid[$_]->set_markup( $this{ $A[$_] } ) if $A[$_] != $B[$_];
  179.     }
  180.     $BEST = $SCORE if $SCORE > $BEST;
  181.     $score->set_markup( $MKF2 . $MKT2 . qq[[ $BEST ] | score: $SCORE] . $MKE2 );
  182.     @B = @A;
  183. }

  184. sub press {
  185.     return if $GAMEOVER;
  186.     my ( undef, $key ) = @_;
  187.     my $kv = $key->keyval;
  188.     return if $kv > 65364 or $kv < 65361;
  189.     $I = $kv - 65361;
  190.     $STOP && ( $I == $I0 ) ? return : ( $I0 = $I );
  191.     play();
  192.     return if $STOP or !@ONE;
  193.     my $i = $ONE[ rand @ONE ];
  194.     $A[$i] = ( 2, 2, 2, 2, 4 )[ rand 5 ];
  195.     paint();
  196. }

  197. __DATA__
  198. # up: 65362
  199. # dn: 65364
  200. # ri: 65363
  201. # lf: 65361
复制代码

论坛徽章:
42
19周年集字徽章-周
日期:2019-10-14 14:35:31平安夜徽章
日期:2015-12-26 00:06:30数据库技术版块每日发帖之星
日期:2015-12-01 06:20:002015亚冠之首尔
日期:2015-11-04 22:25:43IT运维版块每日发帖之星
日期:2015-08-17 06:20:00寅虎
日期:2014-06-04 16:25:27狮子座
日期:2014-05-12 11:00:00辰龙
日期:2013-12-20 17:07:19射手座
日期:2013-10-24 21:01:23CU十二周年纪念徽章
日期:2013-10-24 15:41:34IT运维版块每日发帖之星
日期:2016-01-27 06:20:0015-16赛季CBA联赛之新疆
日期:2016-06-07 14:10:01
发表于 2014-05-17 21:18 |显示全部楼层
牛。学习了

论坛徽章:
8
技术图书徽章
日期:2013-09-30 08:51:28技术图书徽章
日期:2013-12-11 09:26:39白羊座
日期:2013-12-27 15:27:13金牛座
日期:2014-01-06 09:13:05天蝎座
日期:2014-01-21 14:23:28酉鸡
日期:2014-05-09 16:51:12卯兔
日期:2014-08-11 16:49:1515-16赛季CBA联赛之八一
日期:2017-08-14 23:24:57
发表于 2014-05-19 09:45 |显示全部楼层
{:2_166:}  

论坛徽章:
0
发表于 2014-05-21 10:20 |显示全部楼层
牛人啊   {:2_167:}

论坛徽章:
0
发表于 2014-05-21 10:20 |显示全部楼层
牛人啊   {:2_167:}

论坛徽章:
1
狮子座
日期:2013-12-16 16:09:24
发表于 2014-05-23 00:20 |显示全部楼层
赞一个
您需要登录后才可以回帖 登录 | 注册

本版积分规则 发表回复

  

北京盛拓优讯信息技术有限公司. 版权所有 京ICP备16024965号-6 北京市公安局海淀分局网监中心备案编号:11010802020122 niuxiaotong@pcpop.com 17352615567
未成年举报专区
中国互联网协会会员  联系我们:huangweiwei@itpub.net
感谢所有关心和支持过ChinaUnix的朋友们 转载本站内容请注明原作者名及出处

清除 Cookies - ChinaUnix - Archiver - WAP - TOP