[Win32::Console]Perl终端版生命游戏
环境，WinXP/Win7Perl 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/\r?\n$//;
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 ...............**......................
页:
[1]