perl版本俄罗斯方块-含注释

CODE:

#!/usr/bin/perl



# file name block.pl


sub initial_para {
    # constants
    $CONH = 20; # game window's hight
    $CONW = 20; # game window's wigth
    $CONX = 10; # left-top's X
    $CONY = 5;  # left-top's Y
   
    # vars
#    $x_blk;
#    $y_blk;
#    %shape_cur;
#    %shape_tmp;
#    %contents_of;
#    %map_of;
#    %shape_of;
    $score_num = 0; # numble of formed-line
    $score_ = 0;    # scores
   
    # shape of 5 kinds of block
    # accessed by $shape_of{$shp.$x_shp.$y_shp}
    # $shp : kind of block shape
    %shape_of = (
        # $shp.$x_shp.$y_shp
        #
        111,0,121,1,131,0,141,0,
        112,0,122,1,132,0,142,0,
        113,0,123,1,133,0,143,0,
        114,0,124,1,134,0,144,0,
        #                  
        211,0,221,0,231,0,241,0,
        212,0,222,1,232,1,242,0,
        213,0,223,1,233,1,243,0,
        214,0,224,0,234,0,244,0,
        #                  
        311,0,321,1,331,0,341,0,
        312,0,322,1,332,1,342,0,
        313,0,323,0,333,1,343,0,
        314,0,324,0,334,0,344,0,
        #                  
        411,0,421,1,431,0,441,0,
        412,0,422,1,432,1,442,0,
        413,0,423,1,433,0,443,0,
        414,0,424,0,434,0,444,0,
        #                  
        511,0,521,1,531,0,541,0,
        512,0,522,1,532,0,542,0,
        513,0,523,1,533,1,543,0,
        514,0,524,0,534,0,544,0
    );     
   
    # %contents_of hold the information of the total window
    for my $y_con (1..$CONH) {
        for my $x_con (1..$CONW) {
            $contents_of{$x_con."a".$y_con} = ( ($y_con >=  $CONH-1)
                                                 or ($x_con >=  $CONW-1)
                                                 or ($x_con <=  2) ) ?
                                                 1:0;
        }  
    }      
           
           
}         

# right-ratate current block
# inputs  : %shape_cur %contents_of
# outputs : %shape_cur %contents_of
sub rght_rot {
    for $y_shp (1..4) {
        for $x_shp (1..4) {
            $shape_tmp{$x_shp.$y_shp} = $shape_cur{(5-$y_shp).$x_shp};
        }  
    }      
           
    if ( !(&covered) ) { %shape_cur = %shape_tmp; }
   
    &gen_map;
   
   
}

# this sub's function : %shape_cur + %contents_of = %map_of
# %shape_cur hold current block's shape
# %contents_of hold current background's shape
# %map_of hold the shape to be print
sub gen_map {
   
    %map_of = %contents_of;
   
    for my $y_shp (1..4) {
        for my $x_shp (1..4) {
            $map_of{ ($x_shp+$x_blk)."a".($y_shp+$y_blk) } += $shape_cur{$x_shp.$y_shp};
        }
    }
   
}

# left-ratate current block
sub left_rot {
    for $y_shp (1..4) {
        for $x_shp (1..4) {
            $shape_tmp{$x_shp.$y_shp} = $shape_cur{$y_shp.(5-$x_shp)};
        }  
    }      
           
    if ( !(&covered) ) { %shape_cur = %shape_tmp; }
   
    &gen_map;
}

# flip the block, only used in &gen_block
sub flip_blk {
    for $y_shp (1..4) {
        for $x_shp (1..4) {
            $shape_tmp{$x_shp.$y_shp} = $shape_cur{$x_shp.(5-$y_shp)};
        }  
    }      
           
    if ( !(&covered) ) { %shape_cur = %shape_tmp; }
   
    &gen_map;
}

# move current block down
sub mv_down {
    %shape_tmp = %shape_cur;
    $y_blk++;
    if ( &covered ) { $y_blk--; }
   
    &gen_map;
}

