环境，WinXP/Win7 Perl 5.16
默认循环1000次，按ESC提前退出
1 use strict; 2 use Term::ReadKey; 3 use Win32::Console; 4 use Time::HiRes 'sleep'; 5 use IO::Handle; 6 STDOUT->autoflush(1); 7 system("mode con lines=40 cols=100"); 8 9 our $OUT=Win32::Console->new(STD_OUTPUT_HANDLE); 10 $OUT->Cursor(20, 20, 99, 0); #hide cursor 11 12 my ($i, $j); 13 our ($rows, $cols) = (40, 40); 14 our ($mxrow, $mxcol) = ($rows-1, $cols-1); 15 16 # init 17 our @coord; 18 my (@h, @n); 19 my $y = 0; 20 21 foreach (<DATA>) { 22 s/ ? $//; 23 tr/*./10/; 24 @{$h[$y++]} = ( split("", $_) ); 25 } 26 27 foreach $i (0 .. $mxrow) { 28 foreach $j (0 .. $mxcol) { 29 $coord[$i][$j]{'x'} = $j*2; 30 $coord[$i][$j]{'y'} = $i; 31 $h[$i][$j] = 0 unless (defined $h[$i][$j]); 32 $n[$i][$j] = 0; 33 } 34 } 35 36 &Draw(@n, @h); 37 foreach (0..1000) { 38 sleep 0.05; 39 @n = (); 40 &NextBuffer(@h, @n); 41 &Draw(@h, @n); 42 @h = (@n); 43 44 &KeyFunc(); 45 } 46 47 sub NextBuffer { 48 my ($ra, $rb) = (shift, shift); 49 my ($i, $j, $sum); 50 my ($L, $R, $U, $D); 51 foreach $i (0 .. $mxrow) { 52 $U = ($i-1) < 0 ? $mxrow : ($i-1); 53 $D = ($i+1) > $mxrow ? 0 : ($i+1); 54 foreach $j (0 .. $mxcol) { 55 $L = ($j-1) < 0 ? $mxcol : ($j-1); 56 $R = ($j+1) > $mxcol ? 0 : ($j+1); 57 $sum = $ra->[$U][$L] + $ra->[$U][$j] + $ra->[$U][$R] + 58 $ra->[$i][$L] + 0 + $ra->[$i][$R] + 59 $ra->[$D][$L] + $ra->[$D][$j] + $ra->[$D][$R]; 60 61 if ($sum == 3) { 62 $rb->[$i][$j] = 1; 63 } elsif ($sum == 2) { 64 $rb->[$i][$j] = $ra->[$i][$j]; 65 } else { 66 $rb->[$i][$j] = 0; 67 } 68 } 69 } 70 } 71 72 sub Draw { 73 my ($ra, $rb) = (shift, shift); 74 foreach $i (0 .. $mxrow) { 75 foreach $j (0 .. $mxcol) { 76 if ($rb->[$i][$j] != $ra->[$i][$j]) { 77 &Point( 78 $coord[$i][$j]{'x'}, 79 $coord[$i][$j]{'y'}, 80 $rb->[$i][$j], 81 ); 82 } 83 } 84 } 85 } 86 87 sub Point { 88 my ($mx, $my, $light) = (shift, shift, shift); 89 my $color; 90 if ($light == 1) { 91 $color = $FG_WHITE|$BG_GRAY; 92 } else { 93 $color = $FG_WHITE|$BG_BLACK; 94 } 95 $OUT->Cursor($mx, $my); 96 $OUT->FillAttr($color, 2, $mx, $my); 97 } 98 99 sub KeyFunc { 100 my $key; 101 $key = ReadKey(-1); 102 return if (not defined $key); 103 if ( ord($key) == 27 ) { 104 exit; 105 } 106 } 107 108 109 __DATA__ 110 ......................**............... 111 ......................**............... 112 ....................................... 113 ....................................... 114 ....................................... 115 ....................................... 116 ....................................... 117 ....................................... 118 ....................................... 119 ....................................... 120 ....................................... 121 ....................................... 122 .........*..........**...**............ 123 .......*.*............***.............. 124 ......*.*............*...*............. 125 **...*..*.............*.*.............. 126 **....*.*..............*............... 127 .......*.*......*.*.................... 128 .........*......**..................... 129 .................*...*................. 130 .....................**......*......... 131 ....................*.*......*.*....... 132 ...............*..............*.*....** 133 ..............*.*.............*..*...** 134 .............*...*............*.*...... 135 ..............***............*.*....... 136 ............**...**..........*......... 137 ....................................... 138 ....................................... 139 ....................................... 140 ....................................... 141 ....................................... 142 ....................................... 143 ....................................... 144 ....................................... 145 ....................................... 146 ....................................... 147 ...............**...................... 148 ...............**......................