# move current block left
sub mv_left {
    %shape_tmp = %shape_cur;
    $x_blk--;
    if ( &covered ) { $x_blk++; }
   
    &gen_map;
}

# move current block right
sub mv_rght {
    %shape_tmp = %shape_cur;
    $x_blk++;
    if ( &covered ) { $x_blk--; }
   
    &gen_map;
}

# move current block to ground
sub mv_bttm {
    while (!&reach_bottom) {
        &mv_down;
    }
}

# dose current block reach the bottom
sub reach_bottom {
    my $reach_bottom = 0;

    for my $y_shp (1..4) {
        for my $x_shp (1..4) {
            if ( ($shape_cur{$x_shp.$y_shp} ne 0)
                  and ($contents_of{ ($x_shp+$x_blk)."a".($y_shp+$y_blk+1) } ne 0) ) {
                    $reach_bottom = 1;
            }
        }
    }
   
    return $reach_bottom;
}

# to judge : dose %shape_tmp cover other exist blocks
sub covered {
    my $covered = 0;
   
    for my $y_shp (1..4) {
        for my $x_shp (1..4) {
            if ( ($shape_tmp{$x_shp.$y_shp} ne 0)
                  and ($contents_of{ ($x_shp+$x_blk)."a".($y_shp+$y_blk) } ne 0)) {
                    $covered = 1;
            }
        }
    }

    return $covered;
}

# to judge : are there some formed lines
# inputs  : %contents_of
# outputs : @formed_lines - to hold the Y of the formed lines
sub form_lines {
    my $form_lines = 0;
    my @my_formed_lines;
   
    my $formed_cur_line;
    for my $y_con (1..($CONH-2)) {
        $formed_cur_line = 1;
        for my $x_con (3..($CONW-2)) {
            if ( $contents_of{$x_con."a".$y_con} eq 0 ) { $formed_cur_line = 0; }
        }
        if ($formed_cur_line == 1) { $form_lines = 1; push @my_formed_lines,$y_con; }
    }
   
    @formed_lines = @my_formed_lines;
    return $form_lines;
}

# to generate a new block(hold in %shape_cur) based on %shape_of
# outputs : $x_blk $y_blk %shape_of{$shp.$x_shp.$y_shp} %map_of
sub gen_block {
   
    $x_blk = int($CONW/2)-2;
    $y_blk = 0;
    my $c_blk = int(1 + (rand 5));
    $shp = int(1 + (rand 5));
    for my $y_shp (1..4) {
        for my $x_shp (1..4) {
            $shape_cur{$x_shp.$y_shp} = $c_blk * $shape_of{$shp.$x_shp.$y_shp};
        }
    }
   
    for (0..(int(rand 4))) { &rght_rot; }
    for (0..(int(rand 4))) { &flip_blk; }
   
    &gen_map;
   
}

# merge current block to background after "&reach_bottom"
# inputs  : %contents_of %shape_cur
# outputs : %contents_of = %contents_of + %shape_cur
sub merge_to_contents {
    for my $y_shp (1..4) {
        for my $x_shp (1..4) {
            $contents_of{ ($x_shp+$x_blk)."a".($y_shp+$y_blk) } += $shape_cur{$x_shp.$y_shp};
        }
    }
}

# display the motivation of disappealing of formed lines
# and generate the new background(%content_of) by  %content_of = %content_of - formed_lines
# and calculate scores
sub flash_and_mv_lines {
   
    # flash formed lines
    my %formed_map_of;
    %formed_map_of = %contents_of;
    for my $y_con (@formed_lines) {
        for my $x_con (3..$CONW-2) {
            $formed_map_of{$x_con."a".$y_con} = 0;
        }
    }
    for (0..4) {
        %map_of = ($_%2) ? %formed_map_of : %contents_of;
        &plot_map;
        select(undef,undef,undef,0.05);
    }
   
    # move formed lines
    for my $formed_line (@formed_lines) {
        for my $y_con (reverse (1..$formed_line)) {
            for my $x_con (3..$CONW-2) {
                $contents_of{$x_con."a".$y_con} = ($y_con eq 1) ? 0
                                : $contents_of{$x_con."a".($y_con-1)};
            }
        }
    }
   
    # calculate score
    $score_num += ($#formed_lines+1);
    $score_    += ($#formed_lines+1)**2;
}

# inputs  : %map_of
# outputs : pic
sub plot_map {
    for $y_con (1..$CONH-1) {
        for $x_con (2..$CONW-1) {
            
            # location
            print "\e[";
            print $y_con+$CONY;
            print ";";
            print $x_con*2+$CONX;
            print "H";
            
            # color
            print "\e[";
            print 48-$map_of{$x_con."a".$y_con};
            print "m";
            
            # two space indicate a dot
            #print $map_of{$x_con."a".$y_con}," ";
            print "  ";
            
            # recover the color
            print "\e[";
            print 0;
            print "m";
            
        }
    }
   
    #print scores and some help information
    for (1..12) {
        
        # location
        print "\e[";
        print $CONY+$CONH-$_;
        print ";";
        print $CONW*2+$CONX+2;
        print "H";
        
        # items to be printed
        my $ii = 1;
        ($_ eq $ii++) && print "score : $score_";
        ($_ eq $ii++) && print "num   : $score_num";
        $ii++;
        ($_ eq $ii++) && print "exit  : q";
        ($_ eq $ii++) && print "new   : n";
        ($_ eq $ii++) && print "hide  : space";
        $ii++;
        ($_ eq $ii++) && print "down  : w";
        ($_ eq $ii++) && print "bottom: s";
        ($_ eq $ii++) && print "right : d";
        ($_ eq $ii++) && print "left  : a";
        ($_ eq $ii++) && print "roll  : j k";
    }
   
    print "\n";
}


sub main {
   
    # to hide the cursor
    print "\e[?25l";

    # "b" is a shell program used to catch pressing-key
    # because i cant install ReadKey packedge in my system
    open(KEYGEN, "./b |")  or die "Couldn't fork: $!\n";
   
    &initial_para; # initial some paraments
    &gen_block;    # generate the first block
    &plot_map;     #

    # the cycle will be executed when any key is pressed
    while (<KEYGEN>) {
        
        if ($_ eq "w\n") { &mv_down; }
        if ($_ eq "a\n") { &mv_left; }
        if ($_ eq "d\n") { &mv_rght; }
        if ($_ eq "s\n") { &mv_bttm; }
        if ($_ eq "k\n") { &rght_rot; }
        if ($_ eq "j\n") { &left_rot; }
        
        # exit
        if ($_ eq "q\n") { system "clear"; print "\e[?25h"; last; }
        
        # new game
        if ($_ eq "n\n") { &initial_para; &gen_block; }
        
        &plot_map;
        
        # when the bock reach the bottom
        if (&reach_bottom) {
            &merge_to_contents; # merge current block to the background
            if (&form_lines) { flash_and_mv_lines; }
            &gen_block;
            &plot_map;
        }
        
        # press " " or <Enter> to hide the game,and cat this file,
        # you boss will find you are working with the code, ^_^!
        # just like a "BOSS function"
        if ($_ eq "\n") { system "clear"; system "cat $0"; }
        
    }
}

   
# test--------

    &main;

# test--------

QUOTE:

原帖由 Nosferatu 于 2007-12-14 23:38 发表
&subname属于perl5之前比较古老的函数调用方式了，
不像是最近写的程序阿??

QUOTE:

原帖由 crazidog 于 2007-12-16 17:12 发表
偶也回去但了书,好像是说如果SUB的实现写在后面,调用应该使用&

好像在哪个关于代码风格的书上看过,,调用子函数的时候,最好要带上&

应该可以增加可读性